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

Merge branch 'random-dfa'

parents caba941c d3ac9436
......@@ -13,7 +13,7 @@ maintainer: hans-peter.deifel@fau.de
-- category:
build-type: Custom
cabal-version: >=1.24
custom-setup
setup-depends:
base, Cabal, cabal-doctest >= 1.0.2 && <1.1
......@@ -240,3 +240,24 @@ executable prism-converter
, microlens
, microlens-th
, microlens-platform
executable random-dfa
hs-source-dirs: src/random-dfa
main-is: Main.hs
other-modules: Type
, CoalgOutput
, DotOutput
default-language: Haskell2010
default-extensions: OverloadedStrings
, LambdaCase
, MultiParamTypeClasses
, FlexibleInstances
, FunctionalDependencies
build-depends: base
, vector
, microlens
, microlens-th
, microlens-platform
, random
, text
, optparse-applicative
module CoalgOutput (coalgB) where
import Data.Foldable ( fold )
import Data.List ( intersperse )
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Text.Lazy.Builder.Int as Build
import Lens.Micro.Platform
import Type
coalgB :: DFA -> Build.Builder
coalgB dfa = functorB dfa <> "\n\n" <> transitionsB dfa
functorB :: DFA -> Build.Builder
functorB dfa = "{True,False}x(X^" <> Build.decimal (dfa ^. letters) <> ")"
transitionsB :: DFA -> Build.Builder
transitionsB dfa = foldMap (forStateB dfa) [0 .. dfa ^. states - 1]
forStateB :: DFA -> Int -> Build.Builder
forStateB dfa n =
"s"
<> Build.decimal n
<> ": ("
<> Build.fromString (show (dfa ^?! isFinal . ix n))
<> ", {"
<> fold
(intersperse
", "
(zipWith successorB [0 ..] (dfa ^.. transitions . ix n . each))
)
<> "})\n"
successorB :: Int -> Int -> Build.Builder
successorB label target = Build.decimal label <> ": s" <> Build.decimal target
module DotOutput (dotB) where
import Data.Foldable ( fold )
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Text.Lazy.Builder.Int as Build
import Lens.Micro.Platform
import Type
dotB :: DFA -> Build.Builder
dotB dfa = "digraph {\n" <> nodesB dfa <> transitionsB dfa <> "}\n"
nodesB :: DFA -> Build.Builder
nodesB dfa = foldMap (nodeB dfa) [0 .. dfa ^. states - 1]
nodeB :: DFA -> Int -> Build.Builder
nodeB dfa n = " \"n" <> Build.decimal n <> "\" [shape = " <> shape <> "];\n"
where shape = if dfa ^?! isFinal . ix n then "doublecircle" else "circle"
transitionsB :: DFA -> Build.Builder
transitionsB dfa = foldMap (transitionsForB dfa) [0 .. dfa ^. states - 1]
transitionsForB :: DFA -> Int -> Build.Builder
transitionsForB dfa n =
fold (zipWith (transitionB n) [0 ..] (dfa ^.. transitions . ix n . each))
transitionB :: Int -> Int -> Int -> Build.Builder
transitionB source letter target =
" n"
<> Build.decimal source
<> " -> n"
<> Build.decimal target
<> " [label=a"
<> Build.decimal letter
<> "];\n"
{-# LANGUAGE TemplateHaskell #-}
module Main (main) where
import Control.Applicative
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Builder as Build
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import System.Random
import qualified Options.Applicative as OptParse
import Lens.Micro.TH
import Lens.Micro.Platform
import Type
import DotOutput
import CoalgOutput
-- | Generate a random DFA
randomDFA
:: Int -- ^ Number of states
-> Int -- ^ Size of the alphabet
-> IO DFA
randomDFA s a = do
finals <- VU.replicateM s randomIO
matrix <- V.replicateM s (VU.replicateM a (randomRIO (0, s - 1)))
return DFA
{ dfaStates = s
, dfaLetters = a
, dfaIsFinal = finals
, dfaTransitions = matrix
}
data OutputFormat = Dot | MA
instance Show OutputFormat where
show Dot = "dot"
show MA = "ma"
data Options = Options
{ _optStates :: Int
, _optLetters :: Int
, _optFile :: Maybe FilePath
, _optOutputFormat :: OutputFormat
}
makeLensesWith abbreviatedFields ''Options
options :: OptParse.Parser Options
options =
Options
<$> (OptParse.argument
OptParse.auto
(OptParse.metavar "N" <> OptParse.help "Number of states")
)
<*> (OptParse.argument
OptParse.auto
(OptParse.metavar "M" <> OptParse.help "Size of the alphabet")
)
<*> optional
(OptParse.strArgument
(OptParse.metavar "OUTPUT_FILE" <> OptParse.help
"Name of the file where the output should be written."
)
)
<*> (OptParse.option
readFormat
( OptParse.long "output-format"
<> OptParse.metavar "FORMAT"
<> OptParse.value MA
<> OptParse.help
"Syntax used for the output. Posible values are 'ma' or 'dot'."
<> OptParse.showDefault
)
)
readFormat :: OptParse.ReadM OutputFormat
readFormat = OptParse.maybeReader $ \case
"ma" -> Just MA
"dot" -> Just Dot
_ -> Nothing
main :: IO ()
main = do
opts <- OptParse.execParser
(OptParse.info
(options <**> OptParse.helper)
( OptParse.fullDesc
<> OptParse.progDesc "Generate a random determinstic finite automaton"
)
)
let builder = case opts ^. outputFormat of
MA -> coalgB
Dot -> dotB
dfa <- randomDFA (opts ^. states) (opts ^. letters)
let text = Build.toLazyText (builder dfa)
case opts ^. file of
Nothing -> TL.putStr text
Just filename -> TL.writeFile filename text
return ()
{-# LANGUAGE TemplateHaskell #-}
module Type
( DFA(..)
, HasStates(..)
, HasLetters(..)
, HasTransitions(..)
, HasIsFinal(..)
) where
import Data.Vector ( Vector )
import qualified Data.Vector.Unboxed as VU
import Lens.Micro.TH
data DFA = DFA
{ dfaStates :: Int
, dfaLetters :: Int
, dfaTransitions :: Vector (VU.Vector Int)
, dfaIsFinal :: VU.Vector Bool
}
makeLensesWith abbreviatedFields ''DFA
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