From 1f8b6e79f6e5de7901d3c5b965c14a1a3274c624 Mon Sep 17 00:00:00 2001 From: Hans-Peter Deifel Date: Thu, 4 Apr 2019 14:19:10 +0200 Subject: [PATCH] wta: Implement --out-degree parameter --- src/random-wta/Main.hs | 34 +++++++++++++++++++++++++--------- src/random-wta/Probability.hs | 17 +++++++++++++++-- 2 files changed, 40 insertions(+), 11 deletions(-) diff --git a/src/random-wta/Main.hs b/src/random-wta/Main.hs index 4e630a3..faadc09 100644 --- a/src/random-wta/Main.hs +++ b/src/random-wta/Main.hs @@ -19,6 +19,7 @@ import System.Random import Numeric import System.IO import System.Exit +import Control.Applicative import Types import Generator @@ -27,11 +28,13 @@ import Probability data SomeMonoid = forall m. SomeMonoid (MonoidType m) +data ZeroFrequency = Percentage Probability | OutDegree Int + data Opts = Opts { optMonoid :: SomeMonoid , optStates :: Int , optSymbols :: SymbolSpec - , optZeroFrequency :: Probability + , optZeroFrequency :: ZeroFrequency , optRandomState :: Maybe StdGen , optDifferentValues :: Maybe Int } @@ -90,19 +93,23 @@ parseOpts = <> Options.help "Comma separated list of symbols per arity. E.g. 2,0,1 means two symbols with arity 0, non with arity 1 and one with arity two" ) - <*> Options.option + <*> parseZeroFreq + <*> 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")) + +parseZeroFreq :: Options.Parser ZeroFrequency +parseZeroFreq = (Percentage <\$> Options.option (Options.eitherReader readProbability) ( Options.long "zero-frequency" <> Options.showDefault - <> Options.value (Probability 7 1) + <> Options.value 0.7 <> Options.metavar "FREQ" <> Options.help "Frequency of edges with zero weight as number between 0 and 1." - ) - <*> 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")) + )) + <|> (OutDegree <\$> Options.option Options.auto (Options.long "out-degree" <> Options.metavar "NUM_TRANSITIONS" <> Options.help ("Expected number of outgoing transitions per state." <> " This calculates the zero frequency from the number of states, symbols and this parameter."))) withSpec :: Opts -> (forall m . WTASpec m -> x) -> x withSpec opts f = case optMonoid opts of @@ -111,6 +118,13 @@ withSpec opts f = case optMonoid opts of , numSymbols = optSymbols opts } +computeProbability :: WTASpec m -> ZeroFrequency -> Probability +computeProbability _ (Percentage p) = p +computeProbability spec (OutDegree d) = + let n = numStates spec + t = V.sum (V.imap (\i syms -> syms * n^i) (numSymbols spec)) + in fromRationalApprox (1 - fromIntegral d/fromIntegral t) + main :: IO () main = do let optSpec = @@ -130,6 +144,8 @@ main = do withSpec opts \$ \spec -> do randGen <- getStdGen - wta <- runGenerator (GeneratorConfig spec (optZeroFrequency opts) (optDifferentValues opts)) genWTA + let zeroFreq = computeProbability spec (optZeroFrequency opts) + hPutStrLn stderr \$ "p hacking: " ++ show zeroFreq + wta <- runGenerator (GeneratorConfig spec zeroFreq (optDifferentValues opts)) genWTA putStrLn \$ "# Random state for this automaton: '" <> show randGen <> "'" T.putStr (Build.toLazyText (buildWTA wta)) diff --git a/src/random-wta/Probability.hs b/src/random-wta/Probability.hs index 99e1a0d..60078b0 100644 --- a/src/random-wta/Probability.hs +++ b/src/random-wta/Probability.hs @@ -1,13 +1,13 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Probability (Probability(..), readProbability, decide) where +module Probability (Probability(..), readProbability, decide, fromRationalApprox) where import System.Random import Data.Scientific newtype Probability = Probability Scientific - deriving newtype (Show) + deriving newtype (Show,Fractional,Num) readProbability :: String -> Either String Probability readProbability input = Probability <\$> case input of @@ -29,3 +29,16 @@ decide (Probability science) = do let exp = negate (base10Exponent science) randomNumber <- randomRIO (0, (10^exp)-1) return \$ randomNumber < digits + +fromRationalApprox :: Rational -> Probability +fromRationalApprox r = Probability \$ clamp 0 1 \$ case fromRationalRepetend (Just 100) r of + Left (s, _) -> s + -- TODO Maybe make this case more precise. Currently, 1/3 gets converted to + -- 0.3, which might not be precise enough. + Right (s, _) -> s + +clamp :: (Ord a, Num a) => a -> a -> a -> a +clamp low high x + | x < low = low + | x > high = high + | otherwise = x -- GitLab