pda.hs

-- Implementación de Autómata de Pila


-- Se define formalmente como PDA = (Q, Σ, Γ, δ, qo, Z0, F) donde:
-- Q Conjunto de estados
-- Σ Alfabeto de entrada
-- Γ Alfabeto de la pila
-- δ Función de transición
-- q0 Estado Inicial
-- Z0 Símbolo inicial de la pila
-- F Conjunto de estados finales

-- Tipo de dato State, que define un estado de la maquina.
data State = State [Char] deriving (Eq,Show)

-- Tipo de dato que define una transicion de un estado a otro. Puede consumir un simbolo de la cadena de entrada (ReadTrans) o se una epsilon transicion (EpsilonTrans)
data DeltaFunc = ReadTrans (State,Char,Char,State,[Char]) | EpsilonTrans (State,Char,State,[Char]) deriving (Eq,Show)

data Automata = Automata { 
 q::[State] -- lista de estados posibles
 ,sigma::[Char] -- lista de simbolos del alfabeto
 ,gamma::[Char] -- lista de simbolos de la pila
 ,delta::[DeltaFunc] -- lista de transiciones posibles de un estado a otro
 ,q_0::State -- estado inicial 
 ,z_0::Char -- simbolo del fondo de la pila
 ,ff::[State] -- estados finales
 } deriving (Eq,Show) 


data Stack = Stack [Char] deriving (Eq,Show)

-- Funciones necesarias para el funcionamiento del PDA
seeTop::Stack->Char -- devuelve el primer elemento de la pila
seeTop (Stack stack) = head stack

stackAdd::Stack->[Char]->Stack -- esta funcion agrega elementos a la pila
stackAdd (Stack stack) items = Stack (items ++ (tail stack))

-- Un tipo Machine es un autómata con su stack
type Machine = (Automata, Stack)

-- Una configuración se representa mediante el siguiente sinónimo
type Config = (State, String, Stack)

-- Primero definimos computo de un paso
computeStep :: [DeltaFunc] -> Config -> [Config] -- esta funcion recibe una funcion delta y una configuracion y devuelve todas las configuraciones a las que se puede llegar en un paso de procesamiento
computeStep (delta) (q,s,stack) = if s/=[]
 then [(gotoState,(tail s),stackAdd stack intoStack)|ReadTrans (initState,toRead,stackHead,gotoState,intoStack)<-delta,initState==q,toRead==(head s),stackHead==seeTop stack]++[(gotoState,s,stackAdd stack intoStack)|EpsilonTrans (initState,stackHead,gotoState,intoStack)<-delta,initState==q,stackHead==seeTop stack] -- si la cadena no se ha leido por completo entonces devuelve la lista de configuraciones a las que se puede llegar leyendo un simbolo o por una epsilon transicion
 else [(gotoState,s,stackAdd stack intoStack)|EpsilonTrans (initState,stackHead,gotoState,intoStack)<-delta,initState==q,stackHead==seeTop stack] -- si s vacia entonces devuelve configuraciones a las que se puede llegar por epsilon transiciones

machineRun:: [DeltaFunc] -> Config -> [[Config]] -- recibe una funcion delta y una configuracion y devuelve una lista de secuencias de procesamiento posibles a partir de la configuracion inicial segun la delta
machineRun delta initConfig = let stepConfigs = computeStep delta initConfig
 in if stepConfigs /= []
 then concat [[stepConf:twoStepConfs | twoStepConfs <- machineRun delta stepConf] | stepConf <- stepConfigs] -- si se alcanzan nuevas configuraciones en un paso entonces devuelve una lista recursiva donde le agrega a cada nueva configuracion alcanzable todas las que son alcanzables desde estas
 else [[]] -- si ya no se llega a nuevas configuraciones entonces devuelve una lista con la lista vacia

-- Recibe una Machine y una cadena
-- Imprime el procesamiento formal de la cadena con configuraciones
compute :: Machine -> String -> [[Config]]
compute ((Automata {q=qLst,sigma=sigma,gamma=gamma,delta=delta,q_0=q_0,z_0=z_0,ff=ff}),(Stack [])) entrada = [(q_0,entrada,Stack [z_0]):res | res<-machineRun delta (q_0,entrada,Stack [z_0])]

getState :: Config -> State -- funcion que devuelve el estado de una configuracion
getState (stt,_,_) = stt

getStr :: Config -> String -- funcion que devuelve la cadena de una configuracion
getStr (_,str,_) = str

getStack :: Config -> Stack -- funcion que devuelve la pila de una configuracion
getStack (_,_,stk) = stk

getFinals :: Machine -> [State] -- funcion que devuelve la lista de estados finales de una maquina
getFinals ((Automata {q=qLst,sigma=sigma,gamma=gamma,delta=delta,q_0=q_0,z_0=z_0,ff=ff}),(Stack [])) = ff

-- Recibe una Machine y una cadena
-- Regresa un bool diciendo si la cadena es aceptada [true] o no [false]
-- por el autómata de pila
acceptByStack :: Machine -> String -> Bool
acceptByStack maq entrada = or [(getStr (last res)=="" && getStack (last res)==Stack "") | res <- compute maq entrada] -- checa si alguna secuencia de procesamiento termina en una configuracion donde se haya leido toda la cadena de entrada y tenga la pila vacia


-- Recibe una Machine y una cadena
-- Reresa si un bool diciendo si la cadena es aceptada [true] o no [false]
-- por el autómata de pila
acceptByState :: Machine -> String -> Bool
acceptByState maq entrada = or [(getStr (last res)=="" && elem (getState (last res)) (getFinals maq)) | res <- compute maq entrada] -- checa si alguna secuencia de procesamiento termina en una configuracion donde se haya leido toda la cadena de entrada y el estado sea alguno de los finales para la maquina

