1
Fork 0
mirror of https://git.cs.ou.nl/joshua.moerman/mealy-decompose.git synced 2025-04-30 02:07:44 +02:00

Added RandomGen to the main executable

This commit is contained in:
Joshua Moerman 2025-04-16 13:59:41 +02:00
parent e938befa20
commit 8da20fdbad
3 changed files with 29 additions and 19 deletions

View file

@ -5,6 +5,7 @@ module Main where
import CommonOptions import CommonOptions
import DecomposeInput import DecomposeInput
import DecomposeOutput import DecomposeOutput
import RandomGen
import Options.Applicative import Options.Applicative
import System.Directory import System.Directory
@ -22,6 +23,7 @@ main = do
case optCommand of case optCommand of
DecomposeOutput options -> mainDecomposeOutput options commonOptions DecomposeOutput options -> mainDecomposeOutput options commonOptions
DecomposeInput options -> mainDecomposeInput options commonOptions DecomposeInput options -> mainDecomposeInput options commonOptions
RandomGen options -> mainRandomGen options
data Options = Options data Options = Options
{ optCommand :: Command { optCommand :: Command
@ -38,10 +40,12 @@ optionsParser =
data Command data Command
= DecomposeOutput DecomposeOutputOptions = DecomposeOutput DecomposeOutputOptions
| DecomposeInput DecomposeInputOptions | DecomposeInput DecomposeInputOptions
| RandomGen RandomGenOptions
deriving Show deriving Show
commandParser = commandParser =
subparser subparser
( command "decompose-output" (info (DecomposeOutput <$> decomposeOutputOptionsParser) (progDesc "decompose based on output")) ( command "decompose-output" (info (DecomposeOutput <$> decomposeOutputOptionsParser) (progDesc "decompose based on output"))
<> command "decompose-input" (info (DecomposeInput <$> decomposeInputOptionsParser) (progDesc "decompose based on independent inputs")) <> command "decompose-input" (info (DecomposeInput <$> decomposeInputOptionsParser) (progDesc "decompose based on independent inputs"))
<> command "random-gen" (info (RandomGen <$> randomGenOptionsParser) (progDesc "generate random parallel compositions"))
) )

View file

@ -1,7 +1,7 @@
{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Main where module RandomGen where
import Data.Partition (Block (..)) import Data.Partition (Block (..))
import SplittingTree import SplittingTree
@ -11,9 +11,22 @@ import Control.Monad.Trans.State (execStateT)
import Data.List (sortOn) import Data.List (sortOn)
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Set qualified as Set import Data.Set qualified as Set
import System.Environment import Options.Applicative
import System.Random import System.Random
data RandomGenOptions = RandomGenOptions
{ numStates :: Int
, numComponents :: Int
}
deriving Show
randomGenOptionsParser :: Parser RandomGenOptions
randomGenOptionsParser =
RandomGenOptions
<$> option auto (long "states" <> short 'n' <> help "Number of states per component (max)" <> metavar "NUM" <> showDefault <> value 10)
<*> option auto (long "components" <> short 'c' <> help "Number of components" <> metavar "COMP" <> showDefault <> value 2)
<**> helper
genTransitions :: _ => Int -> [Char] -> [Char] -> RandT _ _ _ genTransitions :: _ => Int -> [Char] -> [Char] -> RandT _ _ _
genTransitions size inputs outputs = do genTransitions size inputs outputs = do
let let
@ -61,12 +74,11 @@ reachability initialState inputs transitions = go 0 Map.empty [initialState]
newStates = [t | i <- inputs, let t = transitions s i, t `Map.notMember` newVis] newStates = [t | i <- inputs, let t = transitions s i, t `Map.notMember` newVis]
in go (n + 1) newVis (rest ++ newStates) in go (n + 1) newVis (rest ++ newStates)
main :: IO () mainRandomGen :: RandomGenOptions -> IO ()
main = do mainRandomGen RandomGenOptions{..} = do
[nStr, cStr] <- getArgs
let let
n = read nStr n = numStates
c = read cStr c = numComponents
-- create random composition -- create random composition
(init0, inputs, trans0, outpf0) <- evalRandIO (genComposition n c ['a', 'b']) (init0, inputs, trans0, outpf0) <- evalRandIO (genComposition n c ['a', 'b'])
@ -89,7 +101,7 @@ main = do
PRState{..} <- execStateT (refine (const (pure ())) outputFuns reverseFuns) (initialPRState states) PRState{..} <- execStateT (refine (const (pure ())) outputFuns reverseFuns) (initialPRState states)
-- print -- print to stdout
let let
toBlock s = getBarePartition partition Map.! s toBlock s = getBarePartition partition Map.! s
allTransitions = [(toBlock s, i, o, toBlock t) | s <- states, i <- inputs, let o = outpf s i, let t = trans s i] allTransitions = [(toBlock s, i, o, toBlock t) | s <- states, i <- inputs, let o = outpf s i, let t = trans s i]

View file

@ -46,11 +46,14 @@ executable mealy-decompose-main
directory, directory,
filepath, filepath,
mealy-decompose, mealy-decompose,
optparse-applicative MonadRandom,
optparse-applicative,
random
other-modules: other-modules:
CommonOptions, CommonOptions,
DecomposeInput, DecomposeInput,
DecomposeOutput DecomposeOutput,
RandomGen
default-extensions: default-extensions:
OverloadedStrings OverloadedStrings
@ -61,15 +64,6 @@ executable mealy-decompose-lstar
build-depends: build-depends:
mealy-decompose mealy-decompose
executable mealy-decompose-random-gen
import: stuff
hs-source-dirs: app
main-is: RandomGen.hs
build-depends:
mealy-decompose,
MonadRandom,
random
executable mealy-decompose-playground executable mealy-decompose-playground
import: stuff import: stuff
hs-source-dirs: app hs-source-dirs: app