bench_fgl.hs

-- benchmarking K 1000/alga bfs
-- time                 17.46 ms   (16.95 ms .. 17.85 ms)
--                      0.997 R²   (0.994 R² .. 0.999 R²)
-- mean                 17.02 ms   (16.81 ms .. 17.22 ms)
-- std dev              503.7 μs   (415.7 μs .. 625.9 μs)
-- 
-- benchmarking K 1000/fgl bfs
-- time                 561.9 ms   (497.6 ms .. 630.1 ms)
--                      0.998 R²   (0.993 R² .. 1.000 R²)
-- mean                 519.7 ms   (489.9 ms .. 543.1 ms)
-- std dev              29.48 ms   (13.61 ms .. 38.25 ms)
-- variance introduced by outliers: 19% (moderately inflated)
-- 
-- benchmarking K 1000/alga dff
-- time                 406.6 ms   (395.9 ms .. 416.6 ms)
--                      1.000 R²   (1.000 R² .. 1.000 R²)
-- mean                 397.8 ms   (393.1 ms .. 402.0 ms)
-- std dev              4.966 ms   (4.046 ms .. 5.543 ms)
-- variance introduced by outliers: 19% (moderately inflated)
-- 
-- benchmarking K 1000/fgl dff
-- time                 353.4 ms   (339.7 ms .. 367.0 ms)
--                      1.000 R²   (0.999 R² .. 1.000 R²)
-- mean                 345.6 ms   (341.3 ms .. 349.6 ms)
-- std dev              4.608 ms   (3.863 ms .. 4.999 ms)
-- variance introduced by outliers: 19% (moderately inflated)
-- 
-- benchmarking sgb int/alga bfs
-- time                 7.218 ms   (7.101 ms .. 7.341 ms)
--                      0.998 R²   (0.997 R² .. 0.999 R²)
-- mean                 7.025 ms   (6.903 ms .. 7.111 ms)
-- std dev              284.9 μs   (177.9 μs .. 433.7 μs)
-- variance introduced by outliers: 19% (moderately inflated)
-- 
-- benchmarking sgb int/fgl bfs
-- time                 26.11 ms   (25.51 ms .. 26.70 ms)
--                      0.998 R²   (0.997 R² .. 1.000 R²)
-- mean                 25.99 ms   (25.73 ms .. 26.25 ms)
-- std dev              539.2 μs   (421.1 μs .. 714.6 μs)
-- 
-- benchmarking sgb int/alga dff
-- time                 21.92 ms   (21.31 ms .. 22.57 ms)
--                      0.997 R²   (0.995 R² .. 0.999 R²)
-- mean                 21.76 ms   (21.39 ms .. 22.02 ms)
-- std dev              706.0 μs   (475.2 μs .. 1.102 ms)
-- 
-- benchmarking sgb int/fgl dff
-- time                 32.16 ms   (31.85 ms .. 32.52 ms)
--                      1.000 R²   (0.999 R² .. 1.000 R²)
-- mean                 32.35 ms   (32.20 ms .. 32.62 ms)
-- std dev              421.1 μs   (243.7 μs .. 752.6 μs)


