1:- module(automaton, [automatondemo/0]). 3:- set_prolog_flag(double_quotes, codes). 4
9:- op(500, yfx, &). 10
11:- dynamic initial/1, final/1. 12:- dynamic gensym_count/1. 13:- dynamic next/3. 14:- retractall(gensym_count(_)), assert(gensym_count(0)). 15
16gensym(X, Y):- retract(gensym_count(C)),
17 C0 is C+1, assert(gensym_count(C0)),
18 atomic_list_concat([X, C0], Y).
19
20dir_path(deldel). 21file_name(deldel).
24automatondemo:-prompt(A,''), automatondemo(A,_).
25
26automatondemo(N):-sample(N,X),format("~w~n",[X]), gv(X).
27
28automatondemo(_,N):-sample(N,X),format("~w~n",[X]), gv(X), get0(_), fail.
29automatondemo(A,_):-prompt(_,A).
32sample(1,epsilon).
33sample(2,empty).
34sample(3,a).
35sample(4,a ^ b).
36sample(5,a ^ b ^c).
37sample(6,a + b).
38sample(7,a + a + a).
39sample(8,&(a,b)).
40sample(9,&(*(a),*(a+b))).
41sample(10,*(a) + *(b)).
42sample(11,*(a) ^ b).
43sample(12,*(a)^ *(b)).
44sample(13,*(a)^ *(a)).
45sample(14,*(*(a))).
46sample(15,*(a) - *(a)).
47sample(16,*(a) - epsilon).
48sample(17, (a+ *(b))^ (*(a)+b)).
49sample(18, *(*(a)^b^ *(a)^ b ^ *(a))).
50sample(19, &(*(*(a)^b^ *(a)^ b ^ *(a)), *(*(b)^a^ *(b)^ a ^ *(b)))).
51sample(20, *(a+ *(b^ *(a)^b))). 52sample(21, &(*(a+ *(b^ *(a)^b)), 53 *(b+ *(a^ *(b)^a)))).
55gv(R) :- graphviz(R).
56
57graphviz(R) :- symbols(R,I,L),!,graphviz(R,I,L).
58
59graphviz(R,[],_):- !, graphviz(R,[a]).
60graphviz(R,I,L):- length(I,N), N =< 3, L=<30, !, graphviz(R,I).
61graphviz(_,_,_):- format(
62 "<p> Too long expression or more than 3 input symbols</p>",[]).
63
64graphviz(R,I) :- reg2aut(R,Aut, I), autviz(Aut).
65
66av(A) :- autviz(A).
67av(A,M) :- write(M), nl, autviz(A), get0(_).
68
69autviz(Aut):-
70 DOT = 'DOTTEMP.dot',
71 PDF = 'DOTTEMP.PDF',
72 file(DOT, write, automaton:aut2dot(Aut)),
73 atomic_list_concat(['dot -Tpdf -o ', PDF, ' ', DOT], DotCom),
74 shell(DotCom),
76 atomic_list_concat(['open ', PDF], Comm),
77 shell(Comm).
78
84
86new_atom(X):- gensym(q,X).
87
89
90symbols(X,Y):- eval(symbols, X, (Y,_)).
91symbols(X,Y,L):- eval(symbols, X, (Y,L)).
92
93symbols(epsilon, ([],1), [], [], true).
94symbols(empty, ([],1), [], [], true).
95symbols(*(X), (Z,L), [X], [(Z,L0)], L is L0+1).
96symbols(-(X), (Z,L), [X], [(Z,L0)], L is L0+1).
97symbols(F, (Z,L), [X, Y], [(Z1,L1), (Z2,L2)],
98 (union(Z1,Z2,Z), L is L1+L2+1)) :-
99 F=..[Op,X,Y], member(Op,[(^),(+),(-),(&)]).
100symbols(A, ([A],1), [], [],true).
101
103
104automaton(R):-
105 symbols(R,I),
106 reg2aut(R,I,am(S,M,Ini,Fin)),
107 format("Regular expression = ~w~n",[R]),
108 format("Initial state = ~w~n",[Ini]),
109 format("List of final states = ~w~n",[Fin]),
110 format("List of states = ~w~n",[S]),
111 format("State transitions:~n"),
112 (member(mv(A,B,C),M),
113 format(" ~w ----- ~w -----> ~w~n",[A,B,C]),fail
114 ; 115 true).
116
117edge_in_dot(X,A,Y):- format("~w -> ~w [label = ~w];~n",[X,Y,A]).
118
119aut2dot(am(_,M,Ini,Fin)):-
120 format("digraph g {~n",[]),
121 format("rankdir=LR;~n",[]),
122 format("dummy [shape = none, label = """"];~n",[]),
123 final_in_dot(Fin),
124 move_in_dot([mv(dummy,'""',Ini)|M]),
125 format("}~n",[]).
126
127final_in_dot([]).
128final_in_dot([X|Y]):-format("~w [shape = doublecircle];~n", [X]),
129 final_in_dot(Y).
130
131move_in_dot([]).
132move_in_dot([mv(X,A,Y)|Z]):-edge_in_dot(X,A,Y), move_in_dot(Z).
133
138
139match(Y,X):-
140 make_and_assert(X,initial,final,next),
141 symbols(X,I),
142 (subset(Y,I) -> accept(Y,initial,final,next)
143 ;
144 format("undefined symbol in the input: ~w~n",[Y])).
145
151
152accept(X,S,F,E):-
153 T=..[S,U],
154 call(T),
155 accept1(X,U,F,E).
156
157accept1([],S,F,_):-!, applyfinal(F,S).
158accept1([X|Y],S,F,E):-
159 applynext(E,S,X,U),
160 accept1(Y,U,F,E).
161
162applyfinal(F,S):-T=..[F,S], call(T).
163
164applynext(E,S,X,U):-T=..[E,S,X,U], call(T).
165
169reg2aut(X,Am,I):-
170 compose_am(X,Am1,I),
171 minimize_am(Am1,Am2),
172 removeredundant(Am2,Am3),
173 refresh_am(Am3,Am).
176removeredundant(am(_,E,St,F),am(D,E1,St,F1)):-
177 sptree(St,E,D),
178 intersection(F,D,F1),
179 filterlinks(D,E,E1).
180
181filterlinks(_,[],[]).
182filterlinks(D,[mv(X,_,_)|R],Z):- (\+ member(X,D)),!,filterlinks(D,R,Z).
183filterlinks(D,[H|R],[H|Z]):-filterlinks(D,R,Z).
184
185refresh_am(X,Y):- refresh_am(X,0,Y).
186
187refresh_am(am(S,D,St,F),First,am(S1,D1,St1,F1)):-
188 makeassoc(First,S,Map),
189 assoclist(S,Map,S1),
190 mapmove(D,Map,D1),
191 member(St-St1,Map),
192 assoclist(F,Map,F1).
193
202
203closure(E,X,Y,Z):-closure(E,X,[],[],Y,Z).
204
205closure(_,[],X,Y,X,Y).
206closure(E,[S|R],X,Y,Z,U):-member(S,X),!,closure(E,R,X,Y,Z,U).
207closure(E,[S|R],X,Y,Z,U):-
208 successors(E,S,L,M),
209 append(L,R,LR),
210 append(M,Y,MY),
211 closure(E,LR,[S|X],MY,Z,U).
212
213successors((I,E),X,L,M):-
214 setof(mv(X,A,Y),
215 (member(A,I),setof(Z,K^(member(K,X),member(mv(K,A,Z),E)),Y)),M),
216 setof(U,X1^B^member(mv(X1,B,U),M),L).
217
219
220makeassoc(X,Y):-makeassoc(0,X,Y).
221
222makeassoc(_,[],[]).
223makeassoc(N,[X|Y],[X-N|R]):-N1 is N+1, makeassoc(N1,Y,R).
224
225assoclist([],_,[]).
226assoclist([X|Y],Map,[N|B]):-member(X-N,Map),assoclist(Y,Map,B).
227
228mapmove([],_,[]):-!.
229mapmove([mv(X,L,Y)|Z], Map, [mv(X1,L,Y1)|Z1]):-
230 member(X-X1,Map),
231 member(Y-Y1,Map),
232 mapmove(Z,Map,Z1).
233
234make_and_assert(X,State,Final,Next):-
235 symbols(X,I),
236 reg2aut(X,I,am(_,M,Ini,Fin)),
237 assert_automaton(State,Ini,Final,Fin,Next,M).
238
239assert_automaton(Sn,S,Fn,F,An,A):-
240 abolish(Sn/1),
241 abolish(Fn/1),
242 abolish(An/3),
243 T=..[Sn,S],
244 asserta(T),
245 assertlist(Fn,F),
246 assertarrowlist(An,A).
247
248assertlist(_,[]):-!.
249assertlist(F,[X|Y]):-
250 T=..[F,X],
251 asserta(T),
252 assertlist(F,Y).
253
254assertarrowlist(_,[]):-!.
255assertarrowlist(A, [mv(X,L,Y)|Z]):-
256 T=..[A,X,L,Y],
257 asserta(T),
258 assertarrowlist(A,Z).
259
260final(am(_,_,_,X),X).
261
262
265
266
267compose_am(empty, am([S],Trans,S,[]),I):-!,
268 new_atom(S),
269 setof(mv(S,A,S),member(A,I),Trans).
270compose_am(epsilon,am([S,T],Trans,S,[S]),I):-!,
271 new_atom(S),
272 new_atom(T),
273 setof(mv(Q,A,T),(member(Q,[S,T]),member(A,I)),Trans).
274compose_am(Z,am(S,D,St,F),I):-
275 Z =.. [Op,X,Y],
276 member(Op,[(+),(-),(&)]),
277 !,
278 reg2aut(X,AX,I),
279 reg2aut(Y,AY,I),
280 product(AX,AY,[S,D,St]),
281 final(AX,FX),
282 final(AY,FY),
283 Fexp =..[Op,FX,FY],
284 makefinal(Fexp,S,F).
285compose_am(^(X,Y),am(S,E,[St1],F),I):-!,
286 reg2aut(X, am(S1,E1,St1,F1),I),
287 reg2aut(Y, AmY,I),
288 length(S1,L),
289 L1 is L+1,
290 refresh_am(AmY,L1,am(_,E2,St2,F2)),
291 cartesian(F1,[St2],E_links),
292 tcl(E_links, E_tcl),
293 append(E1,E2,E3),
294 extend_by_emove(E_tcl, E3, E4),
295 closure((I,E4),[[St1]],S,E),
296 extend_set_by_emove(F2,E_tcl,F3),
297 (setof(P,Q^(member(P,S),member(Q,P),member(Q,F3)),F),!; F=[]).
298compose_am(*(X),am(S,R,[NewSt],Fin), I):-!,
299 reg2aut(X,am(_,E,St,F),I),
300 new_atom(NewSt),
301 cartesian(F,[NewSt],Emoves),
302 tcl([(NewSt,St)|Emoves],TclE),
303 extend_by_emove(TclE,E,D),
304 closure((I,D),[[NewSt]],S,R),
305 extend_set_by_emove([NewSt],TclE,Fin1),
306 (setof(P,Q^(member(P,S),member(Q,P),member(Q,Fin1)),Fin),!; Fin=[]).
307compose_am(-(X),am(S,R,St,Fin), I):-!, reg2aut(X,am(S,R,St,F),I),
308 subtract(S,F,Fin).
309compose_am(A, am([P,Q,R],[mv(P,A,Q)|Trans],P,[Q]),I):-
310 new_atom(P),
311 new_atom(Q),
312 new_atom(R),
313 setof(mv(S,B,R),(member(S,[P,Q,R]),member(B,I)),Moves),
314 remove(mv(P,A,R),Moves,Trans).
315
316extend_by_emove(X,Y,Z):- maplist(insert_link_label(epsilon),X,X1),
317 add_join(X1,Y,Y1),
318 add_join(Y1,X1,Z1),
319 remove_emove(Z1,Z).
320
321insert_link_label(X,(Y,Z), mv(Y,X,Z)).
322
323extend_set_by_emove(X,Y,Z):-choose((A,B),Y,Y1),member(B,X),!,
324 extend_set_by_emove([A|X],Y1,Z).
325extend_set_by_emove(X,_,Y):-sort(X,Y).
326
327remove_emove([],[]).
328remove_emove([mv(_,epsilon,_)|X],Y):-!,remove_emove(X,Y).
329remove_emove([X|Y],[X|Z]):-remove_emove(Y,Z).
330
331makefinal(FX + FY,S,F):-
332 setof((P,Q),(member((P,Q),S),(member(P,FX);member(Q,FY))),F),!.
333makefinal(&(FX,FY),S,F):-
334 setof((P,Q),(member((P,Q),S),(member(P,FX),member(Q,FY))),F),!.
335makefinal(-(FX,FY),S,F):-
336 setof((P,Q),(member((P,Q),S),(member(P,FX), (\+ member(Q,FY)))),F),!.
337makefinal(_,_,[]).
338
339product(am(X1,Y1,Z1,_),am(X2,Y2,Z2,_),[X3,Y3,(Z1,Z2)]):-
340 cartesian(X1,X2,X3),
341 setof(mv((P1,P2),A,(Q1,Q2)),
342 (member(mv(P1,A,Q1),Y1), member(mv(P2,A,Q2),Y2)),Y3).
346reg2reg(R,R1):-symbols(R,I), reg2aut(R,I,A),aut2reg(A,R1).
350aut2reg(am(S,E,St,F), R):-aut2reg(St,F,E,S,R1),reduce(R1,R).
351
352aut2reg(_,[],_,_,empty).
353aut2reg(X,[Y|Z],E,S,P+Q):- pathexp(X,Y,E,S,P), aut2reg(X,Z,E,S,Q).
354
356
357pathexp(X,X,E,N,*(C)):-!,remove(X,N,N1),cycle(X,E,N1,C).
358pathexp(X,Y,E,N,*(C) ^ Q):-
359 remove(X,N,N1),
360 cycle(X,E,N1,C),
361 pathexp1(X,Y,E,E,N1,Q).
367pathexp1(_,_,[],_,_,empty).
368pathexp1(X,Y,[mv(X,A,Z)|R],E,N,(A^P)+Q):-
369 member(Z,N),!,
370 pathexp(Z,Y,E,N,P),
371 pathexp1(X,Y,R,E,N,Q).
372pathexp1(X,Y,[mv(X,A,Y)|R],E,N,A+Q):-!,pathexp1(X,Y,R,E,N,Q).
373pathexp1(X,Y,[_|R],E,N,P):-pathexp1(X,Y,R,E,N,P).
374
375cycle(X,E,N,P):-cycle(X,E,E,N,P).
376
377cycle(_,[],_,_,empty).
378cycle(X,[mv(X,A,X)|R],E,N,A+P):-!,cycle(X,R,E,N,P).
379cycle(X,[mv(X,A,Y)|R],E,N,(A^P)+Q):-member(Y,N),!,
380 pathexp1(Y,X,E,E,N,P),
381 cycle(X,R,E,N,Q).
382cycle(X,[_|R],E,N,P):-cycle(X,R,E,N,P).
383
385equal(epsilon^X,X).
386equal(X^epsilon,X).
387equal(_^empty,empty).
388equal(empty^_,empty).
389equal(empty+X,X).
390equal(X+empty,X).
391equal(*(*(X)), *(X)).
392equal(*(empty), epsilon).
393equal(*(epsilon), epsilon).
394
396reduce(X,Y):-reduceone(X,X1),!,reduce(X1,Y).
397reduce(X,X).
398
399reduceone(X,X1):-equal(X,X1).
400reduceone(X+Y,X1+Y):-reduceone(X,X1).
401reduceone(X+Y,X+Y1):-reduceone(Y,Y1).
402reduceone(X^Y,X1^Y):-reduceone(X,X1).
403reduceone(X^Y,X^Y1):-reduceone(Y,Y1).
404reduceone(&(X,Y),&(X1,Y)):-reduceone(X,X1).
405reduceone(&(X,Y),&(X,Y1)):-reduceone(Y,Y1).
406reduceone(*(X),*(X1)):-reduceone(X,X1).
421minimize_am(am(S,T,St,F),am(QS,QT,QSt,QF)):-
422 equivrel(S,F,T,R),
423 qstate(R,S,QS),
424 qdelta(T,QT,QS),
425 qfinal(F,QF,QS),
426 qstart(St,QSt,QS).
427
428
429equivrel(S,F,M,E):-
430 subtract(S,F,S1),
431 pairs(S,S,S2),
432 pairs(S1,F,P),
433 subtract(S2,P,S3),
434 fill_table(S3,P,mv_triples(M),E).
435
436mv_triples(M, X, A, Y):- member(mv(X,A,Y), M).
447fill_table(R,P,M,E):-choose(X,R,R1),separable(X,M,P),!,
448 fill_table(R1,[X|P],M,E).
449fill_table(R,_,_,R).
450
451separable((X,Y), M, P):- call(M, X, A,X1),
452 call(M, Y, A, Y1),
453 pair_member((X1,Y1),P).
454
455pair_member((X,X),_):-!,fail.
456pair_member((X,Y),A):- X @> Y, !, memberchk((Y,X),A).
457pair_member(Z,A):- memberchk(Z,A).
458
459choose(X,[X|R],R).
460choose(X,[A|R],[A|S]):-choose(X,R,S).
468qstate(R,X,Y):-singleton(X,X1),qstate1(R,X1,Y).
469
470qstate1([],X,X).
471qstate1([(A,B)|R],X,Z):- mergeclass(A,B,X,X1),qstate1(R,X1,Z).
472
473qdelta(X,Y,Q):-qdelta(X,[],Y,Q).
474qdelta([],M,M,_).
475qdelta([mv(U,A,V)|R],M,N,Q):-
476 member(C,Q),member(U,C),
477 member(D,Q),member(V,D),
478 !,
479 addnew(mv(C,A,D),M,M1),
480 qdelta(R,M1,N,Q).
481
482qfinal(X,Y,Q):-qfinal(X,[],Y,Q).
483
484qfinal([],M,M,_).
485qfinal([U|R],M,N,Q):-
486 member(C,Q),member(U,C),
487 !,
488 addnew(C,M,M1),
489 qfinal(R,M1,N,Q).
490
491qstart(X,C,Q):-member(C,Q),member(X,C),!.
497add_join(X,Y,Z):-join(X,Y,Z1), append(X,Y,Z2), append(Z1,Z2,Z).
498
499join(X,Y,Z):-join0(X,Y,Z-[]).
500
501join0([],_,L-L).
502join0([X|Y],Z,U-V):- join1(X,Z,U-W), join0(Y,Z,W-V).
503
504join1(_,[],L-L).
505join1(X,[Y|Z],[U|V]-W):-join2(X,Y,U),!,join1(X,Z,V-W).
506join1(X,[_|Y],Z):-join1(X,Y,Z).
507
508join2(mv(A,F,B),mv(B,G,C), mv(A,D,C)):- compose_label(F,G,D),!.
509
510compose_label(epsilon,X,X).
511compose_label(X,epsilon,X).
512compose_label(X,Y,(X;Y)).
521tcl(E,Tcl):-tcl(E,E,Tcl).
522
523tcl([],X,X):-!.
524tcl(A,X,Y):-tcl(A,[],X,A1,X1),tcl(A1,X1,Y).
525
526tcl([],A,X,A,X).
527tcl([A|R],B,X,C,Y):-
528 tcl(A,X,B,X,B1,X1),
529 tcl(R,B1,X1,C,Y).
530
531tcl(_,[],B,X,B,X).
532tcl(A,[B|R],C,X,D,Y):-join_link(A,B,P),!,
533 addnew(P,C,X,C1,X1),
534 tcl(A,R,C1,X1,D,Y).
535tcl(A,[_|R],C,X,D,Y):-tcl(A,R,C,X,D,Y).
536
537join_link((A,B),(B,C),(A,C)).
544sptree(Root,E,N):-sptree(E,[Root],[],N).
545
546sptree(_,[],X,X).
547sptree(E,[H|R],X,Y):-member(H,X),!,sptree(E,R,X,Y).
548sptree(E,[H|R],X,Y):-sptree(H,E,R,E1,R1),sptree(E1,R1,[H|X],Y).
549
550sptree(_,[],R,[],R).
551sptree(H,[mv(H,_,X)|E],R,E1,[X|R1]):-!,sptree(H,E,R,E1,R1).
552sptree(H,[A|E],R,[A|E1],R1):-sptree(H,E,R,E1,R1).
558addnew(X,D,D):-member(X,D),!.
559addnew(X,D,[X|D]).
560
561addnew(P,C,X,C,X):-member(P,X),!.
562addnew(P,C,X,[P|C],[P|X]).
563
565singleton([],[]).
566singleton([X|Y],[[X]|Z]):-singleton(Y,Z).
567
570mergeclass(_,_,[],[]).
571mergeclass(A,B,[X|Y],Z):-member(A,X),!,mergeclass1(X,B,Y,Z).
572mergeclass(A,B,[X|Y],Z):-member(B,X),!,mergeclass2(X,A,Y,Z).
573mergeclass(A,B,[X|Y],[X|Z]):-mergeclass(A,B,Y,Z).
574
575mergeclass1(X,A,Y,[X|Y]):-member(A,X),!.
576mergeclass1(X,A,Y,Z):-mergeclass2(X,A,Y,Z).
577
578mergeclass2(X,A,[Y|Z],[XY|Z]):-member(A,Y),!,append(X,Y,XY).
579mergeclass2(X,A,[Y|Z],[Y|U]):-mergeclass2(X,A,Z,U).
583cartesian([],_,[]).
584cartesian([A|B],C,D):-cartesian(B,C,E),
585 cartesian1(A,C,F),
586 append(F,E,D).
587
588cartesian1(_,[],[]).
589cartesian1(A,[B|C],[(A,B)|D]):-cartesian1(A,C,D).
595pairs(X,Y,Z):-pairs(X,Y,[],Z).
596
597pairs([],_,X,X).
598pairs([A|B],C,D,E):-pairs1(A,C,D,E1), pairs(B,C,E1,E).
599
600pairs1(_,[],X,X).
601pairs1(A,[A|C],D,E):-!, pairs1(A,C,D,E).
602pairs1(A,[B|C],D,E):-A @> B, !, addnew((B,A),D,D1),pairs1(A,C,D1,E).
603pairs1(A,[B|C],D,E):-addnew((A,B),D,D1),pairs1(A,C,D1,E).
604
605remove(_,[],[]):-!.
606remove(X,[X|Y],Y):-!.
607remove(X,[Y|Z],[Y|U]):-remove(X,Z,U).
608
610
611reg2html(F,D,C,R,[],_,T,H):- !, reg2html(F,D,C,R,[a],T,H).
612reg2html(F,D,C,R,I,L,T,H):- length(I,N), N =< 3, L=<30, !,
613 reg2html(F,D,C,R,I,T,H).
614reg2html(_,_,_,_,_,_,_,
615 "<p> Too long expression 30 or more than 3 input symbols</p>").
616
617reg2html(F,D,C,R,I,T,H) :-
618 reg2aut(R,am(S,M,Ini,Fin),I),
619 H1 = (format_codes("<p>Regular expression = ~w</p>",[R]) &
620 format_codes("<p>Initial state = ~w</p>",[Ini]) &
621 format_codes("<p>Final states = ~w</p>",[Fin]) &
622 format_codes("<p>All states = ~w</p>",[S]) &
623 format_codes("<p>State Transitions:</p>~n",[])),
624 atomic_list_concat([D, '/', F, C, '.dot'], DotName),
625 file(DotName, write, automaton:aut2dot(am(S,M,Ini,Fin))),
626 formatForHtml(F,D,C,T,Format,Args),
627 print_moves(M,M1),
628 eval(H1 & format_codes(Format,Args) & M1, H).
629
630formatForHtml(F,D,C,X,Format,[F,C,X]) :-!,
631 img_frame(Format),
632 atomic_list_concat([D, (/), F, C], Base),
633 ( X == pdf
634 -> Ext = ps2,
635 Com = ps2pdf("-sOutputFile="+ Base+ "."+ pdf,
636 Base+ "."+ Ext)
637 ; Ext = X, Com = "DUMMY=1"
638 ),
639 eh:sh(dot(-'T'(Ext), Base+ (.)+ dot, -o(Base+(.)+Ext)); Com).
640
641img_frame(X) :- flatten([ "<p><div ",
642 "id='diagram' ",
643 "style='border : solid 2px #ff0000; ",
644 "width : 600px; ",
645 "height : 300px; ",
646 "overflow : auto; '><br/>",
647 "<img src=""~w~w.~w""/>",
648 "</div></p>~n"
649 ], X).
650
651print_moves(M,H):-
652 maplist(print_moves_x, M, T),
653 flatten(T,T1),
654 flatten(["<pre>\n",T1, "</pre>\n"], H).
655
656print_moves_x(mv(X,A,Y), H):-
657 format_codes(" ~w----~w--->~w~n",[X,A,Y], H)