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