--definicion del automata que acepta L={a^n b^m c^k | n=m o m=k}
aut = Automata {
 q=[State "q0",State "q1", State "q2", State "q3", State "q4", State "q5", State "q6", State "q7"]
 , sigma=['a','b','c'] -- tres letras del abecedario
 , gamma=['X','Z'] -- dos simbolos de la pila
 ,delta=[EpsilonTrans (State "q0",'Z',State "q1",['Z']) -- Detecta m=n
  ,ReadTrans (State "q1", 'a','Z',State "q1","XZ") -- cuenta a con X
  ,ReadTrans (State "q1", 'a','X',State "q1","XX") -- cuenta a
  ,EpsilonTrans (State "q1",'Z',State "q2",['Z']) -- pasa de gratis a q2
  ,EpsilonTrans (State "q1",'X',State "q2",['X']) -- pasa de gratis a q2
  ,ReadTrans (State "q2", 'b','X',State "q2",[]) -- cuenta b quitando X que puso a
  ,EpsilonTrans (State "q2",'Z',State "q3",['Z']) -- pasa de gratis a q3
  ,ReadTrans (State "q3", 'c','Z',State "q3",['Z']) -- lee todas las c que queden
  ,EpsilonTrans (State "q3",'Z',State "q7",['Z']) -- pasa de gratis a estado final q7
  
  ,EpsilonTrans (State "q0",'Z',State "q4",['Z']) -- Detecta m=k
  ,ReadTrans (State "q4", 'a','Z',State "q4","Z") -- lee todas las a al principio
  ,EpsilonTrans (State "q4",'Z',State "q5",['Z']) -- pasa de gratis a q4
  ,ReadTrans (State "q5", 'b','Z',State "q5","XZ") -- cuenta b con X
  ,ReadTrans (State "q5", 'b','X',State "q5","XX") -- cuenta b
  ,EpsilonTrans (State "q5",'Z',State "q6",['Z']) -- pasa de gratis a q6
  ,EpsilonTrans (State "q5",'X',State "q6",['X']) -- pasa de gratis a q6
  ,ReadTrans (State "q6", 'c','X',State "q6",[]) -- cuenta c y compara con b quitando X
  ,EpsilonTrans (State "q6",'Z',State "q7",['Z'])] -- pasa de gratis a estado final q7
 ,q_0=State "q0" -- estado inicial q0
 ,z_0='Z' -- fondo de pila
 ,ff=[State "q7"]} -- q7 es el estado final

-- Procesamieto formal de "aabbcc" por aut obtenido de la funcion compute
--[[(State "q0","aabbcc",Stack "Z"),(State "q1","aabbcc",Stack "Z"),(State "q1","abbcc",Stack "XZ"),(State "q1","bbcc",Stack "XXZ"),(State "q2","bbcc",Stack "XXZ"),(State "q2","bcc",Stack "XZ"),(State "q2","cc",Stack "Z"),(State "q3","cc",Stack "Z"),(State "q3","c",Stack "Z"),(State "q3","",Stack "Z"),(State "q7","",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q1","aabbcc",Stack "Z"),(State "q1","abbcc",Stack "XZ"),(State "q1","bbcc",Stack "XXZ"),(State "q2","bbcc",Stack "XXZ"),(State "q2","bcc",Stack "XZ"),(State "q2","cc",Stack "Z"),(State "q3","cc",Stack "Z"),(State "q3","c",Stack "Z"),(State "q7","c",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q1","aabbcc",Stack "Z"),(State "q1","abbcc",Stack "XZ"),(State "q1","bbcc",Stack "XXZ"),(State "q2","bbcc",Stack "XXZ"),(State "q2","bcc",Stack "XZ"),(State "q2","cc",Stack "Z"),(State "q3","cc",Stack "Z"),(State "q7","cc",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q1","aabbcc",Stack "Z"),(State "q1","abbcc",Stack "XZ"),(State "q2","abbcc",Stack "XZ")],[(State "q0","aabbcc",Stack "Z"),(State "q1","aabbcc",Stack "Z"),(State "q2","aabbcc",Stack "Z"),(State "q3","aabbcc",Stack "Z"),(State "q7","aabbcc",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q4","aabbcc",Stack "Z"),(State "q4","abbcc",Stack "Z"),(State "q4","bbcc",Stack "Z"),(State "q5","bbcc",Stack "Z"),(State "q5","bcc",Stack "XZ"),(State "q5","cc",Stack "XXZ"),(State "q6","cc",Stack "XXZ"),(State "q6","c",Stack "XZ"),(State "q6","",Stack "Z"),(State "q7","",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q4","aabbcc",Stack "Z"),(State "q4","abbcc",Stack "Z"),(State "q4","bbcc",Stack "Z"),(State "q5","bbcc",Stack "Z"),(State "q5","bcc",Stack "XZ"),(State "q6","bcc",Stack "XZ")],[(State "q0","aabbcc",Stack "Z"),(State "q4","aabbcc",Stack "Z"),(State "q4","abbcc",Stack "Z"),(State "q4","bbcc",Stack "Z"),(State "q5","bbcc",Stack "Z"),(State "q6","bbcc",Stack "Z"),(State "q7","bbcc",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q4","aabbcc",Stack "Z"),(State "q4","abbcc",Stack "Z"),(State "q5","abbcc",Stack "Z"),(State "q6","abbcc",Stack "Z"),(State "q7","abbcc",Stack "Z")],[(State "q0","aabbcc",Stack "Z"),(State "q4","aabbcc",Stack "Z"),(State "q5","aabbcc",Stack "Z"),(State "q6","aabbcc",Stack "Z"),(State "q7","aabbcc",Stack "Z")]]

pros1 = compute (aut, Stack []) "aabbcc"