1:- module(frtvec, [udg_path_count/3, 2 udg_path_count/4, 3 rect_path_count/4, 4 rect_links/2, 5 prepare_udg/1, 6 udg_path/2, 7 hamilton_filter/3 8 ]). 9 10:- use_module(zdd('zdd-array')). 11:- use_module(zdd(zdd)). 12:- use_module(pac(op)). 13% 14udg_path(End, PathSet):- get_key(coa, Coa), 15 set_key(ends, End), 16 udg_mate_prune(Coa, 1, PathSet). 17 18 19% 1x1 1, 20% 2x2 2, 21% 3x3 12, 22% 4x4 184, 23% 5x5 8512, 24% 6x6 1262816, 25% 7x7 575780564, 26% 8x8 789360053252, 27% 9x9 3266598486981642, 28% 10x10 41044208702632496804, 29% 11x11 1568758030464750013214100, 30% 12x12 182413291514248049241470885236, 31% 13x13 64528039343270018963357185158482118, 32% ----------------------------------------------------- 33% 14x14 69450664761521361664274701548907358996488 34 35 /****************************** 36 * counting path in UDG * 37 ******************************/ 38 39% ?- trace. 40% ?- zdd, b_getval(zdd_obj, V), write(V). 41% ?- udg_path_count(a*d, [a-b, b-c, c-d], C). % fail. 42% ?- udg_path_count(a-x, [a-b, b-c, c-d], C). % fail. 43% ?- udg_path_count(a-b, [a-b], C, X), psa(X). 44% ?- udg_path_count(a-b, [a-b], C). 45% ?- udg_path_count(a-d, [a-b, b-c, c-d], C, X), psa(X). 46% ?- udg_path_count(a-c, [a-b, b-c, a-d, d-c], C, X), psa(X). 47 48% ?- spy(add_links). 49% ?- spy(add_link). 50% ?- spy(bdd_cons). 51 52% ?- trace. 53 54% ?- zdd, zdd_array:snow_state, bdd_cons(I, a, 1). 55 56% ?- listing(open_state). 57% ?- N = 11, findall(I-J, ( between(1, N, I), between(1, N, J), I < J), Ls), 58% time(zdd udg_path_count(1-N, Ls, C)). 59%@ % 1,835,060,694 inferences, 233.677 CPU in 238.492 seconds (98% CPU, 7852993 Lips) 60%@ N = 11, 61%@ Ls = [1-2, 1-3, 1-4, 1-5, 1-6, 1-7, 1-8, 1-9, ... - ...|...], 62%@ C = 986410. 63 64% [2024/01/04] Is global variable efficient ? 65% ?- N = 11, findall(I-J, ( between(1, N, I), between(1, N, J), I < J), Ls), 66% time(zdd udg_path_count(1-N, Ls, C)). 67%@ % 1,775,162,524 inferences, 211.846 CPU in 216.653 seconds (98% CPU, 8379506 Lips) 68%@ N = 11, 69%@ Ls = [1-2, 1-3, 1-4, 1-5, 1-6, 1-7, 1-8, 1-9, ... - ...|...], 70%@ C = 986410. 71% 72udg_path_count(Ends, Links, C):- udg_path_count(Ends, Links, C, _). 73 74% 75udg_path_count(Ends, Links, C, X):- 76 prepare_udg(Ends, Links), 77 !, 78 get_key(coa, Coa), 79 udg_mate_prune(Coa, 1, X), 80 card(X, C). 81% 82udg_mate_prune(Ls, X, Y):- 83 add_links(Ls, X, Y0), 84 get_key(ends, Ends), 85 prune_final(Ends, Y0, Y). 86 87 88% ?- zdd. 89% ?- time((rect_path_count(p(0,0)-p(1,1), rect(1,1), C, _))). 90%@ % 12,717 inferences, 0.004 CPU in 0.005 seconds (81% CPU, 2909403 Lips) 91%@ C = 2. 92% ?- time((rect_path_count(p(0,0)-p(2,2), rect(2,2), C, _))). 93% ?- time((rect_path_count(p(3,3)-p(4,4), rect(6,6), C, _))). 94% ?- time((rect_path_count(p(0,0)-p(6,6), rect(6,6), C, _))). 95% ?- time(rect_path_count(rect(1,0), C)). 96% ?- time(rect_path_count(rect(1,1), C)). 97% ?- time(rect_path_count(rect(2,1), C)). 98% ?- time(rect_path_count(rect(1,3), C)). 99% ?- time(rect_path_count(rect(3,1), C)). 100% ?- time(rect_path_count(rect(4,1), C)). 101% ?- time(rect_path_count(rect(5,1), C)). 102% ?- time(rect_path_count(rect(2,2), C)). 103% ?- udg_path_count(a-i, [a-b, a-d, b-e, b-c, d-e, d-g, e-f, c-h, 104% f-i, g-h, h-i], C, X), psa(X). 105% ?- time(rect_path_count(rect(3,3), C)). 106%@ % 834,404 inferences, 0.194 CPU in 0.210 seconds (92% CPU, 4309960 Lips) 107%@ C = 184. 108% ?- time(rect_path_count(rect(4,4), C, X)). 109 110%@ % 1,701,221 inferences, 0.222 CPU in 0.227 seconds (98% CPU, 7668754 Lips) 111%@ C = X, X = 0. 112 113%@ % 4,842,285 inferences, 1.122 CPU in 1.216 seconds (92% CPU, 4317363 Lips) 114%@ C = 8512, 115% ?- profile(time(rect_path_count(rect(5,5), C))). 116%@ % 25,972,781 inferences, 5.039 CPU in 5.315 seconds (95% CPU, 5154627 Lips) 117%@ C = 1262816. 118%@ % 26,340,419 inferences, 7.817 CPU in 8.553 seconds (91% CPU, 3369540 Lips) 119%@ C = 1262816. 120% ?- time(rect_path_count(rect(6,6), C)). 121%@ % 6,267 inferences, 0.002 CPU in 0.002 seconds (88% CPU, 3217146 Lips) 122%@ % 136,478,793 inferences, 15.511 CPU in 15.820 seconds (98% CPU, 8798955 Lips) 123%@ C = 575780564. 124%@ % 136,936,011 inferences, 32.371 CPU in 34.926 seconds (93% CPU, 4230164 Lips) 125%@ C = 575780564. 126 127% ?- time(rect_path_count(rect(7,7), C)). 128% [2025/04/10] imac 129%@ % 658,747,813 inferences, 68.189 CPU in 80.085 seconds (85% CPU, 9660603 Lips) 130%@ C = 789360053252. 131 132%@ % 680,528,412 inferences, 92.151 CPU in 93.624 seconds (98% CPU, 7384928 Lips) 133%@ C = 789360053252. 134%@ % 680,528,412 inferences, 90.989 CPU in 92.526 seconds (98% CPU, 7479215 Lips) 135%@ C = 789360053252. 136 137%@ % 680,528,412 inferences, 89.185 CPU in 90.726 seconds (98% CPU, 7630550 Lips) 138%@ C = 789360053252. 139%@ % 680,528,412 inferences, 88.039 CPU in 89.498 seconds (98% CPU, 7729883 Lips) 140%@ C = 789360053252. 141%@ % 682,767,705 inferences, 87.976 CPU in 89.509 seconds (98% CPU, 7760869 Lips) 142%@ % 682,798,544 inferences, 174.830 CPU in 188.160 seconds (93% CPU, 3905498 Lips) 143%@ C = 789360053252. 144%@ % 665,850,114 inferences, 171.081 CPU in 183.716 seconds (93% CPU, 3892021 Lips) 145%@ C = 789360053252. 146 147% ?- time(rect_path_count(rect(8,8), C)). 148%@ done 149%@ % 2,635,770,519 inferences, 710.614 CPU in 771.786 seconds (92% CPU, 3709143 Lips) 150%@ C = 3266598486981642. 151%@ % 2,619,632,064 inferences, 294.280 CPU in 345.288 seconds (85% CPU, 8901837 Lips) 152%@ C = 3266598486981642. 153 154% ?- time(rect_path_count(rect(9,9), C)). 155%@ done 156%@ % 12,641,494,607 inferences, 3374.703 CPU in 3619.570 seconds (93% CPU, 3745958 Lips) 157%@ C = 41044208702632496804. 158 159% ?- time(rect_path_count(rect(9,9), C)). 160%@ % 12,584,483,532 inferences, 1528.588 CPU in 1775.464 seconds (86% CPU, 8232752 Lips) 161%@ C = 41044208702632496804. 162 163% ?- time(rect_path_count(rect(10,10), C)). 164%@ % 59,632,082,303 inferences, 7437.316 CPU in 8649.928 seconds (86% CPU, 8017958 Lips) 165%@ C = 1568758030464750013214100. 166 167% ?- time(rect_path_count(rect(11,11), C)). 168%@ % 277,342,057,605 inferences, 35622.993 CPU in 41124.669 seconds (87% CPU, 7785479 Lips) 169%@ C = 182413291514248049241470885236. 170 171% [2024/09/03] 13 x 13 grid graph passed also by the simple frontier vector. 172% ?- time(rect_path_count(rect(12,12), C)). 173% 1,273,378,663,129 inferences, 176187.026 CPU in 244597.424 seconds (72% CPU, 7227426 Lips) 174% C = 64528039343270018963357185158482118. 175 176% ?- C = 182413291514248049241470885236, 177% C1 = 64528039343270018963357185158482118, 178% D is C1//C. 179 180% ?- forall(between(1, 13, I), (X is 2^(I*I), writeln(I=> X))). 181 182rect_path_count(R, C):- rect_path_count(R, C, _). 183% 184rect_path_count(R, C, X):- 185 R = rect(W, H), 186 rect_path_count( p(0,0) - p(W,H), R, C, X). 187% 188rect_path_count(Pair, R, C, X):- rect_links(R, Links), 189 udg_path_count(Pair, Links, C, X). 190 191% ?- rect_links(rect(1,1), Links). 192rect_links(rect(W, H), Links):- 193 findall( p(I,J) - p(K,L), 194 ( between(0, W, I), 195 between(0, H, J), 196 ( L = J, K is I + 1, K =< W 197 ; K = I, L is J + 1, L =< H 198 ) 199 ), 200 Links). 201 202 /******************************** 203 * Prepare UDG in coalgebra * 204 ********************************/ 205 206% ?- udg_path_count(a-k, 207% [a-b, a-d, b-c, 208% d-c, d-e, e-f, 209% c-f, b-g, g-h, 210% h-k, c-h, f-k], C). 211 212% ?- prepare_udg([a-b, b-c, c-d]), memo(node_id(a)-Id, memo_nodes), 213% get_key(dom, X). 214 215% ?- prepare_udg(a-d, [a-b, b-c, c-d]), 216% get_key(ends, ST), 217% get_key(frontier, F), 218% get_key(dom, Dom), 219% get_key(coa, U). 220%@ ST = 1-4, 221%@ F = #(..), 222%@ Dom = [1, 2, 3, 4], 223%@ U = [4-[], 3-[4], 2-[3], 1-[2]]. 224 225prepare_udg(ST, Links):- 226 prepare_udg(Links), 227 prepare_ends(ST, Pair), 228 set_key(ends, Pair). 229% 230prepare_udg(Links):- 231 open_memo(memo_nodes), 232 prepare_udg(Links, Succs, D, Vec), 233 length(D, N), 234 completing_succs(Succs, Succs0, N), 235 set_key(coa, Succs0), 236 findall(A-B, ( member(A-S, Succs0), member(B, S)), Unord_links), 237 sort(Unord_links, Unord_links0), 238 set_key(links, Unord_links0), 239 set_key(dom, D), 240 set_key(frontier, Vec). 241% 242prepare_udg(Links, Succs, D, Vec):- 243 intern_links(Links, Links0), 244 normal_mate_list(Links0, Links1), 245 sort(Links1, Links2), 246 domain_of_links(Links2, D), % D is sorted. 247 rel_to_fun(Links2, Succs), 248 Vec=..[#|D], 249 setup_frontier(Links1, Vec). 250% 251prepare_ends(A-B, R):-!, R = A0-B0, 252 memo(node_id(A)-I, memo_nodes), 253 memo(node_id(B)-J, memo_nodes), 254 ( nonvar(I), nonvar(J) -> sort([I, J], [A0, B0]) 255 ; format("No link at ~w or ~w\n", [A,B]), 256 fail 257 ). 258prepare_ends(E, _):- 259 format("Unexpected form of end nodes ~w \n", [E]), 260 fail. 261 262% ?-completing_succs([], Y, 2). 263% ?-completing_succs([2-[a]], Y, 3). 264completing_succs(X, X, 0):-!. 265completing_succs([I-A|Ls], [I-A|Ms], I):-!, J is I - 1, 266 completing_succs(Ls, Ms, J). 267completing_succs(Ls, [I-[]|Ms], I):- J is I - 1, 268 completing_succs(Ls, Ms, J). 269 270% ?- normal_mate_list([1-2], X). 271% ?- normal_mate_list([2-1, 1-2], X). 272normal_mate_list([], []). 273normal_mate_list([P|R], [P0|R0]):- P = I-J, 274 ( J @< I -> P0 = J - I 275 ; P0 = P 276 ), 277 normal_mate_list(R, R0).
dom(R)) if P = { y | R(x,y)}
e.g. R=[a-b, a-c, b-d, b-e] => F=[a-[b,c], b-[d,e]]285% ?- rel_to_fun([], R). 286% ?- rel_to_fun([a-b, a-c, b-d, b-e], R). 287rel_to_fun(L, R):- sort(L, L0), rel_to_fun(L0, [], R). 288% 289rel_to_fun([], X, X). 290rel_to_fun([A-B|L], [A-U|V], R):-!, 291 rel_to_fun(L, [A-[B|U]|V], R). 292rel_to_fun([A-B|L], U, R):-!, 293 rel_to_fun(L, [A-[B]|U], R). 294 295% ?- domain_of_links([a-b, b-c, a-c], Y). 296domain_of_links(X, Y):- 297 findall(A , ( member(L, X), 298 ( L = (A - _) 299 ; L = (_ - A) 300 ) 301 ), 302 Y0), 303 sort(Y0, Y). 304 305% ?- open_memo(memo_nodes), node_id(a, 0, C). 306node_id(N, C, C0):- node_id(N, _, C, C0). 307 308% ?- open_memo(memo_nodes), 309% numlist(1, 10000, Ns), 310% foldl(pred(( [I, C, C0]:- node_id(st(I), K, C, C0))), Ns, 0, R). 311node_id(N, I, C, C0):- memo(node_id(N)-I, memo_nodes), 312 ( nonvar(I) -> C0 = C 313 ; C0 is C+1, 314 I = C0 315 ). 316 317% ?- open_memo(memo_nodes), intern_links([a-b, b-a], R). 318intern_links(L, L0):- intern_links(L, L0, 0, _). 319% 320intern_links([], [], C, C). 321intern_links([A-B|L], [I-J|M], C, D):- 322 node_id(A, I, C, C0), 323 node_id(B, J, C0, C1), 324 intern_links(L, M, C1, D). 325 326 /****************** 327 * frontier * 328 ******************/
335% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), off_frontier(1, 3, X). %false 336% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), off_frontier(3, 2, X). %true 337 338off_frontier(I, J, F):- arg(I, F, K), J @< K.
345% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X), on_frontier(1, 3, X). 346on_frontier(I, J, F):- arg(I, F, K), K @=< J. 347 348 349% ?- X=f(1,2,3), setup_frontier([1-2,2-3], X). 350setup_frontier([], _). 351setup_frontier([I-J|L], F):- 352 update_frontier(I, J, F), 353 !, 354 setup_frontier(L, F). 355 356% ?- X=f(1,2), update_frontier(1,2, X). 357% ?- X=f(1,2,3), update_frontier(2, 3, X), update_frontier(1, 2, X). 358update_frontier(I, J, V):- 359 arg(J, V, A), 360 ( I < A -> setarg(J, V, I) 361 ; true 362 ). 363 364 /******************* 365 * Helpers * 366 *******************/ 367 368% ?- arrow_symbol(_->_, F). 369% ?- arrow_symbol(a->b, F, X, Y). 370arrow_symbol( _ -> _). 371% 372arrow_symbol(A, A0):- functor(A, A0, 2). 373arrow_symbol(A, A0, A1, A2):- functor(A, A0, 2), 374 arg(1, A, A1), 375 arg(2, A, A2). 376 377% 378normal_pair(A-B, B-A):- B < A, !. 379normal_pair(A->B, B->A):- B < A, !. 380normal_pair(X, X). 381% 382ends_frontier(efr(E, Fr)):- 383 get_key(ends, E), 384 get_key(frontier, Fr). 385 386 /************************ 387 * core predicates * 388 ************************/ 389 390add_links([], X, X):-!. 391add_links([A-Ns|Ls], X, Y):- 392 ends_frontier(EF), 393 prune_by_frontier(EF, A, X, X0), 394 bdd_cons(X1, A-A, X0), 395 add_links(A, Ns, X1, X2), 396 slim_gc(X2, X3), 397 add_links(Ls, X3, Y). 398% 399add_links(_, [], X, X):-!. 400add_links(A, [B|Ns], X, Y):- 401 add_link(A-B, X, X0), 402 zdd_join(X, X0, X1), 403 add_links(A, Ns, X1, Y). 404% 405add_link(_, X, 0):- X<2, !. 406add_link(U, X, Y):- % memo useless here. 407 cofact(X, t(A, L, R)), 408 add_link(U, L, L0), 409 U = (U1 - U2), 410 ( A = (_->_) -> R0 = 0 411 ; U = A -> R0 = 0 % cycle found 412 ; A = (A1 - A2), 413 ( A1 = U1 -> 414 subst_node(U1 -> U2, U2, A2, R, R0) 415 ; R0 = 0 416 ) 417 ), 418 zdd_join(L0, R0, Y). 419 420% 421subst_node(_, _, _, X, 0):- X<2, !. 422subst_node(E, A, P, X, Y):- % memo useless here 423 cofact(X, t(U, L, R)), % replace A with P 424 subst_node(E, A, P, L, L0), 425 arrow_symbol(U, F, Lu, Ru), 426 ( F = (->) -> R0 = 0 427 ; Ru = A -> 428 normal_pair(Lu - P, V), 429 zdd_ord_insert([V, E], R, R0) 430 ; Lu = A -> 431 normal_pair(P - Ru, V), 432 zdd_ord_insert([V, E], R, R0) 433 ; A @< Lu -> R0 = 0 434 ; subst_node(E, A, P, R, R1), 435 zdd_insert(U, R1, R0) 436 ), 437 zdd_join(L0, R0, Y). 438 439 /*************************** 440 * Prune by frontier * 441 ***************************/ 442 443% prune_by_frontier(EF, I, X, Y):- 444% prune_by_frontier(X, Y, I, Pair, V).
451prune_by_frontier(_, _, X, X):- X < 2, !. 452prune_by_frontier(EF, I, X, Y):- cofact(X, t(A, L, R)), 453 EF = efr(Pair, V), 454 ( A = (_->_) -> Y = X 455 ; prune_by_frontier(EF, I, L, L0), 456 classify_pair(A, I, Pair, V, C), 457 ( C = arrow -> zdd_insert(A, R, R0) 458 ; C = keep -> 459 prune_by_frontier(EF, I, R, R1), 460 zdd_insert(A, R1, R0) 461 ; C = ignore -> 462 prune_by_frontier(EF, I, R, R0) 463 ; R0 = 0 464 ), 465 zdd_join(L0, R0, Y) 466 ). 467 468% helper. 469on_pair(I, J-K):- K=I; J=I. 470 471% works! [2024/01/11] 472classify_pair((_->_), _, _, _, arrow):-!. 473classify_pair(J-J, I, _, V, C):-!, 474 ( on_frontier(J, I, V) -> C = keep 475 ; C = ignore 476 ). 477classify_pair(J-K, I, Pair, V, C):- % J\==K. 478 ( on_frontier(J, I, V) -> 479 ( on_frontier(K, I, V) -> C = keep 480 ; on_pair(K, Pair) -> C = keep 481 ; C = 0 482 ) 483 ; on_frontier(K, I, V) -> 484 ( on_pair(J, Pair) -> C = keep 485 ; C = 0 486 ) 487 ; C = 0 488 ). 489 490% ?- zdd. 491% ?- X<< {[1-6,2-2,5-5,(1->3),(3->4),(4->6)]}, 492% prune_final(1-6, X, Y), psa(Y). 493 494% ?- X<< +[*[a-b, a->b]], prune_final(a-b, X, Y), psa(X), psa(Y). 495prune_final(_, X, 0):- X < 2, !. 496prune_final(Pair, X, Y):- cofact(X, t(A, L, R)), 497 prune_final(Pair, L, L0), 498 ( A = (_->_) -> R0 = 0, writeln('unexpected ***arrow***') 499 ; A = Pair -> prune_final0(R, R0) 500 ; A = V-V -> prune_final(Pair, R, R0) 501 ; R0 = 0 502 ), 503 zdd_join(L0, R0, Y). 504% 505prune_final0(X, X):- X < 2, !. 506prune_final0(X, Y):- cofact(X, t(A, L, R)), 507 ( A = (_->_) -> Y = X 508 ; prune_final0(L, L0), 509 ( A = (V - V) -> prune_final0(R, R0) 510 ; R0 = 0 511 ) 512 ), 513 zdd_join(L0, R0, Y). 514 515% 516hamilton_prune_final(P, P, _, 1):-!. 517hamilton_prune_final(_, _, X, 0):- X < 2, !. 518hamilton_prune_final(P, Q, X, Y):- cofact(X, t(A, L, R)), 519 hamilton_prune_final(P, Q, L, L0), 520 ( A = (_->_) -> Y = 0 521 ; A = P - Q -> hamilton_prune_final0(R, R0) 522 ; R0 = 0 523 ), 524 zdd_join(L0, R0, Y). 525% 526hamilton_prune_final0(X, X):- X < 2, !. 527hamilton_prune_final0(X, Y):- cofact(X, t(A, L, _R)), 528 ( A = (_->_) -> Y = X 529 ; hamilton_prune_final0(L, L0), 530 R0 = 0, 531 zdd_join(L0, R0, Y) 532 ). 533 534% ?- X<<{[1->2, 1->3, 2->3]}, 535% hamilton_filter([1,2,3], X, Y), card(Y, C). 536% ?- X<<{[1->2]}, 537% hamilton_filter([1,2], X, Y), card(Y, C). 538% ?- X<<{[1->2, 1->3, 2->4, 3->4]}, 539% hamilton_filter([1,2,3,4], X, Y), card(Y, C). 540 541hamilton_filter([I, J], X, Y):-!, hamilton_filter_special(I, J, X, Y). 542hamilton_filter(D, X, Y):- hamilton_filter_list(D, X, Y). 543% 544hamilton_filter_special(_, _, X, 0):- X<2, !. 545hamilton_filter_special(I, J, X, Y):- cofact(X, t(A, L, R)), 546 hamilton_filter_special(I, J, L, L0), 547 ( A=(I->J) -> 548 ( R = 1 -> R0 = 1 549 ; R0 = 0 550 ) 551 ; R0 = 0 552 ), 553 cofact(Y, t(A, L0, R0)). 554% 555hamilton_filter_list([], X, X). 556hamilton_filter_list([J|Js], X, Y):- 557 hamilton_filter(2, J, X, X0), 558 hamilton_filter_list(Js, X0, Y). 559% 560hamilton_filter(0, I, X, Y):-!, without_node(I, X, Y). 561hamilton_filter(_, _, X, 0):- X < 2, !. 562hamilton_filter(K, I, X, Y):- memo(hamilton(K, I, X)-Y), 563 ( nonvar(Y) -> true %, write(.) 564 ; cofact(X, t(A, L, R)), 565 hamilton_filter(K, I, L, L0), 566 ( A=(E-_), I < E -> R0 = 0 567 ; ( on_arrow(I, A) -> 568 K0 is K-1, 569 hamilton_filter(K0, I, R, R0) 570 ; hamilton_filter(K, I, R, R0) 571 ) 572 ), 573 cofact(Y, t(A, L0, R0)) 574 ). 575% 576without_node(_, X, X):- X<2, !. 577without_node(I, X, Y):- memo(without_node(I,X)-Y), 578 ( nonvar(Y) -> true %, write(+) 579 ; cofact(X, t(A, L, R)), 580 without_node(I, L, L0), 581 ( on_arrow(I, A) -> R0 = 0 582 ; without_node(I, R, R0) 583 ), 584 cofact(Y, t(A, L0, R0)) 585 ). 586% 587on_arrow(X, Y->Z):- (X=Y; X=Z)