mirror of
https://git.cs.ou.nl/joshua.moerman/mealy-decompose.git
synced 2025-04-30 02:07:44 +02:00
122 lines
4 KiB
Haskell
122 lines
4 KiB
Haskell
module Main where
|
|
|
|
import DotParser
|
|
import Mealy
|
|
import MealyRefine
|
|
|
|
-- import Control.Monad.IO.Class (liftIO)
|
|
-- import Control.Monad.Trans.State.Strict
|
|
import Control.Monad (forM_)
|
|
-- import Data.Map.Strict qualified as Map
|
|
import Data.Maybe (mapMaybe)
|
|
import Data.Partition (isRefinementOf, numBlocks)
|
|
-- import Data.Semigroup (Arg(..))
|
|
-- import Data.Set qualified as Set
|
|
-- import Data.List.Ordered (nubSort)
|
|
import System.Environment
|
|
import Text.Megaparsec
|
|
|
|
{-
|
|
Hacked together, you can view the result with:
|
|
|
|
tred relation.dot | dot -Tpng -G"rankdir=BT" > relation.png
|
|
|
|
tred is the graphviz tool to remove transitive edges. And the rankdir
|
|
attribute flips the graph upside down.
|
|
-}
|
|
main :: IO ()
|
|
main = do
|
|
-- Read dot file
|
|
[dotFile] <- getArgs
|
|
print dotFile
|
|
transitions <- mapMaybe (parseMaybe parseTransFull) . lines <$> readFile dotFile
|
|
|
|
-- convert to mealy
|
|
let machine = convertToMealy transitions
|
|
|
|
-- print some basic info
|
|
putStrLn $ (show . length $ states machine) <> " states, " <> (show . length $ inputs machine) <> " inputs and " <> (show . length $ outputs machine) <> " outputs"
|
|
putStrLn "Small sample:"
|
|
print . take 4 . states $ machine
|
|
print . take 4 . inputs $ machine
|
|
print . take 4 . outputs $ machine
|
|
|
|
-- DEBUG OUTPUT
|
|
-- forM_ (states machine) (\s -> do
|
|
-- print s
|
|
-- forM_ (inputs machine) (\i -> do
|
|
-- putStr " "
|
|
-- let (o, t) = behaviour machine s i
|
|
-- putStrLn $ "--" <> (show i) <> "/" <> (show o) <> "->" <> (show t)
|
|
-- )
|
|
-- )
|
|
|
|
let printPartition p = putStrLn $ "number of states = " <> show (numBlocks p)
|
|
|
|
-- Minimise input, so we know the actual number of states
|
|
printPartition (refineMealy (mealyMachineToEncoding machine))
|
|
putStrLn ""
|
|
|
|
-- Then compute each projection
|
|
-- I did some manual preprocessing, these are the only interesting bits
|
|
let outs = ["10", "10-O9", "2.2", "3.0", "3.1", "3.10", "3.12", "3.13", "3.14", "3.16", "3.17", "3.18", "3.19", "3.2", "3.20", "3.21", "3.3", "3.4", "3.6", "3.7", "3.8", "3.9", "5.0", "5.1", "5.12", "5.13", "5.17", "5.2", "5.21", "5.23", "5.6", "5.7", "5.8", "5.9", "quiescence"]
|
|
-- outs = outputs machine
|
|
projections0 = allProjections machine outs
|
|
projections = zip outs $ fmap refineMealy projections0
|
|
|
|
-- Print number of states of each projection
|
|
forM_ projections (\(o, partition) -> do
|
|
putStr $ o <> " -> "
|
|
printPartition partition
|
|
)
|
|
|
|
{-
|
|
|
|
-- Check refinement relations for all pairs
|
|
-- This is a bit messy, it skips machines which are equivalent
|
|
-- to earlier checked machines, so we thread some state through this
|
|
-- computation. (And I also want some IO for debugging purposes.)
|
|
(equiv, rel) <- flip execStateT (Map.empty, []) $ do
|
|
forM_ projections (\(o1, b1) -> do
|
|
(repr, _) <- get
|
|
if o1 `Map.member` repr
|
|
then do
|
|
liftIO . putStrLn $ "skip " <> (show o1) <> " |-> " <> (show (repr Map.! o1))
|
|
else do
|
|
liftIO $ print o1
|
|
forM_ projections (\(o2, b2) -> do
|
|
(repr0, _) <- get
|
|
when (o1 < o2 && o2 `Map.notMember` repr0) $ do
|
|
case (isRefinementOf b1 b2, isRefinementOf b2 b1) of
|
|
(True, True) -> do
|
|
(repr, ls) <- get
|
|
put (Map.insert o2 o1 repr, ls)
|
|
(True, False) -> do
|
|
(repr, ls) <- get
|
|
put (repr, (o1, o2):ls)
|
|
(False, True) -> do
|
|
(repr, ls) <- get
|
|
put (repr, (o2, o1):ls)
|
|
(False, False) -> return ()
|
|
|
|
-- liftIO $ putStr " vs. "
|
|
-- liftIO $ print o2
|
|
)
|
|
)
|
|
|
|
putStrLn ""
|
|
putStrLn "Equivalences"
|
|
forM_ (Map.assocs equiv) (\(o2, o1) -> do
|
|
putStrLn $ " " <> (show o2) <> " == " <> (show o1)
|
|
)
|
|
|
|
let cleanRel = [(Map.findWithDefault o1 o1 equiv, Map.findWithDefault o2 o2 equiv) | (o1, o2) <- rel]
|
|
putStrLn ""
|
|
putStrLn "Relation (smaller points to bigger)"
|
|
forM_ (nubSort cleanRel) (\(o1, o2) -> do
|
|
putStrLn $ " " <> (show o2) <> " -> " <> (show o1)
|
|
)
|
|
|
|
return ()
|
|
|
|
-}
|