Commit 3facb35a authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

wta: Fix warnings

parent d5ae202a
...@@ -306,6 +306,7 @@ executable random-wta ...@@ -306,6 +306,7 @@ executable random-wta
, megaparsec >= 7 && <8 , megaparsec >= 7 && <8
, scientific >= 0.3 && <0.4 , scientific >= 0.3 && <0.4
, containers >= 0.6 && <0.7 , containers >= 0.6 && <0.7
ghc-options: -Wall -Wno-name-shadowing
test-suite random-wta-tests test-suite random-wta-tests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
...@@ -324,3 +325,4 @@ test-suite random-wta-tests ...@@ -324,3 +325,4 @@ test-suite random-wta-tests
, containers >= 0.6 && <0.7 , containers >= 0.6 && <0.7
, hspec , hspec
, QuickCheck , QuickCheck
ghc-options: -Wall -Wno-name-shadowing
...@@ -21,7 +21,6 @@ import Data.Foldable ...@@ -21,7 +21,6 @@ import Data.Foldable
import Control.Arrow ( (&&&) ) import Control.Arrow ( (&&&) )
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Coerce
import Data.Ratio import Data.Ratio
import System.IO import System.IO
...@@ -41,7 +40,7 @@ data GeneratorConfig m = GeneratorConfig ...@@ -41,7 +40,7 @@ data GeneratorConfig m = GeneratorConfig
type Generator m = ReaderT (GeneratorConfig m) IO type Generator m = ReaderT (GeneratorConfig m) IO
zeroFreq :: GeneratorConfig m -> Probability zeroFreq :: GeneratorConfig m -> Probability
zeroFreq (GeneratorConfig { zeroPolicy = ZeroFrequency p }) = p zeroFreq GeneratorConfig { zeroPolicy = ZeroFrequency p } = p
zeroFreq _ = error "zeroFreq: unexpected out degree" -- TODO Ugly as hell zeroFreq _ = error "zeroFreq: unexpected out degree" -- TODO Ugly as hell
runGenerator :: GeneratorConfig m -> Generator m a -> IO a runGenerator :: GeneratorConfig m -> Generator m a -> IO a
...@@ -108,7 +107,7 @@ genTransitionsZeroFreq = do ...@@ -108,7 +107,7 @@ genTransitionsZeroFreq = do
-- TODO Implement (Random IndexedTransition) -- TODO Implement (Random IndexedTransition)
uniqueTransitions :: Int -> IndexedTransition -> IO [IndexedTransition] uniqueTransitions :: Int -> IndexedTransition -> IO [IndexedTransition]
uniqueTransitions num idxMax@(IndexedTransition.Index max) uniqueTransitions num idxMax@(IndexedTransition.Index max)
| fromIntegral num < fromIntegral max * (7 % 10) = uniqueTransitionsByGeneration | fromIntegral num < fromIntegral max * ((7 :: Integer) % 10) = uniqueTransitionsByGeneration
num num
idxMax idxMax
| otherwise = uniqueTransitionsByElimination num idxMax | otherwise = uniqueTransitionsByElimination num idxMax
...@@ -144,7 +143,7 @@ genTransitionsNumTrans numTransitions = do ...@@ -144,7 +143,7 @@ genTransitionsNumTrans numTransitions = do
let n = numStates wtaSpec let n = numStates wtaSpec
maxT = IndexedTransition.maxIndex wtaSpec maxT = IndexedTransition.maxIndex wtaSpec
numTransitions' <- if (fromIntegral numTransitions > maxT) numTransitions' <- if fromIntegral numTransitions > maxT
then do then do
let cap = IndexedTransition.fromIndexd maxT let cap = IndexedTransition.fromIndexd maxT
lift $ hPutStrLn lift $ hPutStrLn
...@@ -153,8 +152,7 @@ genTransitionsNumTrans numTransitions = do ...@@ -153,8 +152,7 @@ genTransitionsNumTrans numTransitions = do
<> show cap <> show cap
) )
return (fromIntegral cap) return (fromIntegral cap)
else do else return numTransitions
return numTransitions
transitions <- transitions <-
lift lift
...@@ -177,5 +175,5 @@ genTransitionsNumTrans numTransitions = do ...@@ -177,5 +175,5 @@ genTransitionsNumTrans numTransitions = do
genWTA :: Generator m (WTA m) genWTA :: Generator m (WTA m)
genWTA = asks zeroPolicy >>= \case genWTA = asks zeroPolicy >>= \case
NumTransitions d -> NumTransitions d ->
WTA <$> asks spec <*> genStates <*> (genTransitionsNumTrans d) WTA <$> asks spec <*> genStates <*> genTransitionsNumTrans d
ZeroFrequency _ -> WTA <$> asks spec <*> genStates <*> genTransitionsZeroFreq ZeroFrequency _ -> WTA <$> asks spec <*> genStates <*> genTransitionsZeroFreq
...@@ -119,8 +119,7 @@ parseZeroFreq = ...@@ -119,8 +119,7 @@ parseZeroFreq =
<|> (NumTransitions <$> Options.option <|> (NumTransitions <$> Options.option
Options.auto Options.auto
(Options.long "transitions" <> Options.metavar "NUM" <> Options.help (Options.long "transitions" <> Options.metavar "NUM" <> Options.help
("Number of transitions to generate. They will be distributed randomly over states." "Number of transitions to generate. They will be distributed randomly over states."
)
) )
) )
...@@ -131,13 +130,6 @@ withSpec opts f = case optMonoid opts of ...@@ -131,13 +130,6 @@ withSpec opts f = case optMonoid opts of
, numSymbols = optSymbols opts , numSymbols = optSymbols opts
} }
computeProbability :: WTASpec m -> EdgeConfig -> Probability
computeProbability _ (ZeroFrequency p) = p
computeProbability spec (NumTransitions 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 :: IO ()
main = do main = do
let optSpec = let optSpec =
...@@ -154,8 +146,6 @@ main = do ...@@ -154,8 +146,6 @@ main = do
withSpec opts $ \spec -> do withSpec opts $ \spec -> do
randGen <- getStdGen randGen <- getStdGen
-- let zeroFreq = computeProbability spec (optEdgeConfig opts)
-- hPutStrLn stderr $ "p hacking: " ++ show zeroFreq
wta <- runGenerator wta <- runGenerator
(GeneratorConfig spec (optEdgeConfig opts) (optDifferentValues opts)) (GeneratorConfig spec (optEdgeConfig opts) (optDifferentValues opts))
genWTA genWTA
......
...@@ -5,7 +5,6 @@ module Output (buildWTA) where ...@@ -5,7 +5,6 @@ module Output (buildWTA) where
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Vector ( Vector ) import Data.Vector ( Vector )
import Data.Text.Lazy.Builder ( Builder ) import Data.Text.Lazy.Builder ( Builder )
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Text.Lazy.Builder.Int as Build import qualified Data.Text.Lazy.Builder.Int as Build
import Data.Foldable import Data.Foldable
import Data.List import Data.List
...@@ -33,7 +32,7 @@ polynomial :: SymbolSpec -> Builder ...@@ -33,7 +32,7 @@ polynomial :: SymbolSpec -> Builder
polynomial = sepList " + " id . catMaybes . toList . V.imap summand polynomial = sepList " + " id . catMaybes . toList . V.imap summand
where where
summand :: Int -> Int -> Maybe Builder summand :: Int -> Int -> Maybe Builder
summand arity 0 = Nothing summand _ 0 = Nothing
summand 0 syms = Just (Build.decimal syms) summand 0 syms = Just (Build.decimal syms)
summand arity syms = summand arity syms =
Just $ fold (intersperse "×" (Build.decimal syms : replicate arity "X")) Just $ fold (intersperse "×" (Build.decimal syms : replicate arity "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