HaLeX-1.1.1: HaLeX enables modelling, manipulation and animation of regular languagesSource codeContentsIndex
Language.HaLex.Dfa
Portabilityportable
Stabilityprovisional
Maintainerjas@di.uminho.pt
Contents
Data type
Acceptance
Transformation
Transitions
Printing
Properties of Dfa
Properties of States
Description

Deterministic Finite Automata in Haskell.

Code Included in the Lecture Notes on Language Processing (with a functional flavour).

Synopsis
data Dfa st sy = Dfa [sy] [st] st [st] (st -> sy -> st)
dfaaccept :: Eq st => Dfa st sy -> [sy] -> Bool
dfawalk :: (st -> sy -> st) -> st -> [sy] -> st
ttDfa2Dfa :: (Eq st, Eq sy) => ([sy], [st], st, [st], [(st, sy, st)]) -> Dfa st sy
dfa2tdfa :: (Eq st, Ord sy) => Dfa st sy -> TableDfa st
transitionsFromTo :: Eq st => (st -> sy -> st) -> [sy] -> st -> st -> [sy]
destinationsFrom :: (st -> sy -> st) -> [sy] -> st -> [st]
transitionTableDfa :: (Ord st, Ord sy) => Dfa st sy -> [(st, sy, st)]
reachedStatesFrom :: (Eq [st], Ord st) => (st -> sy -> st) -> [sy] -> st -> [st]
beautifyDfa :: (Ord st, Ord sy) => Dfa st sy -> Dfa Int sy
renameDfa :: (Ord st, Ord sy) => Dfa st sy -> Int -> Dfa Int sy
showDfaDelta :: (Show st, Show sy) => [st] -> [sy] -> (st -> sy -> st) -> [Char] -> [Char]
beautifyDfaWithSyncSt :: Eq st => Dfa [st] sy -> Dfa [Int] sy
dfaIO :: (Show st, Show sy) => Dfa st sy -> String -> IO ()
sizeDfa :: Dfa st sy -> Int
dfadeadstates :: Ord st => Dfa st sy -> [st]
isStDead :: Ord st => (st -> sy -> st) -> [sy] -> [st] -> st -> Bool
isStSync :: Eq st => (st -> sy -> st) -> [sy] -> [st] -> st -> Bool
numberOutgoingArrows :: (st -> sy -> st) -> [sy] -> st -> Int
numberIncomingArrows :: Eq st => (st -> sy -> st) -> [sy] -> [st] -> st -> Int
Data type
data Dfa st sy Source
The type of Deterministic Finite Automata parameterized with the type st of states and sy of symbols.
Constructors
Dfa [sy] [st] st [st] (st -> sy -> st)
show/hide Instances
(Show st, Show sy, Ord st, Ord sy) => Fa Dfa st sy
(Show st, Show sy) => Show (Dfa st sy)
Acceptance
dfaacceptSource
:: Eq st
=> Dfa st syInput symbols
-> [sy]
-> Bool
Test whether the given automaton accepts the given list of input symbols (expressed as a fold).
dfawalkSource
::
=> st -> sy -> stInitial state
-> stInput symbols
-> [sy]Final state
-> st
Execute the transition function of a Dfa on an initial state and list of input symbol. Return the final state when all input symbols have been consumed.
Transformation
ttDfa2DfaSource
:: (Eq st, Eq sy)
=> ([sy], [st], st, [st], [(st, sy, st)])Automaton
-> Dfa st sy
Reconstruct a Dfa from a transition table. Given an automaton expressed by a transition table (ie a list of triples of the form (Origin,Symbol,Destination) it constructs a Dfa. The other elements of the input tuple are the vocabulary, a set of states, an initial state, and a set of final states.
dfa2tdfaSource
:: (Eq st, Ord sy)
=> Dfa st syTransition table
-> TableDfa st
Dfa to a Table-based Dfa
Transitions
transitionsFromToSource
:: Eq st
=> st -> sy -> stVocabulary
-> [sy]Origin
-> stDestination
-> stLabels
-> [sy]
Compute the labels with the same (giving) origin and destination states
destinationsFromSource
::
=> st -> sy -> stVocabulary
-> [sy]Origin
-> stDestination States
-> [st]
Compute the destination states giving the origin state
transitionTableDfaSource
:: (Ord st, Ord sy)
=> Dfa st syTransition table
-> [(st, sy, st)]
Produce the transition table of a given Dfa. Given a Dfa, it returns a list of triples of the form (Origin,Symbol,Destination) defining all the transitions of the Dfa.
reachedStatesFromSource
:: (Eq [st], Ord st)
=> st -> sy -> stVocabulary
-> [sy]Origin
-> stReached states
-> [st]
Compute the states that can be reached from a state according to a given transition function and vocabulary
Printing
beautifyDfa :: (Ord st, Ord sy) => Dfa st sy -> Dfa Int sySource
Beautify a Dfa by assigning (natural) numbers to states.
renameDfaSource
:: (Ord st, Ord sy)
=> Dfa st syInitial state ID
-> IntRenamed automaton
-> Dfa Int sy
Renames a Dfa. It renames a DFA in such a way that the renaming of two isomorphic DFA returns the same DFA. It is the basis for the equivalence test for minimized DFA.
showDfaDelta :: (Show st, Show sy) => [st] -> [sy] -> (st -> sy -> st) -> [Char] -> [Char]Source
Helper function to show the transition function of a Dfa.
beautifyDfaWithSyncStSource
:: Eq st
=> Dfa [st] syBeautified Automaton (states as integers)
-> Dfa [Int] sy
dfaIOSource
:: (Show st, Show sy)
=> Dfa st syHaskell module name
-> String
-> IO ()
Write a Dfa to a Haskell module in a file.
Properties of Dfa
sizeDfa :: Dfa st sy -> IntSource
Compute the size of a deterministic finite automaton. The size of an automaton is the number of its states.
dfadeadstatesSource
:: Ord st
=> Dfa st syDead states
-> [st]
Compute the dead states of a Dfa
Properties of States
isStDeadSource
:: Ord st
=> st -> sy -> stVocabulary
-> [sy]Set of Final States
-> [st]State
-> st
-> Bool

Checks whether a state is dead or not.

One state is dead when it is not possible to reach a final state from it. (probably we should consider that it has to be reachable from the initial state, as well)

isStSyncSource
:: Eq st
=> st -> sy -> stVocabulary
-> [sy]Set of Final States
-> [st]State
-> st
-> Bool

Checks whether a state is a sync state or not

A sync state is a state that has transitions to itself for all symbols of the vocabulary

numberOutgoingArrowsSource
::
=> st -> sy -> stVocabulary
-> [sy]Origin
-> stNumber of Arrows
-> Int
Compute the number of outgoing arrows for a given state
numberIncomingArrowsSource
:: Eq st
=> st -> sy -> stVocabulary
-> [sy]Set of States
-> [st]Destination
-> stNumber of Arrows
-> Int
Compute the number of incoming arrows for a given state
Produced by Haddock version 2.6.0