Máquina de Turing

gistfile1.lhs

Máquina de Turing
----------------------------

Compilar con '-package parsec'; ejemplo de compilación: ' $ ghc -package parsec -o turing turing.lhs '

El ejecutable recibe como primer argumento la descripción de una máquina de Turing, y como segundo 
argumento una cadena inicial para la cinta.

Si la máquina finaliza escribe True si se alcanzó un estado de paro, False en otro caso. 
En ambos casos escribe el estado final de la cinta, en el formato ([lado izquierdo],[lado derecho])
de forma que el primer elemento del lado derecho es el elemento activo en el que se encuentra la cabeza 
lectora/escritora; e.g. ("01010000","11110011") representa a la cinta

0101000011110011
        ^
Ejemplo de representación de máquina: 
|xy|2|(0,x,1,y,R)(1,y,0,x,R)(0, ,-1, ,N)|

Formato: |S|n|(i,a,j,b,D)*|

donde

S: Alfabeto de la máquina
n: Número de estados, sin incluir el paro

(i,a,j,b,D): Transición de qi a qj con el símbolo a en la cinta, 
escribiendo b, y moviéndose en dirección D. El estado de paro es q(-1).

Ejemplo de ejecución: 
$ ./turing "|xy|2|(0,x,1,y,R)(1,y,0,x,R)(0, ,-1, ,N)|" "xyxyxyxyxy"
salida: ' (True,(" yxyxyxyxyx"," ")) '.

> import Text.ParserCombinators.Parsec
> import System.Environment

Tipos.

> data Direccion = R | L | N
> instance Show Direccion where
>   show R = "R"
>   show L = "L"
>   show N = "N"
         
> type Estado = Integer
> type Simbolo = Char
          
> type Transicion = (Estado, Simbolo, Estado, Simbolo, Direccion)
           
> type Cinta = ([Simbolo],[Simbolo])
            
> type Respuesta = (Bool, Cinta)


Analizador de entrada:

Lee una cadena con formato y separa la lista de transiciones.

> transicion :: Parser (Estado, Simbolo, Estado, Simbolo, Direccion)
> transicion = do
>   char '('
>   desde <- manyTill anyChar (char ',')
>   en <- anyChar
>   char ','
>   hasta <- manyTill anyChar (char ',')
>   nuevo <- anyChar
>   char ','
>   dir <- oneOf "RLN"
>   char ')'
>   return ((read desde)::Estado, en::Simbolo, (read hasta)::Estado, nuevo::Simbolo, (if dir == 'R' then R else (if dir == 'L' then L else N)))
             
> lista_transiciones :: Parser [(Estado, Simbolo, Estado, Simbolo, Direccion)]
> lista_transiciones = do
>   char '|'
>   manyTill anyChar (char '|')
>   manyTill anyChar (char '|')
>   r <- many transicion
>   char '|'
>   return r


haz_paso:

Identifica el elemento activo en la cinta, recibe el estado actual. Busca una 
transición que corresponda a esa combinación (asume determinismo, y emplea la 
primera que vea). Produce una nueva cinta y un nuevo estado. O un False si algo salió mal.

> haz_paso :: [Transicion] -> (Estado, Cinta) -> Either Respuesta (Estado, Cinta)

Informa de error cuando intente mover a la izquierda desde el principio de la cinta.

> haz_paso ((_, _, _, _, L):_) (_, ([],x)) = (Left (False,([],x)))
              
> haz_paso ((e1, s1, e2, s2, d):xs) (estado, cinta) =
>   if ((estado == e1) && ((actual cinta) == s1))
>       then (Right (e2, (actualiza cinta s2 d)))
>       else haz_paso xs (estado, cinta)
>   where
>       actual :: Cinta -> Simbolo
>       actual (x, y:ys) = y
>       actual (x, []) = ' '
>
>       actualiza :: Cinta -> Simbolo -> Direccion -> Cinta


Coloca el símbolo nuevo en la posición activa, no mueve nada

>       actualiza (x,y:ys) simbolo N = (x,simbolo:ys)
>       actualiza (x,[]) simbolo N = (x,simbolo:[])

Coloca el símbolo nuevo al final del lado izquierdo, vuelve activo el elemento a la derecha 
del anterior. Desecha el activo anterior.

>       actualiza (x,y:ys) simbolo R = (x++[simbolo],ys)
>       actualiza (x,[]) simbolo R = (x++[simbolo],[])


Cambia el símbolo activo anterior por el nuevo, y mueve el último símbolo del lado izquierdo 
al derecho, volviéndolo activo.

>       actualiza (x,y:ys) simbolo L = ((init x),(last x):simbolo:ys)
>       actualiza (x,[]) simbolo L = ((init x),(last x):simbolo:[])

Significa que no hay transición para estas condiciones

> haz_paso [] (_,x) = (Left (False,x))


'res' nunca se detiene en el lado derecho de Either; pero es necesario implementarlo 
para que 'either' esté completo.

> der :: (Estado, Cinta) -> Respuesta
> der = (\x -> (False,([],[])))

Cuando 'res' termina el Either queda en estado izquierdo. Dependiendo de qué contiene 
sabemos si la máquina paró o tuvo un error.

> izq :: Respuesta -> Respuesta
> izq = id
               
> resuelve :: [Transicion] -> [Simbolo] -> Respuesta


En esta línea se puede definir que el estado inicial sea colocado en medio de la cinta y no 
al principio, para poder viajar un tramo a la izquierda. En este caso comienza con 10 espacios.
Originalmente era ([],s)::Cinta.

> resuelve t s = either izq der (res t (Right (0::Estado, ("          "::[Simbolo],s)::Cinta))) where

'res' aplica 'haz_paso' consecutivamente hasta que falle o hasta que el estado resultante sea el de paro

>   res :: [Transicion] -> Either Respuesta (Estado, Cinta) -> Either Respuesta (Estado, Cinta)

Alcanza estado de paro

>   res _ (Right (-1,x)) = (Left (True,x))

Faltó transición, o intentó rebasar el principio de la cinta; reportar fallo

>   res _ (Left (False,x)) = (Left (False,x))


Paso recursivo

>   res t (Right p) = res t (haz_paso t p)

Programa principal:

> main :: IO ()
> main = do
>   a <- getArgs
>   let
>       tr = parse lista_transiciones "" (head a)
>       ent = (head (tail a))
>   case tr of
>     (Left x) -> print x
>     (Right x) -> print (resuelve x ent)