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

Merge branch 'mcrl2-converter'

parents 8ec6c4d1 26aaab17
...@@ -245,26 +245,57 @@ benchmark bench ...@@ -245,26 +245,57 @@ benchmark bench
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall
executable prism-converter library prism-converter-lib
hs-source-dirs: src/prism-converter hs-source-dirs: src/prism-converter/lib
main-is: Main.hs exposed-modules: Parser
other-modules: Parser
, MarkovChain , MarkovChain
, Mdp , Mdp
, Mdp.Types
, StatesFile , StatesFile
, Mdp.Mcrl2
default-language: Haskell2010 default-language: Haskell2010
build-depends: base >= 4.11 build-depends: base >= 4.11
, text , containers ^>= 0.6
, vector , megaparsec ^>= 7
, megaparsec >= 7 , microlens ^>= 0.4.10
, containers , microlens-platform ^>= 0.3.11
, optparse-applicative , microlens-th ^>= 0.4.2
, prettyprinter , text ^>= 1.2.3
, prettyprinter-ansi-terminal , vector ^>= 0.12
, prettyprinter-convert-ansi-wl-pprint , vector-algorithms ^>= 0.8.0.1
, microlens ghc-options: -Wall -Wno-name-shadowing
, microlens-th if !flag(benchmark-generators)
, microlens-platform 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) if !flag(benchmark-generators)
buildable: False buildable: False
......
...@@ -2,17 +2,16 @@ ...@@ -2,17 +2,16 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Main (main) where module Main (main) where
import System.IO import System.IO
import System.Exit import System.Exit
import Data.Semigroup
import Control.Applicative import Control.Applicative
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
...@@ -37,17 +36,19 @@ instance Show ModelType where ...@@ -37,17 +36,19 @@ instance Show ModelType where
show CTMC = "ctmc" show CTMC = "ctmc"
show MDP = "mdp" show MDP = "mdp"
data OutputFormat = Valmari | Valmari2 | Copar data OutputFormat = Valmari | Valmari2 | Copar | Mcrl2
instance Show OutputFormat where instance Show OutputFormat where
show Valmari = "valmari" show Valmari = "valmari"
show Valmari2 = "valmari2" show Valmari2 = "valmari2"
show Copar = "copar" show Copar = "copar"
show Mcrl2 = "mcrl2"
parseOutputFormat :: String -> Either String OutputFormat parseOutputFormat :: String -> Either String OutputFormat
parseOutputFormat "valmari" = Right Valmari parseOutputFormat "valmari" = Right Valmari
parseOutputFormat "valmari2" = Right Valmari2 parseOutputFormat "valmari2" = Right Valmari2
parseOutputFormat "copar" = Right Copar parseOutputFormat "copar" = Right Copar
parseOutputFormat "mcrl2" = Right Mcrl2
parseOutputFormat other = Left ("Unknown output format '" <> other <> "'") parseOutputFormat other = Left ("Unknown output format '" <> other <> "'")
data Options = Options data Options = Options
...@@ -100,7 +101,7 @@ optionsParser = ...@@ -100,7 +101,7 @@ optionsParser =
(OptParse.eitherReader parseOutputFormat) (OptParse.eitherReader parseOutputFormat)
(OptParse.long "output-format" <> (OptParse.long "output-format" <>
OptParse.help 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.metavar "FORMAT" <>
OptParse.value Copar <> OptParse.value Copar <>
OptParse.showDefault)) <*> OptParse.showDefault)) <*>
...@@ -162,7 +163,7 @@ main = do ...@@ -162,7 +163,7 @@ main = do
Left err -> do Left err -> do
hPutStrLn stderr $ "error while parsing --partition-on-variables: " <> T.unpack err hPutStrLn stderr $ "error while parsing --partition-on-variables: " <> T.unpack err
exitFailure exitFailure
Right vars -> return (Just (computePartition sf vars)) Right vs -> return (Just (computePartition sf vs))
_ -> return Nothing _ -> return Nothing
case (optModelType opts, optOutputFormat opts) of case (optModelType opts, optOutputFormat opts) of
...@@ -171,6 +172,7 @@ main = do ...@@ -171,6 +172,7 @@ main = do
Valmari -> valmariMdpB Valmari -> valmariMdpB
Valmari2 -> valmariMdp2B Valmari2 -> valmariMdp2B
Copar -> mdpB Copar -> mdpB
Mcrl2 -> mcrl2B
in convert opts mdpP (builder initPartition) in convert opts mdpP (builder initPartition)
(inType, outType) -> (inType, outType) ->
let mcType = let mcType =
...@@ -182,4 +184,5 @@ main = do ...@@ -182,4 +184,5 @@ main = do
Valmari -> valmariMarkovChainB Valmari -> valmariMarkovChainB
Valmari2 -> error "valmari2 only implemented for MDPs" Valmari2 -> error "valmari2 only implemented for MDPs"
Copar -> markovChainB Copar -> markovChainB
Mcrl2 -> error "mcrl2-format only supports MDPs"
in convert opts (markovChainP mcType) (builder initPartition) 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 @@ ...@@ -5,8 +5,9 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-} {-# 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.List ( intersperse )
import Data.Foldable import Data.Foldable
...@@ -20,79 +21,66 @@ import qualified Data.Text.Lazy.Builder.RealFloat ...@@ -20,79 +21,66 @@ import qualified Data.Text.Lazy.Builder.RealFloat
as Build as Build
import Data.Vector ( Vector ) import Data.Vector ( Vector )
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Text ( Text )
import Lens.Micro.Platform import Lens.Micro.Platform
import Mdp.Types
import Parser import Parser
import StatesFile ( Partition(..) ) import StatesFile ( Partition(..) )
import qualified Mdp.Mcrl2 as Mcrl2
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Types -- helpers
---------------------------------------------------------------------- ----------------------------------------------------------------------
data Mdp = Mdp convertToDouble :: Mdp Rational -> Mdp Double
{ mdpNumStates :: Int convertToDouble = fmap (fromRational @Double)
, 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
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Parser -- Parser
---------------------------------------------------------------------- ----------------------------------------------------------------------
mdpP :: Parser Mdp mdpP :: Parser (Mdp Rational)
mdpP = Mdp <$> decimalP <*> decimalP <*> transitionsP mdpP = Mdp <$> decimalP <*> decimalP <*> transitionsP
transitionsP :: Parser (Vector Transition) transitionsP :: Parser (Vector (Transition Rational))
transitionsP = do transitionsP = do
numTrans <- decimalP numTrans <- decimalP
V.replicateM numTrans transitionP V.replicateM numTrans transitionP
transitionP :: Parser Transition transitionP :: Parser (Transition Rational)
transitionP = transitionP =
Transition Transition
<$> decimalP <$> decimalP
<*> decimalP <*> decimalP
<*> decimalP <*> decimalP
<*> doubleP <*> rationalP
<*> optional nameP <*> optional nameP
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Builder -- Builder
---------------------------------------------------------------------- ----------------------------------------------------------------------
mdpB :: Maybe Partition -> Mdp -> Build.Builder mdpB :: Maybe Partition -> (Mdp Rational) -> Build.Builder
mdpB partition mdp = 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 :: Maybe Partition -> Build.Builder
functorB Nothing = "P(Nx(DX))\n" functorB Nothing = "P(Nx(DX))\n"
functorB (Just partition) = functorB (Just partition) =
(Build.decimal (numBlocks partition)) <> " x P(Nx(DX))\n" (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 = 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 V.foldl' (\m t -> M.insertWith (++) (t ^. source) [t] m) M.empty ts
in foldMap (uncurry (choicesB partition)) (M.toList stateMap) in foldMap (uncurry (choicesB partition)) (M.toList stateMap)
choicesB :: Maybe Partition -> Int -> [Transition] -> Build.Builder choicesB :: Maybe Partition -> Int -> [(Transition Double)] -> Build.Builder
choicesB partition source ts = choicesB partition src ts =
let choiceMap :: IntMap [Transition] = let choiceMap :: IntMap [(Transition Double)] =
foldl' (\m t -> M.insertWith (++) (t ^. choice) [t] m) M.empty ts foldl' (\m t -> M.insertWith (++) (t ^. choice) [t] m) M.empty ts
in stateB source in stateB src
<> ": " <> ": "
<> partStart partition <> partStart partition
<> "{" <> "{"
...@@ -104,19 +92,19 @@ choicesB partition source ts = ...@@ -104,19 +92,19 @@ choicesB partition source ts =
where where
partStart Nothing = "" partStart Nothing = ""
partStart (Just part) = partStart (Just part) =
"(" <> Build.decimal (stateAssignment part V.! source) <> ", " "(" <> Build.decimal (stateAssignment part V.! src) <> ", "
partEnd Nothing = "" partEnd Nothing = ""
partEnd (Just _) = ")" partEnd (Just _) = ")"
transitionB :: Int -> [Transition] -> Build.Builder transitionB :: Int -> [(Transition Double)] -> Build.Builder
transitionB choice successors = transitionB choi successors =
"(" "("
<> Build.decimal choice <> Build.decimal choi
<> ", {" <> ", {"
<> fold (intersperse ", " (map successorB successors)) <> fold (intersperse ", " (map successorB successors))
<> "})" <> "})"
where where
successorB :: Transition -> Build.Builder successorB :: (Transition Double) -> Build.Builder
successorB t = stateB (t ^. target) <> ": " <> Build.formatRealFloat successorB t = stateB (t ^. target) <> ": " <> Build.formatRealFloat
Build.Fixed Build.Fixed
Nothing Nothing
...@@ -172,7 +160,7 @@ makeFields ''ValmariTransition ...@@ -172,7 +160,7 @@ makeFields ''ValmariTransition
type ValmariPartition = [[Int]] type ValmariPartition = [[Int]]
convertToValmari :: Maybe Partition -> Mdp -> (ValmariMDP, ValmariPartition) convertToValmari :: Maybe Partition -> (Mdp Double) -> (ValmariMDP, ValmariPartition)
convertToValmari maybePart mdp = convertToValmari maybePart mdp =
let nums = mdp ^. numStates let nums = mdp ^. numStates
(numa, transMap) = mkValmariMap mdp (numa, transMap) = mkValmariMap mdp
...@@ -199,12 +187,11 @@ convertToValmari maybePart mdp = ...@@ -199,12 +187,11 @@ convertToValmari maybePart mdp =
-- | Alternative method of modeling the same coalgebra. Here, we don't use -- | 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. -- labels but partition the Distribution states on the label that leads to them.
-- This models the functor P(AxDX) more faithfully. -- This models the functor P(AxDX) more faithfully.
convertToValmari2 :: Maybe Partition -> Mdp -> (ValmariMDP, ValmariPartition) convertToValmari2 :: Maybe Partition -> (Mdp Double) -> (ValmariMDP, ValmariPartition)
convertToValmari2 maybePart mdp = convertToValmari2 maybePart mdp =
let let
nums = mdp ^. numStates nums = mdp ^. numStates
(numa, transMap) = mkValmariMap mdp (numa, transMap) = mkValmariMap mdp
numc = mdp ^. numChoices
actions = V.fromList (concatMap mkChoices (M.toList transMap)) actions = V.fromList (concatMap mkChoices (M.toList transMap))
probs = V.fromList (concatMap mkTransitions (transMap ^.. each . each)) probs = V.fromList (concatMap mkTransitions (transMap ^.. each . each))
stateByChoice = M.fromListWith stateByChoice = M.fromListWith
...@@ -233,14 +220,14 @@ type ValmariMap = IntMap [(Int, (Int, [(Double, Int)]))] ...@@ -233,14 +220,14 @@ type ValmariMap = IntMap [(Int, (Int, [(Double, Int)]))]
-- | Returns the total number of action states and the valmari map -- | 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 mkValmariMap mdp = M.mapAccum uniquifyChoices
0 0
(V.foldl' ins M.empty (mdp ^. transitions)) (V.foldl' ins M.empty (mdp ^. transitions))
where where
ins ins
:: IntMap (IntMap [(Double, Int)]) :: IntMap (IntMap [(Double, Int)])
-> Transition -> (Transition Double)
-> IntMap (IntMap [(Double, Int)]) -> IntMap (IntMap [(Double, Int)])
ins m t = ins m t =
m m
...@@ -263,15 +250,15 @@ partToBlocks p = ...@@ -263,15 +250,15 @@ partToBlocks p =
in M.elems blockMap in M.elems blockMap
valmariMdpB :: Maybe Partition -> Mdp -> Build.Builder valmariMdpB :: Maybe Partition -> (Mdp Rational) -> Build.Builder
valmariMdpB partition mdp = valmariMdpB partition mdp =
let (vmdp, vpartition) = convertToValmari partition mdp let (vmdp, vpartition) = convertToValmari partition (convertToDouble mdp)
in valmariMdpBImpl vmdp vpartition in valmariMdpBImpl vmdp vpartition
valmariMdp2B :: Maybe Partition -> Mdp -> Build.Builder valmariMdp2B :: Maybe Partition -> (Mdp Rational) -> Build.Builder
valmariMdp2B partition mdp = valmariMdp2B partition mdp =
let (vmdp, vpartition) = convertToValmari2 partition mdp let (vmdp, vpartition) = convertToValmari2 partition (convertToDouble mdp)
in valmariMdpBImpl vmdp vpartition in valmariMdpBImpl vmdp vpartition
...@@ -341,3 +328,14 @@ valmariBlocks part = ...@@ -341,3 +328,14 @@ valmariBlocks part =
& (each %~ fold) & (each %~ fold)
& (each %~ (<> " 0\n")) & (each %~ (<> " 0\n"))
& fold & 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 #-}