mirror of
https://git.cs.ou.nl/joshua.moerman/mealy-decompose.git
synced 2025-04-29 17:57:44 +02:00
54 lines
2 KiB
Haskell
54 lines
2 KiB
Haskell
-- | Copyright: (c) 2025 Joshua Moerman, Open Universiteit
|
|
-- SPDX-License-Identifier: EUPL-1.2
|
|
module DecomposeTemp where
|
|
|
|
import DotParser (readDotFile)
|
|
import Mealy
|
|
|
|
import Control.Monad (unless)
|
|
import Data.List (nub, sort)
|
|
import Data.Maybe (mapMaybe)
|
|
import Data.Set qualified as Set
|
|
import Data.Text (Text)
|
|
import Options.Applicative
|
|
|
|
-- Nog een experiment
|
|
|
|
data DecomposeTempOptions = DecomposeTempOptions
|
|
{ filename :: FilePath
|
|
, quiescence :: Text
|
|
, numComponents :: Int
|
|
}
|
|
deriving Show
|
|
|
|
decomposeTempOptionsParser :: Parser DecomposeTempOptions
|
|
decomposeTempOptionsParser =
|
|
DecomposeTempOptions
|
|
<$> argument str (help "Filename to read (dot format)" <> metavar "FILE")
|
|
<*> option str (long "quiescence" <> help "String denoting empty output" <> showDefault <> value "quiescence")
|
|
<*> option auto (long "components" <> short 'c' <> help "Number of components" <> metavar "NUM" <> showDefault <> value 2)
|
|
|
|
mainDecomposeTemp :: DecomposeTempOptions -> IO ()
|
|
mainDecomposeTemp DecomposeTempOptions{..} = do
|
|
putStrLn $ "reading " <> filename <> " and quiescence=" <> show quiescence
|
|
MealyMachine{..} <- readDotFile filename
|
|
|
|
let
|
|
quiescenceTransitions s = mapMaybe (\i -> let (o, t) = behaviour s i in if o == quiescence then Just (s, t) else Nothing) inputs
|
|
valid = all (uncurry (==)) . quiescenceTransitions
|
|
|
|
unless (all valid states) $ do
|
|
putStrLn "WARNING: Not all quiescence-transistions are self-loops!"
|
|
|
|
let
|
|
definedTransitions s = mapMaybe (\i -> let (o, t) = behaviour s i in if o /= quiescence || s /= t then Just (s, i, o, t) else Nothing) inputs
|
|
showState s trns = putStrLn $ show s <> ": " <> show (fmap (\(_, i, _, _) -> i) trns)
|
|
|
|
bfs [] _ = []
|
|
bfs (x : todo) visited
|
|
| x `Set.member` visited = bfs todo visited
|
|
| otherwise =
|
|
let trns = definedTransitions x
|
|
in (x, sort trns) : bfs (todo <> nub (fmap (\(_, _, _, t) -> t) trns)) (Set.insert x visited)
|
|
|
|
mapM_ (uncurry showState) (bfs [initialState] Set.empty)
|