Commit e964655b authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

wta: Add "hoegberg" output format

parent 0588e103
...@@ -291,6 +291,7 @@ executable random-wta ...@@ -291,6 +291,7 @@ executable random-wta
, Output , Output
, Probability , Probability
, IndexedTransition , IndexedTransition
, Hoegberg
default-language: Haskell2010 default-language: Haskell2010
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
, LambdaCase , LambdaCase
......
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Hoegberg (hoegbergWTA) where
import qualified Data.Vector as V
import Data.Vector ( Vector )
import Data.Text.Lazy.Builder ( Builder )
import qualified Data.Text.Lazy.Builder.Int as Build
import Data.Foldable
import Data.List
import Types
declareState :: WTASpec Bool -> Builder
declareState wta =
"# states\n"
<> (fold $ intersperse " " $ map Build.decimal [0 .. numStates wta - 1])
rules :: WTA Bool -> Builder
rules wta =
"# rules\n" <> (fold $ V.imap transitionsForState (stateTransitions wta))
transitionsForState :: Int -> Vector (Transition Bool) -> Builder
transitionsForState from = foldMap (transition from)
transition :: Int -> Transition Bool -> Builder
transition from trans =
"sym"
<> Build.decimal (symbol trans)
<> " "
<> Build.decimal from
<> " 1.0 "
<> (fold $ intersperse " " $ map Build.decimal (toList (successors trans)))
<> "\n"
accepting :: WTA Bool -> Builder
accepting wta =
"# accepting states\n"
<> (foldMap accepting1 $ V.elemIndices True (stateValue wta))
accepting1 :: Int -> Builder
accepting1 s = Build.decimal s <> " 1.0\n"
hoegbergWTA :: WTA Bool -> Builder
hoegbergWTA wta =
declareState (spec wta) <> "\n" <> rules wta <> "%%%\n" <> accepting wta
...@@ -23,6 +23,7 @@ import Control.Applicative ...@@ -23,6 +23,7 @@ import Control.Applicative
import Types import Types
import Generator import Generator
import Output import Output
import Hoegberg
import Probability import Probability
data SomeMonoid = forall m. SomeMonoid (MonoidType m) data SomeMonoid = forall m. SomeMonoid (MonoidType m)
...@@ -35,6 +36,7 @@ data Opts = Opts ...@@ -35,6 +36,7 @@ data Opts = Opts
, optEdgeConfig :: EdgeConfig , optEdgeConfig :: EdgeConfig
, optRandomState :: Maybe StdGen , optRandomState :: Maybe StdGen
, optDifferentValues :: Maybe Int , optDifferentValues :: Maybe Int
, optHoegberg :: Bool
} }
readMonoid :: Options.ReadM SomeMonoid readMonoid :: Options.ReadM SomeMonoid
...@@ -103,6 +105,7 @@ parseOpts = ...@@ -103,6 +105,7 @@ parseOpts =
"Maximal number of differnt monoid values to generate" "Maximal number of differnt monoid values to generate"
) )
) )
<*> Options.switch (Options.long "hoegberg" <> Options.help "Generate output in format suiteable for Hoegbergs Java implementation.")
parseZeroFreq :: Options.Parser EdgeConfig parseZeroFreq :: Options.Parser EdgeConfig
parseZeroFreq = parseZeroFreq =
...@@ -150,4 +153,6 @@ main = do ...@@ -150,4 +153,6 @@ main = do
(GeneratorConfig spec (optEdgeConfig opts) (optDifferentValues opts)) (GeneratorConfig spec (optEdgeConfig opts) (optDifferentValues opts))
genWTA genWTA
putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'" putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'"
T.putStr (Build.toLazyText (buildWTA wta)) case monoid spec of
Powerset | optHoegberg opts -> T.putStr (Build.toLazyText (hoegbergWTA wta))
_ -> T.putStr (Build.toLazyText (buildWTA wta))
...@@ -3,6 +3,7 @@ ...@@ -3,6 +3,7 @@
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
module Types module Types
( MonoidType(..) ( MonoidType(..)
...@@ -22,6 +23,8 @@ data MonoidType m where ...@@ -22,6 +23,8 @@ data MonoidType m where
OrWord ::MonoidType Word OrWord ::MonoidType Word
Powerset ::MonoidType Bool Powerset ::MonoidType Bool
deriving instance Show (MonoidType m)
-- | For each arity, the number of symbols -- | For each arity, the number of symbols
type SymbolSpec = Vector Int type SymbolSpec = Vector Int
...@@ -31,6 +34,8 @@ data WTASpec m = WTASpec ...@@ -31,6 +34,8 @@ data WTASpec m = WTASpec
, numSymbols :: SymbolSpec , numSymbols :: SymbolSpec
} }
deriving instance Show m => Show (WTASpec m)
newtype State = State { fromState :: Int} newtype State = State { fromState :: Int}
deriving (Num,Show,Eq,Integral,Enum,Real,Ord) deriving (Num,Show,Eq,Integral,Enum,Real,Ord)
...@@ -46,3 +51,5 @@ data WTA m = WTA ...@@ -46,3 +51,5 @@ data WTA m = WTA
, stateValue :: Vector m , stateValue :: Vector m
, stateTransitions :: Vector (Vector (Transition m)) , stateTransitions :: Vector (Vector (Transition m))
} }
deriving instance (Show m) => Show (WTA m)
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