Commit f10f0f1f authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

tests: Add more tests for collectTouchedBlocks

parent 3b257514
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module MA.Algorithm.Types
( AlgoState(..)
) where
-- * Lenses
, toSubL
, lastWL
, encodingL
, predL
, partitionL
, h3CacheL
)
where
import Data.STRef
import Data.STRef
import Data.Vector (Vector)
import Data.Vector.Mutable (MVector)
import Data.Vector ( Vector )
import Data.Vector.Mutable ( MVector )
import Lens.Micro.TH
import Data.MorphismEncoding
import Data.RefinablePartition (RefinablePartition)
import MA.Coalgebra.RefinementTypes
import Data.MorphismEncoding
import Data.RefinablePartition ( RefinablePartition )
import MA.Coalgebra.RefinementTypes
data AlgoState s h = AlgoState
{ toSub :: MVector s [EdgeRef]
......@@ -21,3 +31,13 @@ data AlgoState s h = AlgoState
, partition :: RefinablePartition s
, h3Cache :: MVector s (H3 h)
}
makeLensesFor
[ ( "toSub", "toSubL" )
, ( "lastW", "lastWL" )
, ( "encoding", "encodingL" )
, ( "pred", "predL")
, ( "partition", "partitionL")
, ( "h3Cache", "h3CacheL")
]
''AlgoState
module MA.Algorithm.SplitSpec (spec) where
import Test.Hspec
import Test.Hspec
import Control.Monad.ST
import Control.Monad.Reader
import qualified Data.Vector as V
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import Lens.Micro.Platform
import MA.Algorithm.Types
import MA.Algorithm.Split
import Data.BlockQueue
import Data.Partition.Common
import Data.MorphismEncoding (Encoding)
import qualified Data.MorphismEncoding as Encoding
import Data.MorphismEncoding ( fromEdgeRef
, Encoding
)
import qualified Data.MorphismEncoding as Encoding
import MA.RefinementInterface
import MA.Coalgebra.RefinementTypes
import MA.Algorithm.Initialize
import MA.Algorithm.Split
import qualified Data.BlockQueue as Queue
import qualified Data.BlockQueue as Queue
import MA.Functors.Powerset
import qualified Data.RefinablePartition as Partition
spec :: Spec
spec = do
......@@ -26,44 +30,56 @@ spec = do
collectTouchedBlocksSpec :: Spec
collectTouchedBlocksSpec = describe "collectTouchedBlocks" $ do
it "returns an empty list when no predecessors exist" $
withState
@Powerset
(enc [True, False] [(0, (), 1)])
(collectTouchedBlocks (Block 0)) `shouldBe`
[]
it "returns an empty list when no predecessors exist" $ do
withState @Powerset (enc [True, False] [(0, (), 1)])
(collectTouchedBlocks (Block 0))
`shouldBe` []
it "returns the correct block when predecessors exist" $ do
withState @Powerset (enc [True, False] [(0, (), 1)])
(map fst <$> collectTouchedBlocks (Block 1))
`shouldBe` [Block 0]
it "returns the correct block when predecessors exist" $
withState
@Powerset
(enc [True, False] [(0, (), 1)])
(map fst <$> collectTouchedBlocks (Block 1)) `shouldBe`
[Block 0]
it "doesn't return duplicates" $ do
withState @Powerset (enc [True, True, False] [(0, (), 2), (1, (), 2)])
(map fst <$> collectTouchedBlocks (Block 1))
`shouldBe` [Block 0]
it "doesn't return duplicates" $
withState
@Powerset
(enc [True, True, False] [(0, (), 2), (1, (), 2)])
(map fst <$> collectTouchedBlocks (Block 1)) `shouldBe`
[Block 0]
it "computes the correct v0" $ do
withState @Powerset (enc [True, True, False] [(0, (), 2), (1, (), 2)])
(map snd <$> collectTouchedBlocks (Block 1))
-- initially, C contains all blocks, so calling update with empty list of
-- edges to S, the result is: No edges to "outside of C", all edges to C
-- and no edges to S.
`shouldBe` [(False, True, False)]
it "computes the correct v0" $
pending
it "marks the correct states" $ do
let res =
withState @Powerset (enc [True, True, False] [(0, (), 2), (1, (), 2)])
$ do
[(b, _)] <- collectTouchedBlocks (Block 1)
p <- view (_1 . partitionL)
VU.toList <$> lift (Partition.markedStates p b)
res `shouldMatchList` [0, 1]
it "marks the correct states" $
pending
it "adds the correct edges to toSub" $ do
let res =
withState @Powerset (enc [True, True, False] [(0, (), 2), (1, (), 2)])
$ do
_ <- collectTouchedBlocks (Block 1)
ts <- view (_1 . toSubL) >>= V.freeze
return (ts & each . each %~ fromEdgeRef & V.toList)
res `shouldBe` [[0], [1], []]
it "addes the correct edges to toSub" $
pending
withState ::
RefinementInterface h
withState
:: RefinementInterface h
=> Encoding (Label h) (H1 h)
-> (forall s. SplitM s h a)
-> (forall s . SplitM s h a)
-> a
withState e action = runST $ do
(q, as) <- initialize e
queue <- Queue.empty 20
queue <- Queue.empty 20
mapM_ (Queue.enqueue queue) q
runSplit as queue action
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment