1:- module(zdd_array, [ 2 open_state/0, open_state/1, close_state/0, initial_basic_state/2 3 , open_basic_state/1, open_basic_state/2 4 , open_array/1, open_array/2, open_array_gvar/1, open_array_gvar/2 5 , open_array_hash/2 6 , open_vector/2 7 , open_hash/1, open_hash/2, open_hash_gvar/1, open_hash_gvar/2 8 , close_array/1 9 , memo/1, memo/2, memoq/1, init_memo_stack/0 10 , hash_memoadd/2, hash_memochk/2 11 , zdd_dict_memo/1, zdd_dict_memo/2 12 , get_assoc/2 13 , memo_index/2, key_assert/2, key_exists/2 14 , numbering/2, set_counter/1, set_counter/2 15 , biject/3 16 , push_memo/0, pop_memo/0 17 , use_memo/1, reset_memo_call/1 18 , open_memo/1, open_memo/2, close_memo/1 19 , open_hash/2, close_hash/1, hash/3 20 , open_zdd_dict/0, open_zdd_dict/1, open_zdd_dict/2 21 , zdd_dict/3, zdd_dict/4 22 , set_memo/1, update_memo/2, dump_memo/0, dump_memo/1, dump_hash/1 23 , insert_memo/2 24 , unify_args/3, xarg/3, xarg/2, xsetarg/3, array_index/3 25 , add_child/2, add_child/3 26 , pred_memo_update/2 27 , cofact/2, cofact/3, index/3, term/2, show_array/0, show_state/0 28 , iterm/2, iterm/3, index/3, index_elem/3, iterm_hash/2 29 , iterm_hash/3 30 , slim_gc/2, pred_slim_gc/3, slim_iterm/3, slim_iterms/3]). 31 32 33:- use_module(zdd(zdd)). 34 35%-------------------- 36default_asize(2). 37default_hsize(2). 38%-------------------- 39 40atom_only(A, A0) :- ( compound(A) -> A0 = '.' ; A0 = A). 41% 42user:portray(X) :- compound(X), !, 43 ( functor(X, s, N), N > 7 -> write('s(..)') 44 ; functor(X, ctrl, N), N > 2 -> write('<ctrl>') 45 ; compound_name_arguments(X, F, _), 46 ( F = (#) -> write(#(..)) 47 ; F = call_continuation -> write(cont(..)) 48 ) 49 ). 50user:portray(X) :- var(X), get_attr(X, zsat, _), !. 51 52% ?- zdd. 53% ?- reset_memo_call(true). 54 55% 56hash_key_count(H, C):- arg(1, H, C). 57% 58hash_key_count_set(H, C):- setarg(1, H, C). 59% 60hash_bucket_count(H, C):- arg(2, H, C). 61% 62hash_bucket_count_set(H, C):- setarg(2, H, C). 63% 64hash_vector(H, V):- arg(3, H, V). 65% 66hash_vector_set(H, V):- setarg(3, H, V). 67 68% 69check_rehash(H):- H = #(C, B, V), 70 functor(V, _, N), 71 ( C > B + N + N -> rehash(H) 72 ; true 73 ). 74 75% check_rehash(H):- H = #(C, B, V), 76% functor(V, _, N), 77% ( C > B + 1.7 * N -> rehash(H) 78% ; true 79% ). 80 81% ?- open_hash(2, H), hash(a, H, V), writeln(V), writeln(H), 82% V = 2, hash(a, H, U). 83 84hash(X, H, Val):- 85 term_bucket_index(X, H, U, I), 86 ( memberchk(X-V, U) -> Val = V % X exists. 87 ; hash_vector(H, Vec), 88 setarg(I, Vec, [X-Val | U]), 89 hash_key_count(H, C), 90 C0 is C + 1, 91 hash_key_count_set(H, C0), 92 ( U =[] -> % Count up for new bucket. 93 arg(2, H, B), 94 B0 is B + 1, 95 setarg(2, H, B0) 96 ; true % fresh bucket for key X. 97 ), 98 check_rehash(H) 99 ).
104% ?- open_hash(4, H), write(H), \+ hash_memochk(a, H), 105% hash_memoadd(a, H), write(H). 106%@ 107%@ #(0,0,#([],[],[],[]))#(1,1,#([],[],[a],[])) 108%@ H = #(..). 109 110hash_memochk(X-V, H):-!, 111 term_bucket_index(X, H, U, _), 112 memberchk(X-V, U). 113hash_memochk(X, H):- 114 term_bucket_index(X, H, U, _), 115 memberchk(X, U).
122hash_memoadd(X, H):- 123 ( X = Key-_ -> true 124 ; Key = X 125 ), 126 term_bucket_index(Key, H, U, I), 127 hash_vector(H, Vec), 128 setarg(I, Vec, [X | U]), 129 hash_key_count(H, C), 130 C0 is C + 1, 131 hash_key_count_set(H, C0), 132 ( U =[] -> % Count up for new bucket. 133 arg(2, H, B), 134 B0 is B + 1, 135 setarg(2, H, B0) 136 ; true % fresh bucket for key X. 137 ), 138 check_rehash(H). 139 140% ?- open_state. 141% ?- open_state, push_memo, b_getval(zdd_ash, H), pop_memo. 142% ?- open_state, close_state, show_state. 143 144% Assuming a totally ordered set of atoms, a state is a collection of 145% families of (finite) sets of (finite) these atoms. In a state, 146% each family of sets (FOS) is given a unique nonnegative integer. 147% 0 is reserved for the empty family {}, and 1 for {{}} = {0} = 1. 148% If a FOS F is neither 0 nor 1, there must 149% be the maximum atom A among those are an element of a set of F. 150% A is called the maximum atom of F. The maximum atom is defined neither for 151% 0 nor 1. Throuhout successive updating process of a state, once the unique 152% id of a FOS is created, this id is kept for the FOS henceforth. 153% `cofact/3` is the main bidirectional interface predicate on states to get 154% a FOS id (fact), and to store new FOS (cofact) in a state. 155% A nonnegative integer k is used for the FOS whose id is k, and vice versa.
bdd_cons(I, a, 1), psa(I), bdd_cons(J, b, I), psa(J).162% ?- open_state, cofact(X, t(a,0,1)), show_state. 163open_state :- open_state([]). 164 165% 166open_state(Args) :- open_array_hash(Args, #(Array, Hash)), 167 setarg(1, Array, 1), 168 arg(2, Array, Vec), 169 setarg(1, Vec, 0), 170 ( memberchk(zdd_compare(Compare), Args); default_compare(Compare)), 171 ( memberchk(extra(Extra), Args); Extra = [varnum-0, varzip-[]] ), !, 172 nb_linkval(zdd_compare, Compare), 173% nb_linkval(zdd_node, Array), % always work ??. 174 nb_setval(zdd_node, Array), % always work ??. 175 nb_setval(zdd_hash, Hash), 176 nb_linkval(zdd_extra, Extra), 177 init_memo_stack. 178 179% ?- open_array_hash(X), write(X). 180open_array_hash(ArrayHash):- open_array_hash([], ArrayHash). 181 182% ?- open_array_hash([hsize(8), asize(8)], X), write(X). 183% ?- open_array_hash([hsize(2^8), asize(2^8)], X), write(X). 184open_array_hash(Args, #(Array, Hash)):- 185 ( memberchk(hsize(HsizeExp), Args) -> true 186 ; default_hsize(HsizeExp) 187 ), 188 ( memberchk(asize(AsizeExp), Args) -> true 189 ; default_asize(AsizeExp) 190 ), 191 Hsize is HsizeExp, 192 Asize is AsizeExp, 193 open_array(Asize, Array), 194 open_hash(Hsize, Hash). 195 196% ?- set_counter(abc, 3), b_getval(abc, N). 197set_counter(CounterName, N):- nb_setval(CounterName, N). 198% 199set_counter(CounterName):- set_counter(CounterName, 0). 200 201% Numbering objects: 202% ?- set_counter(abc),numbering(abc(1), X). 203% ?- set_counter(abc),numlist(1, 10, Ns), reverse(Ns, NsR), 204% maplist(pred(([X]:- numbering(abc(X),Y), writeln(X-Y))), NsR). 205% ?- set_counter(abc), numlist(1, 10, Ns), append(Ns, Ns, WNs), 206% maplist(pred(([X]:- numbering(abc(X),Y), writeln(X-Y))), WNs). 207% ?- N=100000, time((set_counter(abc), numlist(1, N, Ns), append(Ns, Ns, WNs), 208% maplist(pred([X]:- numbering(abc(X),Y)), WNs))). 209 210% 211numbering(X, I):- memo(X-I), 212 ( nonvar(I) -> true 213 ; functor(X, CounterName, _), 214 b_getval(CounterName, I0), 215 I is I0 + 1, 216 b_setval(CounterName, I) 217 ). 218 219% ?- open_array_hash(A), number_stamp(a, I, A). 220% ?- open_array_hash(A), number_stamp(a, I, A), number_stamp(X, I, A). 221% ?- open_array_hash(A), number_stamp(a, I, A), number_stamp(a, J, A). 222% ?- open_array_hash(A), 223% number_stamp(a1, I1, A), 224% number_stamp(a2, I2, A), 225% number_stamp(a3, I3, A), 226% number_stamp(a4, I4, A), 227% number_stamp(a5, I5, A), 228% number_stamp(a6, I6, A), 229% number_stamp(a7, I7, A), 230% number_stamp(a8, I8, A), 231% number_stamp(a9, I9, A), 232% write(A). 233number_stamp(X, I, #(A,H)):- 234 ( nonvar(I) -> 235 arg(2, A, V), 236 arg(I, V, X) 237 ; hash(X, H, I), 238 ( nonvar(I) -> 239 arg(2, A, V), 240 arg(I, V, X) 241 ; index(I, A, X) 242 ) 243 ). 244 245 246 /****************** 247 * zdd_dict * 248 ******************/ 249 250% ?- open_zdd_dict([], g), b_getval(g, S), write(S). 251open_zdd_dict(Args, G) :- open_zdd_dict_args(Args, Dict), nb_linkval(G, Dict). 252% ?- open_zdd_dict(g), b_getval(g, S), write(S). 253open_zdd_dict(G) :- open_zdd_dict([hsize(32), asize(32)], G). 254% ?- open_zdd_dict, b_getval(zdd_dict, S), write(S). 255open_zdd_dict :- open_zdd_dict([hsize(32), asize(32)], zdd_dict). 256 257% ?- open_zdd_dict_args([], R), write(R). 258open_zdd_dict_args(Args, #(#(1, Array),Hash) ) :- 259 ( memberchk(hsize(HsizeExp), Args); HsizeExp = 2 ), !, 260 ( memberchk(asize(VsizeExp), Args); VsizeExp = 2 ), !, 261 Hsize is HsizeExp, 262 Vsize is VsizeExp, 263 functor(Array, #, Vsize), 264 arg(1, Array, 0), % so as open_state is. 265 open_hash(Hsize, Hash). 266 267% ?- open_zdd_dict, zdd_dict_hash(a, b, I), zdd_dict_hash(a, Val, J). 268zdd_dict_hash(Key, Val, I):- zdd_dict_hash(Key, Val, I, zdd_dict). 269% 270zdd_dict_hash(Key, Val, I, G):- b_getval(G, #(Array, Hash)), 271 zdd_dict_hash(Key, Val, I, Array, Hash). 272 273% ?- open_zdd_dict(g), zdd_dict_hash(a, b, I, g), zdd_dict_hash(a, V, J, g). 274zdd_dict_hash(Key, Val, I, Array, Hash):- 275 hash(Key, Hash, I), % check Key-I entry in H (hash) 276 ( nonvar(I) -> % Key already exists. 277 arg(2, Array, Vec), 278 arg(I, Vec, _-Val) 279 ; index(I, Array, Key-Val) % Key is new. 280 ). 281 282% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val). 283% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a. 284% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a, zdd_dict(I, X, R). 285% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a, 286% zdd_dict(J, t(b, I, I), Val2), zdd_dict(I, _, Val2). 287% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a, 288% zdd_dict(J, t(b, I, I), Val2), Val2=c, 289% zdd_dict(J, X, Val3), 290% zdd_dict(K, X, Val4). 291% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), hello), zdd_dict(I, T, Val). 292 293% A generaiization of the cofact using zdd as keys of dict. 294zdd_dict(I, Key, Val):- zdd_dict(I, Key, Val, zdd_dict). 295% 296zdd_dict(I, Key, Val, Gvar):- b_getval(Gvar, #(Array, Hash)), 297 zdd_dict(I, Key, Val, Array, Hash). 298% 299zdd_dict(I, Key, Val, Array, _):- nonvar(I), !, 300 I > 1, 301 arg(2, Array, Vec), 302 arg(I, Vec, Key0-Val), 303 ( Key0 = t(A,R) -> Key=t(A, 0, R) 304 ; Key = Key0 305 ). 306zdd_dict(I, t(A, L, R), Val, Array, Hash):- 307 ( R = 0 -> % Minato's rule 308 L > 1, 309 I = L, 310 arg(2, Array, Vec), 311 arg(L, Vec, _-Val) 312 ; L = 0 -> 313 zdd_dict_hash(t(A, R), Val, I, Array, Hash) 314 ; zdd_dict_hash(t(A, L, R), Val, I, Array, Hash) 315 ). 316 317% ?- trace. 318% ?- open_basic_state(G), iterm(I, a, G). 319% ?- open_basic_state(G), iterm(I, a). 320% ?- open_basic_state(G), iterm_hash(a, I, G), trace, iterm(X, I, G). 321% ?- open_basic_state(G), b_getval(G, V), writeln(V). 322% ?- open_basic_state(G), cofact(I, t(a, 0, 1), G), psa(I, G), psa(I, G). 323% ?- open_basic_state(G), cofact(X, t(a,0,1), G), cofact(Y, t(b, X, X),G), psa(Y, G). 324% 325% ?- open_basic_state(G), cofact(X, t(a,0,1), G), cofact(Y, t(b, X, X), G), 326% cofact(Y, T, G), psa(Y, G). 327 328% ?- zdd. 329% ?- X<<pow([a,b,c]), Y<<pow([b,c,d]), Z<<(X-Y), psa(Z), slim_gc(Z, U), psa(U). 330% ?- open_basic_state(xxx), b_getval(xxx, Core), write(Core). 331%@ #(#(1,#(0,_7144)),#(0,0,#([],[]))) 332%@ Core = #(..). 333 334open_basic_state(G) :- open_basic_state(G, []). 335% 336open_basic_state(G, Args) :- 337 ( var(G) -> gensym(core, G) 338 ; atom(G) 339 ), 340 initial_basic_state(Args, BasicState), 341 nb_linkval(G, BasicState). 342 343% ?- initial_basic_state([], X). 344initial_basic_state(Args, #(#(1,Vector),Hash)):- 345 ( memberchk(hsize(HsizeExp), Args); HsizeExp = 2 ), !, 346 ( memberchk(asize(VsizeExp), Args); VsizeExp = 2 ), !, 347 Hsize is HsizeExp, 348 Vsize is VsizeExp, 349 functor(Vector, #, Vsize), 350 open_hash(Hsize, Hash), 351 arg(1, Vector, 0). 352% 353open_array(Array):- default_asize(N), 354 open_array(N, Array). 355% 356open_array(N, #(0, Vec)):- N > 0, functor(Vec, #, N). 357 358% ?- open_array_gvar(abc), b_getval(abc, X), writeln(X). 359open_array_gvar(Gvar):- default_asize(N), 360 open_array_gvar(Gvar, N). 361% 362open_array_gvar(Gvar, N):- N > 0, atom(Gvar), 363 functor(Vec, #, N), 364 nb_linkval(Gvar, #(0, Vec)). 365% 366close_array(Gvar):- nb_getval(Gvar, A), 367 close_vector(A), 368 nb_setval(Gvar, []). 369 370show_state:- 371 b_getval(zdd_hash, Hash), writeln(zdd_hash = Hash), 372 b_getval(zdd_node, Vector), writeln(zdd_node = Vector), 373 b_getval(zdd_compare, Compare), writeln(zdd_compare = Compare), 374 b_getval(zdd_extra, Extra), writeln(zdd_extra = Extra), 375 b_getval(zdd_hash, Buckets), writeln(zdd_hash = Buckets). 376 377 /*********************** 378 * State globals * 379 * -------------------- * 380 * zdd_hash * 381 * zdd_node * 382 * zdd_extra * 383 * zdd_compare * 384 ***********************/
memo(a-1), push_memo, memo(a-2), memo(a-A), pop_memo, memo(a-B).
?- push_memo, memo(a-1), memo(a-Y), pop_memo, memo(a-2), memo(a-Z).
?- memo_index(x-I), memo_index(y-J), memo_index(x-K).
?- memo_index(a(1)-V), get_key(a, C).
?- memo_index(a(1)-V), memo_index(a(2)-U), get_key(a, C).
?- memo_index(a(1)-V), memo_index(a(2)-U), memo_index(a(2)-W), get_key(a, C).
?- memo_index(a(1), X), memo_index(b(3), W), memo_index(b(2), Y), memo_index(a(1), Z), memo_index(b(2), U).402memo_index(E-V):- memo(E-V), !, 403 ( nonvar(V) -> true 404 ; functor(E, CounterName, _), 405 memo_index(CounterName, V) 406 ). 407% 408memo_index(Name, V0):- 409 b_getval(zdd_extra, Extra), 410 ( select(Name-V, Extra, Extra0) -> 411 V0 is V+1 412 ; Extra0 = Extra, 413 V0 = 1 414 ), 415 nb_linkval(zdd_extra, [Name-V0|Extra0]). 416 417 418% Structure Sharing. 419setarg_state_extra(X, Y):- arg(2, X, Extra), setarg(2, Y, Extra). 420% 421setarg_state_core(X, Y):- arg(1, X, Core), setarg(1, Y, Core). 422% 423default_compare(compare).
show_array(zdd_node).
! show_array(+G) is det.
Print all triples in array bound to G.430% ?- zdd_eval(pow([a,b,c]), _), show_array. 431% ?- open_state, zmod:zdd_eval(family([[a],[b],[c]]), X), show_array. 432% ?- open_state, show_array. 433 434show_array:- show_array(zdd_node). 435% 436show_array(G) :- b_getval(G, Vec), show_vector(Vec). 437 438% ?- open_state, show_state. 439show_vector(#(C, Vec)):- 440 forall(between(2, C, I), 441 ( arg(I, Vec, V), writeln(I=V))).
445close_state:- 446 nb_linkval(zdd_hash, []), 447 nb_linkval(zdd_node, []), 448 nb_linkval(zdd_extra, []), 449 nb_linkval(zdd_compare, []), 450 nb_linkval(zdd_child, []). 451% 452:- meta_predicate use_memo(). 453use_memo(Goal):- setup_call_cleanup( 454 push_memo, 455 call(Goal), 456 pop_memo 457 ). 458 459% 460:- meta_predicate reset_memo_call(). 461reset_memo_call(X):- setup_call_cleanup( 462 reset_memo, 463 call(X), 464 reset_memo 465 ). 466% 467init_memo_stack:- open_hash(64, H), 468 nb_setval(zdd_hash, H), 469 nb_setval(memo_stack, []). 470% 471reset_memo:- open_hash(64, H), 472 nb_setval(zdd_hash, H). 473 474% push/pop memo 475push_memo:- b_getval(zdd_hash, M), 476 b_getval(memo_stack, Ms), 477 b_setval(memo_stack, [M|Ms]), 478 open_hash(64, H), 479 b_setval(zdd_hash, H). 480% 481pop_memo:- b_getval(memo_stack, [M|Ms]), 482 b_setval(zdd_hash, M), 483 b_setval(memo_stack, Ms). 484 485% 486open_memo(Memo_name):- open_memo(Memo_name, 64). 487% 488open_memo(Memo_name, N):- N > 0, 489 ( atom(Memo_name) -> true 490 ; gensym(memo, Memo_name) 491 ), 492 open_hash(N, Hash), 493 nb_linkval(Memo_name, Hash). 494 495% 496close_memo(Memo_name) :- nb_setval(Memo_name, []). 497 498% ?- zdd. 499% ?- memo(a-1). 500% ?- memo(a-1), memoq(a-1). 501% ?- memo(a-1), memoq(a-X). % false 502% ?- memoq(a-X). % false. 503% ?- memo(a-1), memoq(a-X). % false 504% ?- memo(a-1), memo(a-X). 505% ?- X<<pow(numlist(1, 1000)), card(X, C). 506% ?- memo(a-1), memo(a-V), set_memo(a-2), memo(a-U). 507% ?- set_memo(a-1), memo(a-X). 508% ?- open_hash(2, H), hash(a, H, X), X=3, hash(a, H, Y). 509 510% Take time !! 511% ?- open_hash(2, H), time(repeat(10^8, (hash(a, H, X), X=3, hash(a, H, Y)))). 512%@ % 3,100,000,001 inferences, 204.420 CPU in 237.279 seconds (86% CPU, 15164854 Lips) 513%@ H = #(..). 514% ?- open_hash(2, H), hash(a, H, X), hash(a, H, Y), X==Y. 515%! memo(+P) is det. 516% P = X-V, 517% The input pair X-V is unified with with a member of a bucket of the hash 518% table of the state S. Otherwise, create a new entry for X-V. 519 520% ?- zdd. 521memo(X-V):- b_getval(zdd_hash, H), !, hash(X, H, V). 522 523% ?- zdd. 524zdd_dict_memo(X-V):- b_getval(zdd_dict, #(_, H)), !, hash(X, H, V).
531memo(X-V, G):- b_getval(G, H), !, hash(X, H, V). 532 533zdd_dict_memo(X-V, G):- b_getval(G, #(_, H)), !, hash(X, H, V). 534 535% ?- memo(a-Y), memo(a-R). 536% ?- memo(a-Y), memo(a-R). 537% ?- memo(a-1), memo(a-R). 538% ?- set_memo(a-1), memo(a-Y), set_memo(a-V), memo(a-R), V=2. 539 540% set_memo(X-V) is det. 541% Replace old X entry with X-V when X entry exists, 542% otherwise, simply create X-V entry. 543 544set_memo(X-V) :- b_getval(zdd_hash, H), hash_fresh_entry(X, V, _, H). 545% 546set_memo(X-V, G) :- b_getval(G, H), hash_fresh_entry(X, V, _, H). 547 548% ?- memo(a-1), update_memo(a-X, Y), memo(a-U). 549% ?- memo(a-1), update_memo(a-X, Y). 550% ?- memo(a-1). 551% ?- memo(a-1), update_memo(a-X, Y), Y=2, memo(a-U). % fail
559% ?- memo(a-1), update_memo(a-X, Y), X=f(Y). 560update_memo(X-FreshVar, OldVal):- % must_be(var, FreshVar), 561 b_getval(zdd_hash, H), 562 hash_fresh_entry(X, FreshVar, OldVal, H). 563% 564update_memo(X-FreshVar, OldVal, G):- % must_be(var, FreshVar), 565 b_getval(G, H), 566 hash_fresh_entry(X, FreshVar, OldVal, H).
572% ?- insert_memo(abc(5), p(0,0)-p(1,0)), insert_memo(abc(5), p(1,1)-p(0,1)), memo(abc(5)-X), psa(X). 573 574insert_memo(Key, X):- 575 update_memo(Key-New, Old), 576 ( var(Old) -> Old = 1 % empty set 577 ; true 578 ), 579 zdd_insert(X, Old, New).
586:- meta_predicate pred_memo_update(, ). 587pred_memo_update(Pred, K-V):- update_memo(K-L, L0), 588 call(Pred, V, L0, L). 589% 590:- meta_predicate pred_memo_update(, , ). 591pred_memo_update(Pred, K-V, G):- update_memo(K-L, L0, G), 592 call(Pred, V, L0, L).
memo_add_new(a-1), memo(a-X).
?- memo_add_new(a-1), memo_add_new(a-2), memo(a-X).
?- memo_add_new(a-1), memo_add_new(a-2), memo_add_new(a-1), memo(a-X).
601memo_add_new(X):- pred_memo_update(add_new, X).608memo_add_new(X, G):- pred_memo_update(add_new, X, G). 609 610% ?- pred_memo_update(add_new, a-1), memo(a-X). 611add_new(V, [], [V]):-!. 612add_new(V, L0, L0):- memberchk(V, L0), !. 613add_new(V, L0, [V|L0]). 614 615% ?- add_child(suc(a), 1), memo(suc(a)-X). 616% ?- add_child(a, 1), add_child(a, 2), memo(a-X). 617% ?- add_child(a, 1), add_child(a, 2), memochk_stack(a-X). 618% ?- add_child(a, 1), add_child(a, 2), add_child(a, 1), memo(a-X). 619% ?- numlist(1, 100000, Ns), 620% time(( maplist(pred([Child]:- add_child(a, Child)), Ns), memo(a-X))). 621%@ % 2,300,011 inferences, 74.231 CPU in 74.334 seconds (100% CPU, 30985 Lips) 622%@ Ns = [1, 2, 3, 4, 5, 6, 7, 8, 9|...], 623%@ X = [100000, 99999, 99998, 99997, 99996, 99995, 99994, 99993, 99992|...]. 624 625add_child(X, Child) :- pred_memo_update(add_new, X-Child). 626% 627add_child(X, Child, G):- pred_memo_update(add_new, X-Child, G).
memo(apple-_), get_assoc(apple, _). % true
?- memo(orange). % false635get_assoc(X, V):- hash_get_assoc(X, V, zdd_hash). 636 637hash_get_assoc(X, V, G):- b_getval(G, H), 638 term_bucket_index(X, H, B, _), 639 memberchk(X-V, B). 640% 641get_assoc_stack(X):- b_getval(zdd_hash, H), 642 b_getval(memo_stack, Hs), 643 member(H0, [H|Hs]), 644 term_bucket_index(X, H0, B, _), 645 memberchk(X-_, B).
==
stored in the hash table of S.
?- push_memo, memo(a-b), memoq(a-Y). % fail.
?- push_memo, memo(a-b), memoq(a-b). % true651memoq(X-V):- get_assoc(X, U, zdd_hash), U == V. 652% 653memoq(X-V, G):- get_assoc(X, U, G), U == V. 654% ?- open_memo(g), key_assert(a, g), key_exists(a, g). 655% ?- open_memo(g), key_assert(a, g), key_exists(b, g). % false 656key_assert(X, G):- b_getval(G, H), 657 term_bucket_index(X, H, B, I), 658 ( memberchk(X, B) -> true 659 ; hash_vector(H, Vec), 660 setarg(I, Vec, [X|B]) 661 ). 662% 663key_exists(X, G):- b_getval(G, H), 664 term_bucket_index(X, H, B, _), 665 memberchk(X, B).
arg(I, Vec, Elem) is true.674% ?- open_array(A), write(A). 675% ?- open_array(A), index(I, A, a), index(J, A, a). 676% ?- open_array(A), index(I, A, a), index(J, A, a), index(K, A, a). 677 678index(I, A, X):-nonvar(I), !, % A must be an array #(Count, Vector) 679 arg(2, A, V), 680 arg(I, V, X). 681index(I, A, X):- 682 arg(1, A, K), 683 I is K + 1, 684 arg(2, A, Vec), % Vec must be compound. 685 functor(Vec, _, J), 686 ( K < J -> arg(I, Vec, X) 687 ; extend_array_double(A), 688 arg(2, A, Vec0), % Be careful for not Vec. 689 arg(I, Vec0, X) % Was setarg(I, V, X). 690 ), 691 setarg(1, A, I). 692 693% Simplified/special version of iterm, but almost equivalent. 694% 695% ?- open_array_hash(X), biject(X, a, I), biject(X, b, J), write(X). 696% ?- open_array_hash(X), biject(X, a, I), biject(X, a, J). 697% ?- open_array_hash(X), biject(X, a, I), biject(X, A, I). 698 699biject(Bijection, X, I):-nonvar(I), !, 700 arg(1, Bijection, A), 701 arg(2, A, V), 702 arg(I, V, X). 703biject(#(A, H), X, I):- 704 hash(X, H, I), % check X-I entry in H (hash) 705 ( nonvar(I) -> true % X already exists. 706 ; index(I, A, X) % X is new. 707 ). 708 709% Similar to index_elem but for destructive and free vector 710% of the form #(vector). 711% Accessing free array (without current max index used). 712% 713% ?- xarg(1, a(b(1,2,3)), R). 714% ?- I is 2^16, A = #(#(1,2,3)), xarg(I, A, hello), xarg(I, A, R). 715% ?- I is 2^3, A = #(#(1,2,3)), xarg(I, A, hello), xarg(I, A, R), write(A). 716 717xarg(I, A, X):- % I must be integer>0, and A is of the form a(b(....)). 718 arg(1, A, Vec), 719 ( arg(I, Vec, Y) -> X = Y % within range 720 ; extend_args_double(A), 721 xarg(I, A, X) 722 ).
xarg(I, A, _).727% ?- xarg(1, a(b(1,2,3))). 728% ?- I is 2^16, A = #(#(1,2,3)), xarg(I, A). 729% ?- I is 2^3, A = #(#(1,2,3)), xarg(I, A), xarg(I, A, R), write(A). 730xarg(I, A):- xarg(I, A, _).
f(Vec). % default f should #.
Fails If I is greater than the size the Vec.
othewise, setarg(I, Vec, X).737% ?- xsetarg(10, #(#(1,2,3)), 10). 738% ?- A = a(b(1,2,3)), xsetarg(10, A, 10). 739xsetarg(I, A, X):- % I must be integer>0, and A is of the form a(b(....)). 740 arg(1, A, Vec), 741 ( arg(I, Vec, _) -> setarg(I, Vec, X) % within range 742 ; extend_args_double(A), 743 xsetarg(I, A, X) 744 ).
754% ?- open_array(1, A), writeln(A), 755% array_index(I, A, a), writeln(A), 756% array_index(J, A, a), writeln(A). 757% ?- open_array(1, A), writeln(A), 758% array_index(I, A, a), writeln(A), 759% array_index(I, A, a), writeln(A). 760% ?- open_array(1, A), writeln(A), 761% array_index(I, A, a), writeln(A), 762% array_index(J, A, a), writeln(A). 763 764array_index(I, Array, X):- nonvar(I), !, 765 arg(2, Array, Vec), 766 arg(I, Vec, X). 767array_index(I, Array, X):- Array = #(K, Vec), 768 functor(Vec, _, N), 769 ( K < N -> Vec0 = Vec 770 ; extend_array_double(Array), % NOT confuse with extend_args_double ! 771 arg(2, Array, Vec0) 772 ), 773 I is K + 1, 774 setarg(1, Array, I), 775 arg(I, Vec0, X). 776 777% ?- open_array(3, A), 778% array_index(_, A, a), array_index(_, A, b), 779% snap_array(A). 780 781snap_array(#(K,V)):- forall( between(1, K, I), 782 ( arg(I, V, E), 783 writeln(#(I) = E) 784 )). 785 786% ?- open_vector(0, A), extend_args_double(A), writeln(A), 787% extend_args_double(A), writeln(A), 788% extend_args_double(A), writeln(A), 789% extend_args_double(A), writeln(A), 790% close_vector(A), writeln(A). 791 792open_vector(0, #(#)):-!. 793open_vector(N, #(V)):- functor(V, #, N). 794% 795close_vector(A):- setarg(1, A, #). 796 797% ?- open_array(1, A), 798% extend_array_double(A), writeln(A), 799% extend_array_double(A), writeln(A), 800% extend_array_double(A), writeln(A), 801% extend_array_double(A), writeln(A). 802 803extend_array_double(A):- 804 arg(2, A, V), % differ from extend_args_double/1 805 functor(V, F, N), 806 ( N = 0 -> N0 = 2 807 ; N0 is N + N 808 ), 809 functor(U, F, N0), 810 ( N = 0 -> true 811 ; unify_args(1, V, U) 812 ), 813 setarg(2, A, U). 814 815% ?- A= #(f(a)), extend_args_double(A), write(A). 816% ?- A= #(f), extend_args_double(A), write(A). 817% ?- A= #(f(a,b,c,d)), extend_args_double(A), write(A). 818 819extend_args_double(A):- % nonvar(A), 820 arg(1, A, Vec), % differ from extend_array_double/1 821 functor(Vec, F, N), 822 ( N = 0 -> N0 = 2 823 ; N0 is N + N 824 ), 825 functor(VecDouble, F, N0), 826 ( N = 0 -> true 827 ; unify_args(1, Vec, VecDouble) 828 ), 829 setarg(1, A, VecDouble). 830 831% ?- iterate_double_number(0, 1, X). 832% ?- iterate_double_number(1, 2, X). 833% ?- iterate_double_number(1, 100, X). 834 835iterate_double_number(N, I, N):- I =< N, !. 836iterate_double_number(0, I, I):- !. 837iterate_double_number(N, I, M):- N0 is 2*N, 838 iterate_double_number(N0, I, M). 839 840% NEW style for processing arguments. 841% ?- unify_args(1, f(A, B, C), f(U,V, W)). 842unify_args(X, _):- atom(X), !. 843unify_args(X, Y):- unify_args(1, X, Y). 844% 845unify_args(I, X, A):- arg(I, X, U), !, 846 arg(I, A, U), 847 J is I + 1, 848 unify_args(J, X, A). 849unify_args(_, _, _). 850 851% ?- initial_args(1, a(X, Y), 2). 852%@ X = Y, Y = 2. 853initial_args(I, V, C):- setarg(I, V, C), !, 854 J is I+1, 855 initial_args(J, V, C). 856initial_args(_, _, _). 857 858 /*********************************************** 859 * new_array_elem/get_elem/set_elem * 860 ***********************************************/ 861 862% ?- open_hash(2, H), write(H). 863%! open_hash(+N, -H) is det. 864% Create a new hash table with N entries for buckets, and unify with H. 865% ?- open_hash(3, H), hash(a, H, X), write(H). 866open_hash(Hash):- open_hash(8, Hash). 867% 868open_hash(N, #(0,0,H)):- N>0, 869 functor(H, #, N), 870 initial_args(1, H, []). % Buckets are empty at start. 871 872% ?- open_hash_gvar(g), b_getval(g, H), writeln(H). 873open_hash_gvar(G):- open_hash(Hash), nb_linkval(G, Hash). 874% 875open_hash_gvar(G, N):- open_hash(N, Hash), nb_linkval(G, Hash).
879close_hash(H):- hash_vector_set(H, []). % not by nb_setarg, but by setarg.
885% ?- open_hash(2, H),
886% time(repeat(1000, (hash(a, H, X), X=3, hash(a, H, Y)))).
892term_bucket_index(X, H, B, I):-
893 hash_vector(H, Vec),
894 functor(Vec, _, N),
895 term_hash(X, 3, N, I0),
896 I is I0 + 1,
897 arg(I, Vec, B).
902hash_scan(X, H, Val):-
903 term_bucket_index(X, H, U, _),
904 memberchk(X-V, U),
905 Val == V.914hash_fresh_entry(X, FreshVar, OldVal, H):- 915 check_rehash(H), 916 term_bucket_index(X, H, U, I), 917 hash_vector(H, Vec), 918 ( select(X-OldVal, U, U0) -> 919 setarg(I, Vec, [X-FreshVar | U0]) 920 ; setarg(I, Vec, [X-FreshVar | U]) 921 ). 922 923% ?- open_hash(H), check_rehash(H), writeln(H). 924% ?- open_hash(H), check_rehash(H), check_rehash(H), 925% check_rehash(H), writeln(H).
930% ?- zdd. 931% ?- numlist(1,3, Ns), X<<pow(Ns), psa(X). 932% ?- numlist(1,3, Ns), zmod:zdd_eval(pow(Ns), X), card(X, C). 933% ?- nb_setval(zdd_node, #(1, #(0))), 934% new_array_elem(a, A), new_array_elem(b,B), new_array_elem(c, C), 935% b_getval(zdd_node, V), write(V). 936 937 938% ?- trace. 939% ?- X<< pow(numlist(1,2)), new_array_elem(a, I), 940% new_array_elem(b, J), 941% new_array_elem(c, K), 942% show_array, b_getval(zdd_node, V), write(V). 943 944% ?-new_array_elem(a, I), 945% new_array_elem(b, J), 946% new_array_elem(c, K), 947% show_array, b_getval(zdd_node, V), write(V). 948 949 950% ?-new_array_elem(a, I), 951% new_array_elem(b, J), 952% new_array_elem(c, K). 953 954% ?-new_array_elem(a, I), 955% new_array_elem(a, J), 956% new_array_elem(a, K). 957 958% The new elem may not be necessarily unique. 959new_array_elem(X, I):- b_getval(zdd_node, Array), 960 index(I, Array, X). 961 962% ?- open_hash(H), rehash(H), writeln(H), 963% rehash(H), rehash(H), rehash(H), writeln(H).
968rehash(H):-
969 hash_vector(H, Vec),
970 functor(Vec, F, N),
971 N0 is N + N,
972 functor(Vec0, F, N0),
973 initial_args(1, Vec0, []),
974 ( functor(H, _, 2) ->
975 migrate_hash(1, Vec, Vec0), % Here was a bug
976 hash_vector_set(H, Vec0)
977 ; migrate_hash(1, Vec, Vec0, 0, C), % Here was a bug
978 hash_vector_set(H, Vec0),
979 hash_bucket_count_set(H, C)
980 ).984migrate_hash(I, V, V0):- arg(I, V, B), !, 985 migrate_bucket(B, V0), 986 I0 is I + 1, 987 migrate_hash(I0, V, V0). 988migrate_hash(_, _, _). 989% 990migrate_bucket([], _). 991migrate_bucket([Q|U], H):- 992 ( Q = (X-_) -> E = Q 993 ; X = Q, 994 E = Q 995 ), 996 functor(H, _, S), 997 term_hash(X, 3, S, K), 998 K0 is K + 1, 999 arg(K0, H, D), 1000 setarg(K0, H, [E|D]), 1001 migrate_bucket(U, H). 1002% 1003migrate_hash(I, V, V0, C, C0):- arg(I, V, B), !, 1004 migrate_bucket(B, V0, C, C1), 1005 I0 is I + 1, 1006 migrate_hash(I0, V, V0, C1, C0). 1007migrate_hash(_, _, _, C, C). 1008 1009% 1010migrate_bucket([], _, C, C). 1011migrate_bucket([Q|U], H, C, C0):- 1012 ( Q = (X-_) -> E = Q 1013 ; X = Q, 1014 E = Q 1015 ), 1016 functor(H, _, S), 1017 term_hash(X, 3, S, K), 1018 K0 is K + 1, 1019 arg(K0, H, D), 1020 setarg(K0, H, [E|D]), 1021 ( D = [] -> C1 is C + 1 1022 ; C1 = C 1023 ), 1024 migrate_bucket(U, H, C1, C0). 1025 1026 /**************** 1027 * cofact * 1028 ****************/
t(A, L, R)
Bidirectional.
X is unified with the index of a triple C, or
C is unified with the triple t/3 stored at index X of the array.
It is explained in terms of famiy of sets as follows.
If X is given then
Y is a triple t(A, L, R) such that
A is the minimum atom in X w.r.t specified compare predicate,
L = { U in X | not ( A in U ) },
R = { V \ {A} | V in X, A in V }.
If Y is given then
X = union of L and { unionf of U and {A} | U in R }.
Non standard use of cofact/3 is possible keeping the structure sharing, but withoug zero_suppress rule. IMO the rule is only meaningful under family of sets semantics for the empty family {} of sets.
?- X <<{[a,b,d]}, cofact(X, T).
?- X <<{[a]}, show_state, b_getval(zdd_node, Vec), write(Vec).
?- cofact(X, a), cofact(Y, b), cofact(Z, f(X, Y)),
cofact(Z, C), cofact(X, A), cofact(Y, B).
1054% ?- zdd_array:show_state. 1055% ?- zdd. 1056% ?- R << {[r]}, cofact(I, t(a, 0, R)), cofact(I, T). 1057% ?- N = 10, numlist(1, N, Ns), X<<pow(Ns), card(X, C). 1058 1059% ?- cofact(I, c(a, 1)), cofact(J, c(b, I)), 1060% cofact(J, c(X, K)), cofact(K, c(Y, H)). 1061 1062cofact(I, X):- iterm(I, X). 1063 1064cofact(I, X, AH):- iterm(I, X, AH). 1065 1066 /********************* 1067 * list in zdd * 1068 *********************/ 1069 1070% ?- zdd. 1071% ?- zcons(a, b, I). 1072% ?- zcons(1, 1, X). 1073% zcons(X, Y, I):- integer(I), I>1, !, 1074% iterm_get_elem(I, c(X, Y)). 1075% zcons(X, Y, I):- iterm_hash(c(X, Y), I). 1076zcons(X, Y, I):- cofact(I, c(X, Y)). 1077 1078% ?- zcons(a, 1, I), zcons(b, 1, J), zconcat(I, J, K), 1079% zcons(A, X, K), zcons(B, Y, X). 1080zconcat(1, X, X):-!. 1081zconcat(X, Y, Z):- X>1, 1082 zcons(A, R, X), 1083 zconcat(R, Y, U), 1084 zcons(A, U, Z). 1085 1086% ?- zdd. 1087% ?- list_zlist([[a,b],[a,b]], U), list_zlist(L, U). 1088% ?- list_zlist([a,b,c], R), list_zlist(A, R). 1089% ?- list_zlist([[a,b],c], R), list_zlist(A, R). 1090% ?- N=10000, findall(a(I), between(1, N, I), As), 1091% time((list_zlist(As, U), list_zlist(Xs, U), list_zlist(Xs, V))), 1092% As == Xs. 1093% ?- N=10000, findall(a(I), between(1, N, I), As), 1094% time((list_zlist(As, U), list_zlist(Xs, U), list_zlist(Xs, V))), 1095% U==V, As == Xs. 1096 1097% ?- N=5, numlist(1, N, Ns), list_zlist(Ns, Z), list_zlist(H, Z). 1098%@ N = 5, 1099%@ Ns = H, H = [1, 2, 3, 4, 5], 1100%@ Z = 6. 1101 1102list_zlist(X, Y):- nonvar(X), !, list_to_zlist(X, Y). 1103list_zlist(X, Y):- zlist_to_list(Y, X). 1104% 1105list_to_zlist([], 1). 1106list_to_zlist([I|Y], Z):- 1107 ( is_list(I) -> list_to_zlist(I, H) 1108 ; integer(I), I>=0 -> H = @(I) 1109 ; H = I 1110 ), 1111 list_to_zlist(Y, U), 1112 zcons(H, U, Z). 1113 1114% list_to_zlist([X|Y], Z):- list_to_zlist(X, U), 1115% list_to_zlist(Y, V), 1116% zcons(U, V, Z). 1117% list_to_zlist(X, X). 1118% 1119zlist_to_list(1, []):-!. 1120zlist_to_list(X, [U0|V0]):- integer(X), X > 1, !, 1121 zcons(U, V, X), 1122 zlist_to_list(U, U0), 1123 zlist_to_list(V, V0). 1124zlist_to_list(@(X), X):-!. 1125zlist_to_list(X, X). 1126 1127 1128% ?- zdd, show_state, iterm_get_elem(1, X). 1129% ?- open_basic_state(g), b_getval(g, AH), iterm_get_elem(I, a, AH). 1130% ?- open_basic_state(g), b_getval(g, AH), iterm_get_elem(I, a, AH), iterm_get_elem(J, a, AH). 1131 1132% Helpers for cofact/iterm 1133iterm_get_elem(I, X):- b_getval(zdd_node, #(_, Vec)), 1134 arg(I, Vec, X). 1135% 1136iterm_get_elem(I, X, #(_,Vec)):- arg(I, Vec, X). 1137% 1138iterm_hash(X, I):- b_getval(zdd_hash, H), 1139 hash(X, H, I), % check X-I entry in H (hash) 1140 ( nonvar(I) -> true % X already exists. 1141 ; b_getval(zdd_node, A), 1142 index(I, A, X) % X is new. 1143 ). 1144% 1145iterm_hash(X, I, #(A,H)):- 1146 hash(X, H, I), % check X-I entry in H (hash) 1147 ( nonvar(I) -> true % X already exists. 1148 ; index(I, A, X) % X is new. 1149 ).
1160% ?- zdd. 1161% ?- iterm(I, a), iterm(J, a), iterm(J, A). 1162% ?- iterm(X, @(a)), show_array. 1163 1164iterm(I, X):- nonvar(I), !, % X>1 assumed. 1165 b_getval(zdd_node, #(_, Vec)), 1166 arg(I, Vec, X0), 1167 ( X0 = t(A,R) -> X = t(A, 0, R) 1168 ; X = X0 1169 ). 1170iterm(I, t(_, I, 0)):-!. 1171iterm(I, t(A, 0, R)):-!, iterm_hash(t(A, R), I). 1172iterm(I, X):- iterm_hash(X, I).
1183% ?- open_array_hash(AH), iterm(I, a, AH), 1184% iterm(J, a, AH), iterm(J, A, AH). 1185 1186% ?- open_array_hash(AH), iterm(I, a, AH), 1187% iterm(J, a, AH), iterm(J, A, AH). 1188 1189% iterm(I, X, #(#(_,V),_)):- nonvar(I), !, % X>1 assumed. 1190% arg(I, V, X). 1191% iterm(I, t(_, I, 0)):-!. % Minato's rule. (t/3 is reserved.) 1192% iterm(I, X, #(A, H)):- 1193% hash(X, H, I), 1194% index(I, A, X). 1195 1196% ?- open_array_hash(AH), 1197% iterm(I, t(a, 0, 1), AH), 1198% iterm(I, X, AH). 1199 1200iterm(I, X, AH):- nonvar(I),!, % I > 1 assumed. 1201 AH = #(#(_,V),_), 1202 arg(I, V, X0), 1203 ( X0 = t(A, R) -> X = t(A, 0, R) 1204 ; X = X0 1205 ). 1206iterm(I, t(_, I, 0), _):-!. % zero suppress rule. 1207iterm(I, X, #(A, H)):- 1208 ( X = t(B, 0, U) -> X0 = t(B, U) 1209 ; X0 = X 1210 ), 1211 hash(X0, H, I), 1212 index(I, A, X0). 1213 1214 1215% Similar to xarg but for destructive free array 1216% of the form #(count, vector). 1217 1218% ?- open_array(2, A), 1219% index_elem(I, a, A), 1220% index_elem(J, b, A), 1221% index_elem(K, c, A), 1222% writeln(A). 1223 1224index_elem(I, X, #(_, V)):- nonvar(I), !, % X>1 assumed. 1225 arg(I, V, X). 1226index_elem(I, X, A):- % I is unbound 1227 index(I, A, X). 1228 1229% normal_zdd(J, Array, K) det. 1230% 1231% Converter from what is built by index_elem 1232% to normal form zdd. 1233 1234% ?- open_array(10, A), 1235% index_elem(I, t(a, L, R), A), 1236% index_elem(L, 1, A), 1237% index_elem(R, 1, A), 1238% normal_zdd(I, A, J), 1239% card(J, C), 1240% writeln(A). 1241 1242normal_zdd(J, _, J):- J < 2, !. 1243normal_zdd(J, S, K):- index_elem(J, A, S), 1244 ( integer(A) -> normal_zdd(A, S, K) 1245 ; A = t(U, L, R), 1246 normal_zdd(L, S, L0), 1247 normal_zdd(R, S, R0), 1248 cofact(K, t(U, L0, R0)) 1249 ). 1250 1251 /***************************************************** 1252 * bidirectional term to from index converter. * 1253 *****************************************************/ 1254 1255% ?- zdd. 1256% ?- term(I, a), term(J, @(a)), show_array. 1257% ?- term(I, 0), term(J, 1), show_array. 1258% ?- X=..[., a, b], term(I, X), iterm(I, U), write_canonical(U). 1259% ?- X=..[., a, b], term(I, X), term(I, T), write_canonical(T), compound(T). 1260% ?- N = 100, numlist(1, N, Ns), X=..[f|Ns], 1261% term(I, X), term(I, Y), X = Y. 1262 1263term(I, X):- var(I), !, term_to_index(X, I). 1264term(I, X):- iterm(I, Y), iterm_to_term(Y, X). 1265% 1266term_to_index(@(X), I):-!, iterm(I, @(X)). 1267term_to_index(X, I):- atomic(X), !, iterm(I, X). 1268term_to_index(t(A, L, R), I):-!, 1269 term_to_index(L, J), 1270 term_to_index(R, K), 1271 iterm(I, t(A, J, K)). 1272term_to_index(X, I):- functor(X, F, N), 1273 functor(Y, F, N), 1274 term_to_index(1, X, Y), 1275 iterm(I, Y). 1276% 1277term_to_index(K, X, Y):- arg(K, X, A), !, 1278 arg(K, Y, I), 1279 term_to_index(A, I), 1280 K0 is K + 1, 1281 term_to_index(K0, X, Y). 1282term_to_index(_, _, _). 1283 1284% 1285iterm_to_term(@(X), @(X)):-!. 1286iterm_to_term(X, X):- atomic(X), !. 1287iterm_to_term(t(A, J, K), t(A, L, R)):-!, 1288 iterm_to_term(J, L), 1289 iterm_to_term(K, R). 1290iterm_to_term(X, Y):- functor(X, F, N), 1291 functor(Y, F, N), 1292 iterm_to_term(1, X, Y). 1293% 1294iterm_to_term(K, X, Y):- arg(K, X, I), !, 1295 arg(K, Y, T), 1296 iterm(I, U), 1297 iterm_to_term(U, T), 1298 K0 is K + 1, 1299 iterm_to_term(K0, X, Y). 1300iterm_to_term(_, _, _). 1301% 1302print_root:- b_getval(root, X), 1303 print_iterm(X). 1304% 1305print_iterm(X):-use_memo(print_array_elem(X)). 1306% 1307print_array_elem(X):- X < 2, !. 1308print_array_elem(X):- memo(printed(X)-T), 1309 cofact(X, t(A, L, R)), 1310 ( nonvar(T)-> true 1311 ; T = true, 1312 writeln(X = t(A, L, R)), 1313 print_array_elem(L), 1314 print_array_elem(R) 1315 ). 1316 1317 1318 /***************************************** 1319 * copy, slim, ord_copy, pred_copy * 1320 *****************************************/
slim_iterms(X, Y), and call garbage_collect.1325% ?- zdd. 1326% ?- X<<{[a,b]}, slim_gc(X, Y), psa(Y). 1327% ?- X<<{[a,b]}, slim_gc(X, Y, q_atom_slim), psa(Y). 1328 1329slim_gc(X, Y):- slim_iterms(X, Y), !, garbage_collect.
1335% ?- _<<pow([a,b]), X<<pow([c,d,e]), psa(X), slim_gc(X, Y), psa(Y). 1336 1337slim_iterms(X, Y):- 1338 b_getval(zdd_node, #(_,V)), 1339 initial_basic_state([], #(A,H)), 1340 b_setval(zdd_node, A), 1341 b_setval(zdd_hash, H), 1342 !, 1343 reset_memo_call(slim_iterms(X, Y, V)). 1344 1345% ?- V = #(0, t(a, 0, 1)), slim_iterms(2, Y, V), psa(Y). 1346slim_iterms([], [], _):-!. 1347slim_iterms([X|Xs], [Y|Ys], V):-!, 1348 slim_iterms(X, Y, V), 1349 slim_iterms(Xs, Ys, V). 1350slim_iterms(X, Y, V):- 1351 ( integer(X) -> slim_iterm(X, Y, V) 1352 ; Y = X 1353 ). 1354 1355% 1356slim_iterm(X, X, _):- X< 2,!. 1357slim_iterm(X, Y, V):- memo(slim_iterm(X)-Y), 1358 ( nonvar(Y) -> true 1359 ; arg(X, V, T), 1360 ( T = t(A, L, R) -> slim_iterm(L, L0, V) 1361 ; T = t(A, R) -> L0 = 0 1362 ), 1363 slim_iterm(R, R0, V), 1364 cofact(Y, t(A, L0, R0)) 1365 ).
slim_iterms(X, Y, F), and call garbage_collect,
where F is predicate such that call(F, A, B, V).1371% ?- spy(dummy). 1372% ?- zdd. 1373% ?- X<<{[q(2), q(3)]}, psa(2), psa(3). 1374% ?- X<<{[q(2), q(3)]}, pred_slim_gc(X, Y, test_dummy), psa(Y). 1375test_dummy(q(2), J, V):-!, arg(2, V, t(J, _,_)). 1376test_dummy(I, I, _). 1377 1378:- meta_predicate pred_slim_gc(, , ). 1379pred_slim_gc(X, Y, F):- pred_slim_iterms(X, Y, F), !, garbage_collect. 1380% 1381:- meta_predicate pred_slim_iterms(,,). 1382pred_slim_iterms(X, Y, F):- 1383 b_getval(zdd_node, #(_,V)), 1384 initial_basic_state([], #(A,H)), 1385 b_setval(zdd_node, A), 1386 b_setval(zdd_hash, H), 1387 !, 1388 reset_memo_call(pred_slim_iterms(X, Y, F, V)). 1389 1390% ?- V = f(0, t(a, 0, 1)), slim_iterms(2, Y, V), psa(Y). 1391pred_slim_iterms(X, Y, F, V):- integer(X), !, pred_slim_iterm(X, Y, F, V). 1392pred_slim_iterms([], [], _, _):-!. 1393pred_slim_iterms([X|Xs], [Y|Ys], F, V):- 1394 pred_slim_iterms(X, Y, F, V), 1395 pred_slim_iterms(Xs, Ys, F, V). 1396 1397% 1398:-meta_predicate pred_slim_iterm(, , , ). 1399pred_slim_iterm(X, X, _, _):- X< 2,!. 1400pred_slim_iterm(X, Y, F, V):- memo(pred_slim_iterm(X)-Y), 1401 ( nonvar(Y) -> true 1402 ; arg(X, V, t(A, L, R)), 1403 call(F, A, B, V), 1404 pred_slim_iterm(L, L0, F, V), 1405 pred_slim_iterm(R, R0, F, V), 1406 cofact(Y, t(B, L0, R0)) 1407 ). 1408 1409%----- 1410% ?- ltr, N=3, K=100, open_hash(N, H), nb_setval(zdd_hash, H), 1411% numlist(1, K, Ks), X<< dnf(+Ks), dump_memo. 1412% 1413dump_memo:- dump_memo(zdd_hash). % default main memo. 1414% 1415dump_memo(Name):- b_getval(Name, H), dump_hash(H). 1416% 1417dump_hash(#(C,B,V)):-!, functor(V, _, S), 1418 writeln((cont=C, bucket=B, hsize=S)), 1419 forall(between(1, S, K), ( arg(K, V, D), writeln(D)))