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