mirror of
https://git.cs.ou.nl/joshua.moerman/mealy-decompose.git
synced 2025-06-05 02:17:46 +02:00
Simplified the code a little bit
This commit is contained in:
parent
1252114e23
commit
5136728374
2 changed files with 14 additions and 18 deletions
|
@ -13,7 +13,6 @@ import Data.Maybe (mapMaybe)
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
|
|
||||||
|
|
||||||
debugOutput :: Bool
|
debugOutput :: Bool
|
||||||
debugOutput = False
|
debugOutput = False
|
||||||
|
|
||||||
|
@ -64,5 +63,5 @@ main = do
|
||||||
|
|
||||||
(a, b) <- runStateT learner 0
|
(a, b) <- runStateT learner 0
|
||||||
|
|
||||||
putStrLn $ "Size: " <> show a
|
putStrLn $ "Size: " <> show a
|
||||||
putStrLn $ "MQs: " <> show b
|
putStrLn $ "MQs: " <> show b
|
||||||
|
|
27
src/LStar.hs
27
src/LStar.hs
|
@ -104,35 +104,28 @@ initialiseWithA :: (Applicative f, Ord i) => [i] -> [Word i] -> [Word i] -> MQ f
|
||||||
initialiseWithA alphabet rowIdcs colIdcs mq = (\content -> LStarState{..}) <$> contentA
|
initialiseWithA alphabet rowIdcs colIdcs mq = (\content -> LStarState{..}) <$> contentA
|
||||||
where
|
where
|
||||||
rowIndices = Set.fromList rowIdcs
|
rowIndices = Set.fromList rowIdcs
|
||||||
rowIdcsExt = rowIndices <> Set.fromList [r `snoc` a | r <- rowIdcs, a <- alphabet]
|
|
||||||
colIndices = Set.fromList colIdcs
|
colIndices = Set.fromList colIdcs
|
||||||
domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct rowIdcsExt colIndices
|
queries = [p <> m <> s | p <- rowIdcs, m <- []:fmap pure alphabet, s <- colIdcs]
|
||||||
contentA = Map.traverseWithKey (\w _ -> mq w) domain
|
contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
|
||||||
|
|
||||||
-- preconditie: newRowIndices is disjunct van de huidige rowIndices en de
|
-- preconditie: newRowIndices is disjunct van de huidige rowIndices en de
|
||||||
-- vereniging is prefix-gesloten. (Wordt niet gechecked.)
|
-- vereniging is prefix-gesloten. (Wordt niet gechecked.)
|
||||||
addRowsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
addRowsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
||||||
addRowsA newRowIndices mq table@LStarState{..} = (\newContent -> table
|
addRowsA newRowIndices mq table@LStarState{..} = (\newContent -> table
|
||||||
{ content = content <> newContent
|
{ content = content <> newContent
|
||||||
, rowIndices = rowIndices <> newRowIndicesSet }) <$> contentA
|
, rowIndices = rowIndices <> Set.fromList newRowIndices }) <$> contentA
|
||||||
where
|
where
|
||||||
newRowIndicesExt = Set.fromList [r `snoc` a | r <- newRowIndices, a <- alphabet]
|
queries = [w | p <- newRowIndices, m <- []:fmap pure alphabet, s <- Set.toList colIndices, let w = p <> m <> s, w `Map.notMember` content]
|
||||||
newRowIndicesSet = Set.fromList newRowIndices
|
contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
|
||||||
newRowIndices2 = (newRowIndicesSet <> newRowIndicesExt) `Set.difference` rowIndices
|
|
||||||
domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct newRowIndices2 colIndices
|
|
||||||
contentA = Map.traverseWithKey (\w _ -> mq w) domain
|
|
||||||
|
|
||||||
-- preconditie: zie addRows (?)
|
-- preconditie: zie addRows (?)
|
||||||
addColumnsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
addColumnsA :: (Applicative f, Ord i) => [Word i] -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
||||||
addColumnsA newColIndices mq table@LStarState{..} = (\newContent -> table
|
addColumnsA newColIndices mq table@LStarState{..} = (\newContent -> table
|
||||||
{ content = content <> newContent
|
{ content = content <> newContent
|
||||||
, colIndices = colIndices <> newColIndicesSet }) <$> contentA
|
, colIndices = colIndices <> Set.fromList newColIndices }) <$> contentA
|
||||||
where
|
where
|
||||||
newColIndicesExt = Set.fromList [a `cons` c | c <- newColIndices, a <- alphabet]
|
queries = [w | p <- Set.toList rowIndices, m <- []:fmap pure alphabet, s <- newColIndices, let w = p <> m <> s, w `Map.notMember` content]
|
||||||
newColIndicesSet = Set.fromList newColIndices
|
contentA = Map.traverseWithKey (\w _ -> mq w) . Map.fromList . zip queries $ repeat ()
|
||||||
newColIndices2 = (newColIndicesSet <> newColIndicesExt) `Set.difference` colIndices
|
|
||||||
domain = Map.fromSet (const ()) . Set.map (uncurry (<>)) $ Set.cartesianProduct rowIndices newColIndices2
|
|
||||||
contentA = Map.traverseWithKey (\w _ -> mq w) domain
|
|
||||||
|
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -167,7 +160,11 @@ makeClosedAndConsistentA mq = loop False where
|
||||||
processCounterexampleA :: (Applicative f, Ord i) => Word i -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
processCounterexampleA :: (Applicative f, Ord i) => Word i -> MQ f i o -> LStarState i o -> f (LStarState i o)
|
||||||
processCounterexampleA ce mq table@LStarState{..} = addColumnsA newSuffixes mq table where
|
processCounterexampleA ce mq table@LStarState{..} = addColumnsA newSuffixes mq table where
|
||||||
shortestSuffix = minimumBy (comparing length) [suf | r <- Set.toList rowIndices, Just suf <- [stripPrefix r ce]]
|
shortestSuffix = minimumBy (comparing length) [suf | r <- Set.toList rowIndices, Just suf <- [stripPrefix r ce]]
|
||||||
|
-- Add all suffixes to the table. This ensures that the next hypothesis is bigger
|
||||||
newSuffixes = filter (not . null) . tails . drop 1 $ shortestSuffix
|
newSuffixes = filter (not . null) . tails . drop 1 $ shortestSuffix
|
||||||
|
-- Alternatively: Only add one suffix. This might result in the same hypothesis (and CE)
|
||||||
|
-- But in the end it will progress, possibly with fewer queries.
|
||||||
|
--newSuffixes = take 1 . filter (\s -> s `Set.notMember` colIndices) . filter (not . null) . tails . drop 1 $ shortestSuffix
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
|
Loading…
Add table
Reference in a new issue