Mercurial > hg > Members > toma > Jungle-haskell
changeset 8:f03876c8236a
add ParRead
author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 14 Jan 2014 18:09:51 +0900 |
parents | 644e1345ee83 |
children | 947c5cfa4149 |
files | .hgignore Jungle.hs test.hs test/ParRead.hs test/test.hs |
diffstat | 5 files changed, 121 insertions(+), 40 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Tue Jan 14 18:09:51 2014 +0900 @@ -0,0 +1,6 @@ +syntax: glob +*.swp +*.*~ +*.o +*.orig +*.hi
--- a/Jungle.hs Mon Jan 13 11:43:41 2014 +0900 +++ b/Jungle.hs Tue Jan 14 18:09:51 2014 +0900 @@ -13,8 +13,9 @@ , putAttribute , deleteAttribute , getAttributes -, drawNode -- デバッグ用 +, drawNode , printAttributes +, size ) where import qualified Data.Map as M @@ -164,6 +165,7 @@ map = getAttributesMap $ attributes target -- デバッグ用表示関数 + -- 現在の木構造を整形して表示 drawNode :: Node -> String drawNode node = unlines $ draw "root" node @@ -186,9 +188,9 @@ printAttr :: String -> Node -> [String] printAttr string node = - if M.null attr_map - then printSubTrees keys - else ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys + if not $ M.null attr_map + then ("Node: " ++ string) : (" " ++ attr) : printSubTrees keys + else printSubTrees keys where attr_map = getAttributesMap $ attributes node show_attr [] = [] @@ -200,3 +202,13 @@ printSubTrees [] = [] printSubTrees (x:xs) = printAttr (string ++ "-" ++ (show x)) (fromJust $ M.lookup x map) ++ printSubTrees xs +-- ルートノードの下にいくつの子があるか数える +size :: Node -> Int +size node = M.size map + subTreesSize keys + where + map = getChildrenMap $ children node + keys = M.keys map + subTreesSize [] = 0 + subTreesSize (x:xs) = size (getNode x) + subTreesSize xs + getNode x = fromJust $ M.lookup x map +
--- a/test.hs Mon Jan 13 11:43:41 2014 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Jungle -import Data.Maybe -import qualified Data.ByteString.Lazy.Char8 as B - -jungle = createJungle - -tree = do - a <- createTree jungle "test" - let - t = fromJust $ getTreeByName a "test" - node <- getRootNode t - return (add node) - -addc path pos node = addNewChildAt node path pos - -addchild = - (addc [3] 2) . (addc [] 3) . (addc [1,1] 2) . (addc [1,1] 1). (addc [2] 2) . (addc [1] 2) . - (addc [2] 1) . (addc [] 2). (addc [1] 1) . (addc [] 1) - -adda path key value node = putAttribute node path key value - -addattr = - (adda [1,1] "key" "value") . (adda [1,1] "test" "test2") . - (adda [] "root" "node") . (adda [1] "tes" "abc") . - (adda [3,2] "test" "3-2") . (adda [2,2] "test" "2-2") - -add = addattr . addchild - -{- -ghci> :l test.hs -ghci> y <- tree -ghci> putStrLn $ printAttributes y -ghci> putStrLn $ drawNode y --}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ParRead.hs Tue Jan 14 18:09:51 2014 +0900 @@ -0,0 +1,63 @@ +{-# 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 + + +main = do + let + jungle = createJungle + new_jungle <- createTree jungle "test_tree" + let + tree = fromJust $ getTreeByName new_jungle "test_tree" + node <- getRootNode tree + let + x = testTree node 7 + putStrLn $ show $ size x + updateRootNode tree x + node2 <- getRootNode tree + t0 <- getCurrentTime + printTimeSince t0 + r <- evaluate (runEval $ test node2) + print r + printTimeSince t0 + + +test node = do + x <- rpar (func node) + y <- rseq (func2 node) + rseq x + return (x,y) + +func :: Node -> Int +func node = size node + +func2 :: Node -> Int +func2 node = size node2 + where + node2 = addNewChildAt node [0,0] 0 + + +-- ある程度の大きさの木を作れる +-- size $ testTree y 1 = 10 +-- size $ testTree y 5 = 11742 +-- size $ testTree y 7 = 876808 +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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/test.hs Tue Jan 14 18:09:51 2014 +0900 @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Jungle +import Data.Maybe +import qualified Data.ByteString.Lazy.Char8 as B + +jungle = createJungle + +tree = do + a <- createTree jungle "test" + let + t = fromJust $ getTreeByName a "test" + node <- getRootNode t + return (add node) + +addc path pos node = addNewChildAt node path pos + +addchild = + (addc [3] 2) . (addc [] 3) . (addc [1,1] 2) . (addc [1,1] 1). (addc [2] 2) . (addc [1] 2) . + (addc [2] 1) . (addc [] 2). (addc [1] 1) . (addc [] 1) + +adda path key value node = putAttribute node path key value + +addattr = + (adda [1,1] "key" "value") . (adda [1,1] "test" "test2") . + (adda [] "root" "node") . (adda [1] "tes" "abc") . + (adda [3,2] "test" "3-2") . (adda [2,2] "test" "2-2") + +add = addattr . addchild + +{- +ghci> :l test.hs +ghci> y <- tree +ghci> putStrLn $ printAttributes y +ghci> putStrLn $ drawNode y +-}