Automates finis et Haskell

IMAGE(http://download.tuxfamily.org/tehessinmath/les_images/animdsEx.png)

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:

IMAGE(http://download.tuxfamily.org/tehessinmath/les_images/dsEx.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 :

IMAGE(http://download.tuxfamily.org/tehessinmath/les_images/animdsEx.png)

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

IMAGE(http://download.tuxfamily.org/tehessinmath/les_images/temp.png)

et

Haskell
*Automate> auto2dot (standardise autoDS') "tempS"

donne:

IMAGE(http://download.tuxfamily.org/tehessinmath/les_images/tempS.png)

courtesy of webmatter.de