Voici un exemple de programmation des automates finis en Haskell et une visualisation directe dans emacs via graphviz. On peut aussi admirer le talent de Haskell pour gérer les E/S et lancer une commande externe dans le shell.
Type Automate
Haskell
module Automate where import qualified Data.List as L import qualified Data.Char as C import qualified Data.Map as M import System.IO import System.Exit import System.Process -- des synonymes pour clarifier le code type Etat = Int type Symbole = Char type Chaine = [Symbole] -- les automates ne sont pas forcément déterministes ! type Transition = Etat -> Symbole -> [Etat] -- un enregistrement pour définir les 5 composantes d'un automate à états finis data Automate = Automate {alphabet :: [Symbole], etats :: [Etat], ini :: [Etat], term :: [Etat], trans :: Transition} -- un exemple de fonction de transition tau :: Transition tau 0 'a' = [2] tau 0 'b' = [1] tau 1 'a' = [2] tau 1 'b' = [1] tau 2 'a' = [1] tau 2 'b' = [2] -- un exemple d'automate auto :: Automate auto = Automate { alphabet = ['a','b'], etats = [0,1,2], ini = [0], term = [2], trans = tau } -- Exemple de l'exercice 3 du DS tauDS :: Transition tauDS 0 'a' = [24] tauDS 24 'a' = [3] tauDS 24 'b' = [45] tauDS 3 'b' = [1] tauDS 45 'a' = [1] tauDS 45 'b' = [45] tauDS 1 'a' = [24] tauDS _ _ = [-1] autoDS :: Automate autoDS = Automate { alphabet = ['a','b'], etats = [0,24,3,45,1], ini = [0], term = [0,1], trans = tauDS } -- donne la liste des états parcourus suite à la lecture d'une chaîne parcours :: Automate -> Chaine -> [[Etat]] parcours auto chaine = let parcoursIntermediaire tau listeEtat chaine | chaine == [] = [L.nub listeEtat] | otherwise = (L.nub listeEtat) : (parcoursIntermediaire tau (L.concat $ L.map (\ x -> tau x (head chaine)) listeEtat) (tail chaine)) in parcoursIntermediaire (trans auto ) (ini auto) chaine -- teste si une chaîne est reconnue par un automate estReconnu :: Automate -> Chaine -> Bool estReconnu auto chaine = L.intersect (L.last (parcours auto chaine)) (term auto) /= []
Visualisation
On utilise GraphViz.
Haskell
------------------------------------------------------------------- -- -- VIZualisation -- --------------------------------------------------------------------- -- Crée un fichier .dot pour la compilation via graphviz auto2digraph :: Automate -> String auto2digraph auto = let d = [(show q) ++ "->" ++ (show q') ++ "[label=\"" ++ [a] ++ "\"];\n " | q <- (etats auto), a <- (alphabet auto), q' <- ((trans auto) q a), q' /= -1] dep = [ (show q) ++ "[color = blue,fontcolor=white,style=filled]; \n " | q <- (ini auto) ] ter = [ (show q) ++ "[shape = doublecircle] ; \n " | q <- (term auto)] in "digraph G {\n " ++ "rankdir=LR;\n node [shape = circle];\n " ++ (foldl (++) "" d) ++ (foldl (++) "" dep) ++ (foldl (++) "" ter) ++ "}" -- Par exemple, l'automate auto donne le fichier .dot : -- digraph G { -- rankdir=LR; -- node [shape = circle]; -- 0->24[label="a"]; -- 0->-1[label="b"]; -- 24->3[label="a"]; -- 24->45[label="b"]; -- 3->-1[label="a"]; -- 3->1[label="b"]; -- 45->1[label="a"]; -- 45->45[label="b"]; -- 1->24[label="a"]; -- 1->-1[label="b"]; -- 0[color = blue,fontcolor=white,style=filled]; -- 0[shape = doublecircle] ; -- 1[shape = doublecircle] ; -- } -- Compile et affiche dans un buffer l'automate auto2dot :: Automate -> String -> IO () auto2dot auto nom = let s = auto2digraph auto in do -- on ouvre un fichier .dot out <- openFile (nom ++ ".dot") WriteMode -- on écrit dedans le contenu de auto2digraph auto hPutStrLn out s -- on ferme le fichier hClose out -- on lance la compilation du fichier .dot qui crée une image png dans le répertrtoire courant ExitSuccess <- system ("dot -Tpng " ++ nom ++".dot -o " ++ nom ++ ".png && emacsclient " ++ nom ++ ".png") -- il faut que la fonction retourne quelque chose : un IO () return ()
Alors, la commande GHCI :
Haskell
*Automate> auto2dot auto "essai"
donne le beau fichier png:
Animation
Maintenant, on peut créer une animation pour voir fonctionner la machine, toujours avec notre ami Haskell toujours aussi à l'aise avec les E/S ;-)
Haskell
-- -- -- ANIMATION : on voit fonctionner l'automate (qui doit être déterministe) -- -- -- donne la liste des (symbole, liste états,chaine lue) parcourus suite à la lecture d'une chaîne parcoursAl :: Automate -> Chaine -> [(Symbole,[Etat],Chaine)] parcoursAl auto chaine = (scanl (\ (c,le,m) s -> (s, L.concat $ map (\ e -> (trans auto) e s) le, if m == "Vide" then [C.toUpper s] else (L.init m) ++ [C.toLower (L.last m)] ++ [C.toUpper s]) ) (head chaine, (ini auto),"Vide") chaine) -- éclate la liste précédente pour avoir une liste de (symbole, etat, chaine) parcoursA :: Automate -> Chaine -> [(Symbole,Etat,Chaine)] parcoursA auto chaine = L.concat $ map (\ (s,le,c) -> [(s,e,c) | e <- le]) (parcoursAl auto chaine) -- idem que auto2digraph mais colorie l'état actif en vert auto2digraphEtat :: Automate -> Etat -> String auto2digraphEtat auto e = let d = [(show q) ++ "->" ++ (show q') ++ "[label=\"" ++ [a] ++ "\"];\n " | q <- (etats auto), a <- (alphabet auto), q' <- ((trans auto) q a), q' /= -1] dep = [ (show q) ++ "[color = blue,fontcolor=white,style=filled]; \n " | q <- (ini auto) ] ter = [ (show q) ++ "[shape = doublecircle] ; \n " | q <- (term auto)] in "digraph G {\n " ++ "rankdir=LR;\n node [shape = circle];\n " ++ (foldl (++) "" d) ++ (foldl (++) "" dep) ++ (foldl (++) "" ter) ++ (show e) ++ "[color = green,fontcolor=blue,style=filled];\n " -- idem que auto2dot mais l'automate en argument devient une chîne de caractère string2dot :: String -> String -> IO () string2dot s nom = do out <- openFile (nom ++ ".dot") WriteMode hPutStrLn out s hClose out ExitSuccess <- system ("dot -Tpng " ++ nom ++".dot -o " ++ nom ++ ".png") return () -- apngasm a besoin de numéro de fichiers de même longueur : on normalise (eg 124 fichiers -> tous les fichiers -- seront numérotés 001 002 003 etc.) format :: Int -> Int -> String format k i = (take (k - (L.length (show i))) (repeat '0')) ++ (show i) -- Crée une succession de fichiers png corresqpondant à la progression de la lecture de la chaîne par l'automate auto2dotParcours :: Automate -> Chaine -> String -> IO () auto2dotParcours auto chaine nom = let pA = parcoursA auto chaine p = parcours auto chaine n = L.length pA s = [(auto2digraphEtat auto e) ++ "label = \"" ++ m ++ "\"\n }" | (c,e,m) <- pA] couples = zipWith (\ ch k -> (ch,k)) s (map (format (L.length (show n))) [1..n]) l = foldl1 ( >> ) [string2dot ch (nom ++ k) | (ch,k) <- couples] in l -- crée l'animation dans un fichier anim[nom des fichiers].png et on visualise dans firefox animAuto :: Automate -> Chaine -> String -> IO () animAuto auto c nom = do auto2dotParcours auto c nom ExitSuccess <- system ("apngasm anim" ++ nom ++ ".png " ++ nom ++ "*.png 1 1 && firefox anim" ++ nom ++ ".png") return ()
Il suffit de lancer
Haskell
*Automate> animAuto autoDS "aabaababbbbbbaabbbbba" "dsEx" APNG Assembler 2.8 using 7ZIP with 15 iterations reading dsEx01.png (1 of 22) reading dsEx02.png (2 of 22) ... saving animdsEx.png (frame 22 of 22) all done
et de lire sur firefox :
Standardisation
On voit le plus simple des algorithmes de transformation d'un automate en un automate équivalent (« reconnaît le même langage »).
Le problème, c'est que l'automate obtenu n'est pas forcément déterministe...
On commence par créer un nouveau type, Graphe qui est le dictionnaire des transitions.
Haskell
-- -- Standardisation -- -- -- On commence par ajouter quelques fonctionnalités -- Dictionnaire des transitions. Clé : (q,a) Valeur : tau q a type Graphe = M.Map (Etat,Symbole) [Etat] -- graphe d'un automate graphe :: Automate -> Graphe graphe auto = M.fromList [((q,a),(trans auto) q a) | q <- etats auto, a <- alphabet auto ] instance Show Automate where show a = show (alphabet a, etats a, ini a, term a, graphe a) -- Crée la fonction de transition à partir du graphe graphe2tau :: Graphe -> Transition graphe2tau g = \ q a -> M.findWithDefault ([-1]) (q,a) g -- ensemble des états atteints atteints :: Automate -> [Etat] atteints auto = L.nub $ L.concat $ M.elems (graphe auto) -- teste si un automate est standard : un seul état ini et pas de transition vers cet état ini estStandard :: Automate -> Bool estStandard auto = ((L.length $ ini auto) == 1) && (not (any (\ x -> L.elem x (ini auto)) (atteints auto) )) -- -- algo de standardisation standardise :: Automate -> Automate standardise auto = -- si l'autoamte est standard, rien à faire if estStandard auto then auto else -- sinon on construit un nouvel état let i = (L.maximum (etats auto)) + 1 deb = ini auto fin = term auto tau = trans auto g = graphe auto in -- et un nouvel automate Automate { -- même alphabet alphabet = alphabet auto, -- états existants + nouvel état etats = i : (etats auto), -- i est le seul état initial ini = [i], -- on rajoute i dans les états terminaux si un des états initiaux était terminal term = if L.any (\ x -> L.elem x fin) deb then i : fin else fin, -- on crée les transitions i,s,q si qd,s,q existait avec qd initial trans = graphe2tau $ -- on plie le dictionnaire. L'acc est le dictionnaire mis à jour M.foldWithKey (\ (q,s) le acc -> if L.elem q deb -- on rajoute une nouvelle valeur à la clé (i,s) then M.insertWith (++) (i,s) le acc else acc) g g } -- exemple d'automate non standard (ex 3 DS) : tauDS' :: Transition tauDS' 1 'a' = [2,4] tauDS' 2 'a' = [3] tauDS' 3 'b' = [1] tauDS' 4 'b' = [4,5] tauDS' 5 'a' = [1] tauDS' _ _ = [-1] autoDS' :: Automate autoDS' = Automate { alphabet = ['a','b'], etats = [1..5], ini = [1], term = [1], trans = tauDS' }
Par exemple:
Haskell
*Automate> auto2dot autoDS' "temp"
donne
et
Haskell
*Automate> auto2dot (standardise autoDS') "tempS"
donne: