diff --git a/package.yaml b/package.yaml index 923dbe3..1184ce2 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,8 @@ dependencies: - base >= 4.7 && < 5 - transformers >= 0.5.6 && < 0.6 - containers >= 0.6 && < 0.7 +- graphviz >= 2999.20 && < 2999.21 +- fgl >= 5.7 && < 5.8 # algebraic-graphs >= 0.4 && < 0.5 library: diff --git a/src/Rextra/Automaton.hs b/src/Rextra/Automaton.hs index 784ebe1..64005c9 100644 --- a/src/Rextra/Automaton.hs +++ b/src/Rextra/Automaton.hs @@ -45,10 +45,10 @@ dfaStateToNfaState s = dfaToNfa :: (Ord s, Ord t) => Dfa.Dfa s t -> Nfa.Nfa s t dfaToNfa dfa = let stateMap = Dfa.stateMap dfa - exitingStates = map fst . filter (\(s, state) -> Dfa.accepting state) $ Map.assocs stateMap + exitStates = Dfa.exitStates dfa nfaStateMap = Map.map dfaStateToNfaState stateMap -- The NFA was created from a valid DFA, so it will be valid too. - in fromJust $ Nfa.nfa nfaStateMap (Dfa.entryState dfa) (Set.fromList exitingStates) + in fromJust $ Nfa.nfa nfaStateMap (Dfa.entryState dfa) exitStates {- - Converting a NFA to a DFA diff --git a/src/Rextra/Dfa.hs b/src/Rextra/Dfa.hs index dcb722f..9b89a52 100644 --- a/src/Rextra/Dfa.hs +++ b/src/Rextra/Dfa.hs @@ -9,6 +9,7 @@ module Rextra.Dfa ( -- ** Properties , stateMap , entryState + , exitStates -- ** Executing , transition , execute @@ -34,6 +35,13 @@ data Dfa s t = Dfa getState :: (Ord s) => Dfa s t -> s -> State s t getState dfa s = stateMap dfa Map.! s +exitStates :: (Ord s) => Dfa s t -> Set.Set s +exitStates dfa = Set.fromList + . map fst + . filter (accepting . snd) + . Map.assocs + $ stateMap dfa + data State s t = State { transitions :: Map.Map t s , defaultTransition :: s diff --git a/src/Rextra/Nfa.hs b/src/Rextra/Nfa.hs index 698953e..3c8674c 100644 --- a/src/Rextra/Nfa.hs +++ b/src/Rextra/Nfa.hs @@ -34,6 +34,7 @@ module Rextra.Nfa ( import Data.List import qualified Data.Map.Strict as Map import qualified Data.Set as Set + import Rextra.Util {- diff --git a/src/Rextra/Visualize.hs b/src/Rextra/Visualize.hs new file mode 100644 index 0000000..eae0a6a --- /dev/null +++ b/src/Rextra/Visualize.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE TupleSections #-} + +module Rextra.Visualize where + +import Data.Graph.Inductive +import Data.GraphViz +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set + +import qualified Rextra.Dfa as Dfa +import qualified Rextra.Nfa as Nfa +import Rextra.Util + +{- + - Visualizing DFAs + -} + +convertDfaState :: (Int, Dfa.State Int Char) -> [LEdge String] +convertDfaState (from, state) = + let normalEdges = map (\(t, to) -> (from, to, [t])) . Map.assocs $ Dfa.transitions state + defaultEdge = (from, Dfa.defaultTransition state, "default") + in defaultEdge : normalEdges + +dfaToGraph :: Dfa.Dfa Int Char -> Gr () String +dfaToGraph dfa = + let stateMap = Dfa.stateMap dfa + nodes = map (\k -> (k, ())) $ Map.keys stateMap + edges = concatMap convertDfaState $ Map.assocs stateMap + in mkGraph nodes edges + +dfaAttributes :: Labellable el => Dfa.Dfa Int t -> GraphvizParams Int nl el () nl +dfaAttributes dfa = + let exitStates = Dfa.exitStates dfa + fmtNode (n, l) = if n `Set.member` exitStates + then [shape DoubleCircle] + else [shape Circle] + fmtEdge (n1, n2, l) = [toLabel l] + in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge } + +showDfa :: Dfa.Dfa Int Char -> IO () +showDfa dfa = runGraphvizCanvas' (graphToDot (dfaAttributes dfa) (dfaToGraph dfa)) Gtk + +{- + - Visualizing NFAs + -} + +labelFromSet :: Set.Set Char -> String +labelFromSet charSet = "{" ++ intersperse ',' (Set.toList charSet) ++ "}" + +labelFromCondition :: Nfa.TransitionCondition Char -> String +labelFromCondition (Nfa.Only charSet) = labelFromSet charSet +labelFromCondition (Nfa.AllExcept charSet) + | Set.null charSet = "Σ" + | otherwise = "Σ\\" ++ labelFromSet charSet + +convertNfaState :: (Int, Nfa.State Int Char) -> [LEdge String] +convertNfaState (from, state) = + let transitions = Nfa.transitions state + transitionEdges = map (\(cond, to) -> (from, to, labelFromCondition cond)) transitions + epsilonTransitions = Set.toList $ Nfa.epsilonTransitions state + epsilonEdges = map (\to -> (from, to, "ε")) epsilonTransitions + in transitionEdges ++ epsilonEdges + +nfaToGraph :: Nfa.Nfa Int Char -> Gr () String +nfaToGraph nfa = + let stateMap = Nfa.stateMap nfa + nodes = map (\k -> (k, ())) $ Map.keys stateMap + edges = concatMap convertNfaState $ Map.assocs stateMap + in mkGraph nodes edges + +anyNfaToGraph :: (Ord s) => Nfa.Nfa s Char -> Gr () String +anyNfaToGraph = nfaToGraph . Nfa.rename + +nfaAttributes :: Labellable el => Nfa.Nfa Int t -> GraphvizParams Int nl el () nl +nfaAttributes nfa = + let exitStates = Nfa.exitStates nfa + fmtNode (n, l) = if n `Set.member` exitStates + then [shape DoubleCircle] + else [shape Circle] + fmtEdge (n1, n2, l) = [toLabel l] + in nonClusteredParams { fmtNode = fmtNode, fmtEdge = fmtEdge } + +showNfa :: Nfa.Nfa Int Char -> IO () +showNfa nfa = runGraphvizCanvas' (graphToDot (nfaAttributes nfa) (nfaToGraph nfa)) Gtk