module MA.Algorithm.BenchInitialize (benchmarks) where

import           Criterion

import           Control.Monad.ST

import qualified Data.Vector as V

import           Data.MorphismEncoding (Encoding, State)
import qualified Data.MorphismEncoding as Encoding
import           MA.Functors.Powerset
import           Data.Partition.Common
import           MA.Algorithm.Types
import           MA.Algorithm.Initialize


benchmarks :: Benchmark
benchmarks = bgroup "MA.Algorithm.Initialize"
  [ noEdges
  , withEdges
  ]


noEdges :: Benchmark
noEdges = bgroup "no edges"
  [ benchInit "10 states" (replicate 10 False) []
  , benchInit "100 states" (replicate 100 False) []
  , benchInit "1000 states" (replicate 1000 False) []
  ]

withEdges :: Benchmark
withEdges =
  bgroup
    "with edges"
    [ benchInit "10 states, 1 edge" (True : replicate 9 False) [(0, 1)]
    , benchInit
        "10 states, 10 edges"
        (replicate 10 True)
        [(from, to) | from <- [0 .. 9], let to = (from + 1) `mod` 10]
    , benchInit
        "10 states, 100 edges"
        (replicate 10 True)
        [(from, to) | from <- [0 .. 9], to <- [0 .. 9]]
    , benchInit "100 states, 1 edge" (True : replicate 99 False) [(0, 1)]
    , benchInit
        "100 states, one state 10 edges"
        (True : replicate 99 False)
        [(0, to) | to <- [0 .. 9]]
    , benchInit
        "100 states, one state 100 edges"
        (True : replicate 99 False)
        [(0, to) | to <- [0 .. 99]]
    , benchInit
        "100 states, 10 states one edge"
        (replicate 10 True ++ replicate 90 False)
        [(from, to) | from <- [0 .. 9], let to = from + 10]
    , benchInit
        "100 states, every state an edge"
        (replicate 100 True)
        [(from, to) | from <- [0 .. 99], let to = (from + 1) `mod` 100]
    , benchInit
        "100 states, every state 10 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 9]
        ]
    , benchInit
        "100 states, every state 20 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 19]
        ]
    , benchInit
        "100 states, every state 30 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 29]
        ]
    , benchInit
        "100 states, every state 40 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 39]
        ]
    , benchInit
        "100 states, every state 50 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 49]
        ]
    , benchInit
        "100 states, every state 60 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 59]
        ]
    , benchInit
        "100 states, every state 70 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 69]
        ]
    , benchInit
        "100 states, every state 80 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 79]
        ]
    , benchInit
        "100 states, every state 90 edges"
        (replicate 100 True)
        [ (from, to)
        | from <- [0 .. 99]
        , to <- (`mod` 100) <$> [from..from + 89]
        ]
    , benchInit
        "100 states, 10000 edges"
        (replicate 100 True)
        [(from, to) | from <- [0 .. 99], to <- [0 .. 99]]
    ]


benchInit :: String -> [Bool] -> [(State, State)] -> Benchmark
benchInit name h1s transitions =
  env
    (return (enc h1s transitions))
    (bench name . whnfIO . stToIO . initialize')

enc :: [Bool] -> [(State, State)] -> Encoding () Bool
enc h1s transitions = Encoding.new (V.fromList h1s) edges
  where
    edges = V.fromList (map mkEdge transitions)
    mkEdge (from, to) = Encoding.Edge from () to

initialize' :: Encoding () Bool -> ST s ([Block], AlgoState s Powerset)
initialize' = initialize @Powerset