wta: Implement --out-degree parameter

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))

src/random-wta/Probability.hs

 {-# 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