diff --git a/hs/app/CommonOptions.hs b/hs/app/CommonOptions.hs index c6abbaf..5a733cb 100644 --- a/hs/app/CommonOptions.hs +++ b/hs/app/CommonOptions.hs @@ -4,6 +4,8 @@ import Options.Applicative data CommonOptions = CommonOptions { extraChecks :: Bool + , verbose :: Bool + , moreOutput :: Bool , logDirectory :: FilePath , resultsDirectory :: FilePath } @@ -13,5 +15,7 @@ commonOptionsParser :: Parser CommonOptions commonOptionsParser = CommonOptions <$> switch (long "extra-checks" <> help "Enable extra validation checks") + <*> switch (long "verbose" <> short 'v' <> help "More out to the terminal") + <*> switch (long "more-output" <> help "More output to files") <*> option str (long "log-directory" <> help "Directory for logging" <> showDefault <> value "log") <*> option str (long "results-directory" <> help "Directory for outputs" <> showDefault <> value "results") diff --git a/hs/app/DecomposeOutput.hs b/hs/app/DecomposeOutput.hs index 339b02a..7e94011 100644 --- a/hs/app/DecomposeOutput.hs +++ b/hs/app/DecomposeOutput.hs @@ -24,7 +24,8 @@ import Data.Text.IO qualified as T import Data.Text.Lazy.IO qualified as TL import Data.Tuple (swap) import Options.Applicative -import System.FilePath (()) +import System.FilePath (takeBaseName, (<.>), ()) +import System.IO (hFlush, stdout) data DecomposeOutputOptions = DecomposeOutputOptions { filename :: FilePath @@ -40,8 +41,7 @@ decomposeOutputOptionsParser = mainDecomposeOutput :: DecomposeOutputOptions -> CommonOptions -> IO () mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do - let - report s = appendFile (logDirectory "hs-decompose-output-hs.txt") (filename <> "\t" <> s <> "\n") + let report s = appendFile (logDirectory "hs-decompose-output.txt") (filename <> "\t" <> s <> "\n") -- READING INPUT ---------------- @@ -51,26 +51,29 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do -- PREPROCESSING ---------------- let (outputFuns, reverseFuns) = preprocess machine - printBasics outputFuns reverseFuns machine extraChecks + when verbose $ do + printBasics outputFuns reverseFuns machine extraChecks + putStrLn "" -- MINIMISING EACH COMPONENT ---------------------------- let mappedOutputFuns o = [(i, (o ==) . f) | (i, f) <- outputFuns] projections = [(o, refineFuns (mappedOutputFuns o) reverseFuns (states machine)) | o <- outputs machine] - putStrLn $ "\nComponents " <> show (length (outputs machine)) - mapM_ (\(o, p) -> putStr " " >> T.putStr o >> putStr " has size " >> print (numBlocks p)) projections + putStrLn $ show (length (outputs machine)) <> " components" + when verbose $ do + lazyListPrint . fmap (second numBlocks) $ projections + putStrLn "" -- REDUCING NUMBER OF COMPONENTS -- by checking which partitions are equivalent ---------------------------------------------- let (equiv, uniqPartitions) = equivalenceClasses comparePartitions projections - putStrLn $ "\nRepresentatives " <> show (length uniqPartitions) - print . fmap fst $ uniqPartitions - - -- putStrLn "\nEquivalences" - -- mapM_ (\(o2, o1) -> putStrLn $ " " <> show o2 <> " == " <> show o1) (Map.assocs equiv) + putStrLn $ "Representatives " <> show (length uniqPartitions) + when verbose $ do + lazyListPrint . fmap fst $ uniqPartitions + putStrLn "" -- COMPUTING THE LATTICE OF COMPONENTS -- Then we compare each pair of partitions. We only keep the finest @@ -81,8 +84,26 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do foo (a, b) = (numBlocks b, a) sortedTopMods = sortOn (negate . fst) . fmap foo $ topMods - putStrLn $ "\nTop modules " <> show (length topMods) - mapM_ (\(b, o) -> putStr " " >> T.putStr o >> putStr " has size " >> print b) sortedTopMods + putStrLn $ "Top modules " <> show (length topMods) + when verbose $ do + lazyListPrint sortedTopMods + putStrLn "" + + when moreOutput $ do + let outputFile = takeBaseName filename <> "_info" <.> "txt" + putStrLn $ "Writing more info to " <> outputFile + writeFile + (resultsDirectory takeBaseName filename <> "_info" <.> "txt") + ( "Representatives\n" + <> show (fmap fst uniqPartitions) + <> "\n\n" + <> "Equivalences\n" + <> show (Map.assocs equiv) + <> "\n\n" + <> "Top modules\n" + <> show sortedTopMods + <> "\n\n" + ) -- HEURISTIC MERGING -- Then we try to combine paritions, so that we don't end up with @@ -128,9 +149,9 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do when extraChecks (putStrLn $ " Correct? " <> show (comparePartitions p partition)) putStrLn $ " Size = " <> show (numBlocks p) - do + when moreOutput $ do let - filename' = "partition_" <> show componentIdx <> ".dot" + filename' = takeBaseName filename <> "_partition_" <> show componentIdx <.> "txt" content = T.unlines . fmap T.unwords . toBlocks $ p putStrLn $ " Output (partition) in file " <> filename' @@ -151,7 +172,8 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do initialFirst = sortOn (\(s, _, _, _) -> s /= initialBlock) transitionsBlocks -- Convert to a file - filename1 = "component_" <> show componentIdx <> ".dot" + filenameBase = takeBaseName filename <> "_component_" <> show componentIdx + filename1 = filenameBase <.> "dot" content1 = toString . mealyToDot name $ initialFirst -- So far so good, `initialFirst` could serve as our output @@ -162,7 +184,7 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do result = filter (\(_, i, _, _) -> i `Set.notMember` deadInputs) initialFirst -- Convert to a file - filename2 = "component_reduced_" <> show componentIdx <> ".dot" + filename2 = filenameBase <> "_reduced" <.> "dot" content2 = toString . mealyToDot name $ result putStrLn $ " Output (reduced machine) in file " <> filename1 @@ -190,13 +212,16 @@ printBasics :: _ => _ -> _ -> MealyMachine _ _ _ -> Bool -> IO _ printBasics outputFuns reverseFuns MealyMachine{..} extraChecksEnabled = do putStrLn $ (show . length $ states) <> " states, " <> (show . length $ inputs) <> " inputs and " <> (show . length $ outputs) <> " outputs" when extraChecksEnabled $ do - printPartition (refineFuns outputFuns reverseFuns states) - putStrLn "" + putStrLn $ "Number of states after minimisation: " <> show (numBlocks (refineFuns outputFuns reverseFuns states)) -- | This functions inverts a map. In the new map the values are lists. converseRelation :: Ord b => Map.Map a b -> Map.Map b [a] converseRelation = Map.fromListWith (++) . fmap (second pure . swap) . Map.assocs --- | Prints the number of blocks. -printPartition :: Partition s -> IO () -printPartition p = putStrLn $ "number of states = " <> show (numBlocks p) +lazyListPrint :: Show a => [a] -> IO () +lazyListPrint [] = putStrLn "[]" +lazyListPrint [x] = putStrLn $ "[" <> show x <> "]" +lazyListPrint (x : xs) = do + putStr ("[" <> show x) >> hFlush stdout + mapM_ (\x' -> putStr ("," <> show x') >> hFlush stdout) xs + putStrLn "]"