Commit 1c27a61a authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

wta: Allow to restrict number of different monoid values

Otherwise states get one of 2^64 different values in the initial partition,
meaning that they will be distinguished already.
parent 5ce3af69
...@@ -11,6 +11,7 @@ import Control.Monad.Reader ...@@ -11,6 +11,7 @@ import Control.Monad.Reader
import Data.Coerce import Data.Coerce
import Data.Maybe import Data.Maybe
import Data.Foldable import Data.Foldable
import Control.Arrow ((&&&))
import Types hiding (spec) import Types hiding (spec)
import Probability import Probability
...@@ -18,6 +19,7 @@ import Probability ...@@ -18,6 +19,7 @@ import Probability
data GeneratorConfig m = GeneratorConfig data GeneratorConfig m = GeneratorConfig
{ spec :: WTASpec m { spec :: WTASpec m
, zeroFreq :: Probability , zeroFreq :: Probability
, differentValues :: Maybe Int
} }
type Generator m = ReaderT (GeneratorConfig m) IO type Generator m = ReaderT (GeneratorConfig m) IO
...@@ -26,10 +28,13 @@ runGenerator :: GeneratorConfig m -> Generator m a -> IO a ...@@ -26,10 +28,13 @@ runGenerator :: GeneratorConfig m -> Generator m a -> IO a
runGenerator config action = runReaderT action config runGenerator config action = runReaderT action config
genMonoidValue :: Generator m m genMonoidValue :: Generator m m
genMonoidValue = asks (monoid . spec) >>= \case genMonoidValue = asks ((monoid . spec) &&& differentValues) >>= \case
Powerset -> liftIO $ randomIO (Powerset, Nothing) -> liftIO $ randomIO
OrWord -> liftIO $ randomIO (Powerset, _) -> error $ "differentValues not supported for powerset" -- FIXME detect this early (and handle the case <=2)
MaxInt -> liftIO $ randomIO (OrWord, Nothing) -> liftIO $ randomIO
(OrWord, Just x) -> liftIO $ randomRIO (0, fromIntegral (x-1))
(MaxInt, Nothing) -> liftIO $ randomIO
(MaxInt, Just x) -> liftIO $ randomRIO (0, x-1)
genStates :: Generator m (Vector m) genStates :: Generator m (Vector m)
genStates = do genStates = do
......
...@@ -18,6 +18,7 @@ import qualified Text.Megaparsec.Char.Lexer as Mega ...@@ -18,6 +18,7 @@ import qualified Text.Megaparsec.Char.Lexer as Mega
import Data.Void import Data.Void
import System.Random import System.Random
import System.IO import System.IO
import Numeric
import Types import Types
import Generator import Generator
...@@ -32,6 +33,7 @@ data Opts = Opts ...@@ -32,6 +33,7 @@ data Opts = Opts
, optSymbols :: SymbolSpec , optSymbols :: SymbolSpec
, optZeroFrequency :: Probability , optZeroFrequency :: Probability
, optRandomState :: Maybe StdGen , optRandomState :: Maybe StdGen
, optDifferentValues :: Maybe Int
} }
readMonoid :: Options.ReadM SomeMonoid readMonoid :: Options.ReadM SomeMonoid
...@@ -55,6 +57,12 @@ readSymbols = Options.maybeReader (Mega.parseMaybe parser) ...@@ -55,6 +57,12 @@ readSymbols = Options.maybeReader (Mega.parseMaybe parser)
parser :: Mega.Parsec Void String (Vector Int) parser :: Mega.Parsec Void String (Vector Int)
parser = V.fromList <$> Mega.decimal `Mega.sepBy` (Mega.string ",") parser = V.fromList <$> Mega.decimal `Mega.sepBy` (Mega.string ",")
readCount :: String -> Either String Int
readCount input = case readDec input of
[(0, "")] -> Left "Count must be >0"
[(x, "")] -> Right x
_ -> Left "Count not parse Number"
parseOpts :: Options.Parser Opts parseOpts :: Options.Parser Opts
parseOpts = parseOpts =
Opts Opts
...@@ -93,6 +101,8 @@ parseOpts = ...@@ -93,6 +101,8 @@ parseOpts =
) )
<*> Options.optional <*> Options.optional
(Options.option Options.auto (Options.long "random-state")) (Options.option Options.auto (Options.long "random-state"))
<*> Options.optional
(Options.option (Options.eitherReader readCount) (Options.long "different-values" <> Options.metavar "NUM" <> Options.help "Maximal number of differnt monoid values to generate"))
withSpec :: Opts -> (forall m . WTASpec m -> x) -> x withSpec :: Opts -> (forall m . WTASpec m -> x) -> x
withSpec opts f = case optMonoid opts of withSpec opts f = case optMonoid opts of
...@@ -113,6 +123,6 @@ main = do ...@@ -113,6 +123,6 @@ main = do
withSpec opts $ \spec -> do withSpec opts $ \spec -> do
randGen <- getStdGen randGen <- getStdGen
wta <- runGenerator (GeneratorConfig spec (optZeroFrequency opts)) genWTA wta <- runGenerator (GeneratorConfig spec (optZeroFrequency opts) (optDifferentValues opts)) genWTA
putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'" putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'"
T.putStr (Build.toLazyText (buildWTA wta)) T.putStr (Build.toLazyText (buildWTA wta))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment