1:- module(compstack, []). 2:- use_module(pac('expand-pac')). 3 4 /*************************************** 5 * some tiny for co_term_algebra * 6 ***************************************/ 7 8qassoc(X-V, [Y-V|_]):- X==Y, !. 9qassoc(P, [_|A]):- qassoc(P, A). 10% 11qmember(X, [Y|_]):- X==Y,!. 12qmember(X, [_|Y]):- qmember(X, Y). 13 14% 15unify(X - Y):-!, X=Y. 16unify(X = Y):-!, X=Y. 17unify((X, Y)):- X=Y. 18 19% ?- qsubst([a],[a-b], X). 20% ?- qsubst([A],[A-B], X). 21qsubst([], _, []). 22qsubst([X|Xs], Zip, [Y|Ys]):- qassoc(X-Y, Zip), 23 qsubst(Xs, Zip, Ys). 24 25% ?- hyphen_zip([a,b],[1,2], Z). 26hyphen_zip([],[],[]). 27hyphen_zip([A|As],[B|Bs],[A-B|Cs]):-hyphen_zip(As, Bs, Cs). 28 29% ?- extract_dom([a,b],[a-1,c-3,b-2], R). 30extract_dom([], _, []). 31extract_dom([T|Ts], Zip, [V|Dom]):-qassoc(T-V, Zip), 32 extract_dom(Ts, Zip, Dom). 33 34% ?- collect_subterms([a,B,B, C], [], X). 35% ?- A=f(A), collect_subterms([A], [], X). 36% ?- B=f(C,D), C=f(B, 0), D=g(B, C), collect_subterms([a,B,C], [], X). 37collect_subterms([], X, X):-!. 38collect_subterms([A|As], X, Y):- 39 ( qmember(A, X) -> X1 = X 40 ; \+ compound(A) -> X1 = [A|X] 41 ; X0 = [A|X], 42 A =..[_|Us], 43 collect_subterms(Us, X0, X1) 44 ), 45 collect_subterms(As, X1, Y). 46 47% ?- co_term_algebra([], []). 48% ?- co_term_algebra([a], X). 49% ?- co_term_algebra([[a,b], f(c)], Coa), maplist(unify, Coa). 50% ?- A=f(A), co_term_algebra([[A,b], A], Coa), maplist(unify, Coa). 51% ?- A=f(A), co_term_algebra([A,b], Coa). 52% ?- A=f(a, b), co_term_algebra([A,b], Coa). 53% ?- co_term_algebra([a,a], Coa, Zip). 54% ?- co_term_algebra([_a,_b], Coa, Zip). 55co_term_algebra(Ts, Coa):-co_term_algebra(Ts, Coa, _). 56% 57co_term_algebra(Ts, Coa, Dom):-collect_subterms(Ts, [], Ts0), 58 length(Ts0, N), 59 length(Vs, N), 60 hyphen_zip(Ts0, Vs, Zip), 61 co_term_algebra_sub(Ts0, Zip, Coa), 62 extract_dom(Ts, Zip, Dom). 63% 64co_term_algebra_sub([], _, []):-!. 65co_term_algebra_sub([T|Ts], Zip, [J-V|Coa]):- qassoc(T-J, Zip), 66 ( compound(T) -> 67 T =..[F|Us], 68 qsubst(Us, Zip, Vs), 69 V =..[F|Vs] 70 ; V = T 71 ), 72 !, 73 co_term_algebra_sub(Ts, Zip, Coa). 74 75 /*************************************************************** 76 * compare based on co-term-algebra without transitivity * 77 ***************************************************************/ 78 79% ?- compare_rat(C, a, a). 80% ?- compare_rat(C, a, b). 81% ?- compare_rat(C, b, a). 82% ?- compare_rat(C, f(a), f(a)). 83% ?- compare_rat(C, f(a), f(b)). 84% ?- compare_rat(C, f(b), f(a)). 85% ?- compare_rat(C, B, A), compare_rat(D, A, B). 86% ?- compare_rat(C, f(a,b), f(b,a)). 87% ?- compare_rat(C, f(b,a), f(a, b)). 88% ?- A=f(B,0), B=f(A, 1), compare_rat(C, A, B), compare_rat(D, B, A). 89compare_rat(C, X, Y):- 90 co_term_algebra([X, Y], Coa, [A, B]), 91 compare_in_CTA([], Coa, C, A, B). 92 93% ?- compare_arity(C, a(1,2), b(2,3)). 94% ?- predsort(compare_arity, [a(2,2), a(2,2)], S). 95compare_arity(C, A, B):- functor(A, F, J), 96 functor(B, G, K), 97 compare(C, J/F, K/G). 98% 99compare_in_CTA(CTA, C, X, Y):- compare_in_CTA([], CTA, C, X, Y). 100% 101compare_in_CTA(_, _, =, X, Y):- X == Y, !. 102compare_in_CTA(S, CTA, C, X, Y):- qassoc(X-T, CTA), 103 qassoc(Y-U, CTA), 104 compare_flat_term([X-Y|S], CTA, C, T, U). 105% 106compare_flat_term(S, CTA, C, T, U):- 107 ( compound(T), compound(U) -> 108 compare_arity(D, T, U), 109 ( D = (=) -> 110 compare_target_args([T-U|S], CTA, 1, C, T, U) 111 ; C = D 112 ) 113 ; compare(C, T, U) 114 ). 115% 116compare_target_args(S, CTA, I, C, T, U):- arg(I, T, A), arg(I, U, B), !, 117 qassoc(A-A0, CTA), 118 qassoc(B-B0, CTA), 119 ( qmember(A0-B0, S) -> 120 J is I + 1, 121 compare_target_args(S, CTA, J, C, T, U) 122 ; compare_flat_term(S, CTA, D, A0, B0), 123 ( D = (=) -> 124 J is I + 1, 125 compare_target_args(S, CTA, J, C, T, U) 126 ; C = D 127 ) 128 ). 129 130% J.Burse 131% ?- b_setval(compare_history, []), aggregate_all(count, 132% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 133% random_cyclic(C), ground(C), semi_lex_compare(>, A,B), semi_lex_compare(>, B,C), 134% semi_lex_compare(<, A,C)), F). 135 136% ?- b_setval(compare_history, []), aggregate_all(count, 137% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 138% random_cyclic(C), ground(C), semi_lex_compare(<, A,B), semi_lex_compare(<, B,C), 139% semi_lex_compare(>, A,C)), F). 140%@ F = 98. 141 142%@ F = 108. 143%@ F = 0. 144%@ F = 0. 145% ?- b_setval(compare_history, []), aggregate_all(count, 146% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 147% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(<, B,C), 148% compare_cyclic(>, A,C)), F). 149%@ F = 3. 150% ?- b_setval(compare_history, []), aggregate_all(count, 151% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 152% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(>, B,C), 153% compare_cyclic(<, A,C)), F). 154%@ F = 1239430. 155%@ F = 3. 156 157% ?- N is 10^8, aggregate_all(count, 158% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 159% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(>, B,C), 160% compare_cyclic(<, A,C)), F). 161%@ N = 100000000, 162%@ F = 1232991. 163 164% ?- b_setval(compare_history, []), aggregate_all(count, 165% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 166% random_cyclic(C), ground(C), semi_lex_compare(>, A,B), semi_lex_compare(>, B,C), 167% semi_lex_compare(<, A,C)), F). 168%@ F = 0. 169%@ F = 0. 170%@ F = 0. 171 172% ?- b_setval(compare_history, []), aggregate_all(count, 173% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 174% random_cyclic(C), ground(C), semi_lex_compare(Cab, A,B), semi_lex_compare(Cbc, B,C), 175% semi_lex_compare(Cac, A,C), non_transitive(Cab, Cbc, Cac)), F). 176%@ F = 101. 177%@ F = 101. 178%@ F = 126. 179%@ F = 0. 180% ?- b_setval(compare_history, []), aggregate_all(count, 181% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 182% random_cyclic(C), ground(C), semi_lex_compare(Cab, A,B), semi_lex_compare(Cbc, B,C), 183% semi_lex_compare(Cac, A,C), non_transitive1(Cab, Cbc, Cac)), F). 184%@ F = 112. 185%@ F = 99. 186%@ F = 92. 187 188% ?- b_setval(compare_history, []), aggregate_all(count, 189% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 190% random_cyclic(C), ground(C), semi_lex_compare(Cab, A,B), semi_lex_compare(Cbc, B,C), 191% semi_lex_compare(Cac, A,C), non_transitive2(Cab, Cbc, Cac)), F). 192%@ F = 0. 193 194% ?- b_setval(compare_history, []), aggregate_all(count, 195% (between(1,100000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 196% random_cyclic(C), ground(C), semi_lex_compare(Cab, A,B), semi_lex_compare(Cbc, B,C), 197% semi_lex_compare(Cac, A,C), non_transitive2(Cab, Cbc, Cac)), F). 198%@ F = 0. 199 200non_transitive(<, <, >). 201non_transitive(>, >, <). 202 203non_transitive1(<, <, >). 204non_transitive2(>, >, <). 205 206all_dif(X):- select(A, X, Y), select(B, Y, _), A==B, !, fail. 207all_dif(_). 208 209% ?- between(1, 100, _), random_ground_cyclic(T). 210random_ground_cyclic(T):- random_cyclic(T), ground(T), cyclic_term(T). 211 212% 213find_non_transitive_case([T1,T2,T3], [C12,C23,C13]):- 214 random_ground_cyclic(T1), 215 random_ground_cyclic(T2), 216 random_ground_cyclic(T3), 217 all_dif([T1, T2, T3]), 218 semi_lex_compare(C12,T1,T2), 219 semi_lex_compare(C23,T2,T3), 220 semi_lex_compare(C13,T1,T3), 221 non_transitive(C12, C23, C13). 222 223% ?- b_setval(compare_history, []), 224% call_with_time_limit(10, (repeat, 225% find_non_transitive_case(U, V) )), !, 226% check_violation_with_fresh_history(U, W). 227 228% ?- S_1=s(S_1,1),S_2=s(S_2,S_2),S_3=s(s(S_3,S_3),S_3), 229% H=[S_1, s(S_2,0), S_3, S_1], 230% compare_with_history(Cab, s(S_2,0), S_1, H, H1), 231% compare_with_history(Cbc, S_1, S_3, H1, H2), 232% compare_with_history(Cac, s(S_2,0), S_3, H2, H3). 233 234% ?- S_1=s(S_1,1),S_2=s(S_2,S_2),S_3=s(s(S_3,S_3),S_3), 235% H=[], 236% compare_with_history(Cab, s(S_2,0), S_1, H, H1), 237% compare_with_history(Cbc, S_1, S_3, H1, H2), 238% compare_with_history(Cac, s(S_2,0), S_3, H2, H3). 239 240check_distinct_history:- b_getval(compare_history, A), 241 select(X, A, B), member(M, B), 242 X == M, throw(history_duplicate). 243check_distinct_history. 244 245% 246check_violation([A, B, C], U):- 247 b_getval(compare_history, H), nl, nl, print(H), 248 compare_with_history(C12, A, B, H, H1), nl, nl, writeln(H1), 249 compare_with_history(C23, B, C, H1, H2), nl,nl, writeln(H2), 250 compare_with_history(C13, A, C, H2, H3), nl,nl, writeln(H3), 251 U = [C12,C23,C13]. 252 253check_violation_with_fresh_history([A, B, C], U):- 254 compare_with_history(C12, A, B, [], H), nl, writeln(H), 255 compare_with_history(C23, B, C, H, H1), nl, writeln(H1), 256 compare_with_history(C13, A, C, H1, H2), nl, writeln(H2), 257 U = [C12,C23,C13]. 258 259 260% ?- b_setval(compare_history, []), aggregate_all(count, 261% (between(1,10000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 262% random_cyclic(C), ground(C), semi_lex_compare(>, A,B), semi_lex_compare(>, B,C), 263% semi_lex_compare(<, A,C)), F). 264%@ F = 0. 265 266% ?- b_setval(compare_history, []), aggregate_all(count, 267% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 268% random_cyclic(C), ground(C), semi_lex_compare(Cab, A,B), semi_lex_compare(Cbc, B,C), semi_lex_compare(Cac, A,C), non_transitive1(Cab, Cbc, Cac)), F). 269%@ F = 110. 270 271 272% by J. Burse 273% random_cyclic(-Term) 274random_cyclic(T) :- 275 random_cyclic([T], T). 276 277% random_cyclic(+List, -Term) 278random_cyclic(L, T) :- 279 length(L, M), 280 random(R), 281 N is truncate(R*(M+3)), 282 (N = 0 -> T = 0; 283 N = 1 -> T = 1; 284 N = 2 -> T = s(P,Q), random_cyclic([P|L], P), random_cyclic([Q|L], Q); 285 K is N-3, nth0(K, L, S), S=T). 286 287 288% ?- A=f(B, 0), B=f(A, 1), factorization(f(A, B), U, F). 289% ?- minimum_factorization(f(f(a), f(a)), U, L). 290% ?- minimum_factorization(f(f(a), f(b)), U, L). 291% ?- A=f(B, B), B=f(A, A), minimum_factorization(f(A, B), U, F). 292% ?- A=f(B, 0), B=f(A, 1), minimum_factorization(f(A, B), U, F). 293% ?- A=f(B, X), B=f(A, Y), minimum_factorization(f(A, B), U, F). 294% ?- A=f(B, X), B=f(A, X), minimum_factorization(f(A, B), U, F). 295minimum_factorization(T, S, L):- 296 factorization(T, S, L0), 297 minimize(L0, L). 298% 299minimize(X, Y):- select(U=_, X, X0), 300 select(V=_, X0, X1), 301 U \== V, 302 bisimulation(U, V, X, [], Cs), 303 !, 304 unify_cluster_list(Cs), 305 sort(X0, X1), 306 minimize(X1, Y). 307minimize(X, X). 308 309% ?- A=f(B, 0), B=f(A, 1), factorization(g(A,B), V, C). 310% ?- A=f(B, 0), B=f(A, 1), factorization(f(A,B), V, C). 311% ?- A=f(B, X), B=f(A, Y), factorization(f(A,B), V, C). 312factorization(X, V, C):- factorization(X, V, [], C, [], _). 313 314% ?- A=f(B, 0), B=f(A, 1), factorization(g(A,B), V, [], U, [], V). 315% ?- A=f(B, X), B=f(A, Y), factorization(g(A,B), V, [], U, [], V). 316factorization(X, V, C, C, H, H):- member(U=T, H), T == X, !, V=U. 317factorization(X, V, C, [V=X|C], H, H):- var(X), !. 318factorization(X, V, C, [V=U|C1], H, H1):- X=..[F|Xs], 319 factorization_list(Xs, Vs, C, C1, [V=X|H], H1), 320 U =..[F|Vs]. 321% 322factorization_list([], [], C, C, H, H). 323factorization_list([X|Xs], [V|Vs], C, C0, H, H0):- 324 factorization(X, V, C, C1, H, H1), 325 factorization_list(Xs, Vs, C1, C0, H1, H0). 326% 327unify_cluster([]):-!. 328unify_cluster([_]):-!. 329unify_cluster([X, X|R]):- unify_cluster([X|R]). 330% 331unify_cluster_list([]). 332unify_cluster_list([C|Cs]):-unify_cluster(C), unify_cluster_list(Cs). 333% 334get_target(U, A, X):- member(V=A, X), U==V, !. 335 336% ?- bisimulation(U, V, [U=a, V=a], [], Cs). 337bisimulation(U, V, X, Cs, Cs0):- 338 get_target(U, A, X), 339 get_target(V, B, X), 340 ( ( var(A); var(B) ) -> A == B, Cs0 = Cs 341 ; functor(A, F, N), 342 functor(B, F, N), 343 A=..[_|As], 344 B=..[_|Bs], 345 union_find(U, V, Cs, Cs1), 346 bisimulation_list(As, Bs, X, Cs1, Cs0) 347 ). 348% 349bisimulation_list([], [], _, Cs, Cs):-!. 350bisimulation_list([A|As], [B|Bs], X, Cs, Cs0):- 351 ( in_same_cluster(A, B, Cs) -> Cs1 = Cs 352 ; bisimulation(A, B, X, Cs, Cs1) 353 ), 354 bisimulation_list(As, Bs, X, Cs1, Cs0). 355% 356in_same_cluster(U, V, [C|_]):- 357 member(X, C), X==U, 358 member(Y, C), Y==V, 359 !. 360in_same_cluster(U, V, [_|Cs]):- in_same_cluster(U, V, Cs). 361 362% ?- union_find(A, B, [], X), union_find(C, B, X, Y). 363union_find(X, Y, Cs, Ds):- 364 find_cluster(X, C, Cs, Cs0), 365 ( member(U, C), U==Y -> Ds =[C|Cs0] 366 ; find_cluster(Y, C0, Cs0, Cs1), 367 append(C0, C, C1), 368 Ds =[C1|Cs1] 369 ). 370% 371find_cluster(X, C, [], []):-!, C=[X]. 372find_cluster(X, C, [D|Cs], Cs):-member(B, D), B==X, !, C=D. 373find_cluster(X, C, [D|Cs], [D|Ds]):-find_cluster(X, C, Cs, Ds). 374 375% ?- semi_lex_sort([a,b,a], X). 376% ?- A=f(A), B=f(B), semi_lex_sort([A, B], X). 377% ?- A=f(A, 0), B=f(B,1), C=f(C, 2), semi_lex_sort([A, B, C], X). 378% ?- A=f(B, 0), B=f(C,1), C=f(A, 2), semi_lex_sort([C, B, A, A, B, C], X). 379% ?- A=f(B, 0), B=f(C,1), C=f(A, 2), sort([C, B, A, A, B, C], X). 380% ?- b_setval(compare_history, []), A=(B,2), B=(A,1), C=(C,1), 381% semi_lex_compare(X, A, B), semi_lex_compare(Y, B, C), semi_lex_compare(Z, A, C). 382 383% ?- b_setval(compare_history, []), A=(B,2), B=(A,1), C=(C,1), 384% semi_lex_compare(X, A, B), semi_lex_compare(Y, B, C), 385% semi_lex_compare(Z, A, C), 386% semi_lex_compare(X1, B, A), 387% semi_lex_compare(Y1, C, B), 388% semi_lex_compare(Z1, C, A). 389 390% ?- b_setval(compare_history, []), A=(B,2), B=(A,1), C=(C,1), 391% semi_lex_compare(X, A, B), semi_lex_compare(Y, B, C), semi_lex_compare(Z, A, C), 392% semi_lex_compare(X1, A, B), semi_lex_compare(Y1, B, C), semi_lex_compare(Z1, A, C). 393 394init_history:- b_setval(compare_history, []). 395get_history(X):- b_getval(compare_history, X). 396set_history(X):- b_setval(compare_history, X). 397 398semi_lex_compare(C, X, Y):- b_getval(compare_history, H), 399 compare_with_history(C, X, Y, H, H0), 400 b_setval(compare_history, H0). 401 402% 403semi_lex_sort(X, Y):- b_setval(compare_history, []), 404 predsort(semi_lex_compare, X, Y). 405 406% ?- b_setval(compare_history, []), 407% X=a(Y, 1), Y=a(X, 2), Z=a(Z, 3), semi_lex_sort0([X, Y, X, Z], S), 408% semi_lex_sort0([Y, Y, Z, Z, X, X], S). 409semi_lex_sort0(X, Y):- predsort(semi_lex_compare, X, Y). 410% ?- chrono_sort([a,b], X). 411% ?- chrono_sort([a(1), b(2), c(3), a(1), b(3), c(4)], B). 412%@ B = [a(1), c(3), a(1), b(2), c(4), b(3)]. 413 414chrono_sort(X, Y):- b_setval(compare_history, []), 415 predsort(force_order_compare, X, Y). 416 417 418 /******************************* 419 * switch compare_cyclic * 420 *******************************/ 421 422 423% compare_cyclic(C, X, Y):- compare_with_heap(C, X, Y, [], _). 424% compare_cyclic(C, X, Y):- compare_with_stack(C, t(1, X, Y), []). 425compare_cyclic(C, X, Y):- compare_with_stack(C, X, Y, []). 426% compare_cyclic(C, X, Y):- compare_with_arity_tree(C, X, Y). 427% compare_cyclic(C, X, Y):- compare_rat(C, X, Y). 428 429 430 431 /***************************** 432 * compare_with_stack * 433 *****************************/ 434 435% force_order_compare(=, X, Y):- X==Y, !. 436% force_order_compare(C, X, Y):- b_getval(compare_history, H), 437% force_order(C, X, Y, H, H0), 438% b_setval(compare_history, H0). 439 440% ?- force_order(C, a, b, [], H). 441%@ C = (>), 442%@ H = [a/0-[a, b]]. 443% ?- force_order(C, a(1), a(2), [], H), 444% force_order(D, a(3), a(4), H, H0), 445% force_order(E, a(4), a(1), H0, H1), 446% force_order(F, a(1), a(4), H1, H2). 447% ?- force_order(C, a, b, [], H). 448% ?- force_order(C, b, a, [], H). 449 450% X \== Y is assumed. 451force_order(C, X, Y, H, H0):- functor(X, F, N), 452 ( select(F/N-G, H, H1) -> true 453 ; G = [], 454 H1 = H 455 ), 456 force_order_list(C, X, Y, G, G1), 457 H0 = [F/N-G1|H1]. 458% 459force_order_list(C, X, Y, G, G0):- 460 update_cluster(Y, G, G1), 461 update_cluster(X, G1, G0), 462 ( precede(X, Y, G0) -> C = (<) 463 ; C = (>) 464 ). 465 466% force_order_list(C, X, Y, G, G0):- 467% ( memberchk(X, G)-> 468% ( memberchk(Y, G) -> 469% ( precede(X, Y, G) -> C = (<) 470% ; C = (>) 471% ), 472% G0 = G 473% ; C = (>), 474% G0 = [Y|G] 475% ) 476% ; memberchk(Y, G)-> 477% C = (<), 478% G0 = [X|G] 479% ; C = (<), 480% G0 = [X, Y|G] 481% ). 482 483% ?- update_cluster(a, [], X). 484update_history(X, H, H0):- 485 functor(X, F, N), 486 ( select(F/N-G, H, H1) ->true 487 ; G = [], 488 H1 = H 489 ), 490 update_cluster(X, G, G1), 491 H0 = [F/N-G1|H1]. 492% 493update_cluster(X, [], [X]):-!. 494update_cluster(X, [Y|Z], U):- 495 compare_with_stack(C, X, Y), 496 ( C = (=) -> U = [Y|Z] 497 ; ( C = (<); C = incomparable ) -> U = [X, Y|Z] 498 ; update_cluster(X, Z, V), 499 U = [Y|V] 500 ). 501 502% ?- precede(a, b, [c, a, b]). 503% ?- precede(a, b, [c, a, d, b]). 504% ?- precede(a, b, [c, b, a]). 505precede(X, _, [U|_]):- X == U, !. 506precede(X, Y, [U|L]):- Y\==U, precede(X, Y, L). 507 508% ?- compare_with_stack(C, a, a). 509% ?- A=f(A), compare_with_stack(C, A, A). 510% ?- A=f(A), B=f(B), compare_with_stack(C, A, B). 511% ?- A=f(A,0), B=f(B,1), compare_with_stack(C, A, B). 512% ?- A=f(B,0), B=f(A,1), compare_with_stack(C, A, B). 513% ?- A=f(B,0), B=f(A,1), compare_with_stack(C, B, A). 514% ?- A=f(A, 0), B=f(B, 1), C=f(C, 2), predsort(compare_with_stack, [A, B, C], R). 515% ?- init_history, between(1,1000000,_), 516% random_cyclic(T1), ground(T1), 517% random_cyclic(T2), ground(T2), 518% random_cyclic(T3), ground(T3), 519% semi_lex_compare(Ct,T1,T2), 520% semi_lex_compare(Ct,T2,T3), 521% semi_lex_compare(C,T1,T3), C\==Ct. 522 523% ?- init_history, between(1,100000000,_), 524% random_cyclic(T1), ground(T1), 525% random_cyclic(T2), ground(T2), 526% random_cyclic(T3), ground(T3), 527% compare_cyclic(Ct,T1,T2), 528% compare_cyclic(Ct,T2,T3), 529% compare_cyclic(C,T1,T3), C\==Ct. 530 531% ?- between(1,10,I), random_cyclic(T1), ground(T1), random_cyclic(T2), ground(T2), 532% random_cyclic(T3), ground(T3), writeln(I). 533 534% ?- N = 100, findall(X, ( between(1, N, I), X=f(X, I)), L), append(L, L, L2), 535 536% ?- N = 100, findall(X, ( between(1, N, I), X=f(X, I)), L), append([L, L], L2), 537 538% ?- N = 100, findall(X, ( between(1, N, I), X=f(X, I)), L), append([L, L], L2), 539% time(sort(L2, R)), length(R, LenR), equal_set(L2, R). 540%@ % -1 inferences, 0.000 CPU in 0.000 seconds (71% CPU, -66667 Lips) 541%@ N = LenR, LenR = 100, 542 543% ?- X=f(a, 0), Y=f(b, 1), compare_with_history(C, X, Y, [], Z). 544% ?- X=f(Y, 0), Y=f(X, 1), compare_with_stack(C, X, Y, [], [], Z). 545% ?- X=f(Y, 0), Y=f(X, 1), Z=f(U,0), U=f(Z, 1), compare_with_stack(C, X, Z, [], [], A). 546% ?- X=f(Y, 0), Y=f(X, 1), Z=f(U,0), U=f(Z, 1), compare_with_stack(C, g(X, Y), g(Z, U), [],[], A). 547% ?- X=f(Y, 0), Y=f(X, 1), compare_with_stack(C, X, Y, [], [], H). 548% ?- X=f(Y, 0), Y=f(X, 1), Z=f(X, 3), compare_with_stack(C, X, Y, [],[], H). 549% ?- X=f(Y, 0), Y=f(X, 1), Z=f(X, 3), compare_with_stack(C, X, Y, [], [], H), compare_with_stack(D, Z, Y, [], H, H0). 550 551% ?- A=f(A), B = f(B), compare_with_history(C, A, B, [], H). 552% ?- A=f(B,0), B = f(A, 1), compare_with_history(C, A, B, [], H). 553% ?- A=f(B,0), B = f(A, 1), compare_with_history(C, f(A), f(B), [], H). 554% ?- A=f(B,0), B = f(A, 1), compare_with_history(C, f(g(A,B)), f(B), [], H), compare_with_history(D, f(B), f(g(A,B)), H, H0). 555 556compare_with_history(C, X, Y, H, H0):- 557 ( cyclic_term(X) -> update_history(X, H, H1) 558 ; H1 = H 559 ), 560 ( cyclic_term(Y) -> update_history(Y, H1, H2) 561 ; H2 = H1 562 ), 563 compare_with_stack(D, X, Y, []), 564 ( D = incomparable -> force_order(C, X, Y, H2, H0) 565 ; C = D, 566 H0 = H2 567 ). 568 569% % ?- X=f(Y, 1), Y=f(X, 2), compare_with_stack(C, X, Y). 570% compare_with_stack(C, X, Y):- compare_with_stack(C, X, Y, []). 571% % 572% compare_with_stack(C, X, Y, P):- 573% ( X == Y -> C = (=) 574% ; (atomic(X); atomic(Y)) -> compare(C, X, Y) 575% ; memberchk(X-Y, P) -> C = incomparable 576% ; functor(X, F, N), 577% functor(Y, G, M), 578% compare(D, N, M), 579% ( D = (=) -> 580% compare(E, F, G), 581% ( E = (=) -> 582% compare_args_with_stack(C, 1, X, Y, [X-Y|P]) 583% ; C = E 584% ) 585% ; C = D 586% ) 587% ). 588% % 589% compare_args_with_stack(C, K, A, B, P):- 590% arg(K, A, X), 591% arg(K, B, Y), 592% !, 593% compare_with_stack(D, X, Y, P), 594% ( D = (=) -> 595% K0 is K+1, 596% compare_args_with_stack(C, K0, A, B, P) 597% ; C = D 598% ). 599% % compare_args_with_stack(=, _, _, _, _). 600% compare_args_with_stack(incomparable, _, _, _, _). 601 602 /********************************** 603 * compare with arity stack * 604 **********************************/ 605 606% ?- N is 10^8, b_setval(compare_history, []), aggregate_all(count, 607% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 608% random_cyclic(C), ground(C), compare_cyclic(>, A,B), compare_cyclic(>, B,C), 609% compare_cyclic(<, A,C)), F). 610%@ N = 100000000, 611%@ F = 6. 612%@ F = 0. 613 614% ?- N is 10^8, aggregate_all(count, 615% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 616% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(<, B,C), 617% compare_cyclic(>, A,C)), F). 618%@ N = 100000000, 619%@ F = 3. 620%@ N = 100000000, 621%@ F = 2. 622 623 624% ?- b_setval(compare_history, []), aggregate_all(count, 625% (between(1,100,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 626% random_cyclic(C), ground(C), compare_cyclic(>, A,B), compare_cyclic(>, B,C), 627% compare_cyclic(<, A,C)), F). 628 629% ?- b_setval(compare_history, []), aggregate_all(count, 630% (between(1,100000000,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 631% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(<, B,C), 632% compare_cyclic(>, A,C)), F). 633%@ F = 5. 634%@ F = 7. 635 636% ?- N is 10^8, aggregate_all(count, 637% (between(1, N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 638% random_cyclic(C), ground(C), 639% compare_with_stack_heap(0, <, A, B), 640% compare_with_stack_heap(0, <, B, C), 641% compare_with_stack_heap(0, >, A,C)), F). 642%@ N = 100000000, 643%@ F = 0. 644 645% ?- N is 10^8, aggregate_all(count, 646% (between(1, N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 647% random_cyclic(C), ground(C), 648% compare_with_stack_heap(0, >, A, B), 649% compare_with_stack_heap(0, >, B, C), 650% compare_with_stack_heap(0, <, A,C)), F). 651%@ N = 100000000, 652%@ F = 0. 653 654% ?- N is 10^8, b_setval(compare_history, []), aggregate_all(count, 655% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 656% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(<, B,C), 657% compare_cyclic(>, A,C)), F). 658%@ N = 100000000, 659%@ F = 6. 660 661% ?- N is 10^8, b_setval(compare_history, []), aggregate_all(count, 662% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 663% random_cyclic(C), ground(C), compare_cyclic(>, A,B), compare_cyclic(>, B,C), 664% compare_cyclic(<, A,C)), F). 665%@ N = 100000000, 666%@ F = 6. 667 668% ?- N is 10^8, b_setval(compare_history, []), aggregate_all(count, 669% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 670% random_cyclic(C), ground(C), compare_cyclic(<, A,B), compare_cyclic(<, B,C), 671% compare_cyclic(>, A,C)), F). 672%@ N = 100000000, 673%@ F = 7. 674 675 676% ?- N is 10^8, init_history, b_setval(compare_history, []), aggregate_all(count, 677% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 678% random_cyclic(C), ground(C), 679% compare_with_stack_heap(<, A,B), 680% compare_with_stack_heap(<, B,C), 681% compare_with_stack_heap(>, A,C)), F). 682%@ N = 100000000, 683%@ F = 38. 684 685% ?- N is 10^6, init_history, b_setval(compare_history, []), aggregate_all(count, 686% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 687% random_cyclic(C), ground(C), 688% compare_with_stack_heap(<, A,B), 689% compare_with_stack_heap(<, B,C), 690% compare_with_stack_heap(>, A,C)), F). 691 692% Find anomaly 693% ?- find_anomaly(X, Y). 694 695find_anomaly([A, B, C], [Cab, Cbc, Cac]):- 696 repeat, 697 random_cyclic(A), ground(A), 698 random_cyclic(B), ground(B), 699 random_cyclic(C), ground(C), 700 compare_cyclic(Cab, A, B), 701 compare_cyclic(Cbc, B, C), 702 compare_cyclic(Cac, A, C), 703 non_transitive(Cab, Cbc, Cac), 704 !. 705 706% ?- compare_cyclic(C, b(1), a(2,3)). 707% ?- compare_cyclic(C, a(3,2), a(2,3)). 708% ?- X=f(X), Y=f(Y), compare_cyclic(C, X, Y). 709% ?- X=f(f(X,X), Y), Y=f(X, Y), compare_cyclic(C, X, Y). 710% ?- X=f(Y, 1), Y=f(X, 1), compare_cyclic(C, Y, X). 711% ?- X=f(Y, 1), Y=f(X, 2), compare_cyclic(C, Y, X). 712% ?- A=a(A,0), B=a(B,1), compare_cyclic(C, A, B). 713% ?- A=a(A,1), B=a(B,0), compare_cyclic(C, A, B). 714 715 /*************************** 716 * compare_with_heap * 717 ***************************/ 718 719compare_with_heap(C, X, Y, H, H):- \+ (compound(X), compound(Y)), !, 720 compare(C, X, Y). 721compare_with_heap(=, X, Y, H, H):- X==Y, !. 722compare_with_heap(=, X, Y, H, H):- qmember(X-Y, H), !. 723compare_with_heap(C, X, Y, H, H0):- 724 functor(X, F, N), 725 functor(Y, G, M), 726 compare(D, N, M), 727 ( D=(=) -> 728 compare(E, F, G), 729 ( E=(=) -> 730 compare_args_with_heap(C, 1, X, Y, [X-Y|H], H0) 731 ; C = E, H0 = H 732 ) 733 ; C = D, H0 = H 734 ). 735% 736compare_args_with_heap(C, I, X, Y, H, H0):- 737 arg(I, X, A), 738 arg(I, Y, B), 739 !, 740 compare_with_heap(D, A, B, H, H1), 741 ( D = (=) -> 742 I0 is I + 1, 743 compare_args_with_heap(C, I0, X, Y, H1, H0) 744 ; C = D, H0 = H1 745 ). 746compare_args_with_heap(=, _, _, _, H, H). 747 748 /********************************* 749 * naive compare_with_stack * 750 *********************************/ 751 752% ?- compare_with_stack(C,a,a). 753% ?- A=f(A, B), B=f(B, A), compare_with_stack(C, A, A). 754% ?- A=f(B, 0), B=f(A, 1), compare_with_stack(C, A, B), 755% compare_with_stack(D, B, A). 756% ?- A=f(B, X), B=f(A, Y), compare_with_stack(C, A, B), 757% compare_with_stack(D, B, A). 758 759compare_with_stack(C, X, Y):-compare_with_stack(C, X, Y, []). 760% 761compare_with_stack(C, X, Y, _):- \+ (compound(X), compound(Y)), !, 762 compare(C, X, Y). 763compare_with_stack(=, X, Y, _):- X==Y, !. 764compare_with_stack(=, X, Y, H):- qmember(X-Y, H), !. 765compare_with_stack(C, X, Y, H):- 766 compare_arity(D, X, Y), 767 ( D = (=) -> 768 compare_args_with_stack(1, C, X, Y, [X-Y|H]) 769 ; C = D 770 ). 771% 772compare_args_with_stack(I, C, X, Y, H):- 773 arg(I, X, A), 774 arg(I, Y, B), 775 !, 776 compare_with_stack(D, A, B, H), 777 ( D = (=) -> 778 I0 is I + 1, 779 compare_args_with_stack(I0, C, X, Y, H) 780 ; C = D 781 ). 782compare_args_with_stack(_ ,= , _, _, _). 783 784 /********************************* 785 * compare_with_stack_heap * 786 *********************************/ 787 788% ?- N is 10^8, init_history, b_setval(compare_history, []), aggregate_all(count, 789% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 790% random_cyclic(C), ground(C), 791% compare_with_stack_heap(<, A,B), 792% compare_with_stack_heap(<, B,C), 793% compare_with_stack_heap(>, A,C)), F). 794%@ N = 100000000, 795%@ F = 4. 796 797% ?- init_history, compare_with_stack_heap(C, a, a). 798%@ C = (=). 799% ?- init_history, A=f(A, B), B=f(B, A), compare_with_stack_heap(C, A, A). 800%@ A = B, B = _S1, % where 801%@ _S1 = f(_S1, _S2), 802%@ _S2 = f(_S2, _S1), 803%@ C = (=). 804% ?- init_history, A=f(B, 0), B=f(A, 1), compare_with_stack_heap(C, A, B), 805% compare_with_stack_heap(D, B, A). 806% ?- init_history, A=f(B, X), B=f(A, Y), compare_with_stack_heap(C, A, B), 807% compare_with_stack_heap(D, B, A). 808 809compare_with_stack_heap(C, X, Y):- 810 ( X==Y -> C = (=) 811 ; compound(X), compound(Y) -> 812 compare_with_stack_heap_top(B, C, X, Y), 813 ( B = 0 -> true 814 ; get_history(H), 815 union_find_precede(C, X, Y, H, H0), 816 set_history(H0) 817 ) 818 ; compare(C, X, Y) 819 ). 820 821 822compare_with_stack_heap_top(B, C, X, Y):- compare_with_stack_heap(0, B, C, X, Y, []). 823 824compare_with_stack_heap(B, B, C, X, Y, _):- \+ (compound(X), compound(Y)), !, 825 compare(C, X, Y). 826compare_with_stack_heap(B, B, =, X, Y, _):- X==Y, !. 827compare_with_stack_heap(B, B0, _, X, Y, S):- qmember(X-Y, S), !, 828 B0 is B+1. 829compare_with_stack_heap(B, B0, C, X, Y, S):- 830 compare_args_with_stack_heap(B, B0, 1, C, X, Y, [X-Y|S]). 831% 832compare_args_with_stack_heap(U, V, I, C, X, Y, S):- 833 arg(I, X, A), 834 arg(I, Y, B), 835 !, 836 compare_with_stack_heap(U, U0, D, A, B, S), 837 ( D = (=) -> 838 I0 is I + 1, 839 compare_args_with_stack_heap(U0, V, I0, C, X, Y, S) 840 ; C = D 841 ). 842compare_args_with_stack_heap(U, U, _, = , _, _, _). 843 844 845% compare_with_stack_heap(H, C, X, Y):- get_history(H0), 846% compare_with_stack_heap(H0, H, C, X, Y, []), 847% set_history(H). 848% % 849% compare_with_stack_heap(H, H, C, X, Y, _):- \+ (compound(X), compound(Y)), !, 850% compare(C, X, Y). 851% compare_with_stack_heap(H, H, =, X, Y, _):- X==Y, !. 852% compare_with_stack_heap(H, [X-Y|H], =, X, Y, S):- qmember(X-Y, S), !. 853% compare_with_stack_heap(H, H0, C, X, Y, S):- 854% compare_args_with_stack_heap(H, H0, 1, C, X, Y, [X-Y|S]). 855% % 856% compare_args_with_stack_heap(H, H0, I, C, X, Y, S):- 857% arg(I, X, A), 858% arg(I, Y, B), 859% !, 860% compare_with_stack_heap(H, H1, D, A, B, S), 861% ( D = (=) -> 862% I0 is I + 1, 863% compare_args_with_stack_heap(H1, H0, I0, C, X, Y, S) 864% ; C = D, 865% H0 = H1 866% ). 867% compare_args_with_stack_heap(H ,H ,_ , = , _, _, _). 868 869% ?- qselect(a, G, [], H). 870% ?- qselect(a, G, [[b], [a]], H). 871qselect(X, G, [G|Gs], Gs):- qmember(X, G), !. 872qselect(X, G, [G0|Gs], [G0|Gs1]):- qselect(X, G, Gs, Gs1). 873 874% ?- union_find(a, b, U, [], X). 875% ?- union_find(a, b, U, [[a],[b], [c]], X). 876% ?- union_find(a, b, U, [[a, a1]], X). 877% ?- union_find(a, b, U, [[a, a1], [b,b1]], X). 878% ?- union_find(a, b, U, [[b,b1]], X). 879 880union_find(X, Y, U, H, H0):-qselect(X, G, H, H1),!, 881 ( qmember(Y, G) -> 882 H0 = H, 883 U = G 884 ; qselect(Y, G1, H1, H2) -> 885 append(G, G1, G2), 886 H0=[G2|H2], 887 U = G2 888 ; H0=[[Y|G]|H1], 889 U = [Y|G] 890 ). 891union_find(X, Y, U, H, H0):-qselect(Y, G, H, H1),!, 892 H0=[[X|G]|H1], 893 U = [X|G]. 894union_find(X, Y, [X,Y], H, [[X,Y]|H]).% 895% 896% ?- union_find_precede(b, a, C, [[a],[b]], H). 897% ?- union_find_precede(a, b, C, [[a],[b]], H). 898% ?- union_find_precede(a, b, C, [[b],[a]], H). 899% ?- union_find_precede(a, b, C, [[b,a]], H). 900% ?- union_find_precede(a, b, C, [[b, c, a]], H). 901union_find_precede(X, Y, C, H, H0):-union_find(X, Y, G, H, H0), 902 ( precede(X, Y, G) -> C = (<) 903 ; C = (>) 904 ).
f(A, B), B=f(B, A), compare_with_stack(C, A, A).
%@ false.
% ?- A=f(B, 0), B=f(A, 1),
% compare_with_stack(C, t(1, A, B), []),
% compare_with_stack(D, t(1, B, A), []).
%
compare_with_stack(C, t(1, X, Y), _):- \+ (compound(X), compound(Y)), !,
compare(C, X, Y).
compare_with_stack(=, t(I, X, _), _):- functor(X, _, N), I>N, !.
compare_with_stack(=, t(_, X, Y), _):- X==Y, !.
compare_with_stack(C, t(I, X, Y), H):- qmember(t(I, X, Y), H), !,
I0 is I + 1,
compare_with_stack(C, t(I0, X, Y), H).
compare_with_stack(C, t(I, X, Y), H):-
arg(I, X, A),
arg(I, Y, B),
compare_with_stack(D, t(1, A, B), [t(I, X, Y)|H]),
( D = (=) ->
I0 is I + 1,
compare_with_stack(C, t(I0, X, Y), H)
; C = D
).
932 /********************************** 933 * compare_with_arity_stack * 934 **********************************/ 935 936compare_with_arity_tree(C, X, Y):- (\+compound(X) ; \+compound(Y)), !, 937 compare(C, X, Y). 938compare_with_arity_tree(C, X, Y):- 939 compare_arity(D, X, Y, Arity), 940 ( D = (=) -> 941 compare_with_arity_tree(C, [t(Arity, 1, X, Y)]) 942 ; C = D 943 ). 944 945% 946compare_with_arity_tree(=, []):-!. 947compare_with_arity_tree(C, [P|Ps]):- 948 ( qmember(P, Ps) -> 949 skip_arity_tree_path([P|Ps], Q), 950 compare_with_arity_tree(C, Q) 951 ; child_pair(P, X, Y), 952 ( X==Y -> 953 skip_arity_tree_path([P|Ps], Q), 954 compare_with_arity_tree(C, Q) 955 ; ( \+compound(X); \+compound(Y)) -> 956 compare(D, X, Y), 957 ( D = (=) -> 958 skip_arity_tree_path([P|Ps], Q), 959 compare_with_arity_tree(C, Q) 960 ; C = D 961 ) 962 ; compare_arity(D, X, Y, Arity), 963 ( D = (=) -> 964 compare_with_arity_tree(C, [t(Arity, 1, X, Y), P|Ps]) 965 ; C = D 966 ) 967 ) 968 ). 969 970 /********************************* 971 * compare_with_arity_path * 972 *********************************/ 973 974% ?- N is 10^8, init_history, aggregate_all(count, 975% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 976% random_cyclic(C), ground(C), 977% compare_with_arity_path(<, A, B), 978% compare_with_arity_path(<, B, C), 979% compare_with_arity_path(>, A, C)), F). 980%@ N = 100000000, 981%@ F = 1031. 982 983% ?- init_history, A=f(A), B=f(B), compare_with_arity_path(C, A, B). 984% ?- init_history, A=f(B,0), B=f(A,1), compare_with_arity_path(Cab, A, B), 985% compare_with_arity_path(Cba, B, A), 986% compare_with_arity_path(Dab, A, B), 987% compare_with_arity_path(Dba, B, A). 988 989compare_with_arity_path(C, X, Y):- 990 ( X == Y -> C = (=) 991 ; compound(X), compound(Y) -> 992 compare_with_arity_path(D, X, Y, Path), 993 ( D = (<>) -> 994 extract_arity_path(Path, As), 995 get_history(H), 996 union_find_precede(C, As, X, Y, H, H0), 997 set_history(H0) 998 ; C = D 999 ) 1000 ; compare(C, X, Y) 1001 ). 1002 1003% ?- union_find_precede(C, [a,b], c, d, [[a,b]-[c,d]], H0). 1004% ?- union_find_precede(C, [a,b], d, c, [[a,b]-[c,d]], H0). 1005% ?- union_find_precede(C, [a,b], d, c, [[a,b]-[c]], H0). 1006% ?- union_find_precede(C, [a,b], d, c, [[a,b]-[d]], H0). 1007union_find_precede(C, Path, X, Y, H, H0):- 1008 ( select(Path-Cluster, H, H1) -> 1009 qadd_new([X, Y], Cluster, Cluster0), 1010 H0 = [Path-Cluster0|H1], 1011 ( precede(X, Y, Cluster0) -> C = (<) 1012 ; C = (>) 1013 ) 1014 ; H0 = [Path-[X,Y]|H], 1015 C = (<) 1016 ). 1017 1018% ?- qadd_new([a,b],[c,b], X). 1019qadd_new([], X, X). 1020qadd_new([A|As], X, Y):- 1021 ( qmember(A, X)-> X1 = X 1022 ; X1 = [A|X] 1023 ), 1024 qadd_new(As, X1, Y). 1025 1026% ?- compare_with_arity_path(C, f(a), f(b), S). 1027%@ C = (<), 1028% ?- A=f(B,0), B=f(A,1), compare_with_arity_path(C, A, B, S). 1029% ?- A=f(f(A, 1),0), B=f(A,1), compare_with_arity_path(C, A, B, S). 1030% ?- A=f(a, B,0), B=f(a, A,1), compare_with_arity_path(C, A, B, S). 1031% ?- A=f(f(A, 1),0), B=f(A,1), X=a(a(a(A))), Y=a(a(a(B))), compare_with_arity_path(C, X, Y, S), 1032% all_dif(S). 1033 1034compare_with_arity_path(C, X, Y, Path):-compare_with_arity_path(C, X, Y, [], Path). 1035% 1036compare_with_arity_path(C, X, Y, H, H):- (\+compound(X) ; \+compound(Y)), !, 1037 compare(C, X, Y). 1038compare_with_arity_path(C, X, Y, P, P0):- 1039 compare_arity(D, X, Y, Arity), 1040 ( D = (=) -> 1041 compare_with_arity_path_down(C, [t(Arity, 1, X, Y)|P], P0) 1042 ; C = D, 1043 P0 = P 1044 ). 1045% 1046compare_with_arity_path_down(=, [], []):-!. 1047compare_with_arity_path_down(C, [P|Ps], P0):- 1048 ( qmember(P, Ps) -> 1049 P0 = Ps, 1050 C = (<>) 1051 ; child_pair(P, X, Y), 1052 ( X==Y -> 1053 skip_arity_tree_path([P|Ps], Q), 1054 compare_with_arity_path_down(C, Q, P0) 1055 ; ( \+compound(X); \+compound(Y)) -> 1056 compare(D, X, Y), 1057 ( D = (=) -> 1058 skip_arity_tree_path([P|Ps], Q), 1059 compare_with_arity_path_down(C, Q, P0) 1060 ; C = D, 1061 P0 = P 1062 ) 1063 ; compare_arity(D, X, Y, Arity), 1064 ( D = (=) -> 1065 compare_with_arity_path_down(C, [t(Arity, 1, X, Y), P|Ps], P0) 1066 ; C = D, 1067 P0 = [P|Ps] 1068 ) 1069 ) 1070 ). 1071 1072% ?- extract_arity_path([t(a/2, 1, u,v), t(b/3, 3, c, d)], P). 1073extract_arity_path([], []):-!. 1074extract_arity_path([t(Arity, I, _, _)|As], [t(Arity, I)|P]):- 1075 extract_arity_path(As, P). 1076 1077 1078 /******************************** 1079 * anti_symmetric_compare * 1080 ********************************/ 1081 1082% ?- N is 10^8, init_history, aggregate_all(count, 1083% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 1084% random_cyclic(C), ground(C), 1085% anti_symmetric_compare(<, A, B), 1086% anti_symmetric_compare(<, B, C), 1087% anti_symmetric_compare(>, A, C)), F). 1088%@ N = 100000000, 1089%@ F = 4. 1090%@ N = 100000000, 1091%@ F = 1. 1092 1093% ?- N is 10^8, init_history, aggregate_all(count, 1094% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 1095% random_cyclic(C), ground(C), 1096% anti_symmetric_compare(>, A, B), 1097% anti_symmetric_compare(>, B, C), 1098% anti_symmetric_compare(<, A, C)), F). 1099%@ N = 100000000, 1100%@ F = 7. 1101 1102% ?- init_history, A=f(A), B=f(B), anti_symmetric_compare(C, A, B). 1103% ?- init_history, A=f(B,0), B=f(A,1), anti_symmetric_compare(Cab, A, B), 1104% anti_symmetric_compare(Cba, B, A), 1105% anti_symmetric_compare(Dab, A, B), 1106% anti_symmetric_compare(Dba, B, A). 1107 1108% ?- A=f(B,0), B=f(A,1), anti_symmetric_compare(Cab, A, B), anti_symmetric_compare(Cba, B, A). 1109 1110anti_symmetric_compare(C, X, Y):- 1111 ( X == Y -> C = (=) 1112 ; compound(X), compound(Y) -> 1113 compare_arity(D, X, Y, Arity), 1114 ( D = (=)-> 1115 anti_symmetric_compare(C, [t(Arity, 1, X, Y)]) 1116 ; C = D 1117 ) 1118 ; compare(C, X, Y) 1119 ). 1120% 1121anti_symmetric_compare(=, []):-!. 1122anti_symmetric_compare(C, [P|Ps]):- 1123 ( qmember(P, Ps) -> 1124 skip_arity_tree_path([P|Ps], Q), 1125 anti_symmetric_compare(C, Q) 1126 ; child_pair(P, X, Y), 1127 ( X==Y -> 1128 skip_arity_tree_path([P|Ps], Q), 1129 anti_symmetric_compare(C, Q) 1130 ; ( \+compound(X); \+compound(Y)) -> 1131 compare(D, X, Y), 1132 ( D = (=) -> 1133 skip_arity_tree_path([P|Ps], Q), 1134 anti_symmetric_compare(C, Q) 1135 ; C = D 1136 ) 1137 ; compare_arity(D, X, Y, Arity), 1138 ( D = (=) -> 1139 anti_symmetric_compare(C, [t(Arity, 1, X, Y), P|Ps]) 1140 ; C = D 1141 ) 1142 ) 1143 ). 1144 1145 /******************* 1146 * some tiny * 1147 *******************/ 1148 1149% ?- skip_arity_tree_path([t(b/2, 1, b(c,d), b(d, e))], Q). 1150% ?- skip_arity_tree_path([t(a/1, a(x), a(y)), t(b/2, 1, b(c,d), b(d, e))], Q). 1151% ?- skip_arity_tree_path([t(a/1, a(x), a(y)), t(b/2, 2, b(c,d), b(d, e))], Q). 1152 1153skip_arity_tree_path([], []):-!. 1154skip_arity_tree_path([T|P], [T0|P]):- forward(T, T0), !. 1155skip_arity_tree_path([_|P], Q):- skip_arity_tree_path(P, Q). 1156% 1157forward(t(F/N, I, A, B), t(F/N, J, A, B)):- 1158 I < N, 1159 J is I + 1. 1160 1161% ?- child_pair(t(a/2, 1, a(x,u), a(y, u)), X, Y). 1162child_pair(t(_, I, X, Y), A, B):- arg(I, X, A), arg(I, Y, B). 1163 1164% ?- compare_arity(C, f(a), f(g), A). 1165% ?- compare_arity(C, f(a,b), f(a), A). 1166% ?- compare_arity(C, f(a), g(a,b), A). 1167 1168compare_arity(C, X, Y, F/N):- 1169 functor(X, F, N), 1170 functor(Y, G, M), 1171 compare(C, N/F, M/G). 1172 1173% ?- binary_tree(30, X), binary_tree(30, Y), time(X=Y). 1174binary_tree(N, X):- length(Vs, N), 1175 binary_tree_(Vs, X). 1176 1177binary_tree_([], _):-!. 1178binary_tree_([A|As], f(A, A)):-binary_tree_(As, A). 1179 1180% ?- equal_set([a,b], [a,b,b,a]). 1181% ?- equal_set([a,b], [a,b,c,a]). 1182equal_set(X, Y):- forall(member(A, X), member(A, Y)), 1183 forall(member(B, Y), member(B, X)). 1184 1185 1186 /******************** 1187 * Jan's code * 1188 ********************/ 1189 1190rep_compare(C, X, Y) :- 1191 rep_compare(C, X, [], Y, []). 1192 1193rep_compare(C, X, SX, Y, SY), compound(X), compound(Y) => 1194 naish_lookup(X, SX, X2, Flag), 1195 naish_lookup(Y, SY, Y2, Flag), 1196 ( Flag == true 1197 -> compare(C, X2, Y2) 1198 ; compound_name_arity(X, NX, AX), 1199 compound_name_arity(Y, NY, AY), 1200 ( NX == NY, AX == AY 1201 -> compare_args(C, 1, AX, X, [X|SX], Y, [Y|SY]) 1202 ; compare(C, AX-NX, AY-NY) 1203 ) 1204 ). 1205rep_compare(C, X, _, Y, _) => 1206 compare(C, X, Y). 1207 1208compare_args(C, I, Arity, X, SX, Y, SY), I =< Arity => 1209 arg(I, X, AX), 1210 arg(I, Y, AY), 1211 rep_compare(C0, AX, SX, AY, SY), 1212 ( C0 == (=) 1213 -> I1 is I+1, 1214 compare_args(C, I1, Arity, X, SX, Y, SY) 1215 ; C = C0 1216 ). 1217compare_args(C, _I, _Arity, _X, _SX, _Y, _SY) => 1218 C = (=). 1219 1220naish_lookup(Term, Stack, Naish, true) :- 1221 nth1(N, Stack, Term2), 1222 Term2 == Term, 1223 !, 1224 Naish = N. 1225naish_lookup(Term, _, Term, _). 1226 1227% ?- N is 10^8, test(N, rep_compare). 1228 1229% ?- listing(nth1). 1230%@ lists:nth1(Index, List, Elem) :- 1231%@ ( integer(Index) 1232%@ -> Index0 is Index+ -1, 1233%@ '$seek_list'(Index0, List, RestIndex, RestList), 1234%@ nth0_det(RestIndex, RestList, Elem) 1235%@ ; var(Index) 1236%@ -> List=[H|T], 1237%@ nth_gen(T, Elem, H, 1, Index) 1238%@ ; must_be(integer, Index) 1239%@ ). 1240%@ 1241%@ lists:nth1(V, In, Element, Rest) :- 1242%@ var(V), 1243%@ !, 1244%@ generate_nth(1, V, In, Element, Rest). 1245%@ lists:nth1(V, In, Element, Rest) :- 1246%@ must_be(positive_integer, V), 1247%@ succ(V0, V), 1248%@ find_nth0(V0, In, Element, Rest). 1249%@ 1250%@ true. 1251 1252 1253% 1254test(N, Pred) :- 1255 N > 0, 1256 !, 1257 ( N mod 10000 =:= 0 1258 -> format(user_error, '\r~t~D~20|', [N]) 1259 ; true 1260 ), 1261 random_cyclic(X), 1262 random_cyclic(Y), 1263 call(Pred, C1, X, Y), 1264 call(Pred, C2, Y, X), 1265 ( consistent(C1, C2) 1266 -> N2 is N - 1, 1267 test(N2, Pred) 1268 ; format(user_error, 'FAILED:~n\t~q~n\t~q~n', [X, Y]) 1269 ). 1270test(_, _). 1271 1272consistent(=, =). 1273consistent(<, >). 1274consistent(>, <). 1275 1276 1277% ?- N is 10^8, aggregate_all(count, 1278% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 1279% random_cyclic(C), ground(C), 1280% rep_compare(<, A, B), 1281% rep_compare(<, B, C), 1282% rep_compare(>, A, C)), F). 1283%@ N = 100000000, 1284%@ F = 0. 1285 1286% ?- N is 10^8, aggregate_all(count, 1287% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 1288% random_cyclic(C), ground(C), 1289% rep_compare(>, A, B), 1290% rep_compare(>, B, C), 1291% rep_compare(<, A, C)), F). 1292%@ N = 100000000, 1293%@ F = 0. 1294 1295% ?- N is 10^8, aggregate_all(count, 1296% (between(1,N,_), random_cyclic(A), ground(A), random_cyclic(B), ground(B), 1297% random_cyclic(C), ground(C), 1298% rep_compare(Cab, A, B), 1299% rep_compare(Cbc, B, C), 1300% rep_compare(Cac, A, C), 1301% non_transitive(Cab,Cbc,Cac)), F). 1302%@ N = 100000000, 1303%@ F = 0. 1304 1305 1306 1307 1308 1309% % random_cyclic(-Term) 1310% random_cyclic(T) :- 1311% random_cyclic([T], T). 1312 1313% % random_cyclic(+List, -Term) 1314% random_cyclic(L, T) :- 1315% length(L, M), 1316% random(R), 1317% N is truncate(R*(M+3)), 1318% ( N = 0 1319% -> T = 0 1320% ; N = 1 1321% -> T = 1 1322% ; N = 2 1323% -> T = s(P,Q), 1324% random_cyclic([P|L], P), 1325% random_cyclic([Q|L], Q) 1326% ; K is N-3, 1327% nth0(K, L, S), 1328% S = T 1329% ).