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

Merge branch 'mcrl2-converter'

parents 8ec6c4d1 26aaab17
......@@ -245,26 +245,57 @@ benchmark bench
default-language: Haskell2010
ghc-options: -Wall
executable prism-converter
hs-source-dirs: src/prism-converter
main-is: Main.hs
other-modules: Parser
library prism-converter-lib
hs-source-dirs: src/prism-converter/lib
exposed-modules: Parser
, MarkovChain
, Mdp
, Mdp.Types
, StatesFile
, Mdp.Mcrl2
default-language: Haskell2010
build-depends: base >= 4.11
, text
, vector
, megaparsec >= 7
, containers
, optparse-applicative
, prettyprinter
, prettyprinter-ansi-terminal
, prettyprinter-convert-ansi-wl-pprint
, microlens
, microlens-th
, microlens-platform
, containers ^>= 0.6
, megaparsec ^>= 7
, microlens ^>= 0.4.10
, microlens-platform ^>= 0.3.11
, microlens-th ^>= 0.4.2
, text ^>= 1.2.3
, vector ^>= 0.12
, vector-algorithms ^>= 0.8.0.1
ghc-options: -Wall -Wno-name-shadowing
if !flag(benchmark-generators)
buildable: False
executable prism-converter
hs-source-dirs: src/prism-converter
main-is: Main.hs
default-language: Haskell2010
build-depends: base >= 4.11
, prism-converter-lib
, containers ^>= 0.6
, megaparsec ^>= 7
, optparse-applicative ^>= 0.14.3
, prettyprinter ^>= 1.2 || ^>= 1.3
, prettyprinter-ansi-terminal ^>= 1.1
, prettyprinter-convert-ansi-wl-pprint ^>= 1.1
, text ^>= 1.2.3
ghc-options: -Wall -Wno-name-shadowing
if !flag(benchmark-generators)
buildable: False
test-suite prism-converter-tests
type: exitcode-stdio-1.0
hs-source-dirs: src/prism-converter
main-is: Tests.hs
default-language: Haskell2010
build-depends: base >= 4.11
, hspec >= 2.6 && <2.8
, microlens-platform ^>= 0.3.11
, prism-converter-lib
, vector ^>= 0.12.0.2
, text ^>= 1.2.3
ghc-options: -Wall -Wno-name-shadowing
if !flag(benchmark-generators)
buildable: False
......
......@@ -2,17 +2,16 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Main (main) where
import System.IO
import System.Exit
import Data.Semigroup
import Control.Applicative
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
......@@ -37,17 +36,19 @@ instance Show ModelType where
show CTMC = "ctmc"
show MDP = "mdp"
data OutputFormat = Valmari | Valmari2 | Copar
data OutputFormat = Valmari | Valmari2 | Copar | Mcrl2
instance Show OutputFormat where
show Valmari = "valmari"
show Valmari2 = "valmari2"
show Copar = "copar"
show Mcrl2 = "mcrl2"
parseOutputFormat :: String -> Either String OutputFormat
parseOutputFormat "valmari" = Right Valmari
parseOutputFormat "valmari2" = Right Valmari2
parseOutputFormat "copar" = Right Copar
parseOutputFormat "mcrl2" = Right Mcrl2
parseOutputFormat other = Left ("Unknown output format '" <> other <> "'")
data Options = Options
......@@ -100,7 +101,7 @@ optionsParser =
(OptParse.eitherReader parseOutputFormat)
(OptParse.long "output-format" <>
OptParse.help
"Syntax used for the output file. Can be either 'copar', 'valmari' or 'valmari2'" <>
"Syntax used for the output file. Can be either 'copar', 'valmari', 'valmari2' or 'mcrl2'" <>
OptParse.metavar "FORMAT" <>
OptParse.value Copar <>
OptParse.showDefault)) <*>
......@@ -162,7 +163,7 @@ main = do
Left err -> do
hPutStrLn stderr $ "error while parsing --partition-on-variables: " <> T.unpack err
exitFailure
Right vars -> return (Just (computePartition sf vars))
Right vs -> return (Just (computePartition sf vs))
_ -> return Nothing
case (optModelType opts, optOutputFormat opts) of
......@@ -171,6 +172,7 @@ main = do
Valmari -> valmariMdpB
Valmari2 -> valmariMdp2B
Copar -> mdpB
Mcrl2 -> mcrl2B
in convert opts mdpP (builder initPartition)
(inType, outType) ->
let mcType =
......@@ -182,4 +184,5 @@ main = do
Valmari -> valmariMarkovChainB
Valmari2 -> error "valmari2 only implemented for MDPs"
Copar -> markovChainB
Mcrl2 -> error "mcrl2-format only supports MDPs"
in convert opts (markovChainP mcType) (builder initPartition)
# Prism converter
This directory containers a helper program called `prism-converter` that
converts transition matrices of PRISM[1] models into coalgebra specifications.
## Building
```sh
stack build --flag copar:benchmark-generators
```
## Generating transition matrices
You can generate those transition matrices with PRISM itself by using:
```sh
prism -exporttrans TRA_FILE -exportstates STA_FILE -const CONST_ASSIGNMENTS
```
Given the constant assignments `CONST_ASSIGNMENTS` (see the PRISM documentation
on syntax and semantics of those), thsi output a transition matrix in `TRA_FILE`
and a states file in `STA_FILE`. Please see [2] for additional details.
## Converting them into coalgebra specs
The resulting files can then be converted into a coalgebra specification using
```sh
stack exec prism-converter -- --model-type TYPE --states-file STA_FILE TRA_FILE
```
where type is one of dtmc, ctmc or mdp.
See `stack exec prism-converter -- --help` for details.
[1]: https://www.prismmodelchecker.org
[2]: https://www.prismmodelchecker.org/manual/RunningPRISM/ExportingTheModel
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Lens.Micro.Platform
import Test.Hspec
import qualified Data.Vector as V
import qualified Data.Text.Lazy.Builder as Build
import Mdp.Mcrl2
import Mdp.Types
import StatesFile
main :: IO ()
main = hspec $ do
convertToMcrlSpec
mcrl2BSpec
convertToMcrlSpec :: Spec
convertToMcrlSpec = describe "convertToMcrl" $ do
it "generates the correct number of states" $ do
let mdp = Mdp 4 1 mempty
let res = convertToMcrl Nothing mdp
res ^. numStates `shouldBe` mdp ^. numStates
it "generates a uniform initial distribution" $ do
let mdp = Mdp 4 1 mempty
let res = convertToMcrl Nothing mdp
res ^.. outDistribution . each . probability `shouldBe` (replicate 4 0.25)
it "generates the correct transition if there's only one" $ do
let mdp = Mdp 2 1 (V.singleton (Transition 0 0 1 1.0 Nothing))
let res = convertToMcrl Nothing mdp
let trans = Mcrl2Transition 0 "0" (V.singleton (Mcrl2PropTrans 1.0 1))
res ^? transitions . ix 0 `shouldBe` Just trans
it "generates one out-distribution for two transitions with same label" $ do
let mdp = Mdp 2 1 (V.fromList [Transition 0 0 0 0.5 Nothing, Transition 0 0 1 0.5 Nothing])
let res = convertToMcrl Nothing mdp
let trans = Mcrl2Transition 0 "0" (V.fromList [Mcrl2PropTrans 0.5 0, Mcrl2PropTrans 0.5 1])
res ^? transitions . ix 0 `shouldBe` Just trans
it "groups non-consecutive transitions with same source and label" $ do
let mdp = Mdp 2 1 (V.fromList [Transition 0 0 0 0.5 Nothing
, Transition 0 1 1 1.0 Nothing
, Transition 0 0 1 0.5 Nothing])
let res = convertToMcrl Nothing mdp
let trans = [ Mcrl2Transition 0 "0" (V.fromList [Mcrl2PropTrans 0.5 0, Mcrl2PropTrans 0.5 1])
, Mcrl2Transition 0 "1" (V.fromList [Mcrl2PropTrans 1.0 1])
]
res ^.. transitions . each `shouldBe` trans
it "generates two two distinct transitions for two transitions with different label" $ do
let mdp = Mdp 2 2 (V.fromList [Transition 0 0 1 1.0 Nothing, Transition 0 1 1 1.0 Nothing])
let res = convertToMcrl Nothing mdp
let trans1 = Mcrl2Transition 0 "0" (V.singleton (Mcrl2PropTrans 1.0 1))
let trans2 = Mcrl2Transition 0 "1" (V.singleton (Mcrl2PropTrans 1.0 1))
res ^.. transitions . traverse `shouldBe` [trans1, trans2]
it "correctly models the initial partition" $ do
let mdp = Mdp 2 2 (V.fromList [Transition 0 0 1 1.0 Nothing, Transition 0 1 1 1.0 Nothing])
let part = Partition 2 (V.fromList [0, 1])
let res = convertToMcrl (Just part) mdp
let trans = [ Mcrl2Transition 0 "0" (V.singleton (Mcrl2PropTrans 1.0 1))
, Mcrl2Transition 0 "1" (V.singleton (Mcrl2PropTrans 1.0 1))
, Mcrl2Transition 2 "i0" (V.singleton (Mcrl2PropTrans 1.0 0))
, Mcrl2Transition 3 "i1" (V.singleton (Mcrl2PropTrans 1.0 1))
]
res ^.. transitions . traverse `shouldBe` trans
mcrl2BSpec :: Spec
mcrl2BSpec = describe "mcrl2BSpec" $ do
it "works for an example" $ do
let mdp = Mdp 2 2 (V.fromList [Transition 0 0 1 1.0 Nothing, Transition 0 1 1 1.0 Nothing])
let res = "des (0 1/2 1,2,2)\n(0,\"0\",1)\n(0,\"1\",1)\n"
(Build.toLazyText (mcrl2B (convertToMcrl Nothing mdp)) ^. strict) `shouldBe` res
it "works for another example" $ do
let mdp = Mdp 2 1 (V.fromList [Transition 0 0 0 0.5 Nothing, Transition 0 0 1 0.5 Nothing])
let res = "des (0 1/2 1,1,2)\n(0,\"0\",0 1/2 1)\n"
(Build.toLazyText (mcrl2B (convertToMcrl Nothing mdp)) ^. strict) `shouldBe` res
it "works for an example with initial partition" $ do
let mdp = Mdp 2 2 (V.fromList [Transition 0 0 1 1.0 Nothing, Transition 0 1 1 1.0 Nothing])
let part = Partition 2 (V.fromList [0, 1])
let res = "des (0 1/4 1 1/4 2 1/4 3,4,4)\n(0,\"0\",1)\n(0,\"1\",1)\n(2,\"i0\",0)\n(3,\"i1\",1)\n"
(Build.toLazyText (mcrl2B (convertToMcrl (Just part) mdp)) ^. strict) `shouldBe` res
......@@ -5,8 +5,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Mdp (mdpP, mdpB, valmariMdpB, valmariMdp2B) where
module Mdp (mdpP, mdpB, valmariMdpB, valmariMdp2B, mcrl2B) where
import Data.List ( intersperse )
import Data.Foldable
......@@ -20,79 +21,66 @@ import qualified Data.Text.Lazy.Builder.RealFloat
as Build
import Data.Vector ( Vector )
import qualified Data.Vector as V
import Data.Text ( Text )
import Lens.Micro.Platform
import Mdp.Types
import Parser
import StatesFile ( Partition(..) )
import qualified Mdp.Mcrl2 as Mcrl2
----------------------------------------------------------------------
-- Types
-- helpers
----------------------------------------------------------------------
data Mdp = Mdp
{ mdpNumStates :: Int
, mdpNumChoices :: Int
, mdpTransitions :: Vector Transition
} deriving (Show)
-- TODO Support optional action label
data Transition = Transition
{ transitionSource :: Int
, transitionChoice :: Int
, transitionTarget :: Int
, transitionProbability :: Double
, transitionAction :: Maybe Text
} deriving (Show)
makeFields ''Mdp
makeFields ''Transition
convertToDouble :: Mdp Rational -> Mdp Double
convertToDouble = fmap (fromRational @Double)
----------------------------------------------------------------------
-- Parser
----------------------------------------------------------------------
mdpP :: Parser Mdp
mdpP :: Parser (Mdp Rational)
mdpP = Mdp <$> decimalP <*> decimalP <*> transitionsP
transitionsP :: Parser (Vector Transition)
transitionsP :: Parser (Vector (Transition Rational))
transitionsP = do
numTrans <- decimalP
V.replicateM numTrans transitionP
transitionP :: Parser Transition
transitionP :: Parser (Transition Rational)
transitionP =
Transition
<$> decimalP
<*> decimalP
<*> decimalP
<*> doubleP
<*> rationalP
<*> optional nameP
----------------------------------------------------------------------
-- Builder
----------------------------------------------------------------------
mdpB :: Maybe Partition -> Mdp -> Build.Builder
mdpB :: Maybe Partition -> (Mdp Rational) -> Build.Builder
mdpB partition mdp =
functorB partition <> "\n" <> transitionsB partition (mdp ^. transitions)
let mdp' = convertToDouble mdp
in functorB partition <> "\n" <> transitionsB partition (mdp' ^. transitions)
functorB :: Maybe Partition -> Build.Builder
functorB Nothing = "P(Nx(DX))\n"
functorB (Just partition) =
(Build.decimal (numBlocks partition)) <> " x P(Nx(DX))\n"
transitionsB :: Maybe Partition -> Vector Transition -> Build.Builder
transitionsB :: Maybe Partition -> Vector (Transition Double) -> Build.Builder
transitionsB partition ts =
let stateMap :: IntMap [Transition] =
let stateMap :: IntMap [(Transition Double)] =
V.foldl' (\m t -> M.insertWith (++) (t ^. source) [t] m) M.empty ts
in foldMap (uncurry (choicesB partition)) (M.toList stateMap)
choicesB :: Maybe Partition -> Int -> [Transition] -> Build.Builder
choicesB partition source ts =
let choiceMap :: IntMap [Transition] =
choicesB :: Maybe Partition -> Int -> [(Transition Double)] -> Build.Builder
choicesB partition src ts =
let choiceMap :: IntMap [(Transition Double)] =
foldl' (\m t -> M.insertWith (++) (t ^. choice) [t] m) M.empty ts
in stateB source
in stateB src
<> ": "
<> partStart partition
<> "{"
......@@ -104,19 +92,19 @@ choicesB partition source ts =
where
partStart Nothing = ""
partStart (Just part) =
"(" <> Build.decimal (stateAssignment part V.! source) <> ", "
"(" <> Build.decimal (stateAssignment part V.! src) <> ", "
partEnd Nothing = ""
partEnd (Just _) = ")"
transitionB :: Int -> [Transition] -> Build.Builder
transitionB choice successors =
transitionB :: Int -> [(Transition Double)] -> Build.Builder
transitionB choi successors =
"("
<> Build.decimal choice
<> Build.decimal choi
<> ", {"
<> fold (intersperse ", " (map successorB successors))
<> "})"
where
successorB :: Transition -> Build.Builder
successorB :: (Transition Double) -> Build.Builder
successorB t = stateB (t ^. target) <> ": " <> Build.formatRealFloat
Build.Fixed
Nothing
......@@ -172,7 +160,7 @@ makeFields ''ValmariTransition
type ValmariPartition = [[Int]]
convertToValmari :: Maybe Partition -> Mdp -> (ValmariMDP, ValmariPartition)
convertToValmari :: Maybe Partition -> (Mdp Double) -> (ValmariMDP, ValmariPartition)
convertToValmari maybePart mdp =
let nums = mdp ^. numStates
(numa, transMap) = mkValmariMap mdp
......@@ -199,12 +187,11 @@ convertToValmari maybePart mdp =
-- | Alternative method of modeling the same coalgebra. Here, we don't use
-- labels but partition the Distribution states on the label that leads to them.
-- This models the functor P(AxDX) more faithfully.
convertToValmari2 :: Maybe Partition -> Mdp -> (ValmariMDP, ValmariPartition)
convertToValmari2 :: Maybe Partition -> (Mdp Double) -> (ValmariMDP, ValmariPartition)
convertToValmari2 maybePart mdp =
let
nums = mdp ^. numStates
(numa, transMap) = mkValmariMap mdp
numc = mdp ^. numChoices
actions = V.fromList (concatMap mkChoices (M.toList transMap))
probs = V.fromList (concatMap mkTransitions (transMap ^.. each . each))
stateByChoice = M.fromListWith
......@@ -233,14 +220,14 @@ type ValmariMap = IntMap [(Int, (Int, [(Double, Int)]))]
-- | Returns the total number of action states and the valmari map
mkValmariMap :: Mdp -> (Int, ValmariMap)
mkValmariMap :: (Mdp Double) -> (Int, ValmariMap)
mkValmariMap mdp = M.mapAccum uniquifyChoices
0
(V.foldl' ins M.empty (mdp ^. transitions))
where
ins
:: IntMap (IntMap [(Double, Int)])
-> Transition
-> (Transition Double)
-> IntMap (IntMap [(Double, Int)])
ins m t =
m
......@@ -263,15 +250,15 @@ partToBlocks p =
in M.elems blockMap
valmariMdpB :: Maybe Partition -> Mdp -> Build.Builder
valmariMdpB :: Maybe Partition -> (Mdp Rational) -> Build.Builder
valmariMdpB partition mdp =
let (vmdp, vpartition) = convertToValmari partition mdp
let (vmdp, vpartition) = convertToValmari partition (convertToDouble mdp)
in valmariMdpBImpl vmdp vpartition
valmariMdp2B :: Maybe Partition -> Mdp -> Build.Builder
valmariMdp2B :: Maybe Partition -> (Mdp Rational) -> Build.Builder
valmariMdp2B partition mdp =
let (vmdp, vpartition) = convertToValmari2 partition mdp
let (vmdp, vpartition) = convertToValmari2 partition (convertToDouble mdp)
in valmariMdpBImpl vmdp vpartition
......@@ -341,3 +328,14 @@ valmariBlocks part =
& (each %~ fold)
& (each %~ (<> " 0\n"))
& fold
----------------------------------------------------------------------
-- mcrl2
----------------------------------------------------------------------
-- FIXME Support partition
mcrl2B :: Maybe Partition -> Mdp Rational -> Build.Builder
mcrl2B = ((.) . (.)) Mcrl2.mcrl2B Mcrl2.convertToMcrl
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Mdp.Mcrl2
( Mcrl2Mdp(Mcrl2Mdp)
, Mcrl2Transition(Mcrl2Transition)
, Mcrl2Distribution
, Mcrl2PropTrans(Mcrl2PropTrans)
, numStates
, transitions
, outDistribution
, source
, label
, probability
, target
, convertToMcrl
, mcrl2B
) where
import Data.Ord
import Control.Arrow ((&&&))
import Data.Ratio
import Data.Maybe
import Lens.Micro.Platform
import Data.Vector ( Vector )
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Intro as V
import Data.Text ( Text )
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Text.Lazy.Builder.Int as Build
import Mdp.Types
import StatesFile (Partition(..))
----------------------------------------------------------------------
-- Builder for .aut-Format used in mcrl2
--
-- This format is informally:
--
-- des (initial distribution, nr transitions, nr states)
-- (state, "label", out distribution)
-- ...
----------------------------------------------------------------------
data Mcrl2Mdp = Mcrl2Mdp
{ mcrl2MdpNumStates :: Int
, mcrl2MdpTransitions :: Vector Mcrl2Transition
, mcrl2MdpOutDistribution :: Mcrl2Distribution
} deriving (Show)
data Mcrl2Transition = Mcrl2Transition
{ mcrl2TransitionSource :: Int
, mcrl2TransitionLabel :: Text
, mcrl2TransitionOutDistribution :: Mcrl2Distribution
} deriving (Show, Eq)
type Mcrl2Distribution = Vector Mcrl2PropTrans
data Mcrl2PropTrans = Mcrl2PropTrans
{ mcrl2PropTransProbability :: Rational
, mcrl2PropTransTarget :: Int
} deriving (Show, Eq)
makeFields ''Mcrl2Mdp
makeFields ''Mcrl2Transition
makeFields ''Mcrl2PropTrans
convertToMcrl :: Maybe Partition -> Mdp Rational -> Mcrl2Mdp
convertToMcrl maybePart mdp = Mcrl2Mdp stateCount ts initDistri
where
partitionTransitions = maybe mempty convertPartition maybePart
ts = convertTransitionsToMcrl (mdp^.transitions) <> partitionTransitions
stateCount = (mdp ^.numStates) * (if isJust maybePart then 2 else 1)
initDistri = V.fromList $
map (Mcrl2PropTrans (1%fromIntegral stateCount)) [0 .. stateCount - 1]
-- | Introduce a new state for each existing state with one edge between them,
-- labeled with the block number.
convertPartition :: Partition -> Vector Mcrl2Transition
convertPartition part = V.imap mkPartTrans (stateAssignment part)
where
len = length (stateAssignment part)
mkPartTrans src blk = Mcrl2Transition (len + src) (mkPartLabel blk) (mkPartDist src)
mkPartLabel blk = "i" <> T.pack (show blk)
mkPartDist src = V.singleton (Mcrl2PropTrans 1 src)
convertTransitionsToMcrl :: Vector (Transition Rational) -> Vector Mcrl2Transition
convertTransitionsToMcrl trans = mkMcrl2Tans <$> partitionVector (view source &&& view choice) sorted
where
sorted = V.create $ do
v <- V.thaw trans -- TODO Maybe use unsafe thaw
V.sortBy (comparing $ view source &&& view choice) v
return v
mkMcrl2Tans :: Vector (Transition Rational) -> Mcrl2Transition
mkMcrl2Tans distri = Mcrl2Transition (h ^. source) (T.pack $ show $ h ^. choice) (mkPropTrans <$> distri)
where h = V.head distri
mkPropTrans :: (Transition Rational) -> Mcrl2PropTrans
mkPropTrans t = Mcrl2PropTrans (t ^. probability) (t ^. target)
partitionVector :: Eq b => (a -> b) -> Vector a -> Vector (Vector a)
partitionVector p = V.unfoldr helper
where
helper vec
| null vec = Nothing
| otherwise = Just $ V.span (((p (V.head vec)) ==) . p) vec
----------------------------------------------------------------------
-- Pretty Printer
--
-- The format is something like the following:
--
-- des (1 1/4 2 1/4 3 1/4 0,240,240)
-- (0,"step",5 1/4 6 1/4 7 1/4 4)
-- (1,"step",9 1/4 10 1/4 11 1/4 8)
-- (2,"step",13 1/4 14 1/4 15 1/4 12)
-- (3,"step",17 1/4 18 1/4 19 1/4 16)
-- (4,"step",21 1/4 22 1/4 23 1/4 20)
-- (5,"step",1 1/4 2 1/4 3 1/4 0)
-- ...
----------------------------------------------------------------------
-- TODO Rationals!!!
mcrl2B :: Mcrl2Mdp -> Build.Builder
mcrl2B mdp =
"des ("
<> distributionB (mdp ^. outDistribution)
<> ","
<> Build.decimal (mdp ^. transitions . to length)
<> ","
<> Build.decimal (mdp ^. numStates)
<> ")\n"
<> foldMap transitionB (mdp^.transitions)
distributionB :: Mcrl2Distribution -> Build.Builder
distributionB distri = foldMap (\x -> propTransB x <> " ") (V.init distri)
<> Build.decimal (V.last distri ^. target)
propTransB :: Mcrl2PropTrans -> Build.Builder
propTransB t = Build.decimal (t ^. target) <> " "
<> ratioB (t ^. probability)
transitionB :: Mcrl2Transition -> Build.Builder
transitionB t = "(" <> Build.decimal (t ^. source) <> ","
<> "\"" <> Build.fromText (t ^. label)
<> "\"," <> distributionB (t ^. outDistribution)
<> ")\n"
ratioB :: Rational -> Build.Builder
ratioB r = Build.decimal (numerator r) <> "/" <> Build.decimal (denominator r)
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module Mdp.Types
( Mdp(Mdp)
, Transition(Transition)
, numStates
, numChoices
, transitions
, source
, choice
, target
, probability
, action
, HasNumStates
, HasNumChoices
, HasTransitions
, HasSource
, HasChoice
, HasTarget
, HasProbability
, HasAction
) where
import Data.Vector ( Vector )
import Data.Text ( Text )
import Lens.Micro.Platform
data Mdp p = Mdp
{ mdpNumStates :: Int
, mdpNumChoices :: Int
, mdpTransitions :: Vector (Transition p)
} deriving (Show, Functor)
-- TODO Support optional action label
data Transition p = Transition
{ transitionSource :: Int
, transitionChoice :: Int
, transitionTarget :: Int
, transitionProbability :: p
, transitionAction :: Maybe Text
} deriving (Show, Functor)
makeFields ''Mdp
makeFields ''Transition
......@@ -5,6 +5,7 @@ module Parser
, lexeme
, decimalP
, doubleP
, rationalP
, nameP
, symbolP
) where
......@@ -29,6 +30,10 @@ decimalP = lexeme L.decimal
doubleP :: Parser Double
doubleP = lexeme (try L.float <|> (fromIntegral @Int <$> L.decimal))
-- | Parse a decimal into a ratio
rationalP :: Parser Rational
rationalP = toRational <$> lexeme L.scientific
isName1 :: Char -> Bool
isName1 c = isLetter c || c == '_'
......
......@@ -11,7 +11,6 @@ module StatesFile
import Control.Monad
import Data.Bifunctor (first)
import Data.Semigroup
import Data.Text (Text)
import qualified Data.Text as T
......
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