# HG changeset patch
# User Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp>
# Date 1389690591 -32400
# Node ID f03876c8236ad3e47d75aaec510c05efc67110a3
# Parent  644e1345ee83c456ed47a08f94902494d2154803
add ParRead

diff -r 644e1345ee83 -r f03876c8236a .hgignore
--- /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
diff -r 644e1345ee83 -r f03876c8236a Jungle.hs
--- 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
+
diff -r 644e1345ee83 -r f03876c8236a test.hs
--- 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
--}
diff -r 644e1345ee83 -r f03876c8236a test/ParRead.hs
--- /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)
diff -r 644e1345ee83 -r f03876c8236a test/test.hs
--- /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
+-}