From 1c27a61a5ac9a33ea99a63cb1b44853bb94e7ef8 Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Wed, 3 Apr 2019 16:21:39 +0200
Subject: [PATCH] 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.
---
src/random-wta/Generator.hs | 13 +++++++++----
src/random-wta/Main.hs | 12 +++++++++++-
2 files changed, 20 insertions(+), 5 deletions(-)
diff --git a/src/random-wta/Generator.hs b/src/random-wta/Generator.hs
index 69e0b91..515ae94 100644
--- a/src/random-wta/Generator.hs
+++ b/src/random-wta/Generator.hs
@@ -11,6 +11,7 @@ import Control.Monad.Reader
import Data.Coerce
import Data.Maybe
import Data.Foldable
+import Control.Arrow ((&&&))
import Types hiding (spec)
import Probability
@@ -18,6 +19,7 @@ import Probability
data GeneratorConfig m = GeneratorConfig
{ spec :: WTASpec m
, zeroFreq :: Probability
+ , differentValues :: Maybe Int
}
type Generator m = ReaderT (GeneratorConfig m) IO
@@ -26,10 +28,13 @@ runGenerator :: GeneratorConfig m -> Generator m a -> IO a
runGenerator config action = runReaderT action config
genMonoidValue :: Generator m m
-genMonoidValue = asks (monoid . spec) >>= \case
- Powerset -> liftIO $ randomIO
- OrWord -> liftIO $ randomIO
- MaxInt -> liftIO $ randomIO
+genMonoidValue = asks ((monoid . spec) &&& differentValues) >>= \case
+ (Powerset, Nothing) -> liftIO $ randomIO
+ (Powerset, _) -> error $ "differentValues not supported for powerset" -- FIXME detect this early (and handle the case <=2)
+ (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 = do
diff --git a/src/random-wta/Main.hs b/src/random-wta/Main.hs
index db19d26..0efec8c 100644
--- a/src/random-wta/Main.hs
+++ b/src/random-wta/Main.hs
@@ -18,6 +18,7 @@ import qualified Text.Megaparsec.Char.Lexer as Mega
import Data.Void
import System.Random
import System.IO
+import Numeric
import Types
import Generator
@@ -32,6 +33,7 @@ data Opts = Opts
, optSymbols :: SymbolSpec
, optZeroFrequency :: Probability
, optRandomState :: Maybe StdGen
+ , optDifferentValues :: Maybe Int
}
readMonoid :: Options.ReadM SomeMonoid
@@ -55,6 +57,12 @@ readSymbols = Options.maybeReader (Mega.parseMaybe parser)
parser :: Mega.Parsec Void String (Vector Int)
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 =
Opts
@@ -93,6 +101,8 @@ parseOpts =
)
<*> Options.optional
(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 f = case optMonoid opts of
@@ -113,6 +123,6 @@ main = do
withSpec opts $ \spec -> do
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 <> "'"
T.putStr (Build.toLazyText (buildWTA wta))
--
GitLab