1:- module(automaton, [automatondemo/0]).    2% :- set_prolog_flag(unknown, fail).
    3:- set_prolog_flag(double_quotes, codes).    4
    5% ?- qcompile(misc('automaton-web')).
    6% ?- module(automaton).
    7% ?- gv(a).
   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). % directory for temporary files  .pdf .png .bb  etc
   25file_name(deldel). % file name without extension.
   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))).    % Parity check automaton
   56sample(21, &(*(a+ *(b^ *(a)^b)),   % Doubly parity check automaton
   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),
   79%	atomic_list_concat(['open ', '-a Graphviz ', DOT], Comm),
   80	atomic_list_concat(['open ', PDF], Comm),
   81	shell(Comm).
   82
   83% sample runs:
   84% ?- match([0,1,(.),1,0], (0+1)^ *(0+1) ^ (epsilon+ (.) ^ *(0+1))).
   85% ?- match([1,2,3],*(-(0))).
   86% ?- match([1,1], *(1) + *(0)).
   87% ?- automaton((*(0+1))-(*(0)^*(1))).
   88
   89% for compatibility
   90new_atom(X):- gensym(q,X).
   91
   92% ex.  symbols(a+b, X) ==> X=[a,b].
   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
  106% ex. automaton(a+b) ==> will display the created automaton.
  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	;          % or
  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
  138% match([a],a) ==> yes
  139% match([a],b) ==> undefined symbol in the input.
  140% match([a,a], *(a)) ==> yes
  141% match([a,b],(-b)^(-a))  ==> yes
  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
  150% 'accept' is a predicate to test whether input is accepted by automaton
  151% (<initial sate>, <finail states>, <state transition function>)
  152%
  153% accept(X,S,F,E)  if the automaton (?, ?, E, S, F) accepts the input X.
  154%
  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
  170% main predicate
  171% generete an automaton for the given regular expression.
  172% reg2aut(<regular expression>, <input symbols>, <Automaton>).
  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
  198% make non-determinitic moves into deterministic ones
  199%
  200% ?- closure(([a,b],[mv(p,a,p),mv(p,a,q),mv(p,b,p)]), [[p]], X,Y).
  201%
  202% X = [[p, q], [p]]
  203% Y = [mv([p, q],a,[p, q]), mv([p,q],b,[p]), mv([p],a,[p,q]),
  204%     mv([p], b, [p])]
  205%
  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
  222% ex. makeassoc([a,b,c],X) => X = [a-0, b-1, c-2]
  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
  267% ex. compose_am(a,X,[a]) =>
  268% X =am([q1,q2,q3],[mv(q1,a,q2),mv(q21,a,q3),mv(q3,a,q3)],q1,[q2])
  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
  359% pathexp(X,Y,E,N,P)
  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
  388% equations to simpify regular expressions.
  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
  399% Applying the equations as far as they are applicable.
  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
  568% singleton([a,b,c],X) ==> X=[[a], [b], [c]]
  569singleton([],[]).
  570singleton([X|Y],[[X]|Z]):-singleton(Y,Z).
  571
  572% mergeclass(a,b, [[a,c],[d],[b,e]],X).
  573%   ==>  X = [[d], [a,c,b,e]]
  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
  613%%%%%%%%  For Web
  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)