[project @ 1996-07-25 21:02:03 by partain]
[nofib.git] / parallel / coins / coins.hs
1 -- Time-stamp: <Sat Jul 20 1996 21:47:15 Stardate: [-31]7839.33 hwloidl>
2 --
3 -- Compute all ways in which a certain amount of money can be paid by using
4 -- a fixed set of coins. In a NUM setup only the number of such possibilities
5 -- is computed. Use a GRAN setup for compilation under GranSim (i.e. compile
6 -- time option -DGRAN), a GUM setup to get a real parallel program.
7 -- This is a pre-strategy version using forcing functions from the module
8 -- ParForce.hs
9 -----------------------------------------------------------------------------
10
11 #if defined(GUM) || defined(GRAN)
12
13 module Main(mainPrimIO) where
14
15 import PreludeGlaST
16
17 #else
18
19 module Main(main) where
20
21 #endif
22
23 -- import Random (randomInts) -- Just for testing
24
25 -- ToDo: Move this into the ParForce module to hide GUM/GrAnSim specifics
26 #if defined(GUM)
27 -- Ignore name and priority fields in GUM
28 parGlobal :: Int -> Int -> Int -> Int -> a -> b -> b
29 parGlobal _ _ _ _ = par
30
31 -- Copied from ParForce
32 seq :: a -> b -> b
33 seq = _seq_
34
35 par :: a -> b -> b
36 par = _par_
37
38 par_map :: Int -> (a -> b) -> [a] -> [b]
39 par_map p f [] = []
40 par_map p f (x:xs) = parGlobal p p 1 0 fx
41 ( parGlobal p p 1 0 (forcelist pmxs)
42 (fx:pmxs) )
43 where fx = f x
44 pmxs = par_map p f xs
45
46 forcelist [] = ()
47 forcelist (x:xs) = seq x (forcelist xs)
48 #elif defined(GRAN)
49 import ParForce
50 #else /* HBCPP */
51 import ParForce
52 #endif
53
54 -- import PreludeMonadicIO
55 -- import PreludeIOError
56 -- import LibTime
57
58 -- import Util -- quicksort is in there (part of libghc)
59
60
61 #if defined(MAX_PAR)
62
63 pay_num :: Int -> Int -> [Int] -> Int
64 pay_num _ 0 coins = 1 -- [accum]
65 pay_num _ val [] = 0
66 pay_num pri val coins =
67 parGlobal 5 5 1 0 coins' (
68 parGlobal 4 4 1 0 coins'' (
69 res
70 ))
71 where coins' = dropWhile (>val) coins
72 coins'' = nub coins'
73 res = sum ( par_map pri
74 ( \ c -> let
75 xs = dropWhile (>c) coins'
76 new_coins = xs\\[c]
77 in
78 parGlobal 2 2 1 0 xs (
79 parGlobal 3 3 1 0 new_coins (
80 pay_num (pri-1)
81 (val-c)
82 new_coins
83 ) )
84 )
85 coins'' )
86
87 pay :: Int -> Int -> [Int] -> [Int] -> [[Int]]
88 pay pri 0 coins accum = [accum]
89 pay pri val [] _ = []
90 pay pri val coins accum =
91 parGlobal 5 5 1 0 coins' (
92 parGlobal 4 4 1 0 coins'' (
93 res
94 ))
95 where coins' = dropWhile (>val) coins
96 coins'' = nub coins'
97 res = concat ( par_map pri
98 ( \ c -> let
99 new_coins =
100 ((dropWhile (>c) coins')\\[c])
101 in
102 parGlobal 3 3 1 0 new_coins (
103 pay (pri-1)
104 (val-c)
105 new_coins
106 (c:accum)
107 )
108 )
109 coins'' )
110 #else
111 pay_num :: Int -> Int -> [Int] -> Int
112 pay_num _ 0 coins = 1 -- [accum]
113 pay_num _ val [] = 0
114 pay_num pri val coins =
115 res
116 where coins' = dropWhile (>val) coins
117 coins'' = nub coins'
118 res = sum ( par_map pri
119 ( \ c -> let
120 new_coins =
121 ((dropWhile (>c) coins')\\[c])
122 in
123 pay_num (pri-1)
124 (val-c)
125 new_coins
126 )
127 coins'' )
128
129 pay :: Int -> Int -> [Int] -> [Int] -> [[Int]]
130 pay _ 0 coins accum = [accum]
131 pay _ val [] _ = []
132 pay pri val coins accum =
133 res
134 where coins' = dropWhile (>val) coins
135 coins'' = nub coins'
136 res = concat ( par_map pri
137 ( \ c -> let
138 new_coins =
139 ((dropWhile (>c) coins')\\[c])
140 in
141 pay (pri-1)
142 (val-c)
143 new_coins
144 (c:accum)
145 )
146 coins'' )
147 #endif
148
149
150 #if defined(RANDOM_INPUT)
151 getRandInt :: Int -> Int
152 getRandInt bound =
153 unsafePerformPrimIO (
154 getClockTime `thenPrimIO` \ t ->
155 returnPrimIO (
156 case t of
157 Left _ -> error "error in getClockTime"
158 Right b -> let
159 CalendarTime _ _ _ _ _ _ x _ _ _ _ _ = toCalendarTime b
160 in
161 ((fromInteger x) `mod` bound) :: Int ) )
162 #endif
163
164 -- +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
165
166 count_results :: [[Int]] -> Int
167 count_results = sum . concat
168
169 #if defined(NUM)
170 jaH :: Int -> Int
171 jaH = id
172 #else
173 jaH :: [[Int]] -> Int
174 jaH = length -- foldr (\ x y -> if (y==10) then 1 else 0) 0
175 -- jaH = length . filter (==10) . concat
176 #endif
177
178 #if defined(GRAN) || defined(GUM)
179
180 #ifdef ARGS
181 args_to_IntList a = map (\ a1 -> fst ((readDec a1) !! 0)) a
182
183 mainPrimIO = getArgsPrimIO `thenPrimIO` \ a ->
184 munch_input a
185 #else
186 mainPrimIO = munch_input []
187 #endif
188
189 #ifdef PRINT
190 munch_input a = appendChanPrimIO stdout ("\nCoins:\n" ++ (show coinsz)) `seqPrimIO`
191 appendChanPrimIO stdout ("\nValue: " ++ (show value)) `seqPrimIO`
192 appendChanPrimIO stdout ("\nResult: " ++ (pp res)) `seqPrimIO`
193 appendChanPrimIO stdout "\n" `seqPrimIO`
194 returnPrimIO ()
195 #else
196
197 # ifdef ARGS
198 munch_input a = if null a
199 then appendChanPrimIO stdout usage `seqPrimIO`
200 returnPrimIO ()
201 else
202 # else
203 munch_input _ =
204 # endif
205 seq (jaH res) (returnPrimIO ())
206 #endif
207
208 #else /* no PrimIO i.e. std Haskell 1.2 */
209
210 #ifdef ARGS
211 args_to_IntList a = map (\ a1 -> fst ((readDec a1) !! 0)) a
212
213 main = getArgs exit ( \ a -> munch_input a )
214 #else
215 main = munch_input []
216 #endif
217
218 #ifdef PRINT
219 munch_input a = appendChan stdout ("\nCoins:\n" ++ (show coinsz)) abort $
220 appendChan stdout ("\nValue: " ++ (show value)) abort $
221 appendChan stdout ("\nResult: " ++ (pp res)) abort $
222 appendChan stdout "\n" abort done
223 #else
224
225 # ifdef ARGS
226 munch_input a = if null a
227 then appendChan stdout usage abort done
228 else
229 # else
230 munch_input _ =
231 # endif
232 seq (jaH res) (appendChan stdout "done" abort done)
233 #endif
234
235 #endif /* PrimIO? */
236 where
237 #ifdef ARGS
238 -- usage = "Usage: coins <value> <coin1> <qty1> <coin2> <qty2> ...\n"
239 usage = "Usage: coins <value> \n"
240
241 value = head (args_to_IntList a) -- 14
242 {-
243 coins_flat = tail (args_to_IntList a) -- 14
244
245 zipify [] = []
246 zipify (c:q:xs) = (c,q) : zipify xs
247
248 coinsz = zipify coins_flat
249 coins = concat (map (\(v,q) -> [v | i <- [1..q]]) coinsz)
250 -}
251 #else
252 #if defined(RANDOM_INPUT)
253 value = (getRandInt 100) + 150 -- i.e. [150, 250]
254 #else
255 value = 179 -- 279
256 #endif
257 #endif
258 vals = [250, 100, 25, 10, 5, 1]
259 -- quants = [1, 3, 2, 5, 7, 12] -- std setup
260 quants = [5, 8, 8, 9, 12, 17]
261
262 coinsz = zip vals quants
263 coins = concat (map (\(v,q) -> [v | i <- [1..q]]) coinsz)
264
265 #if defined(NUM)
266 res = pay_num 100 value coins
267 #else
268 res = pay 100 value coins []
269 #endif
270
271
272 #if defined(NUM)
273 pp :: Int -> String
274 pp = show
275 #else
276 pp = unlines . reverse . snd .
277 foldr (\ l (n,q) ->
278 (n+1, ("<" ++ (show (n, length l, sum l)) ++ "> " ++ (show l)):q ))
279 (1,[])
280 #endif
281