Skip to content
GitLab
Commit 5c5d3534 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files

wta: Fix formatting

parent 13b7f0a1
Hide whitespace changes
Inline Side-by-side
src/random-wta/Generator.hs
View file @ 5c5d3534
......@@ -11,9 +11,9 @@ import Control.Monad.Reader
import Data.Coerce
import Data.Maybe
import Data.Foldable
import Control.Arrow ((&&&))
import Control.Arrow ( (&&&) )
import Types hiding (spec)
import Types hiding ( spec )
import Probability
data GeneratorConfig m = GeneratorConfig
......@@ -30,13 +30,13 @@ runGenerator config action = runReaderT action config
genMonoidValue :: Generator m m
genMonoidValue = asks ((monoid . spec) &&& differentValues) >>= \case
(Powerset, Nothing) -> liftIO randomIO
(Powerset, Just 1) -> return True
(Powerset, Just 2) -> liftIO randomIO
(Powerset, _) -> error "differentValues >2 not supported for powerset"
(OrWord, Nothing) -> liftIO randomIO
(OrWord, Just x) -> liftIO $ randomRIO (1, fromIntegral x)
(MaxInt, Nothing) -> liftIO randomIO
(MaxInt, Just x) -> liftIO $ randomRIO (1, x)
(Powerset, Just 1 ) -> return True
(Powerset, Just 2 ) -> liftIO randomIO
(Powerset, _ ) -> error "differentValues >2 not supported for powerset"
(OrWord , Nothing) -> liftIO randomIO
(OrWord , Just x ) -> liftIO $ randomRIO (1, fromIntegral x)
(MaxInt , Nothing) -> liftIO randomIO
(MaxInt , Just x ) -> liftIO $ randomRIO (1, x)
genStates :: Generator m (Vector m)
genStates = do
......
src/random-wta/Main.hs
View file @ 5c5d3534
......@@ -96,19 +96,37 @@ parseOpts =
<*> 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"))
(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 0.7
<> Options.metavar "FREQ"
parseZeroFreq =
(Percentage <$> Options.option
(Options.eitherReader readProbability)
( Options.long "zero-frequency"
<> Options.showDefault
<> 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
"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 ("Expected number of outgoing transitions per state." <> " This calculates the zero frequency from the number of states, symbols and this parameter.")))
("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
......@@ -121,8 +139,8 @@ 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)
t = V.sum (V.imap (\i syms -> syms * n ^ i) (numSymbols spec))
in fromRationalApprox (1 - fromIntegral d / fromIntegral t)
main :: IO ()
main = do
......@@ -131,18 +149,19 @@ main = do
opts <- Options.execParser optSpec
case optMonoid opts of
SomeMonoid Powerset
| maybe False (>2) (optDifferentValues opts) -> do
hPutStrLn stderr "error: Powerset can't have more than 2 different values"
exitFailure
SomeMonoid Powerset | maybe False (> 2) (optDifferentValues opts) -> do
hPutStrLn stderr "error: Powerset can't have more than 2 different values"
exitFailure
_ -> return ()
mapM_ setStdGen (optRandomState opts)
mapM_ setStdGen (optRandomState opts)
withSpec opts $ \spec -> do
randGen <- getStdGen
let zeroFreq = computeProbability spec (optZeroFrequency opts)
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 <> "'"
T.putStr (Build.toLazyText (buildWTA wta))
src/random-wta/Output.hs
View file @ 5c5d3534
......@@ -35,16 +35,16 @@ polynomial = sepList " + " id . catMaybes . toList . V.imap summand
summand :: Int -> Int -> Maybe Builder
summand arity 0 = Nothing
summand 0 syms = Just (Build.decimal syms)
summand arity syms = Just $
fold (intersperse "×" (Build.decimal syms : replicate arity "X"))
summand arity syms =
Just $ fold (intersperse "×" (Build.decimal syms : replicate arity "X"))
data ValueUse = Weight | StateVal
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 StateVal OrWord w = Build.decimal w
buildValue _ Powerset b = if b then "1" else "0"
buildValue StateVal OrWord w = Build.decimal w
buildValue _ Powerset b = if b then "1" else "0"
buildTransition :: MonoidType m -> Transition m -> Builder
buildTransition mon trans =
......@@ -57,7 +57,12 @@ buildTransition mon trans =
where
buildSuccs succs = if V.null succs
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 Powerset _ = ""
......@@ -69,7 +74,7 @@ buildTransitions mon trans =
buildState :: WTASpec m -> (Int, m, Vector (Transition m)) -> Builder
buildState wtaSpec (state, value, trans) =
buildStateName (State state)
buildStateName (State state)
<> ": ("
<> buildValue StateVal (monoid wtaSpec) value
<> ", "
......
src/random-wta/Probability.hs
View file @ 5c5d3534
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Probability (Probability(..), readProbability, decide, fromRationalApprox) where
module Probability
( Probability(..)
, readProbability
, decide
, fromRationalApprox
)
where
import System.Random
import Data.Scientific
......@@ -12,33 +18,31 @@ newtype Probability = Probability Scientific
readProbability :: String -> Either String Probability
readProbability input = Probability <$> case input of
"0" -> Right (scientific 0 0)
('0':'.':rest) -> case reads rest of
('0' : '.' : rest) -> case reads rest of
[(digits, "")] -> Right (scientific digits (negate (length rest)))
_ -> failure
"1" -> Right (scientific 1 0)
('1':'.':rest)
| all (=='0') rest -> Right (scientific 1 0)
| otherwise -> failure
('1' : '.' : rest) | all (== '0') rest -> Right (scientific 1 0)
| otherwise -> failure
_ -> failure
where failure = Left "Could not parse probability"
decide :: Probability -> IO Bool
decide (Probability science) = do
let digits = coefficient science
let exp = negate (base10Exponent science)
randomNumber <- randomRIO (0, (10^exp)-1)
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
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
clamp low high x | x < low = low
| x > high = high
| otherwise = x
Supports Markdown
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