1:- module(coalgebra, [show_am/1, regex_to_pdf/2, regex_to_pdf/3,
2 gv/1]).gv(a).
?- gv("ab").7% ?- show_am(a+b). 8% ?- show_am("([a-d])*[b-e]"). 9% ?- show_am("c|a|b|c"). 10% ?- show_am("cabc"). 11% ?- show_am("(ca)|(bc)"). 12% ?- show_am("(ca)+(bc)"). 13% ?- time(show_am("^(.*)/([^/]*)")). 14 15% ?- time(show_am("^(.*)/([^/]*)$")). 16 17 18:- use_module(library(lists)). 19:- use_module(pac(basic)). 20:- use_module(pac('expand-pac')). 21:- use_module(pac('expand-word')). 22:- use_module(util(misc)). 23:- use_module(util(math)). 24:- use_module(util('emacs-handler')). 25:- use_module(util(meta2)). 26:- use_module(util(file)). 27:- use_module(util(obj)). 28:- use_module(util(web)). 29 30term_expansion --> pac:expand_pac. 31:- use_module(pac(op)). 32 33% :- set_prolog_flag(unknown, fail). 34% :- expand_file_name('~', X), log(X). % empty string. 35:-op(750, yfx, &). 36 37signature([(^)/2,(+)/2,(\)/2,(&)/2,(#)/2,(-)/1,(*)/1,reverse/1]). 38 39% 'coa' stands for coalgebra; 'sts', state transition system; 40% am, automaton; dfam, deterministic finite automaton 41% ?- trace, coalgebra:compose_am((a+b)^(c+d), X). 42 43% ?- qcompile(util(coalgebra)). 44% ?- module(coalgebra). 45% ?- am(a, X). 46% ?- am(a+b, X). 47% ?- am(a^b, X). 48% ?- compose_am(*(a), X). 49 50compose_am(E, C):- symbols(E, S), 51 preprocess_complement(S, E, E0), 52 am(E0, C0), 53 remove_dead_states(C0, C). 54 55dfam --> call, det_am, minimum_am, refresh_am. 56 57% ?- listing(am). 58 59am(empty,A1):-!,ampty_am(A1) . 60am(epsilon,A1):-!,epsilon_am(A1) . 61am(A+B,A1):-!,(am(A,A2),am(B,A3)),dfam(disj_am(A2,A3),A1) . 62am(A&B,A1):-!,(am(A,A2),am(B,A3)),dfam(conj_am(A2,A3),A1) . 63am(A^B,A1):-!,(am(A,A2),am(B,A3)),dfam(concat_am(A2,A3),A1) . 64am(*A,A1):-!,am(A,A2),dfam(star_am(A2),A1) . 65am((A\B),A1):-!,(am(A,A2),am(B,A3)),dfam(subtr_am(A2,A3),A1) . 66am(#(A,B),A1):-!,(am(A,A2),am(B,A3)),dfam(xor_am(A2,A3),A1) . 67am(reverse(A),A1):-!,am(A,A2),dfam(reverse_am(A2),A1) . 68am(X,am([(1,[(X,[2])]),(2,[])],1,[2])):-! .
74empty_am(am([ (1,[])],1, [])). 75 76epsilon_am(am([ (1,[])],1, [1])). 77 78conj_am(X, Y, Z):- prod_am(conj, X, Y, Z). 79 80disj_am(X, Y, Z):- prod_am(disj, X, Y, Z). 81 82concat_am(am(C0,I0,F0), Am1, Am):- 83 length(C0, L), 84 L1 is L+1, 85 refresh_am(Am1, am(C1, I1, F1), L1, _), 86 product(F0, [I1], E), 87 append(C0, C1, H), 88 join_am(E, am(H,I0,F1), Am). 89 90star_am(am(C,I,F), Am):- 91 product(F, [I], E), 92 join_am(E, am(C,I,[I|F]), Am). 93 94subtr_am(X, Y, Z):- prod_am(subtr, X, Y, Z). 95 96xor_am(X, Y, Z):- prod_am(xor, X, Y, Z). 97 98reverse_am(Am0, Am) :- 99 am_sts(Am0, sts(S0, I, F)), 100 maplist(reverse_triple, S0, S), 101 sts_coa(S, C), 102 length(C, L), N is L+1, 103 product([N], F, E), 104 join_am(E, am([(N, [])|C], N, [I]), Am). 105 106join_am(R, am(C0, I0, F0), am(C1, I0, F1)):- join_link(R, C0, C1), 107 foldl(propagate_final_state, R, F0, F1). 108 109% 110prod_am(FinalPred, am(C0, I0, F0), am(C1, I1, F1), am(C, I, F)):- 111 coalgebra([(I0, I1)], product_coa(p(C0, C1)), C2), 112 refresh_coa(C2, C, 1, Assoc), 113 assoc(Assoc, (I0, I1), I), 114 maplist(fst, C2, S), 115 call(FinalPred, S, F0, F1, F2), 116 maplist(assoc(Assoc), F2, F). 117 118conj(S, F0, F1, F):- collect(conj(F0, F1), S, F). 119 120conj(F0, F1, (X, Y)):- memberchk(X, F0), memberchk(Y, F1). 121 122disj(S, F0, F1, F):- collect(disj(F0, F1), S, F). 123 124disj(F0, F1, (X, Y)):- (memberchk(X, F0); memberchk(Y, F1)), !. 125 126subtr(S, F0, F1, F):- collect(subtr(F0, F1), S, F). 127 128subtr(F0, F1, (X, Y)):- (memberchk(X, F0), \+ memberchk(Y, F1)), !. 129 130xor(S, F0, F1, F):- collect(xor(F0, F1), S, F). 131 132xor(F0, F1, (X, Y)):- 133 ( memberchk(X, F0), \+ memberchk(Y, F1) 134 ; \+ memberchk(X, F0), memberchk(Y, F1) 135 ), 136 !. 137 138product_coa(X, Y, Z, U):-product_coa(X, Y, Z), 139 union_image(Z, U). 140 141product_coa(_, (0, 0), []):-!. 142product_coa(p(_, C1), (0, X1), Y):- !, memberchk((X1, Y1), C1), 143 maplist(pairing_fst(0), Y1, Y). 144product_coa(p(C0, _), (X0, 0), Y):- !, memberchk((X0, Y0), C0), 145 maplist(pairing_snd(0), Y0, Y). 146product_coa(p(C0, C1), _, []):- (C0 = []; C1=[]), !. 147product_coa(p(C0, C1), (X0, X1), Y):- 148 memberchk((X0, Y0), C0), 149 memberchk((X1, Y1), C1), 150 product_coa0(Y0, Y1, Y). 151 152product_coa0([], R1, R):-!, maplist(pairing_fst(0), R1, R). 153product_coa0(R0, [], R):-!, maplist(pairing_snd(0), R0, R). 154product_coa0([(X,[Y0])|R0], [(X,[Y1])|R1], [(X, [(Y0, Y1)])|R]):-!, 155 product_coa0(R0, R1, R). 156product_coa0([(X0,[Y0])|R0], [(X1,[Y1])|R1], [(X0, [(Y0, 0)])|R]):- 157 X0 @< X1, !, product_coa0(R0, [(X1,[Y1])|R1], R). 158product_coa0([(X0,[Y0])|R0], [(X1,[Y1])|R1], [(X1, [(0, Y1)])|R]):- 159 product_coa0([(X0,[Y0])|R0], R1, R).
162det_am(am(C, I, F), Am):- 163 pow_coa(I, C, D0), 164 maplist(fst, D0, S0), 165 collect(meet(F), S0, F0), 166 refresh_dfam(am(D0, [I], F0), Am). 167 168%%% coalgebra/3 (generalized sub_coa, inspired by `F-coalgebra') 169coalgebra(X, Y, Z) :- coalgebra(X, Y, [], Z0), sort(Z0, Z). 170 171coalgebra([], _, X, X). 172coalgebra([N|Ns], Generator, Y, Z) :- call(Generator, N, U, Sucs), !, 173 Y1 = [(N, U) | Y], 174 new_nodes(Sucs, Y1, D1), 175 union(D1, Ns, Ms), 176 coalgebra(Ms, Generator, Y1, Z).
sub_coa(X, C, Z, U).
X: subset of domain(C).
C: coalgebra
Z: restriction of U.
U: the minimum subcoalgebra of C over X.
?- sub_coa([1], comma_set([(1,[(a,1),(b,1)]), (2,[(a, 1), (b,2)])]), [], X).
X = [ (1, [ (a, 1), (b, 1)])]
?- sub_coa([[1]], pow_merge(eq_set([ 1 = [ (a,[2]), (b,[1,2]) ], 2 = [(a,[1]),(b,[1])]])), X).
X = [ ([1, 2], [ (a, [1, 2]), (b, [1, 2])]), ([2], [ (a, [1]), (b, [1])]), ([1], [ (a, [2]), (b, [1, 2])])]
190sub_coa(X, Y, Z) :- sub_coa(X, Y, [], Z0), sort(Z0, Z). 191 192sub_coa([], _, X, X). 193sub_coa([N|Ns], Generator, Y, Z) :- call(Generator, N, U), !, 194 Y1 = [(N, U) | Y], 195 maplist(snd, U, D), 196 new_nodes(D, Y1, D1), 197 union(D1, Ns, Ms), 198 sub_coa(Ms, Generator, Y1, Z). 199 200% ?- sts_coa(1, [(1,a,2), (1, b, 1), (2, a, 1)], P). 201% ?- sts_coa(1, [(1,a,2), (1, b, 1), (1, b, 2), (2, a, 1)], P). 202% P = [ ([1, 2], [ (a, [1, 2]), (b, [1, 2])]), ([2], [ (a, [1])]), ([1], [ (a, [2]), (b, [1, 2])])] 203% ?- sts_coa([(1,a,2),(1, a, 1), (1, b, 1), (2, a, 1)], Ts), pow_coa(1, Ts, P). 204% P = [ ([1], [ (a, [1, 2]), (b, [1])]), ([1, 2], [ (a, [1, 2]), (b, [1])])] 205% ?- sts_coa([(1,a,2), (1, b, 1), (1, b, 2)], P). 206% P = [ (1, [ (a, [2]), (b, [1, 2])]), (2, [])] 207 208sts_coa(S0, Ts, P) :- sts_coa(Ts, C), 209 sub_coa([[S0]], pow_merge(comma_set(C)), P). 210 211sts_coa(Ts, C):- maplist(triple_pair, Ts, Ts0), 212 foldl(extend_coa, Ts0, [], C0), 213 range_of_triples(Ts, F), 214 maplist(pair_with_empty, F, Ps), 215 merge_coa(Ps, C0, C). 216 217% ?- sts_am(sts([(1, a, 1), (1, a, 2), (1, b, 2), (2, a, 3)], 1, [1]), D). 218% D = coa([ (1, []), (2, [ (a, 1)]), (3, [ (a, 3), (b, 2)]), (4, [ (a, 3), (b, 2)]), (5, [ (a, 4), (b, 2)])], 5, [3, 4, 5]) 219 220sts_am(sts(T, I, F), Am):- sts_coa(T, C), det_am(am(C, I, F), Am).
224pow_coa(S0, Ts, P) :- coalgebra([[S0]], pow_image(comma_set(Ts)), P). 225 226pow_image(Gen, Xs, R, Ys):- maplist(Gen, Xs, R0), 227 foldl(foldl(extend(contract_merge)), R0, [], R), 228 maplist(snd, R, Ys). 229 230pow_merge(A, X, R):- maplist(A, X, R0), 231 foldl(foldl(extend(contract_merge)), R0, [], R). 232 233new_nodes([], _, []). 234new_nodes([N|Ns], L, Ms) :- member((N, _), L) 235 -> new_nodes(Ns, L, Ms) 236 ; Ms=[N|Ms0], new_nodes(Ns, L, Ms0). 237 238% ?- extend_coa((a, [(1,[2])]), [(a,[(2,[4])])], X). 239% X = [ (a, [ (1, [2]), (2, [4])])] 240 241merge_coa(X, Y, Z):- foldl(extend_coa, X, Y, Z). 242 243extend_coa(X, Y, Z):- extend(merge_indexed_family_of_sets, X, Y, Z). 244 245% ?- merge_indexed_family_of_sets([(1,[2]), (2,[3])], [(2,[4])], X). 246% X = [ (1, [2]), (2, [4, 3])] 247 248merge_indexed_family_of_sets(X, Y, Z):- foldl(extend(contract_merge),X, Y, Z). 249 250extend(F, (X, S0), [(X, S1)|R], [(X, S2)|R]):-!, call(F, S0, S1, S2). 251extend(F, (X, S0), [(Y, S1)|R0], [(Y, S1)|R]):- X@>Y, !, 252 extend(F, (X, S0), R0, R). 253extend(F, (X, S0), R, [(X, S)|R]):- call(F, S0, [], S). 254 255 256% ?- coalgebra:contract_merge([1,3,6], [2, 5, 7], R). 257%@ R = [1, 2, 3, 5, 6, 7]. 258 259% Remark. 260% ?- union([1,3,6], [2, 5, 7], R). 261%@ R = [1, 3, 6, 2, 5, 7]. 262% ?- union([1,3,6], [2, 3, 5, 7], R). 263%@ R = [1, 6, 2, 3, 5, 7]. 264 265contract_merge([], X, X):-!. 266contract_merge(X, [], X):-!. 267contract_merge([X|R], [X|S], [X|T]):- !, contract_merge(R, S, T). 268contract_merge([X|R], [Y|S], [X|T]):- X@<Y, !, contract_merge(R, [Y|S], T). 269contract_merge([X|R], [Y|S], [Y|T]):- contract_merge([X|R], S, T). 270 271 272% ?- coalgebra:contract_insert(3, [2, 5, 7], R). 273%@ R = [2, 3, 5, 7]. 274 275contract_insert(X, [], [X]):-!. 276contract_insert(X, [X|S], [X|S]):- !. 277contract_insert(X, [Y|S], [X, Y|S]):- X@<Y, !. 278contract_insert(X, [Y|S], [Y|R]):- contract_insert(X, S, R). 279 280 281%%%% refresh coalgebra by renaming states 282refresh_dfam(A, B) :- refresh_dfam(A, B, 1, _). 283 284refresh_dfam(am(A,I,F), am(B,J,G), N, A_list) :- 285 make_assoc(A, N, A_list), 286 maplist(refresh_state_dfam(A_list), A, B), 287 maplist(assoc(A_list), [I|F], [J|G]). 288 289 290refresh_state_dfam(A, (X, S), (Y, T)):- assoc(A, X, Y), 291 maplist(refresh_right_dfam(A), S, T). 292 293refresh_right_dfam(Assoc, (A, S), (A, [S1])) :- assoc(Assoc, S, S1). 294 295%%%% 296refresh_am(X, Y):- refresh_am(X, Y, 1, _). 297 298refresh_am(am(A, B, C), am(A0, B0, C0), N, Assoc):- 299 refresh_coa(A, A0, N, Assoc), 300 maplist(assoc(Assoc),[B|C], [B0|C0]). 301 302refresh_coa(A, B) :- refresh_coa(A, B, 1, _). 303 304refresh_coa(A, B, N0) :- refresh_coa(A, B, N0, _). 305 306refresh_coa(A, B, N, A_list) :- make_assoc(A, N, A_list), 307 maplist(refresh_state(A_list), A, B). 308 309refresh_state(A, (X, S), (Y, T)):- assoc(A, X, Y), 310 maplist(refresh_pair(A), S, T). 311 312refresh_pair(Assoc, (A, S), (A, S1)) :- maplist(assoc(Assoc), S, S1). 313 314% ?- join_link([(a, b)], [(a, []), (b, [(1, [a])])], C). 315% C = [ (a, [ (1, [a, b])]), (b, [ (1, [a, b])])] 316% ?- join_link([ (a, b), (b, a)], [ (a, []), (b, [ (1, [a])])], C). 317% C = [ (a, [ (1, [a])]), (b, [ (1, [a])])] 318% ?- join_link([ (a, b), (b, a)], [ (a, [(1,[b])]), (b, [ (1, [a])])], C). 319% C = [ (a, [ (1, [a, b])]), (b, [ (1, [a, b])])] 320 321join_link(R, C0, C):- foldl(extend_link, R, C0, C). 322 323extend_link(P) --> extend_link_right(P), extend_link_left(P). 324 325extend_link_right((X,Y), C0, C):- maplist(extend_link_right(X, Y), C0, C). 326 327extend_link_right(X, Y, (A, F0), (A, F)):- maplist(associate(X, Y), F0, F). 328 329associate(X, Y, (A, S0), (A, S)):- memberchk(X, S0) 330 -> contract_merge([Y], S0, S) 331 ; S = S0. 332 333extend_link_left((X, Y), C0, C):- memberchk((Y, F), C0), 334 extend_coa((X, F), C0, C). 335 336propagate_final_state((X, Y), F0, F1):- memberchk(Y, F0), !, union([X], F0, F1). 337propagate_final_state(_, F, F). 338 339%%% automata state minimization 340% ?- coalgebra:minimum_am(am([ (1, [ (a, [2])]), (2, [ (b, [3])]), (3, [])], 1, [3]), A). 341% A = am([ (1,[ (a,[2])]), (2,[ (b,[3])]), (3,[])],1,[3]). 342 343% ?- qcompile(util(coalgebra)), module(coalgebra). 344% ?- listing(hybrid_regex_html/3). 345 346% ?- call(coalgebra:hybrid_regex_html,*char(alnum)+ +char(digit),svg,_25662). 347% ?- call(coalgebra:hybrid_regex_html,*char(alnum)+ +char(digit),pdf,_25662). 348 349minimum_am(am(C0, I, Final), Am):- 350 C = [(0,[])|C0], 351 maplist(fst, C, S), 352 pairs(S, P0), 353 maplist(ordered_pair(0), Final, DeadStateConflict0), 354 basic_conflicts(P0, [], Final, P1, Q), 355 append(DeadStateConflict0, Q, Q1), 356 remove_conflicts(P1, Q1, C, P, _), 357 maplist(pred([X,[X]]), S, Bs0), 358 union_find(P, Bs0, Bs1), 359 remove_dead_state(Bs1, Bs), 360 quotient_am(am(C0,I,Final), Bs, Am). 361 362% ?- basic_conflicts([(1,2),(2,3)], [], [3], X, Y). 363% X = [ (1, 2)], Y = [ (2, 3)] 364 365basic_conflicts([],[], _, [],[]). 366basic_conflicts([(X,Y)|P0], Q0, F, P, [(X,Y)|Q]):- 367 ( memberchk(X, F) 368 -> \+ memberchk(Y, F) 369 ; memberchk(Y, F) 370 ), 371 !, 372 basic_conflicts(P0, Q0, F, P, Q). 373basic_conflicts([A|P0], Q0, F, [A|P], Q):- basic_conflicts(P0, Q0, F, P, Q). 374 375remove_conflicts(P0, Q0, C, P, Q):- select((X,Y), P0, P1), 376 conflict(X, Y, Q0, C), 377 !, 378 remove_conflicts(P1, [(X,Y)|Q0], C, P, Q). 379remove_conflicts(P, Q, _, P, Q). 380 381conflict(X, Y, Q, C):- memberchk((X, F), C), 382 memberchk((Y, G), C), 383 conflict(F, G, Q). 384 385conflict(F, G, Q):- select((X,S1), F, F1), select((X,S2), G, G1), !, 386 ( pair_member(S1, S2, Q) -> true ; conflict(F1, G1, Q) ). 387conflict(F, G,Q):-(member((_X,S),F); member((_X,S),G)), 388 member(Y, S), pair_member0(Y, 0, Q). 389 390pair_member(V, W, Q):- member(X, V), member(Y, W), pair_member0(X, Y, Q). 391 392pair_member0(X, Y, [(X, Y)|_]). 393pair_member0(X, Y, [(Y, X)|_]). 394pair_member0(X, Y, [_|Q]):- pair_member0(X, Y, Q). 395 396% ?- union_find([(a,b),(x,y), (x,x), (y, z), (b,c)], [], R). 397%@ R = [[a,b,c],[x,y,z]]. 398% ?- union_find([(a-b),(x-y), (x-x), (y-z), (b-c)], [], R). 399%@ R = [[a,b,c],[x,y,z]]. 400 401union_find([],X,X). 402union_find([P|R],C,D):- (P = (X,Y); P = (X-Y)), !, 403 union_find(X, Y, C, C1), 404 union_find(R,C1,D). 405 406% 407union_find(X,Y,Z,U):-find_cluster(X,Z,C,Z0), 408 (memberchk(Y, C) -> U=[C|Z0] 409 ; find_cluster(Y, Z0, C0, Z1), 410 append(C,C0, C1), 411 U=[C1|Z1] 412 ). 413 414% 415remove_dead_state([],[]). 416remove_dead_state([[0|X]|R],[X|R]):-!. 417remove_dead_state([X|R],[X|S]):-remove_dead_state(R,S).
421remove_dead_states(am(M0,I,F), am(M, I, F)):- select((X, Ps), M0, M1), 422 \+ memberchk(X, F), 423 dead_state(X, Ps), 424 !, 425 maplist(delete_target(X), M1, M). 426remove_dead_states(A, A). 427 428delete_target(X, (Y,Ps), (Y,Qs)):- maplist(delete_target0(X), Ps, Qs). 429 430delete_target0(X, (Y,Ps), (Y,Qs)):-select(X, Ps, Qs), !. 431delete_target0(_, Z, Z). 432 433dead_state(X, Ps):- forall(member((_,Xs), Ps), (Xs ==[]; Xs=[X])). 434 435% quotient dfam 436 437quotient_am(am(C0,I0,F0), Bs, am(C, I, F)):- 438 maplist(quotient_state(Bs), C0, C1), 439 sort(C1, C2), 440 remove_duplicates(C2, C), 441 quotient_map(Bs, I0, I), 442 maplist(quotient_map(Bs), F0, F1), 443 sort(F1, F). 444 445remove_duplicates([], []). 446remove_duplicates([(X,Y),(X,_)|C0], C):-!, remove_duplicates([(X,Y)|C0], C). 447remove_duplicates([(X,Y)|C0], [(X,Y)|C]):- remove_duplicates(C0, C). 448 449quotient_map(Bs, X, A):- member(B, Bs), memberchk(X, B), B=[A|_], !. 450 451quotient_state(Bs, (X, S), (Y, T)):- quotient_map(Bs, X, Y), 452 maplist(quotient_snd(Bs), S, T). 453 454quotient_snd(Bs, (A, X), (A, Y)):- maplist(quotient_map(Bs), X, Y0), 455 sort(Y0, Y). 456 457% 458compare_two_regex(A:B, C):- regex_compare(C, A, B). 459 460% 461compare_am(R0, R, E0, E):- compose_am(E0, am(C0, I0, F0)), 462 compose_am(E, am(C, I, F)), 463 coalgebra([(I0, I)], product_coa(p(C0, C)), D), 464 compare_am(R0, R, D, F0, F). 465 466% 467compare_am(R, R, [], _, _):-!. 468compare_am(R0, R, [((X,Y),_)|D], F, G):- 469 ( memberchk(X, F) 470 -> ( memberchk(Y, G) 471 -> R1=R0 472 ; subtract(R0, [=, <], R1) 473 ) 474 ; ( memberchk(Y, G) 475 -> subtract(R0, [=, >], R1) 476 ; R1=R0 477 ) 478 ), 479 compare_am(R1, R, D, F, G). 480 481% 482order_boole(=, R, true):- memberchk(=, R). 483order_boole(<, [<], true). 484order_boole(>, [>], true). 485order_boole(>=, R, true):- memberchk(>, R); memberchk(=, R). 486order_boole(=<, R, true):- memberchk(<, R); memberchk(=, R). 487order_boole(_, _, false):- memberchk(<, _R); memberchk(=, _R). 488 489%%%% tiny routines (selector, etc.) %%%% 490%% 491 492&(X, Y, Z):- append(X, Y, Z). 493 494% ?- find_cluster(a, [[a,b],[c,d]], C, X). 495find_cluster(X,[],[X],[]):-!. 496find_cluster(X,[Y|Z],Y,Z):- memberchk(X,Y),!. 497find_cluster(X,[Y|Z],U,[Y|V]):- find_cluster(X,Z,U,V). 498 499 500% ?- field_of_triples([(c, 2, d), (b,1,a)], X). 501% X = [a, b, c, d] 502field_of_triples(Ts, F):- unzip(Ts, L, G), 503 maplist(snd, G, R), 504 append(L, R, F0), 505 sort(F0, F). 506 507range_of_triples(Ts, R):- maplist(third, Ts, R0), sort(R0, R). 508 509make_assoc([],_,[]). 510make_assoc([(X,_)|R], N, [(X,N)|S] ):- N1 is N+1, make_assoc(R, N1, S). 511 512assoc(A, X, Y):- memberchk((X,Y), A). 513 514meet(X, Y):- member(A, X), memberchk(A, Y), !. 515 516third((_,_,X), X). 517 518triple_pair((X,A,Y), (X,[(A,[Y])])). 519 520pair_with_empty(X, (X, [])). 521 522reverse_triple((X,A,Y), (Y,A,X)). 523 524eq_set( F, X, Y) :- member(X = Y, F). 525 526comma_set(F, X, Y) :- memberchk((X, Y), F), !. 527comma_set(_, _, []). 528 529pairing_fst(A, (X, [Y]), (X, [(A,Y)])). 530 531pairing_snd(A, (X, [Y]), (X, [(Y,A)])). 532 533union_image(X, Y):- foldl(union_snd, X, [], Y). 534 535union_snd((_, X), A, B):- union(X, A, B). 536 537%;; (setq module-query "qcompile(util(coalgebra)), module(coalgebra).") 538% ?- qcompile(util(coalgebra)), module(coalgebra). 539 540% directory for temporary files .pdf .png .bb etc 541am_dir_path(D):- getenv(home_html_root, C), 542 atomics_to_string([C, automata], /, D). 543% 544am_file_name(am). 545% 546compose_sts(E, Sts):- compose_am(E, Am0), am_sts(Am0, Sts). 547 548am_sts(am(M0,X,Y), sts(M,X,Y)):- 549 act_tree(coalgebra:list_triple, M0, M). 550 551list_triple([Y, A, X], (X, A, Y)). 552 553%%% 554% ?- coalgebra:arrows([(b, g, c), (a, f, b), (c, h, d), (d, k, b), (c, c, c)]). 555arrows(Arrows):-autviz_jpg(arrows2dot, Arrows). 556 557% ?- qcompile(util(coalgebra)). 558% ?- module(coalgebra). 559 560% ?- trace, gv(a). 561% ?- gv(a+b+c+d+e). 562 563gv(R) :- compose_sts(R, Aut), autviz(Aut). 564 565autviz(Aut):-autviz(coalgebra:aut2dot, Aut). 566 567% 568autviz(Pred, Aut):- 569 absolute_file_name(tmp('DOTTEMP.dot'), DOT), 570 absolute_file_name(tmp('DOTTEMP.'), M), 571 file(DOT, write, call(Pred, Aut)), 572 qshell(dot(-'T'(ps2), -o(M+ps), M+dot); 573 ps2pdf(M+ps, M+pdf); 574 open(-a('Preview'), M+pdf)). 575 576autviz_jpg(Pred, Aut):- 577 absolute_file_name(tmp('DOTTEMP.dot'), DOT), 578 absolute_file_name(tmp('DOTTEMP.'), M), 579 file(DOT, write, call(Pred, Aut)), 580 qshell(dot(-'T'(jpg), -o(M+jpg), M+dot); open(-a('Preview'), M+jpg)). 581 582states(M, S):- maplist(fst, M, L0), 583 maplist(third, M, L1), 584 union(L0, L1, S0), 585 sort(S0, S). 586 587automaton(R):- compose_sts(R, sts(M,Ini,Fin)), 588 states(M, S), 589 format("Regular expression = ~w~n",[R]), 590 format("Initial state = ~w~n",[Ini]), 591 format("List of final states = ~w~n",[Fin]), 592 format("List of states = ~w~n",[S]), 593 format("State transitions:~n"), 594 ( member((A,B,C), M), 595 format(" ~w ----- ~w -----> ~w~n",[A,B,C]), fail 596 ; 597 true 598 ). 599 600% 601aut2dot(sts(M,Ini,Fin)):-arrows2dot([(dummy, '', Ini)|M], Fin). 602 603arrows2dot(Arrows):-arrows2dot(Arrows, []). 604 605arrows2dot(Arrows, Fin):- 606 format("digraph g {~n",[]), 607 format("rankdir=LR;~n",[]), 608 format("dummy [shape = none, label = \"\"];~n",[]), 609 final_in_dot(Fin), 610 move_in_dot(Arrows), 611 format("}~n",[]). 612 /****************************************************** 613 * convert a regex to automata in a pdf file. * 614 ******************************************************/ 615 616% ?- regex_coalgebra(".*", X). 617% ?- coalgebra:show_am("."). 618% ?- coalgebra:show_am("[a-zA-B]******hello"). 619% ?- coalgebra:show_am("a*"). 620% ?- coalgebra:show_am(".*"). 621% ?- coalgebra:show_am("a*b*c"). 622% ?- coalgebra:show_am("([^abc]+[abc])*"). 623% ?- coalgebra:show_am("[st][0-9][0-9][0-9][0-9][0-9][0-9]*"). 624% ?- coalgebra:show_am("(a|b|c)*"). 625% ?- coalgebra:show_am(a\a). 626% ?- coalgebra:show_am((*(*(a) + b + *(a) + b + *(a)))). 627% ?- pac:show_am((*(*(a) + b + *(a) + b + *(a)))). 628% ?- coalgebra:show_am(* char(alnum)). 629 630show_am(Regex) :- regex_to_pdf(Regex, PDF), qshell(open(PDF)). 631 632% ?- regex_to_pdf("a", "~/Desktop/deldel", PDF). 633regex_to_pdf(Regex, PDF) :- once(regex_to_pdf(Regex, 'DOTTEMP', PDF)). 634% 635regex_to_pdf(Regex, Base, PDF):- once(regex_am(Regex, coa(A, I))), 636 am_finals(coa(A, I), F), 637 coalgebra_triples(A, B), 638 automaton_quasi_string(am(B, I, F), Quasi_String), 639 expand_file_name(Base, [M]), 640 atomics_to_string([M, ".dot"], DOT), 641 atomics_to_string([M, ".pdf"], PDF), 642 file(DOT, write, smash(Quasi_String)), 643 qshell(dot(-'T'(pdf), -o(PDF), DOT)). 644 645 /*********************************** 646 * handling character escape * 647 ***********************************/ 648 649automaton_quasi_string(am(A, Ini, F), 650 [ "digraph g {\n", 651 "rankdir=LR;\n", 652 IniName, 653 Label, 654 Finals, 655 Moves, 656 "}\n" 657 ]) :- 658 number_string(Ini, IniName), 659 atomics_to_string([" [label= \"start( =", IniName, ")\"];\n"], Label), 660 maplist(triple_elim_dot, A, Moves), 661 maplist( pred([X, [Y, " [shape = doublecircle];\n"]] :- 662 number_string(X, Y)), 663 F, 664 Finals). 665 666% ?- trace, coalgebra:triple_elim_dot((1, dot([97-98, 100-103]), 2), R). 667%@ R = ["1", "->", "2", " [label = \"", [91, 97, 93], "\"];\n"] . 668 669triple_elim_dot((X, A, Y), [X0, "->", Y0, " [label = ", B, "];\n"]) 670 :- 671 number_string(X, X0), 672 number_string(Y, Y0), 673 adjacent_interval(A, OA, []), 674 maplist(interval_exp, OA, A0), 675 term_string(A0, B0, [quoted(false)]), 676 term_string(B0, B, [nl(false)]). 677 678% ?- coalgebra:simplify_interval([inf-97, 99-sup], X). 679%@ X = [\=(b)] . 680% ?- coalgebra:simplify_interval([inf-97, 100-sup], X). 681%@ X = [=<(a), >=(d)] . 682 683% 684interval_exp(x(X, _), Y):- atom_string(X, Y). 685% interval_exp(x(X), Y):- atom_string(X, Y). 686interval_exp(X, Y):- interval_code_char(X, Y), !. 687interval_exp((inf-sup)\W, !=(W0)) :- code_to_char_x(W, W0). 688interval_exp(X\W, Y\W0):- interval_code_char(X, Y), 689 code_to_char_x(W, W0). 690 691% 692interval_code_char(x(X, _), Y):- atom_string(X, Y). 693interval_code_char(inf-sup, '.'). 694interval_code_char(inf-A, =<(A0)):- code_to_char_x(A, A0). 695interval_code_char(A-sup, >=(A0)):- code_to_char_x(A, A0). 696interval_code_char(A-A, A0):- code_to_char_x(A, A0). 697interval_code_char(A-B, A0-B0):- code_to_char_x(A, A0), 698 code_to_char_x(B, B0). 699 700% 701code_to_char_x(x(X, _), Y):- !, atom_string(X, Y). 702code_to_char_x(sup, sup):-!. 703code_to_char_x(X, Y):- char_code(Y0, X), 704 convert_char(Y0, Y). 705% 706printable(A):- member(T, [csym, period, punct, prolog_symbol]), 707 char_type(A, T), 708 !. 709% 710convert_char('\n', "\\n"). 711convert_char('\t', "\\t"). 712convert_char('\s', "\\ "). 713convert_char('.', "\\."). 714convert_char(A, A):- printable(A), !. 715convert_char(A, B):- char_code(A, C), 716 number_string(C, B0), 717 string_concat("code", B0, B). 718 719% 720coalgebra_triples([], []). 721coalgebra_triples([A-G|R], Triples):- 722 make_triples(A, G, T), 723 coalgebra_triples(R, TR), 724 append(T, TR, Triples). 725 726% 727make_triples(_, [], []). 728make_triples(A, [B-C|R],[ (A, B, C)|Ts]) :- make_triples(A, R, Ts). 729make_triples(A, [_|R], Ts):- make_triples(A, R, Ts). 730% 731 732final_in_dot([]). 733final_in_dot([X|Y]):-format("~w [shape = doublecircle];~n",[X]), 734 final_in_dot(Y). 735 736move_in_dot([]). 737move_in_dot([(X,A,Y)|Z]):-edge_in_dot(X,A,Y), move_in_dot(Z). 738 739edge_in_dot(X,A,Y):- format("\"~w\" -> \"~w\" [label = \"~w\"];~n",[X,Y,A]). 740 741% main predicate 742% generete an automaton for the given regular expression. 743 744% ?- trace. 745% ?- format_list(["a"-[],"b"-[]], "c", "", R). 746%@ R = "acb". 747 748% ?- am_state_summary(char(1-2), 1, 3, [1,2,3], S). 749am_state_summary(R, Ini, Fin, S, Summary):- 750 maplist(pred([F-A, S]:- format(string(S), F, A)), 751 [ 752 "Regular expression = ~w<br>"-[R], 753 "Initial state = ~w<br>"-[Ini], 754 "Final states = ~w<br>"-[Fin], 755 "All states = ~w<br>"-[S] 756 ], Sum), 757 atomics_to_string(Sum, Summary). 758 759reg2html(R, T, URL):- 760 am_dir_path(D), % T: output type 761 am_file_name(F), 762 phrase((counter(update), obj_get([count(C)])), 763 [directory(D), counter_name(atm_cur_id)], _), 764 format(codes(OutHtml), "~w/~w~w.html", [D, F, C]), 765 reg2html(F, D, C, R, T, Body), 766 flatten(["<html><body>\n", Body, "</body></html>"], H1), 767 atom_codes(OutNameAtom, OutHtml), 768 create_file(OutNameAtom, H1), 769 expand_cgi_path(OutHtml, URL). 770 771reg2html(F, D, C, R, T, H) :- compose_sts(R, sts(M, Ini, Fin)), 772 states(M, S), 773 H1 = (format_codes(`<p>Regular expression = ~w</p>`,[R]) & 774 format_codes(`<p>Initial state = ~w</p>`,[Ini]) & 775 format_codes(`<p>Final states = ~w</p>`,[Fin]) & 776 format_codes(`<p>All states = ~w</p>`,[S]) & 777 format_codes(`<p>State Transitions:</p>~n`,[])), 778 atomic_list_concat([D, '/', F, C, '.dot'], DotName), 779 file(DotName, write, coalgebra:aut2dot(sts(M, Ini, Fin))), 780 formatForHtml(F, D, C, T, Format, Args), 781 print_moves(M, M1), 782 format_codes_list(H1 & format_codes(Format, Args) & M1, L, []), 783 !, 784 append(L, H). 785 786% 787hybrid_regex_diagram(Regex, T, Out):- % T: output type; svg/pdf 788 D = automata, 789 F = am, 790 phrase((counter(update), obj:obj_get([count(C)])), 791 [directory(D), counter_name(atm_cur_id)], _), 792 hybrid_regex_diagram(Regex, F, D, C, T, Out). 793 794% 795hybrid_regex_diagram(R, F, D, C, T, [Summary, Transition, Diagram]) :- 796 regex_am(R, coa(A, Ini)), 797 am_finals(coa(A, _), Fin), 798 coalgebra_triples(A, M), 799 automaton_quasi_string(am(M, Ini, Fin), Quasi_String), 800 maplist(pred([U-_, U]), A, S), 801 am_state_summary(R, Ini, Fin, S, Summary), 802 U = "<p> State Transitions:</p>", 803 hybrid_print_moves(M, Moves), 804 atomics_to_string([U, Moves], "<br>\n", Transition), 805 string_concat(F, C, Base), 806 string_concat(Base, ".dot", DotFile), 807 getenv(home_html_root, Dir), 808 atomics_to_string([Dir,/,D], WorkD), 809 working_directory(WD_, WorkD), 810 file(DotFile, write, smash(Quasi_String)), 811 once(option_table(T, Opt, Ext0, Ext1)), 812 ( T == pdf -> 813 Com = ps2pdf("-sOutputFile=" + Base + "."+ Ext1, 814 Base + "."+ Ext0) 815 ; Com = 'DUMMY=1' 816 ), 817 once(qshell(dot(-'T'(Opt), 818 Base + "." + dot, 819 -o(Base + "." + Ext0)); Com)), 820 working_directory(WD_, WorkD), 821 atomics_to_string([D,/, Base, ".", Ext0], Diagram). 822 823% ?- apply3(coalgebra:hybrid_regex_html, [*char(alnum)+ +char(digit),svg], R). 824 825% char class automata [2014/06/02] 826hybrid_regex_html(X, T, URL):- % T: output type; svg/pdf 827 am_dir_path(D), 828 am_file_name(F), 829 phrase((counter(update), obj:obj_get([count(C)])), 830 [directory(D), counter_name(atm_cur_id)], _), 831 format(string(HtmlLoc), "~w/~w~w.html", [D, F, C]), 832 hybrid_regex_html(F, D, C, X, T, Body), 833 smash(Body, BodyStr), 834 atomic_list_concat(["<html><body>\n", BodyStr, "</body></html>"], HtmlTag), 835 create_file(HtmlLoc, HtmlTag), 836 getenv(host_html_root, R), 837 atomic_list_concat([R, /, automata, /, F, C, '.html'], URL). 838 839% ?- smash0([2, b, c], X). 840%@ X = "\u0002bc" . 841hybrid_regex_html(F, D, C, R, T, H) :- 842 regex_am(R, coa(A, Ini)), 843 am_finals(coa(A, _), Fin), 844 length(A, Num), 845 coalgebra_triples(A, M), 846 automaton_quasi_string(am(M, Ini, Fin), Quasi_String), 847 maplist(pred([U-_, U]), A, S), 848 H1 = (format_codes(`<p>Regular expression = ~w</p>`,[R]) & 849 format_codes(`<p> The number of states = ~d</p>`,[Num]) & 850 format_codes(`<p> Initial state = ~w</p>`,[Ini]) & 851 format_codes(`<p> Final states = ~w</p>`,[Fin]) & 852 format_codes(`<p> All states = ~w</p>`,[S]) & 853 format_codes(`<p> State Transitions:</p>~n`,[])), 854 atomic_list_concat([D, '/', F, C, '.dot'], DotName), 855 file(DotName, write, smash(Quasi_String)), 856 formatForHtml(F,D,C,T,Format,Args), % call sh from inside 857 hybrid_print_moves(M, M1), 858 format_codes_list(H1 & format_codes(Format,Args) & M1, L, []), 859 !, 860 append(L, H). 861 862% 863format_codes_list(X&Y, L, M):- !, format_codes_list(X, L, L0), 864 format_codes_list(Y, L0, M). 865format_codes_list([], L, L). 866format_codes_list([X|Y], [[X|Y]|L], L). 867format_codes_list(P, [V|L], L):- call(P, V). 868 869% 870option_table(pdf, ps2, ps, pdf). 871option_table(png, 'png:gd', png, png). 872option_table(X, X, X, X). 873 874formatForHtml(F,D,C,X,Format,[F,C,X]) :- 875 img_frame(Format), 876 atomic_list_concat([D, (/), F, C], Base), 877 once(option_table(X, Opt, Ext0, Ext1)), 878 ( X == pdf 879 -> Com = ps2pdf(`-sOutputFile=`+ Base+ `.`+ Ext1, 880 Base+ `.`+ Ext0) 881 ; Com = 'DUMMY=1' 882 ), 883 once(qshell(dot(-'T'(Opt), Base+ `.` + dot, 884 -o(Base + `.` + Ext0)); Com)). 885 886img_frame(X) :- flatten([ `<p><div `, 887 `id='diagram' `, 888 `style='border : solid 2px #ff0000; `, 889 `width : 1600px; `, % was 600px 890 `height : 500px; `, % was 300px 891 `overflow : auto; '><br/>`, 892 `<img src="~w~w.~w"/>`, 893 `</div></p>~n` 894 ], X). 895 896% ?- coalgebra:hybrid_print_moves([(1, [97-97], 2)], R). 897% ?- coalgebra:hybrid_print_moves([(1, [97-97], 2), (1, [97-97], 2), (1, [97-97], 2)], R). 898 899hybrid_print_moves(M, H):- 900 maplist(pred([(X, A, Y), (X, B, Y)]:- 901 maplist(interval_code_char, A, B)), 902 M, M0), 903 maplist(print_move, M0, H1), 904 atomics_to_string(H1, "<br>", H). 905 906print_move((X,A,Y), H):- 907 format(string(H), " ~w----~w--->~w~n" , [X,A,Y]). 908 909 910% ?- symbols(a + b, X). 911% ?- symbols(a + b, X) 912% X = [a, b]. 913 914symbols(A, S) :- collect_symbols(A, S0), sort(S0, S). 915 916symbols_(A, [A]):- atomic(A), !. 917symbols_(E, S):- E =..[Op|As], 918 length(As,L), 919 signature(Sig), 920 memberchk(Op/L, Sig), 921 maplist(symbols_, As, Bs), 922 append(Bs, S). 923symbols_(A = [A]). 924 925% ?- pac:expand_exp('`'([]), a, V, [], G, P, []). 926 927% ?- trace, pac: expand_kind_rule(s, [], [], epsilon = '`'([]), Y). 928%@ Y = (s(epsilon, []):-!) . 929 930% ?- spy(ekind). 931%@ % Spy point on pac:ekind/0 932%@ true. 933 934 935 936collect_symbols(epsilon,[]):-! . 937collect_symbols(empty,[]):-! . 938collect_symbols(E,A1):-(E=..[Op|As],length(As,L),L>0,signature(Sig),memberchk(Op/L,Sig)),!,maplist(collect_symbols,As,A2),append(A2,A1) . 939collect_symbols(A,[A]):-! . 940 941 942% ?- coalgebra:ya_symbols(a, X). 943% ?- listing(preprocess_complement). 944 945preprocess_complement(A, X, Y):- 946 ( A== [] 947 -> U = epsilon 948 ; vector_term(+, A, A0), 949 U= *(A0) 950 ), 951 elim_unary_minus(U, X, Y). 952 953% 954elim_unary_minus(A, -(B), A\C):- !, elim_unary_minus(A, B, C). 955elim_unary_minus(A, B, C):- compound(B), B =..[Op|Bs], 956 length(Bs,L), 957 L>0, 958 signature(Sig), 959 memberchk(Op/L, Sig), 960 !, 961 maplist(elim_unary_minus(A), Bs, Cs), 962 C =..[Op|Cs]. 963elim_unary_minus(_, B, B). 964 965% ?- gv(a). 966 967% ?- vector_term(+, [a,b,c], V). 968% ?- coalgebra:elim_unary_minus(epsilon, a, X). 969%@ X = a. 970% ?- coalgebra:elim_unary_minus(universe, -(a + (-b)), X). 971%@ X = (universe\a+ (universe\b)). 972 973complement_subtract(U, -X, U\X). 974 975is_unary_minus_term(-(_))