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

wta: Implement --out-degree parameter

parent 36bc8d65
......@@ -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))
{-# 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
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