Deterministic Finite Automaton implementation in Haskell

Dfa.hs

module Dfa (DFA, State, transition, runString, match, findEquivalent, nequivalent, automaton1, automaton2, minimise) where

import Data.List
import Text.Layout.Table

type State = Int
data DFA = DFA
    { states :: [State]
    , initial :: State
    , final :: [State]
    , alphabet :: String
    , transition ::  (State -> Char -> State)
    }

instance Show DFA where
    show (DFA ss s0 f as t) = "States: " ++ show ss ++ "\nInitial: " ++ show s0 ++ "\nFinal: " ++ show f ++ "\nCharacters: " ++ show as ++ "\nTransition function:\n" ++ transTable
                            where
                                dfa = DFA ss s0 f as t
                                getRow s = show s : map (show . transition dfa s) as
                                results = map getRow ss
                                transTable = tableString (replicate (length as + 1) def) asciiRoundS (titlesH ("state": map show as)) (map rowG results)

states :: DFA -> [State]
states (DFA ss _ _ _ _) = ss

initial :: DFA -> State
initial (DFA _ s0 _ _ _) = s0

final :: DFA -> [State]
final (DFA _ _ f _ _) = f

alphabet :: DFA -> String
alphabet (DFA _ _ _ as _) = as

transition :: DFA -> State -> Char -> State
transition (DFA _ _ _ _ t) = t

transitionString :: DFA -> State -> String -> State
transitionString dfa = foldl (transition dfa) 

runString :: DFA -> String -> State
runString (DFA ss s0 f l t) = transitionString (DFA ss s0 f l t) s0

match :: DFA -> String -> Bool
match dfa is = elem (runString dfa is) $ final dfa

alltransitions :: DFA -> State -> [State]
alltransitions dfa s = map (transition dfa s) $ alphabet dfa

equivalentPartition :: Eq a => (a -> a -> Bool) -> [a] -> [[a]]
equivalentPartition _ [] = []
equivalentPartition f (x:xs) = (x:match): equivalentPartition f others
                               where
                                   (match, others) = partition (f x) xs

increaseUntilFixed :: Eq a => (Int -> a) -> Int -> a
increaseUntilFixed f i = if x == x' then x' else increaseUntilFixed f (i+1)
                            where
                                x = f i
                                x' = f (i+1)

findEquivalent :: DFA -> [[State]]
findEquivalent dfa = increaseUntilFixed keepPartition 0
                     where
                         keepPartition n = equivalentPartition (nequivalent dfa n) (states dfa)
                                     

nequivalent :: DFA -> Int -> State -> State -> Bool
nequivalent dfa 0 s1 s2 = elem s1 (final dfa) == elem s2 (final dfa)
nequivalent dfa n s1 s2 = nequivalent dfa (n-1) s1 s2 && transitionsEqual
                                        where
                                            transitionsEqual = all (uncurry $ nequivalent dfa (n-1)) $ zip (alltransitions dfa s1) (alltransitions dfa s2)

removeState :: DFA -> (State, State) -> DFA
removeState (DFA ss s0 f l t) (del, repl) = DFA ss' s0' f' l t'
                                            where
                                                ss' = delete del ss
                                                s0' = if s0 == del then repl else s0
                                                f' = delete del f
                                                t' x c = if t x c == del then repl else t x c

statesToRemove :: DFA -> [(State, State)]
statesToRemove = concatMap f . findEquivalent
                 where
                     f [] = []
                     f [x] = []
                     f (x:xs) = map (\y -> (y, x)) xs

minimise :: DFA -> DFA
minimise dfa = foldl removeState dfa (statesToRemove dfa)

automaton1func :: State -> Char -> State
automaton1func 1 'a' = 2
automaton1func 1 'b' = 3
automaton1func 2 'a' = 2
automaton1func 2 'b' = 3
automaton1func 3  _  = 3

automaton1 = DFA s s0 f l t
            where
                s = [1,2,3]
                s0 = 1
                f = [3]
                l = "ab"
                t = automaton1func

automaton2func :: State -> Char -> State
automaton2func 1 '0' = 2
automaton2func 1 '1' = 3
automaton2func 2 _   = 2
automaton2func 3 _   = 2

automaton2 = DFA s s0 f l t
            where
                s = [1,2,3]
                s0 = 1
                f = [2]
                l = "01"
                t = automaton2func