Commit 5c5d3534 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

wta: Fix formatting

parent 13b7f0a1
...@@ -11,9 +11,9 @@ import Control.Monad.Reader ...@@ -11,9 +11,9 @@ import Control.Monad.Reader
import Data.Coerce import Data.Coerce
import Data.Maybe import Data.Maybe
import Data.Foldable import Data.Foldable
import Control.Arrow ((&&&)) import Control.Arrow ( (&&&) )
import Types hiding (spec) import Types hiding ( spec )
import Probability import Probability
data GeneratorConfig m = GeneratorConfig data GeneratorConfig m = GeneratorConfig
...@@ -30,13 +30,13 @@ runGenerator config action = runReaderT action config ...@@ -30,13 +30,13 @@ runGenerator config action = runReaderT action config
genMonoidValue :: Generator m m genMonoidValue :: Generator m m
genMonoidValue = asks ((monoid . spec) &&& differentValues) >>= \case genMonoidValue = asks ((monoid . spec) &&& differentValues) >>= \case
(Powerset, Nothing) -> liftIO randomIO (Powerset, Nothing) -> liftIO randomIO
(Powerset, Just 1) -> return True (Powerset, Just 1 ) -> return True
(Powerset, Just 2) -> liftIO randomIO (Powerset, Just 2 ) -> liftIO randomIO
(Powerset, _) -> error "differentValues >2 not supported for powerset" (Powerset, _ ) -> error "differentValues >2 not supported for powerset"
(OrWord, Nothing) -> liftIO randomIO (OrWord , Nothing) -> liftIO randomIO
(OrWord, Just x) -> liftIO $ randomRIO (1, fromIntegral x) (OrWord , Just x ) -> liftIO $ randomRIO (1, fromIntegral x)
(MaxInt, Nothing) -> liftIO randomIO (MaxInt , Nothing) -> liftIO randomIO
(MaxInt, Just x) -> liftIO $ randomRIO (1, x) (MaxInt , Just x ) -> liftIO $ randomRIO (1, x)
genStates :: Generator m (Vector m) genStates :: Generator m (Vector m)
genStates = do genStates = do
......
...@@ -96,19 +96,37 @@ parseOpts = ...@@ -96,19 +96,37 @@ parseOpts =
<*> Options.optional <*> Options.optional
(Options.option Options.auto (Options.long "random-state")) (Options.option Options.auto (Options.long "random-state"))
<*> Options.optional <*> Options.optional
(Options.option (Options.eitherReader readCount) (Options.long "different-values" <> Options.metavar "NUM" <> Options.help "Maximal number of differnt monoid values to generate")) (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 :: Options.Parser ZeroFrequency
parseZeroFreq = (Percentage <$> Options.option parseZeroFreq =
(Options.eitherReader readProbability) (Percentage <$> Options.option
( Options.long "zero-frequency" (Options.eitherReader readProbability)
<> Options.showDefault ( Options.long "zero-frequency"
<> Options.value 0.7 <> Options.showDefault
<> Options.metavar "FREQ" <> Options.value 0.7
<> Options.metavar "FREQ"
<> Options.help
"Frequency of edges with zero weight as number between 0 and 1."
)
)
<|> (OutDegree <$> Options.option
Options.auto
( Options.long "out-degree"
<> Options.metavar "NUM_TRANSITIONS"
<> Options.help <> Options.help
"Frequency of edges with zero weight as number between 0 and 1." ("Expected number of outgoing transitions per state."
)) <> " This calculates the zero frequency from the number of states, symbols and this parameter."
<|> (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 -> (forall m . WTASpec m -> x) -> x
withSpec opts f = case optMonoid opts of withSpec opts f = case optMonoid opts of
...@@ -121,8 +139,8 @@ computeProbability :: WTASpec m -> ZeroFrequency -> Probability ...@@ -121,8 +139,8 @@ computeProbability :: WTASpec m -> ZeroFrequency -> Probability
computeProbability _ (Percentage p) = p computeProbability _ (Percentage p) = p
computeProbability spec (OutDegree d) = computeProbability spec (OutDegree d) =
let n = numStates spec let n = numStates spec
t = V.sum (V.imap (\i syms -> syms * n^i) (numSymbols spec)) t = V.sum (V.imap (\i syms -> syms * n ^ i) (numSymbols spec))
in fromRationalApprox (1 - fromIntegral d/fromIntegral t) in fromRationalApprox (1 - fromIntegral d / fromIntegral t)
main :: IO () main :: IO ()
main = do main = do
...@@ -131,18 +149,19 @@ main = do ...@@ -131,18 +149,19 @@ main = do
opts <- Options.execParser optSpec opts <- Options.execParser optSpec
case optMonoid opts of case optMonoid opts of
SomeMonoid Powerset SomeMonoid Powerset | maybe False (> 2) (optDifferentValues opts) -> do
| maybe False (>2) (optDifferentValues opts) -> do hPutStrLn stderr "error: Powerset can't have more than 2 different values"
hPutStrLn stderr "error: Powerset can't have more than 2 different values" exitFailure
exitFailure
_ -> return () _ -> return ()
mapM_ setStdGen (optRandomState opts) mapM_ setStdGen (optRandomState opts)
withSpec opts $ \spec -> do withSpec opts $ \spec -> do
randGen <- getStdGen randGen <- getStdGen
let zeroFreq = computeProbability spec (optZeroFrequency opts) let zeroFreq = computeProbability spec (optZeroFrequency opts)
hPutStrLn stderr $ "p hacking: " ++ show zeroFreq hPutStrLn stderr $ "p hacking: " ++ show zeroFreq
wta <- runGenerator (GeneratorConfig spec zeroFreq (optDifferentValues opts)) genWTA wta <- runGenerator
(GeneratorConfig spec zeroFreq (optDifferentValues opts))
genWTA
putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'" putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'"
T.putStr (Build.toLazyText (buildWTA wta)) T.putStr (Build.toLazyText (buildWTA wta))
...@@ -35,16 +35,16 @@ polynomial = sepList " + " id . catMaybes . toList . V.imap summand ...@@ -35,16 +35,16 @@ polynomial = sepList " + " id . catMaybes . toList . V.imap summand
summand :: Int -> Int -> Maybe Builder summand :: Int -> Int -> Maybe Builder
summand arity 0 = Nothing summand arity 0 = Nothing
summand 0 syms = Just (Build.decimal syms) summand 0 syms = Just (Build.decimal syms)
summand arity syms = Just $ summand arity syms =
fold (intersperse "×" (Build.decimal syms : replicate arity "X")) Just $ fold (intersperse "×" (Build.decimal syms : replicate arity "X"))
data ValueUse = Weight | StateVal data ValueUse = Weight | StateVal
buildValue :: ValueUse -> MonoidType m -> m -> Builder buildValue :: ValueUse -> MonoidType m -> m -> Builder
buildValue _ MaxInt i = Build.decimal i buildValue _ MaxInt i = Build.decimal i
buildValue Weight OrWord w = "0x" <> Build.hexadecimal w buildValue Weight OrWord w = "0x" <> Build.hexadecimal w
buildValue StateVal OrWord w = Build.decimal w buildValue StateVal OrWord w = Build.decimal w
buildValue _ Powerset b = if b then "1" else "0" buildValue _ Powerset b = if b then "1" else "0"
buildTransition :: MonoidType m -> Transition m -> Builder buildTransition :: MonoidType m -> Transition m -> Builder
buildTransition mon trans = buildTransition mon trans =
...@@ -57,7 +57,12 @@ buildTransition mon trans = ...@@ -57,7 +57,12 @@ buildTransition mon trans =
where where
buildSuccs succs = if V.null succs buildSuccs succs = if V.null succs
then Build.decimal (symbol trans) then Build.decimal (symbol trans)
else "(" <> Build.decimal (symbol trans) <> ", " <> sepList ", " buildStateName (successors trans) <> ")" else
"("
<> Build.decimal (symbol trans)
<> ", "
<> sepList ", " buildStateName (successors trans)
<> ")"
buildWeight :: MonoidType m -> m -> Builder buildWeight :: MonoidType m -> m -> Builder
buildWeight Powerset _ = "" buildWeight Powerset _ = ""
...@@ -69,7 +74,7 @@ buildTransitions mon trans = ...@@ -69,7 +74,7 @@ buildTransitions mon trans =
buildState :: WTASpec m -> (Int, m, Vector (Transition m)) -> Builder buildState :: WTASpec m -> (Int, m, Vector (Transition m)) -> Builder
buildState wtaSpec (state, value, trans) = buildState wtaSpec (state, value, trans) =
buildStateName (State state) buildStateName (State state)
<> ": (" <> ": ("
<> buildValue StateVal (monoid wtaSpec) value <> buildValue StateVal (monoid wtaSpec) value
<> ", " <> ", "
......
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Probability (Probability(..), readProbability, decide, fromRationalApprox) where module Probability
( Probability(..)
, readProbability
, decide
, fromRationalApprox
)
where
import System.Random import System.Random
import Data.Scientific import Data.Scientific
...@@ -12,33 +18,31 @@ newtype Probability = Probability Scientific ...@@ -12,33 +18,31 @@ newtype Probability = Probability Scientific
readProbability :: String -> Either String Probability readProbability :: String -> Either String Probability
readProbability input = Probability <$> case input of readProbability input = Probability <$> case input of
"0" -> Right (scientific 0 0) "0" -> Right (scientific 0 0)
('0':'.':rest) -> case reads rest of ('0' : '.' : rest) -> case reads rest of
[(digits, "")] -> Right (scientific digits (negate (length rest))) [(digits, "")] -> Right (scientific digits (negate (length rest)))
_ -> failure _ -> failure
"1" -> Right (scientific 1 0) "1" -> Right (scientific 1 0)
('1':'.':rest) ('1' : '.' : rest) | all (== '0') rest -> Right (scientific 1 0)
| all (=='0') rest -> Right (scientific 1 0) | otherwise -> failure
| otherwise -> failure
_ -> failure _ -> failure
where failure = Left "Could not parse probability" where failure = Left "Could not parse probability"
decide :: Probability -> IO Bool decide :: Probability -> IO Bool
decide (Probability science) = do decide (Probability science) = do
let digits = coefficient science let digits = coefficient science
let exp = negate (base10Exponent science) let exp = negate (base10Exponent science)
randomNumber <- randomRIO (0, (10^exp)-1) randomNumber <- randomRIO (0, (10 ^ exp) - 1)
return $ randomNumber < digits return $ randomNumber < digits
fromRationalApprox :: Rational -> Probability fromRationalApprox :: Rational -> Probability
fromRationalApprox r = Probability $ clamp 0 1 $ case fromRationalRepetend (Just 100) r of fromRationalApprox r =
Left (s, _) -> s Probability $ clamp 0 1 $ case fromRationalRepetend (Just 100) r of
-- TODO Maybe make this case more precise. Currently, 1/3 gets converted to Left (s, _) -> s
-- 0.3, which might not be precise enough. -- TODO Maybe make this case more precise. Currently, 1/3 gets converted to
Right (s, _) -> s -- 0.3, which might not be precise enough.
Right (s, _) -> s
clamp :: (Ord a, Num a) => a -> a -> a -> a clamp :: (Ord a, Num a) => a -> a -> a -> a
clamp low high x clamp low high x | x < low = low
| x < low = low | x > high = high
| x > high = high | otherwise = x
| 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