regex-NKA

import Data.List
--           poc stavu, startovni, koncove, abeceda,
data Symbol = Symbol Char
            | Epsilon

type Prech = (Int, Symbol, Int)
type Aut = (Int, [Int], [Int], String, [Prech])

data RegExpr = Val Char
          | Iter RegExpr
          | Zret RegExpr RegExpr
          | Spoj RegExpr RegExpr
          deriving (Eq, Show)

re1 = Zret (Zret ( Iter (Spoj (Val 'a') (Val 'b'))) (Val 'a')) (Val 'b')

isEpsilon :: Symbol -> Bool
isEpsilon (Symbol a)=False
isEpsilon Epsilon =True

getCh :: Symbol -> Char
getCh (Symbol a) =  a
getCh Epsilon =  '&'

printSymbol :: Symbol -> String
printSymbol (Symbol a) =  show a
printSymbol Epsilon =  "&"

instance Show Symbol where -- pridani do  Show fce
    show a=printSymbol a

ex1 :: Aut
ex1 = (3, [0], [2], "ab", [(0,Symbol 'a',1), (0,Symbol 'b',0), (1,Symbol 'a',1), (1,Symbol 'b',2), (2,Symbol 'a',1), (2,Symbol 'b',0)])

ex2 :: Aut
ex2 = (3, [0], [2], "ab", [(0,Symbol 'a',1), (0,Symbol 'a',0), (0,Symbol 'b',0), (1,Symbol 'b',2),(1,Epsilon,2)])

krok :: Char -> [Int] -> [Prech] -> [Int]
krok x stavy prech = [novyStav| (stav, symbol, novyStav)<-prech,(existPath symbol x), elem stav stavy]

existPath :: Symbol -> Char -> Bool
existPath (Symbol s) c = getCh (Symbol s) ==c
existPath Epsilon _ = True

projdi:: String -> [Int] -> [Prech] -> [Int]
projdi []     stavy _     = stavy
projdi (x:xs) stavy prech = projdi xs (krok x stavy prech) prech

indx::[Int]->[[Int]]->Int
indx x xs = let Just y = elemIndex x xs
                  in y

jeKoncovy :: [Int]-> [Int] ->Bool
jeKoncovy koncovy aktualni = elem True [elem x koncovy| x<-aktualni]

test:: Aut -> String -> Bool
test (_, start, koncove, _, prech) slovo =
  let noveStavy = projdi slovo start prech
  in jeKoncovy koncove noveStavy


preved:: Aut -> Aut
preved (pocetStavu, start, koncove, symboly, prech) =
  let stavy = dostupne [] [start] prech symboly
      np = [(indx q stavy, (Symbol s), indx (krok s q prech) stavy) |s<-symboly, q<-stavy]
  in (length stavy, start, [indx x stavy|x<-stavy, jeKoncovy koncove x ],symboly,np )

dostupne:: [[Int]] -> [[Int]] -> [Prech] ->String -> [[Int]]
dostupne vytvorene [] _ symboly= vytvorene
dostupne x (s:zbytek) prech symboly =
  let nove = [krok x s prech | x<-symboly]
      nz = x ++ [s]
  in dostupne nz (zbytek++[x|x<-nove, notElem x nz, notElem x zbytek]) prech symboly


spojAut :: Aut -> Aut -> Aut
spojAut (pocetStavuA, startA, koncoveA, symbolyA, prechA) (pocetStavuB, startB,koncoveB, symbolyB, prechB) =
  ((pocetStavuA+pocetStavuB+1), [0],[a|a<-([aa+1| aa<-koncoveA]++[bb+1+pocetStavuA| bb <-koncoveB])], nub (symbolyA++symbolyB), (spojPrechody prechA prechB startA pocetStavuA startB))

spojPrechody :: [Prech]->[Prech] -> [Int] ->Int -> [Int] ->[Prech] -- prA, prB, pocatStA,pocetStA, pocatStB,
spojPrechody pA pB pocA ppa pocB =[(0,Epsilon,pp+1)|pp<-pocA]++[(0,Epsilon,pb+1+ppa)|pb<-pocB] ++ [((z+1), co, (kam+1))|(z,co,kam)<-pA] ++[((zB+1+ppa), coB, kamB+1+ppa)|(zB,coB,kamB)<-pB]

zretAut :: Aut -> Aut -> Aut
zretAut (pocetStavuA, startA, koncoveA, symbolyA, prechA) (pocetStavuB, startB,koncoveB, symbolyB, prechB) =
  let zretPrech = prechA ++ [(f,Epsilon,t+pocetStavuA)|f<-koncoveA, t<-startB] ++ [(x+pocetStavuA,y,z+pocetStavuA)|(x,y,z)<-prechB]
  in ((pocetStavuA+pocetStavuB),startA,[x+pocetStavuA|x<-koncoveB],nub (symbolyA++symbolyB),zretPrech)


iterAut :: Aut ->  Aut
iterAut (pocetStavuA, startA, koncoveA, symbolyA, prechA) =
  ((pocetStavuA+1),[0],[0] ++ [x+1|x<-koncoveA], symbolyA, [(0,Epsilon,a+1)|a <-startA] ++ [(k+1,Epsilon,0)|k<-koncoveA] ++ [(z+1,co,kam+1)|(z,co,kam)<-prechA] )


makeSimpleAut :: Char -> Aut
makeSimpleAut znak = (2,[0],[1],[znak],[(0, Symbol znak,1)])


prevedRegex :: RegExpr -> Aut
prevedRegex (Val x) = makeSimpleAut x
prevedRegex (Iter x) = iterAut (prevedRegex x)
prevedRegex (Zret x y) = zretAut (prevedRegex x) (prevedRegex y)
prevedRegex (Spoj x y) = spojAut (prevedRegex x) (prevedRegex y)

re2 = Zret (Spoj (Iter (Spoj (Val 'a') (Val 'b'))) (Val 'c')) (Val 'a')