{-# language TupleSections, LambdaCase, BangPatterns #-}

module Main where

import Criterion.Main
import System.Environment
import qualified Data.Graph as LG
import qualified Data.Graph.Inductive as FGL
import qualified Data.Graph.Inductive.Query as FGL
import qualified Data.Graph.Inductive.PatriciaTree as FGLPT
import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM
import qualified Algebra.Graph.AdjacencyMap as AM
import qualified Algebra.Graph.AdjacencyIntMap.Algorithm as AIM
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import Control.DeepSeq
import Data.Bifunctor
import qualified Data.Graph.Typed as KL
import Data.List (tails)
import Data.Tree
import Data.Foldable

hamming x y = length $ filter not $ zipWith (==) x y

sgb wds = (word_graph, int_graph) where
  int_graph = AIM.edges $ map (bimap fst fst) es
  word_graph = AM.edges $ map (bimap snd snd) es
  es = [ (iu,jv) | iu@(i,u) <- ws, jv@(j,v) <- ws, hamming u v <= 1 ]
  ws = zip [0..] wds

-- | see if circuit in aocp is found, namely:
-- ["tears","sears","stars","stare","stale","stile","smile"]
find_smile_from_tears g = toList $ head $ goF forest where
  forest = AM.bfsForestFrom ["tears"] g
  goT (Node "smile" _) = Node "smile" []
  goT (Node x xs) = Node x $ goF xs
  goF fs = [ goT tree | tree <- fs, "smile" `elem` tree ]

klbfs g = KL.bfsForestFrom (AM.vertexList g) (KL.fromAdjacencyMap g)
klbfs' g = KL.bfsForestFrom (AIM.vertexList g) (KL.fromAdjacencyIntMap g)
kldfs g = KL.dfsForestFrom (AM.vertexList g) (KL.fromAdjacencyMap g)
kldfs' g = KL.dfsForestFrom (AIM.vertexList g) (KL.fromAdjacencyIntMap g)

-- | bench stanford graph base 5 letter word graph with
-- words connected if they differ by one char.
benchSGB = do
  wds <- lines <$> readFile "sgb-words.txt"
  let (!gw,!gi) = sgb wds
      !es = AIM.edgeList gi
      !kl = LG.buildG (0,length wds - 1) es
  gw `deepseq` pure ()
  gi `deepseq` pure ()
  kl `deepseq` pure ()
  withArgs ["-o","words.html"] $ defaultMain
    [ bgroup "sgb words"
      [ bench "Set bfs" $ nf AM.bfsForest gw
      , bench "KL bfs" $ nf klbfs gw
      , bench "Set dfs" $ nf AM.dfsForest gw
      , bench "KL dfs" $ nf kldfs gw
      ] 
    , bgroup "sgb words->ints"
      [ bench "IntSet bfs" $ nf AIM.bfsForest gi
      , bench "STArray/KL bfs" $ nf klbfs' gi
      , bench "IntSet dfs" $ nf AIM.dfsForest gi
      , bench "existing KL dfs" $ nf kldfs' gi
      , bench "Data.Graph.dfs" $ nf LG.dff kl
      ]
    ]

benchAIM = do
  wds <- lines <$> readFile "sgb-words.txt"
  let (_,!gi) = sgb wds
      !sgv = AIM.vertexList gi
      !sge = AIM.edgeList gi
      !es = [ (x,y) | x <- [1..1000], y <- [1..1000] ]
      !fglk1000 = FGL.mkUGraph [1..1000] es :: FGLPT.UGr
      !fglgb = FGL.mkUGraph sgv sge :: FGLPT.UGr
      !k1000 = AIM.edges es
      !pth = AIM.circuit [1..10000]
      !vts = AIM.vertices [1..10000]
      !str = AIM.star 1 [1..1000]
  fglk1000 `deepseq` pure ()
  k1000    `deepseq` pure ()
  fglgb    `deepseq` pure ()
  gi       `deepseq` pure ()
  withArgs ["-o","aim.html"] $ defaultMain
    [ bgroup "K 1000"
      [ bench "alga bfs" $ nf (AIM.bfs [1]) k1000
      , bench "fgl bfs" $ nf (FGL.bfs 1) fglk1000
      , bench "alga dff" $ nf AIM.dfsForest k1000
      , bench "fgl dff" $ nf FGL.dff' fglk1000
      ]
    , bgroup "sgb int"
      [ bench "alga bfs" $ nf (AIM.bfs [0]) gi
      , bench "fgl bfs" $ nf (FGL.bfs 0) fglgb
      , bench "alga dff" $ nf AIM.dfsForest gi
      , bench "fgl dff" $ nf FGL.dff' fglgb
      ]
    ]

main = do
--  benchSGB
  benchAIM