Mercurial > hg > Members > toma > Jungle-haskell
view test/ParWrite.hs @ 18:8d4e37c1a86a
Print attrSize in ParWrite
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 22 Jan 2014 16:08:13 +0900 |
parents | 72cc49b616cd |
children | 824543aea6fc |
line wrap: on
line source
{-# LANGUAGE OverloadedStrings #-} import Control.Parallel import Control.Parallel.Strategies import Text.Printf import Jungle import Data.Maybe import Data.List import Data.Time.Clock import qualified Data.ByteString.Lazy.Char8 as B import Control.Exception import System.Environment import Control.Monad.IO.Class treeId :: String treeId = "test_tree" treeId2 :: String treeId2 = "hoge_tree" treeDepth :: Int treeDepth = 5 lastPos :: [Int] lastPos = last $ concatMap permutations . subsequences $ [0..treeDepth] writeCount :: Int writeCount = 100000 main = do jungle <- createTree createJungle treeId jungle <- createTree jungle treeId2 node <- getRootNode jungle treeId node2 <- getRootNode jungle treeId2 let miniTree = testTree node treeDepth miniTree2 = testTree node2 treeDepth updateRootNode jungle treeId miniTree updateRootNode jungle treeId2 miniTree2 putStrLn $ show $ size miniTree putStrLn $ show $ size miniTree2 t0 <- getCurrentTime printTimeSince t0 a <- sequence$ runEval $ dualWrite jungle print a printTimeSince t0 -- parallel write for two trees by singleWrite dualWrite jungle = do x <- rpar (test jungle treeId) y <- rpar (test jungle treeId2) return [x, y] test jungle id = do updateRootNodeWith (writeFunctions writeCount) jungle id tree <- getRootNode jungle id return (attrSize tree) -- generate functions to node update writeFunctions :: Int -> Node -> Node writeFunctions writeCount node = foldl' apply node [0..writeCount] where apply node x = putAttribute node lastPos (show x) (B.pack . show $ x) -- utils from ParRead testTree node h = foldl' (add h) node (concatMap permutations . subsequences $ [0..h]) where add w node h = addc node h w addc node h w = foldl' (add h) node [0..w] where add h node pos = addNewChildAt node h pos printTimeSince t0 = do t1 <- getCurrentTime printf "time: %.2fs\n" (realToFrac (diffUTCTime t1 t0) :: Double)