Main.hs 10.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
{-# OPTIONS -Wall #-}
--
-- Euler totient function (strategic version).
-- Orig taken from "Research Directions in Parallel Functional Programming",
-- Chapter "Performance Monitoring", Nathan Charles and Colin Runciman.
--
-- (c) 2001 Hans-Wolfgang Loidl
--
-- modifications by Jost Berthold, 07/2008:
--    ported to current GHC = hierarchical libraries
--    removed some dead (unused) code
--    simplified/secured usage
--    included a reference computation (using prime numbers)
--    tested best version (JFP_Final) against two "equivalents" using
--          strategies
--
---------------------------------------------------------------------------

module Main where

import System.Environment (getArgs)
import Control.Parallel.Strategies
import Control.Parallel
import Control.Monad (when)

import ListAux -- split/join functions, put in new module
import SumEulerPrimes

import Data.List(foldl1')

---------------------------------------------------------------------------
-- Generic clustering routines

-- Classes
35
-- maybe: class (Functor c) => MMonad c where { ... mmap = fmap }
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
class MMonad c where
  munit  :: a -> c a
  mjoin  :: c (c a) ->  c a
  mmap   :: (a -> b) -> c a -> c b

class (MMonad c) => MMonadPlus c where
  mzero :: c a
  mplus :: c a -> c a -> c a

class (MMonad c) => Cluster c where
  cluster    :: Int -> c a -> c (c a)
  decluster  :: c (c a) -> c a
  lift       :: (c a -> b) -> (c (c a) -> (c b))
  -- default defs
  --cluster = ???
  decluster = mjoin
  lift      = mmap

-- Instances
instance MMonad [] where
  munit x = [x]
  mjoin   = concat
  mmap    = map

instance Cluster [] where
  cluster   = splitAtN

---------------------------------------------------------------------------

usage :: String
usage = "Usage: <program> version size chunksize"
        ++"\nFor versions see source code."

main :: IO ()
main = do args <- getArgs
71
          let
72
            lenArgs = length args
73
          when (lenArgs < 3)
74
                   (putStrLn (usage ++ "\n(using defaults: 38,5000,100)"))
75
          let
76 77 78 79 80 81 82 83 84 85 86 87 88
            argDef :: Read a => Int -> a -> a
            argDef m defVal | m < lenArgs = read (args!!m)
                            | otherwise   = defVal
            x, n, c :: Int
            x = argDef 0 38   -- which sumEuler to use
            n = argDef 1 5000 -- size of the interval
            c = argDef 2 100  -- chunksize
            -- parallel computation
            (res, _str) = case x of
                    ------------------
                    -- BEST VERSION:
                    38 -> (sumEulerJFP_Final c n, "JFP_Final paper version (splitAtN)")
                    -- VERSIONS TO TEST ADDITIONALLY:
89
--		    48 -> (sumEulerS8 c n,   "parallel w/ parChunkFoldMap strategy")
90
--		    58 -> (sumEulerS8' c n,   "parallel w/ parChunkFold'Map strategy")
91 92 93 94 95 96 97 98 99 100 101
                    8 -> (sumEulerJFP c n, "JFP paper version (splitAtN)")
                    ------------------
                    0 -> (sumEuler_seq n,   "sequential")
                    1 -> (sumEulerS1 n,     "parallel w/ parList strategy")
                    -- not bad:
                    2 -> (sumEulerS2 c n,   "parallel w/ parListChunk")
		    3 -> (sumEulerChunk c n,"parallel w/ chunkify")
		    4 -> (sumEulerShuffle c n,"parallel w/ shuffle")
		    5 -> (sumEulerCluster c n,"parallel w/ generic clustering")
                    -- not bad:
		    6 -> (sumEulerS6 c n,   "parallel w/ parListChunk over reversed list")
102
--		    7 -> (sumEulerS7 c n,   "parallel w/ parChunkFoldMap strategy")
103 104
                    18 -> (sumEulerJFP1 c n, "JFP1 paper version (splitIntoChunks)")
                    28 -> (sumEulerJFP0 c n, "JFP0 paper version (explicit list comprh)")
105
--                    9 -> (sumEulerStepList c n, "parallel w/ seqStepList for strategic shuffling")
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
                    _ -> error "undefined version."

          putStrLn ("sumEuler [" ++ show base ++ ".." ++ show (base+n) ++ "] = " ++ show res)

          -- reference implementation (which is rather fast)
          let expected = sumPhi n
          when False $ putStrLn ("Expected result: " ++ show expected)

---------------------------------------------------------------------------
-- main computation function in many variants

-- HERE: best versions in contrast

sumEulerJFP  :: Int -> Int -> Int
sumEulerJFP c n = sum (map (sum . map euler) (splitAtN c (mkList n))
121
                       `using` parList rdeepseq)
122 123 124

sumEulerJFP_Final  :: Int -> Int -> Int
sumEulerJFP_Final c n = sum ([(sum . map euler) x | x <- splitAtN c [n,n-1..0]]
125
                            `using` parList rdeepseq)
126 127 128 129

-- -- using a fold-of-map strategy w/ folding inside a chunk
-- sumEulerS8 :: Int -> Int -> Int
-- sumEulerS8 c n  = parChunkFoldMap c rnf (+) euler (mkList n)
130
--
131 132 133
-- -- using a fold-of-map strategy w/ STRICT LEFT-folding inside a chunk
-- sumEulerS8' :: Int -> Int -> Int
-- sumEulerS8' c n  = parChunkFoldMap' c rnf (+) euler (mkList n)
134
--
135
-- -- parallel fold-of-map with chunking over fold and map
136
-- parChunkFoldMap :: (NFData b) => Int -> Strategy b ->
137
--                                  (b -> b -> b) -> (a -> b) -> [a] -> b
138
-- parChunkFoldMap c s f g xs = foldl1 f (map (foldl1 f . map g)
139 140
-- 		                           (splitAtN c xs)
-- 		                       `using` parList s)	
141
--
142
-- -- parallel fold-of-map with chunking over fold and map
143
-- parChunkFoldMap' :: (NFData b) => Int -> Strategy b ->
144
--                                  (b -> b -> b) -> (a -> b) -> [a] -> b
145
-- parChunkFoldMap' c s f g xs = foldl1' f (map (foldl1' f . map g)
146 147
-- 		                           (splitAtN c xs)
-- 		                       `using` parList s)	
148 149 150 151 152 153 154

-----------------------------------------------------------------------
-- OTHER VARIANTS

-- strategic function application
sumEulerS1 :: Int -> Int
sumEulerS1 n  = sum ( map euler (mkList n)
155
                        `using`
156
	                parList rdeepseq )
157 158 159 160 161 162 163

-- NUKED:
-- sumEulerS1 c n  = sum $|| (parListChunk c rnf) $ map euler $ mkList $ n

-- naive parallel version w/ parList
sumEulerS2 :: Int -> Int -> Int
sumEulerS2 c n  = sum ( map euler (mkList n)
164
                        `using`
165
	                parListChunk c rdeepseq )
166 167 168 169

-- using a parallel fold over a chunkified list
sumEulerS6 :: Int -> Int -> Int
sumEulerS6 c n  = sum (map (sum . map euler) (splitAtN c (mkList n))
170
		       `using` parList rdeepseq)	
171

172 173 174
-- -- using a fold-of-map strategy over a chunkified list
-- sumEulerS7 :: Int -> Int -> Int
-- sumEulerS7 c n  = parFoldChunkMap c rnf (+) euler (mkList n)
175 176 177

-- explicit restructuring
sumEulerChunk :: Int -> Int -> Int
178
sumEulerChunk c n  = sum (parMap rdeepseq ( \ xs -> sum (map euler xs))
179 180 181 182
                                     (splitAtN c (mkList n)))

-- using generic clustering functions
sumEulerCluster :: Int -> Int -> Int
183
sumEulerCluster c n = sum ((lift worker) (cluster c (mkList n))
184
                           `using` parList rdeepseq)
185 186 187 188 189
                      where worker = sum . map euler

-- using a shuffling to improve load balance
sumEulerShuffle :: Int -> Int -> Int
sumEulerShuffle c n  = sum ((map worker) (unshuffle (noFromSize c n) (mkList n))
190
                           `using` parList rdeepseq)
191 192 193
                       where worker = sum . map euler

noFromSize :: Int -> Int -> Int
194
noFromSize c n | n `mod` c == 0 = n `div` c
195 196
               | otherwise      = n `div` c + 1

197 198 199 200
-- -- Evaluates every n-th element in the list starting with the first elem
-- seqStepList :: Int -> Strategy a -> Strategy [a]
-- seqStepList _ _strat []    = ()
-- seqStepList n strat (x:xs) = strat x `pseq` (seqStepList n strat (drop (n-1) xs))
201
--
202 203 204
-- seqStepList' :: Int -> Strategy a -> Strategy [a]
-- -- seqStepList' _ strat [] = ()
-- seqStepList' n strat xs = parList (\ i -> seqStepList n strat (drop i xs)) [0..n-1]
205
--
206 207
-- sumEulerStepList :: Int -> Int -> Int
-- sumEulerStepList c n  = sum ( map euler (mkList n)
208
--                               `using`
209 210 211
-- 	                      seqStepList' n' rnf )
--                        where --worker = sum . map euler
--                              n' = if n `mod` c == 0 then n `div` c else (n `div` c)+1
212 213 214 215 216 217 218 219

-- ---------------------------------------------------------------------------
-- Variants of the code for the JFP paper
-- ---------------------------------------------------------------------------

sumEulerJFP0  :: Int -> Int -> Int
sumEulerJFP0 c n = sum ([ (sum . map euler) [ c*i+j | j <- [0..c-1], c*i+j<=n ]
                        | i <- [0..(n+c-1) `div` c - 1] ]
220
                       `using` parList rdeepseq)
221 222 223

sumEulerJFP1  :: Int -> Int -> Int
sumEulerJFP1 c n = sum (map (sum . map euler) (splitIntoChunks c n)
224
                        `using` parList rdeepseq)
225 226 227 228 229 230 231

splitIntoChunks :: Int -> Int -> [[Int]]
splitIntoChunks c n = [ [ c*i+j | j <- [0..c-1], c*i+j<=n ]
                      | i <- [0..(n+c-1) `div` c - 1] ]

-- boring sequential version
sumEuler_seq :: Int -> Int
232
sumEuler_seq = sum . map euler . mkList
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285

---------------------------------------------------------------------------
-- smallest input for euler
base :: Int
base = 0

-- produce a list of input values
mkList :: Int -> [Int]
mkList = reverse . enumFromTo base . (+ base)
-- random numbers
-- mkList seed n = take n (randoms seed)

---------------------------------------------------------------------------
-- main fct

euler :: Int -> Int
euler n = length (filter (relprime n) [1..(n-1)])

---------------------------------------------------------------------------
-- orig code from Nathan
{-
euler :: Int -> Int
euler n = let
            relPrimes = let
                          numbers = [1..(n-1)]
                        in
                          numbers `par` (filter (relprime n) numbers)
          in
            (spine relPrimes) `par` (length relPrimes)
-}

---------------------------------------------------------------------------
-- aux fcts

hcf :: Int -> Int -> Int
hcf x 0 = x
hcf x y = hcf y (rem x y)

relprime :: Int -> Int -> Bool
relprime x y = hcf x y == 1

---------------------------------------------------------------------------
-- Strategy code
---------------------------------------------------------------------------

-- Strategy combining fold and map
parChunkFold :: Int -> Strategy a -> (a -> a -> a) -> [a] -> a
parChunkFold c s f xs = foldl1 f (map (foldl1 f) yss `using` parList s)
                        where yss = splitAtN c xs

parFoldMap :: Strategy b -> (b -> b -> b) -> (a -> b) -> [a] -> b
parFoldMap s f g xs = foldl1 f (map g xs `using` parList s)

286
---- parallel fold-of-map with chunking over map only
287
--parFoldChunkMap :: (NFData b) => Int -> Strategy b ->
288 289
--                                 (b -> b -> b) -> (a -> b) -> [a] -> b
--parFoldChunkMap c s f g xs = foldl1 f (map g xs `using` parListChunk c s)
290