summaryrefslogtreecommitdiff
path: root/benchmarks/simple.hs
diff options
context:
space:
mode:
Diffstat (limited to 'benchmarks/simple.hs')
-rw-r--r--benchmarks/simple.hs45
1 files changed, 45 insertions, 0 deletions
diff --git a/benchmarks/simple.hs b/benchmarks/simple.hs
new file mode 100644
index 0000000..c3f2e58
--- /dev/null
+++ b/benchmarks/simple.hs
@@ -0,0 +1,45 @@
+
+{-# LANGUAGE BangPatterns #-}
+
+{-# OPTIONS_GHC -fprof-auto #-}
+
+import Control.DeepSeq
+import qualified Data.Graph.Dynamic.EulerTour as ETF
+import qualified Data.Graph.Dynamic.Levels as Levels
+
+main :: IO ()
+main = do
+ foo <- completeGraph 250
+ return $ rnf foo
+
+completeGraph :: Int -> IO [(Bool, Bool)]
+completeGraph n = do
+ levels <- Levels.edgeless' vertices
+ mapM_ (\(x, y) -> Levels.link levels x y) edges
+ mapM (\(x, y) -> do
+ c1 <- Levels.connected levels x y
+ Levels.cut levels x y
+ c2 <- Levels.connected levels x y
+ return (c1, c2)
+ ) edges
+ where
+ vertices = [(x, y, z) | x <- [0..n-1], y <- [0..n-1], z <- [0..n-1]]
+ dist (x1, y1, z1) (x2, y2, z2) = abs (x1 - x2) + abs (y1 - y2) + abs (z1 - z2)
+ adjVecs = [(-1, 0, 0), (1, 0, 0), (0, -1, 0), (0, 1, 0), (0, 0, -1), (0, 0, 1)]
+ addV3 (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)
+ valid (x, y, z) = x >= 0 && x < n && y >= 0 && y < n && z >= 0 && z < n
+ edges = [(x, y) | x <- vertices, d <- adjVecs, let y = addV3 x d, valid y]
+
+completeBinaryTree :: Int -> IO [(Bool, Bool)]
+completeBinaryTree n = do
+ etf <- ETF.edgeless' [0..n-1]
+ mapM_ (\(x, y) -> ETF.link etf x y) edges
+ mapM (\(x, y) -> do
+ c1 <- ETF.connected etf x y
+ ETF.cut etf x y
+ c2 <- ETF.connected etf x y
+ return (c1, c2)
+ ) edges
+ return []
+ where
+ edges = [(x, y) | x <- [0..n-1], y <- filter (< n) [2 * x, 2 * x + 1]]