dph-examples 0.5.1.1 → 0.5.1.2
raw patch · 4 files changed
+273/−172 lines, 4 filesnew-component:exe:dph-nbody-batchnew-component:exe:dph-nbody-gloss
Files
- dph-examples.cabal +27/−21
- real/NBody/Gloss/Main.hs +0/−151
- real/NBody/MainBatch.hs +95/−0
- real/NBody/MainGloss.hs +151/−0
dph-examples.cabal view
@@ -2,7 +2,7 @@ Name: dph-examples-Version: 0.5.1.1+Version: 0.5.1.2 License: BSD3 License-file: LICENSE Author: The DPH Team@@ -11,13 +11,13 @@ Cabal-Version: >=1.8 Stability: experimental Category: Data Structures-Homepage: http://www.cse.unsw.edu.au/~chak/project/dph/-Description: Examples using the DPH library.-Synopsis: Examples using the DPH library.+Homepage: http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell+Description: Examples using Data Parallel Haskell+Synopsis: Examples using Data Parallel Haskell -Flag gloss- Description: Enable graphical front ends that use the gloss library.- Default: False+-- Flag gloss+-- Description: Enable graphical front ends that use the gloss library.+-- Default: False -- With these examples, -- the plain dph-NAME versions are parallel versions built against dph-par@@ -206,26 +206,32 @@ -- NBody -----------------------------------------------------------------------Executable dph-nbody- Main-is: Main.hs- other-modules: Common.Dump Common.World Common.Body Common.Util - Solver Solver.ListBH.Solver- Solver.NestedBH.Solver- Solver.VectorBH.Solver- Solver.VectorNaive.Solver- Timing Points2D.Types Points2D.Generate-- if flag(gloss)- other-modules: Gloss.MainArgs Gloss.Draw Gloss.Config+Executable dph-nbody-gloss+ Main-is: MainGloss.hs+ other-modules: Common.Dump Common.World Common.Body Common.Util + Solver Solver.ListBH.Solver+ Solver.NestedBH.Solver+ Solver.VectorBH.Solver+ Solver.VectorNaive.Solver+ Timing Points2D.Types Points2D.Generate+ Gloss.MainArgs Gloss.Draw Gloss.Config Build-depends: base == 4.4.*, vector == 0.7.*, dph-base == 0.5.*, dph-prim-par == 0.5.*, dph-par == 0.5.*, random == 1.0.*, old-time == 1.0.*, parseargs == 0.1.*, gloss == 1.3.* hs-source-dirs: lib real/NBody real/NBody/Gloss ghc-options: -rtsopts -threaded -fllvm -Odph -fdph-par -fcpr-off -fsimplifier-phases=4 -fstrictness-before=3 -fno-liberate-case- else- other-modules: Batch.MainArgs Batch.Config+++Executable dph-nbody-batch+ Main-is: MainBatch.hs+ other-modules: Common.Dump Common.World Common.Body Common.Util + Solver Solver.ListBH.Solver+ Solver.NestedBH.Solver+ Solver.VectorBH.Solver+ Solver.VectorNaive.Solver+ Timing Points2D.Types Points2D.Generate+ Batch.MainArgs Batch.Config Build-depends: base == 4.4.*, vector == 0.7.*, dph-base == 0.5.*, dph-prim-par == 0.5.*, dph-par == 0.5.*, random == 1.0.*, old-time == 1.0.*, parseargs == 0.1.* hs-source-dirs: lib real/NBody real/NBody/Batch ghc-options: -rtsopts -threaded -fllvm -Odph -fdph-par -fcpr-off -fsimplifier-phases=4 -fstrictness-before=3 -fno-liberate-case- endif -- Executable dph-nbody-seq -- Main-is: Main.hs
− real/NBody/Gloss/Main.hs
@@ -1,151 +0,0 @@-{-# LANGUAGE ParallelListComp, BangPatterns #-}--import Gloss.MainArgs-import Gloss.Draw-import Gloss.Config--import Common.Dump-import Common.World-import Common.Body-import Common.Util--import Solver-import Timing-import Points2D.Generate--import Graphics.Gloss-import Graphics.Gloss.Interface.Simulate--import System.Environment-import System.Console.ParseArgs-import System.IO.Unsafe-import Control.Monad-import Data.Maybe-import qualified Data.Vector.Unboxed as V---main :: IO ()-main - = do args <- parseArgsIO ArgsComplete mainArgs- - when (gotArg args ArgHelp)- $ usageError args ""-- mainWithArgs args- --mainWithArgs :: Args MainArg -> IO ()-mainWithArgs args- = let config = loadConfig args-- -- The solver we're using to calculate the acclerations.- solverName = configSolverName config- calcAccels = fromMaybe (error $ unlines- [ "unknown solver " ++ show solverName- , "choose one of " ++ (show $ map fst solvers) ])- $ lookup solverName solvers- - -- Setup initial world- vPoints = genPointsDisc - (configBodyCount config)- (0, 0) - (configStartDiscSize config)-- vBodies = V.map (setStartVelOfBody $ configStartSpeed config)- $ V.map (setMassOfBody $ configBodyMass config)- $ V.map (uncurry unitBody) - $ vPoints-- worldStart = World- { worldBodies = vBodies- , worldSteps = 0 }- - in case configWindowSize config of- Just windowSize -> mainGloss config calcAccels worldStart windowSize- Nothing -> mainBatch config calcAccels worldStart ----- | Run the simulation in a gloss window.-mainGloss - :: Config- -> Solver -- ^ Fn to calculate accels of each point.- -> World -- ^ Initial world.- -> Int -- ^ Size of window.- -> IO ()- -mainGloss config calcAccels worldStart windowSize- = let draw = drawWorld (configShouldDrawTree config)-- advance _viewport time world - = let world' = advanceWorld - (calcAccels $ configEpsilon config)- (configTimeStep config)- world-- -- if we've done enough steps then bail out now.- in case configMaxSteps config of- Nothing -> world'- Just maxSteps- | worldSteps world' < maxSteps -> world'- - -- Gloss doesn't provide a clean way to end the animation...- | otherwise - -> unsafePerformIO (mainEnd (configDumpFinal config) world' >> (error $ "done")) - `seq` error "advanceWorld: we're finished, stop calling me."-- in simulateInWindow- "Barnes-Hut" -- window name- (windowSize, windowSize)-- window size- (10, 10) -- window position- black -- background color- (configRate config) -- number of iterations per second- worldStart -- initial world- draw -- fn to convert a world to a picture- advance -- fn to advance the world----- | Run the simulation in batch mode, not displaying anything to the screen.-mainBatch- :: Config- -> Solver -- ^ Fn to calculate accels of each point.- -> World -- ^ Initial world.- -> IO ()- -mainBatch config calcAccels worldStart- = do- worldStart `seq` return ()-- (world', tElapsed)- <- time - $ let world = mainBatchRun config calcAccels worldStart- in world `seq` return world- - putStr $ prettyTime tElapsed- mainEnd (configDumpFinal config) world'- --mainBatchRun config calcAccels worldStart - = go worldStart- where go !world- = let world' = advanceWorld- (calcAccels $ configEpsilon config)- (configTimeStep config)- world- in case configMaxSteps config of- Nothing -> go world'- Just maxSteps- | worldSteps world' < maxSteps -> go world'- | otherwise -> world'----- | Called at end of run to dump final world state.-mainEnd - :: Maybe FilePath -- ^ Write final bodies to this file.- -> World -- ^ Final world state.- -> IO ()--mainEnd mDumpFinal world- = do -- Dump the final world state to file if requested.- maybe (return ()) (dumpWorld world) mDumpFinal--
+ real/NBody/MainBatch.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE ParallelListComp, BangPatterns #-}++import Batch.MainArgs+import Batch.Config+import Common.Dump+import Common.World+import Common.Body+import Common.Util+import Solver+import Timing+import Points2D.Generate+import System.Environment+import System.Console.ParseArgs+import System.IO.Unsafe+import Control.Monad+import Data.Maybe+import qualified Data.Vector.Unboxed as V+++main :: IO ()+main + = do args <- parseArgsIO ArgsComplete mainArgs++ when (gotArg args ArgHelp)+ $ usageError args ""++ mainWithArgs args+ ++mainWithArgs :: Args MainArg -> IO ()+mainWithArgs args+ = let config = loadConfig args++ -- The solver we're using to calculate the acclerations.+ solverName = configSolverName config+ calcAccels = fromMaybe (error $ unlines+ [ "unknown solver " ++ show solverName+ , "choose one of " ++ (show $ map fst solvers) ])+ $ lookup solverName solvers+ + -- Setup initial world+ vPoints = genPointsDisc + (configBodyCount config)+ (0, 0) + (configStartDiscSize config)++ vBodies = V.map (setStartVelOfBody $ configStartSpeed config)+ $ V.map (setMassOfBody $ configBodyMass config)+ $ V.map (uncurry unitBody) + $ vPoints++ worldStart = World+ { worldBodies = vBodies+ , worldSteps = 0 }++ in mainBatch config calcAccels worldStart +++-- | Run the simulation in batch mode.+mainBatch :: Config -> Solver -> World -> IO ()+mainBatch config calcAccels worldStart+ = do+ worldStart `seq` return ()++ (world', tElapsed)+ <- time + $ let world = mainBatchRun config calcAccels worldStart+ in world `seq` return world+ + putStr $ prettyTime tElapsed+ mainEnd (configDumpFinal config) world'+++mainBatchRun config calcAccels worldStart + = go worldStart+ where go !world+ = let world' = advanceWorld+ (calcAccels $ configEpsilon config)+ (configTimeStep config)+ world++ in if worldSteps world' < configMaxSteps config+ then go world'+ else world'+++-- | Called at end of run to dump final world state.+mainEnd :: Maybe FilePath -- ^ Write final bodies to this file.+ -> World -- ^ Final world state.+ -> IO ()++mainEnd mDumpFinal world+ = do -- Dump the final world state to file if requested.+ maybe (return ()) (dumpWorld world) mDumpFinal+
+ real/NBody/MainGloss.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE ParallelListComp, BangPatterns #-}++import Gloss.MainArgs+import Gloss.Draw+import Gloss.Config++import Common.Dump+import Common.World+import Common.Body+import Common.Util++import Solver+import Timing+import Points2D.Generate++import Graphics.Gloss+import Graphics.Gloss.Interface.Simulate++import System.Environment+import System.Console.ParseArgs+import System.IO.Unsafe+import Control.Monad+import Data.Maybe+import qualified Data.Vector.Unboxed as V+++main :: IO ()+main + = do args <- parseArgsIO ArgsComplete mainArgs+ + when (gotArg args ArgHelp)+ $ usageError args ""++ mainWithArgs args+ ++mainWithArgs :: Args MainArg -> IO ()+mainWithArgs args+ = let config = loadConfig args++ -- The solver we're using to calculate the acclerations.+ solverName = configSolverName config+ calcAccels = fromMaybe (error $ unlines+ [ "unknown solver " ++ show solverName+ , "choose one of " ++ (show $ map fst solvers) ])+ $ lookup solverName solvers+ + -- Setup initial world+ vPoints = genPointsDisc + (configBodyCount config)+ (0, 0) + (configStartDiscSize config)++ vBodies = V.map (setStartVelOfBody $ configStartSpeed config)+ $ V.map (setMassOfBody $ configBodyMass config)+ $ V.map (uncurry unitBody) + $ vPoints++ worldStart = World+ { worldBodies = vBodies+ , worldSteps = 0 }+ + in case configWindowSize config of+ Just windowSize -> mainGloss config calcAccels worldStart windowSize+ Nothing -> mainBatch config calcAccels worldStart +++-- | Run the simulation in a gloss window.+mainGloss + :: Config+ -> Solver -- ^ Fn to calculate accels of each point.+ -> World -- ^ Initial world.+ -> Int -- ^ Size of window.+ -> IO ()+ +mainGloss config calcAccels worldStart windowSize+ = let draw = drawWorld (configShouldDrawTree config)++ advance _viewport time world + = let world' = advanceWorld + (calcAccels $ configEpsilon config)+ (configTimeStep config)+ world++ -- if we've done enough steps then bail out now.+ in case configMaxSteps config of+ Nothing -> world'+ Just maxSteps+ | worldSteps world' < maxSteps -> world'+ + -- Gloss doesn't provide a clean way to end the animation...+ | otherwise + -> unsafePerformIO (mainEnd (configDumpFinal config) world' >> (error $ "done")) + `seq` error "advanceWorld: we're finished, stop calling me."++ in simulateInWindow+ "Barnes-Hut" -- window name+ (windowSize, windowSize)-- window size+ (10, 10) -- window position+ black -- background color+ (configRate config) -- number of iterations per second+ worldStart -- initial world+ draw -- fn to convert a world to a picture+ advance -- fn to advance the world+++-- | Run the simulation in batch mode, not displaying anything to the screen.+mainBatch+ :: Config+ -> Solver -- ^ Fn to calculate accels of each point.+ -> World -- ^ Initial world.+ -> IO ()+ +mainBatch config calcAccels worldStart+ = do+ worldStart `seq` return ()++ (world', tElapsed)+ <- time + $ let world = mainBatchRun config calcAccels worldStart+ in world `seq` return world+ + putStr $ prettyTime tElapsed+ mainEnd (configDumpFinal config) world'+ ++mainBatchRun config calcAccels worldStart + = go worldStart+ where go !world+ = let world' = advanceWorld+ (calcAccels $ configEpsilon config)+ (configTimeStep config)+ world+ in case configMaxSteps config of+ Nothing -> go world'+ Just maxSteps+ | worldSteps world' < maxSteps -> go world'+ | otherwise -> world'+++-- | Called at end of run to dump final world state.+mainEnd + :: Maybe FilePath -- ^ Write final bodies to this file.+ -> World -- ^ Final world state.+ -> IO ()++mainEnd mDumpFinal world+ = do -- Dump the final world state to file if requested.+ maybe (return ()) (dumpWorld world) mDumpFinal++