1:- module(mate_order, []). 2
3:- use_module(zdd('zdd-array')). 4:- use_module(zdd(zdd)). 5:- use_module(pac(op)).
15
16prepare(I-J, Links, I0-J0, Succs, D, Vec, State):-
17 open_state(S),
18 build_node_layers([J], Links, N),
19 reverse(N, N0),
20 number_node_layers(N0, 0, _, S),
21 number_links(Links, Links1, S),
22 normal_mate_list(Links1, Links2),
23 predsort(mate_compare, Links2, Links3),
24 reverse(Links3, Links4),
25 Links0 = Links4,
26 memo(number_node(J)-J0, S),
27 memo(number_node(I)-I0, S),
28 domain_of_links([I0-J0|Links4], D),
29 rel_to_fun(Links0, Succs),
30 close_state(S),
31 setup_links_frontier(J0, Links0, Vec),
32 obj_id((I0-J0, Vec), Id),
33 memo(frontier_id-Id, State).
43rel_to_fun(L, R):- reverse(L, L0),
44 rel_to_fun(L0, [], R).
46rel_to_fun([], X, X).
47rel_to_fun([A-B|L], [A-U|V], R):-!,
48 rel_to_fun(L, [A-[B|U]|V], R).
49rel_to_fun([A-B|L], U, R):-!,
50 rel_to_fun(L, [A-[B]|U], R).
51
62
63on_frontier(I, J, F):- arg(I, F, K), K < J.
73
74off_frontier(I, J, F):- arg(I, F, K), J =< K.
86
87setup_links_frontier(N, Links, F):- functor(F, #, N),
88 initialize_frontier(F),
89 setup_frontier(Links, F).
90
92initialize_frontier(V):- functor(V, _, N),
93 initialize_frontier(N, V), !.
95initialize_frontier(0, _):-!.
96initialize_frontier(I, V):- setarg(I, V, I),
97 J is I - 1,
98 initialize_frontier(J, V).
99
101setup_frontier([], _).
102setup_frontier([I-J|L], F):-
103 update_frontier(I, J, F),
104 !,
105 setup_frontier(L, F).
106
109update_frontier(I, J, V):-
110 arg(I, V, A),
111 ( J < A -> setarg(I, V, J)
112 ; true
113 ),
114 arg(J, V, B),
115 ( I < B -> setarg(J, V, I)
116 ; true
117 ).
118
119
120
121 124
125:- op(20, fx, #). 126#(S) :- fetch_state(S).
127
130
140
151
152rectangular_benchimark(R, Z, S):- R = rect(W, H),
153 rect_links(R, Links),
154 path_count_by_simple_frontier(Links, p(0,0)-p(W, H), Z, S).
155
156
171
172
173
179
181
190
195
196map_count_path([]):-!.
197map_count_path([A|As]):- last(A, P),
198 count_path(st(A, P)), !, map_count_path(As).
199
202count_path(st(L,ST)):- open_state(S),
203 path_count_by_simple_frontier(L, ST, Z, S),
204 card(Z, C, S),
205 format("path count = ~w\n", [C]),
206 close_state(S).
207
208 211
215random_dif_pair(P, A, B):- sort(P, P0), length(P0, L),
216 L > 1,
217 random_ord_dif_pair(P0, A, B, L).
218
220random_ord_dif_pair(P, A, B, L):-
221 I is random(L),
222 J is random(L),
223 ( I\==J ->
224 nth0(I, P, A),
225 nth0(J, P, B)
226 ; random_ord_dif_pair(P, A, B, L)
227 ).
228
231elim_node([], _, []):-!.
232elim_node(Ns, [], Ns):-!.
233elim_node(Ns, [A-B|As], Ns0):-
234 elim_node_one(Ns, [A,B], Ns1),
235 elim_node(Ns1, As, Ns0).
237elim_node_one([], _, []):-!.
238elim_node_one(Ns, [], Ns):-!.
239elim_node_one([A|Ns], Us, Ns0):-
240 ( select(A, Us, Us1) ->
241 elim_node_one(Ns, Us1, Ns0)
242 ; elim_node_one(Ns, Us, Ns1),
243 Ns0=[A|Ns1]
244 ).
245
249
250choose_random_paths(_, 0, _, Ps, Ps, _):-!.
251choose_random_paths(IV, N, X, [P|Q], R, S):-
252 zdd_rand_path(X, P, [], S),
253 length(P, Len),
254 interval(IV, Len),
255 !,
256 N0 is N-1,
257 choose_random_paths(IV, N0, X, Q, R, S).
258choose_random_paths(IV, N, X, P, Q, S):-
259 choose_random_paths(IV, N, X, P, Q, S).
261interval(I-J, K):- I=<K, K=<J.
262
265power_links(A, B, S):-
266 findall(X-Y, (member(X, A), member(Y, A), X@<Y), L),
267 <<(B, pow(L), S).
268
271normal_mate_list([], []).
272normal_mate_list([P|R], [P0|R0]):- P=I-J,
273 ( J@<I -> P0= J-I
274 ; P0 = P
275 ),
276 normal_mate_list(R, R0).
277
278
279 282
284
290path_count_by_simple_frontier(Links, ST, X, S):-
291 normal_links_with_st(ST, Links, ST0, Links0, D),
292 path_count_by_simple_frontier(Links0, D, ST0, X, S).
293
294path_count_by_simple_frontier(Links, D, ST, Z, S):- Ctrl=[gc(link)], 295 path_count_by_simple_frontier(Ctrl, Links, D, ST, Z, S).
297path_count_by_simple_frontier(Ctrl, Links, D, ST, Z, S):- ST = I-J,
298 findall(K-K, member(K, D), Init),
299 zdd_append(Init, 1, X, S),
300 Ctrl0=[end(J), start(I)|Ctrl],
301 add_links(Ctrl0, Links, X, Y, S),
302 prune_final(I, J, Y, Z, S).
303
317
318
319
320normal_links_with_st(I-J, Links, I0-J0, Links0, D):-
321 open_state(S),
322 build_node_layers([J], Links, N),
323 reverse(N, N0),
324 number_node_layers(N0, 0, _, S),
325 number_links(Links, Links1, S),
326 normal_mate_list(Links1, Links2),
327 predsort(mate_compare, Links2, Links3),
328 reverse(Links3, Links4),
329 map_put_fr(Links4, Links0),
330 memo(number_node(J)-J0, S),
331 memo(number_node(I)-I0, S),
332 domain_of_links([I0-J0|Links4], D),
333 close_state(S).
335map_put_fr([], []).
336map_put_fr([I-J|R], [fr(I-J, J)|R0]):- map_put_fr(R, R0).
337
338
339
340 343
345domain_of_links(X, Y):-
346 findall( A, ( member(L, X),
347 ( L = (A - _)
348 ; L = (_ - A)
349 )
350 ),
351 Y0),
352 sort(Y0, Y).
353
356build_node_layers(Ns, X, L):- build_link_node_layers(Ns, X, _, _, L, []).
357
360build_link_node_layers([], X, X, [], N, N):-!.
361build_link_node_layers(Ns, X, Y, [L|Ls], [Ns|N], N0):-
362 layer_links(Ns, X, X0, L),
363 domain_of_links(L, Ns0),
364 subtract(Ns0, Ns, Ns1),
365 build_link_node_layers(Ns1, X0, Y, Ls, N, N0).
366
369number_layers_frontier([], [], C, C, _).
370number_layers_frontier([L|Ls], [L0|Ls0], C, C0, S):-
371 number_links(L, L0, C, C1, S),
372 number_layers_frontier(Ls, Ls0, C1, C0, S).
373
376number_node_layers([], C, C, _).
377number_node_layers([Ns|R], C, C0, S):-
378 number_node_list(Ns, C, C1, S),
379 number_node_layers(R, C1, C0, S).
380
383number_node_list([], C, C, _):-!.
384number_node_list([N|Ns], C, C0, S):- number_node(N, C, C1, S),
385 number_node_list(Ns, C1, C0, S).
386
390layer_links(_, [], [], []):-!.
391layer_links(Ns, [A-B|Links], Links0, [A-B|Layer]):-
392 ( member(C, Ns),
393 (A = C; B = C)
394 ),
395 !,
396 layer_links(Ns, Links, Links0, Layer).
397layer_links(Ns, [L|Links], [L|Links0], Layer):-
398 layer_links(Ns, Links, Links0, Layer).
399
401number_node(N, C, C0, S):- number_node(N, _, C, C0, S).
402
405number_node(N, I, C, C0, S):- memo(number_node(N)-I, S),
406 ( nonvar(I) -> C0 = C
407 ; C0 is C+1,
408 I = C0
409 ).
410
412number_links([], [], _).
413number_links([A-B|L], [A0-B0|L0], S):-
414 memo(number_node(A)-A0, S),
415 memo(number_node(B)-B0, S),
416 number_links(L, L0, S).
417
420number_links([], [], C, C, _).
421number_links([A-B|L], [A0-B0|L0], C, C0, S):-
422 number_node(A, A0, C, C1, S),
423 number_node(B, B0, C1, C2, S),
424 number_links(L, L0, C2, C0, S).
425
426 429
433
437mate_compare(C, A-B, X-Y):- compare(C0, B, Y),
438 ( C0=(=) -> compare(C, A, X)
439 ; C = C0
440 ).
441
444arrow_symbol( _ -> _).
446arrow_symbol(A, A0):- functor(A, A0, 2).
447arrow_symbol(A, A0, A1, A2):- functor(A, A0, 2),
448 arg(1, A, A1),
449 arg(2, A, A2).
450
456composable_pairs_with_check(ST, X, Y, A, B):-
457 min_max_check(ST, X, Y),
458 composable_pairs(X, Y, A, B),
459 !.
460
461
467min_max_check(_ - Max, _ - Max, U - V):-!,
468 ( V = Max -> U = Max; true ).
469min_max_check(Min - _, Min - _, U - V):-!,
470 ( V = Min -> U = Min; true ).
471min_max_check(_, _, _).
472
474composable_pairs(A-B, A-C, B, C).
475composable_pairs(A-B, C-A, B, C).
476composable_pairs(B-A, A-C, B, C).
477composable_pairs(B-A, C-A, B, C).
479normal_pair(A-B, U-V):-!, ( B @< A -> U=B, V=A; U=A, V=B ).
480normal_pair(A->B, U->V):- ( B @< A -> U=B, V=A; U=A, V=B ).
481
484rect_nodes(rect(W, H), Ns):-
485 findall(p(I,J),
486 ( between(0, W, I),
487 between(0, H, J)
488 ),
489 Ns).
490
493rect_links(rect(W, H), Links):-
494 findall( p(I,J)-p(K,L),
495 ( between(0, W, I),
496 between(0, H, J),
497 ( L=J, K is I + 1, K =< W
498 ; K=I, L is J + 1, L =< H
499 )
500 ),
501 Links).
502
503 507add_links(_, [], X, X, _).
508add_links(Ctrl, [FR|Ls], X, Y, S):- FR=fr(U, F),
509 memberchk(end(End), Ctrl),
510 add_link(F-End, U, X, X1, S),
511 zdd_join(X, X1, X2, S),
512 ( ( Ls = [] ; Ls = [fr(_, G)|_], G \== F ) -> 513 prune_by_classify_link(F, End, X2, X3, S)
514 ; X3 = X2 515 ),
516 ( memberchk(gc(link), Ctrl) ->
518 zdd_slim(X3, X4, S),
519 garbage_collect
520 ; X4 = X3
521 ),
522 add_links(Ctrl, Ls, X4, Y, S).
523
525add_link(_, _, X, 0, _):- X<2, !.
526add_link(FE, U, X, Y, S):- FE = F-E,
527 cofact(X, t(A, L, R), S),
528 add_link(FE, U, L, L0, S),
529 classify_link(F, E, A, Case),
530 ( ( Case = 0; Case = arrow ) -> R0 = 0 531 ; Case = ignore -> add_link(FE, U, R, R0, S) 532 ; U = Ul-Ur,
533 ( A = U -> R0 = 0 534 ; composable_pairs(U, A, U0, V0) ->
535 subst_node(FE, [Ul->Ur], U0, V0, R, R0, S)
536 ; add_link(FE, U, R, R1, S),
537 zdd_insert(A, R1, R0, S)
538 )
539 ),
540 zdd_join(L0, R0, Y, S).
542xadd_links([], X, X, _).
543xadd_links([A-Ns|Ls], X, Y, S):-
544 cofact(X0, t(A-A, 0, X), S),
545 memo(frontier_vec-Id, S),
546 obj_id((M, V), Id, S),
547 M = (_, E),
548 xadd_links(M, A, Ns, X0, X1, S),
549 zdd_join(X0, X1, X2, S),
550 prune_by_frontier(A, X2, X3, E, V, S),
551 xadd_links(Ls, X3, Y, S).
552
553xadd_links(_, _, [], X, X, _).
554xadd_links(M, A, [B|Ns], X, Y, S):-
555 xadd_link(M, A-B, X, X0, S),
556 zdd_join(X, X0, X1, S),
557 xadd_links(M, A, Ns, X1, Y, S).
558
559strong_less_than(_-A, B-_):- A<B.
561xadd_link(_, _, X, 0, _):- X<2, !.
562xadd_link(M, U, X, Y, S):-
563 cofact(X, t(A, L, R), S),
564 arrow_symbol(A, F),
565 ( F = (->) -> Y = 0
566 ; xadd_link(M, U, L, L0, S),
567 ( U = A -> R0 = 0 568 ; strong_less_than(U, A) -> R0 = 0 569 ; ( composable_pairs_with_check(M, U, A, V, W) ->
570 U = (Ul-Ur),
571 xsubst_node(M, [Ul->Ur], V, W, R, R0, S)
572 ; xadd_link(M, U, R, R1, S),
573 zdd_insert(A, R1, R0, S)
574 )
575 ),
576 zdd_join(L0, R0, Y, S)
577 ).
579xsubst_node(_, _, _, _, X, 0, _):- X < 2, !.
580xsubst_node(M, Es, A, P, X, Y, S):- cofact(X, t(U, L, R), S), 581 arrow_symbol(U, F, Lu, Ru),
582 ( F = (->) -> Y = 0
583 ; xsubst_node(M, Es, A, P, L, L0, S),
584 ( Ru = A ->
585 normal_pair(Lu-P, V),
586 zdd_ord_insert([V|Es], R, R0, S)
587 ; Lu = A ->
588 normal_pair(P-Ru, V),
589 zdd_ord_insert([V|Es], R, R0, S)
590 ; xsubst_node(M, Es, A, P, R, R1, S),
591 zdd_insert(U, R1, R0, S)
592 ),
593 zdd_join(L0, R0, Y, S)
594 ).
595
597subst_node(_, _, _, _, X, 0, _):- X < 2, !.
598subst_node(FE, Es, A, P, X, Y, S):- FE = Fr-End, 599 cofact(X, t(U, L, R), S),
600 subst_node(FE, Es, A, P, L, L0, S),
601 classify_link(Fr, End, U, Case),
602 arrow_symbol(U, _, Lu, Ru),
603 ( ( Case = 0 ; Case = arrow ) -> R0 = 0
604 ; Case = ignore ->
605 subst_node(FE, Es, A, P, R, R0, S)
606 ; ( Ru = A ->
607 normal_pair(Lu-P, V),
608 zdd_ord_insert([V|Es], R, R0, S)
609 ; Lu = A ->
610 normal_pair(P-Ru, V),
611 zdd_ord_insert([V|Es], R, R0, S)
612 ; subst_node(FE, Es, A, P, R, R1, S),
613 zdd_insert(U, R1, R0, S)
614 )
615 ),
616 zdd_join(L0, R0, Y, S).
617
618 621
623
624prune_final(P, P, _, 1, _):-!.
625prune_final(_, _, X, 0, _):- X<2, !.
626prune_final(P, Q, X, Y, S):- cofact(X, t(A, L, R), S),
627 prune_final(P, Q, L, L0, S),
628 ( A = (_->_) -> R0 = 0
629 ; A = P-Q -> prune_final0(R, R0, S)
630 ; A = V-V -> prune_final(P, Q, R, R0, S)
631 ; R0 = 0
632 ),
633 zdd_join(L0, R0, Y, S).
635prune_final0(X, X, _):- X<2, !.
636prune_final0(X, Y, S):- cofact(X, t(A, L, R), S),
637 prune_final0(L, L0, S),
638 ( A = (_->_) -> zdd_insert(A, R, R0, S)
639 ; A = (B-B) -> prune_final0(R, R0, S)
640 ; R0 = 0
641 ),
642 zdd_join(L0, R0, Y, S).
643
644 647
649
652on_frontier(P, F):- P @=< F.
654classify_link(_, _, _->_, arrow):-!.
655classify_link(F, End, A-B, Case):- on_frontier(A, F), !,
656 ( on_frontier(B, F) -> Case = keep
657 ; B = End -> Case = keep
658 ; Case = 0
659 ).
660classify_link(_, E, E-E, 0):-!.
661classify_link(_, _, A-A, ignore):-!.
662classify_link(_, _, _, 0).
663
665prune_by_classify_link(_, _, X, X, _):- X<2, !.
666prune_by_classify_link(F, End, X, Y, S):- cofact(X, t(A, L, R), S),
667 prune_by_classify_link(F, End, L, L0, S),
668 classify_link(F, End, A, Case),
669 ( Case = arrow -> zdd_insert(A, R, R0, S)
670 ; Case = keep -> 671 prune_by_classify_link(F, End, R, R1, S),
672 zdd_insert(A, R1, R0, S)
673 ; Case = ignore -> 674 prune_by_classify_link(F, End, R, R0, S)
675 ; R0 = 0 676 ),
677 zdd_join(L0, R0, Y, S).
678
680prune_by_frontier(I, X, Y, S):- memo(frontier-(E, V), S),
681 prune_by_frontier(X, Y, I, E, V, S).
690prune_by_frontier(X, X, _I, _E, _V, _):- X<2, !.
691prune_by_frontier(X, X, E, E, _, _):-!.
692prune_by_frontier(X, X, 1, _, _, _):-!.
693prune_by_frontier(X, Y, I, E, V, S):- cofact(X, t(A, L, R), S),
694 ( A = (_->_) -> Y = X
695 ; A = (J-K),
696 prune_by_frontier(L, L0, I, E, V, S),
697 ( K = J ->
698 ( off_frontier(J, I, V) ->
699 ( J = E -> R0 = 0
700 ; prune_by_frontier(R, R0, I, E, V, S)
701 )
702 ; prune_by_frontier(R, R1, I, E, V, S),
703 zdd_insert(A, R1, R0, S)
704 )
705 ; K = E ->
706 ( off_frontier(J, I, V) -> R0 = 0
707 ; prune_by_frontier(R, R1, I, E, V, S),
708 zdd_insert(A, R1, R0, S)
709 )
710 ; on_frontier(J, I, V), on_frontier(K, I, V) ->
711 prune_by_frontier(R, R1, I, E, V, S),
712 zdd_insert(A, R1, R0, S)
713 ; R0 = 0
714 ),
715 zdd_join(L0, R0, Y, S)
716 ).
717
718 721
723
724pmate(X, S):- setup_call_cleanup(
725 open_state(M),
726 ( drop_path(X, Y, S, M),
727 psa(Y, M)
728 ),
729 close_state(M)).
730
732drop_path(X, Y, _, _):- X<2, !, Y=X.
733drop_path(X, Y, S, M):- cofact(X, t(A, L, R), S),
734 drop_path(L, L0, S, M),
735 ( A=(_-_) ->
736 drop_path(R, R1, S, M),
737 zdd_insert(A, R1, R0, M)
738 ; R0 = 1
739 ),
740 zdd_join(L0, R0, Y, M)