wta: Implement --out-degree parameter

import           Numeric

import           System.IO

import           System.Exit

import           Control.Applicative

import           Types

import           Generator

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

  }

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

                            , 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 =

  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

  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