1:- module(pac_meta, [act_tree/3, times/3, 2 pac_product/4, scons/3, 3 paths_of_term/2]). 4 5:- set_prolog_flag(optimise, true). 6term_expansion --> pac:expand_pac. 7:- use_module(pac(op)). 8paths_of_term(T, X):- 9 fold_paths_of_term( pred([A, [Ra|B], B]:- reverse(A, Ra)), 10 T, X, []). 11 12% ?- repeat(10, writeln(hello)). 13% ?- repeat(10000, pred([X,Y]:- Y is X+1), 0, X). 14% ?- maplist(pred([], [[X|_], X], true), [[1,2],[a,b]], V). 15% ?- map([]^[[X|_], X]:-true, [[1,2],[a,b]], V). 16% ?- map([[X|_], X], [[1,2],[a,b]], V). 17% ?- map([[X|_], X]\\true, [[1,2],[a,b]], V). 18% ?- map((=,=),[1,2],X). 19 20% ?- meta:phrase_list(pred([], [[X|_], X]), [[1,2],[a,b]], V). 21% ?- phrase_list([]^[[X|_], X]:-true, [[1,2],[a,b]], V). 22% ?- phrase_list([[X|_], X], [[1,2],[a,b]], V). 23% ?- phrase_list([[X|_], X]\\true, [[1,2],[a,b]], V). 24% ?- phrase_list((=,=),[1,2],X). 25 26% ?- meta:map([[X|_], X], [[1,2],[a,b]], V). 27% ?- meta:map([]^[[X|_], X]:-true, [[1,2],[a,b]], V). 28% ?- meta:map([[X|_], X]:- true, [[1,2],[a,b]], V). 29% ?- meta:map((=,=),[1,2],X). 30 31:- meta_predicate map(, , ). 32map(P) --> maplist(phrase(P)). 33% 34:- meta_predicate phrase_list(, , ). 35phrase_list(P) --> maplist(phrase(P)). 36 37% Fold a tree (t(a, [t1, t2,...,tn]), where Default t = (,) . 38% similar folding lists. 39% ?- act_tree( pred([[X,Y],X=Y]), [(a, [1,2]), (b, [3,4])], R). 40% R = [4=b,3=b,2=a,1=a]. 41% ?- act_tree( pred([[A,B], (A, B)]), [(a, [1,2]), (b, [3,4])], X). 42% X = [ (1, a), (2, a), (3, b), (4, b)] 43% ?- act_tree(pred([[Y,Z], [(Y,Z)|A], A]), [(a, [1,2]), (b, [3,4])], X,[]). 44% X = [ (4, b), (3, b), (2, a), (1, a)]. 45% ?- r_act_tree(pred([A, [A|B], B]), [(a, [1,2]), (b, [3,4])], X, []). 46% X = [[4,b],[3,b],[2,a],[1,a]]. 47:- meta_predicate l_act_tree(,,,), 48 r_act_tree(,,,), 49 act_tree(,,), 50 act_tree(,,,). 51%% 52act_tree(F, T, X, Y):- act_tree(l, F, T, X, Y). 53 54r_act_tree(F, T, X, Y):- act_tree(r, F, T, X, Y).
57l_act_tree(F, T, X, Y):- act_tree(l, F, T, X, Y). 58 59act_tree(F, Tree, V):- 60 l_act_tree(pred(F, [A, [B|X],X]:- call(F, A, B)), 61 Tree, V, []). 62% 63act_tree(M, F, T, X, Y):- act_tree(M, ',', F, [], T, X, Y). 64 65act_tree(M, I, F, T, X, Y):- act_tree(M, I, F, [], T, X, Y). 66 67act_tree(_,_, _, _, [], X, X):-!. 68act_tree(l,S, F, As, [T0|T], X, Y):- !, 69 act_tree(l, S, F, As, T0, X, X0), 70 act_tree(l, S, F, As, T, X0, Y). 71act_tree(r, S, F, As, [T0|T], X, Y):- !, 72 act_tree(r, S, F, As, T0, X0, Y), 73 act_tree(r, S, F, As, T, X, X0). 74act_tree(M, S, F, As, T, X, Y):- compound(T), functor(T, S, 2), !, 75 arg(1, T, A), 76 arg(2, T, B), 77 act_tree(M, S, F, [A|As], B, X, Y). 78act_tree(_, _, F, As, T, X, Y):- call(F, [T|As], X, Y). 79 80% ?- times(2, [a,b], B). 81% B = [[a,a],[a,b],[b,a],[b,b]] 82times(N, A, B):- times(N, A, [[]], B). 83 84times(0, _, A, A). 85times(N, A, B, C):- N>0, scons(A, B, D), 86 N0 is N-1, 87 times(N0, A, D, C). 88 89% ?- meta:scons([1,2,3],[[a,b],[c,d]], R). 90%@ R = [[1, a, b], [1, c, d], [2, a, b], [2, c, d], [3, a, b], [3, c, d]]. 91scons(X, Y, Z):- 92 foldl(pred(Y, [A, U, V] 93 :- foldl(pred([Y,A], [B, [[A|B]|R], R]), 94 Y, U, V)), 95 X, Z, []). 96 97:- meta_predicate pac_product(,,,). 98% ?-meta:pac_product(pred([X, Y, [X|Y]]), [1,2,3],[[a,b],[c,d]], R). 99% ?-meta:pac_product(pred([X, Y, [X, X|Y]]), [1,2,3],[[a,b],[c,d]], R). 100% ?-meta:pac_product(pred([X, Y, X-Y]), [1,2,3],[a,b,c,d], R). 101 102pac_product(F, X, Y, Z):- 103 foldl(pred([F, Y], [A, U, V]:- 104 foldl(pred([F, A], [B, [C|R], R]:-call(F, A, B, C)), 105 Y, U, V)), 106 X, Z, []). 107% 108map_cons(X,Y,Z):- maplist(pred([A,B,[A|B]]), X, Y, Z). 109 110% ?- pac_meta:cartesian([1,2,3],[a,b,c], Z). 111cartesian(X, Y, Z):- pac_product(pred([A,B,[A-B]]), X, Y, Z). 112 113%;; (setq module-query "qcompile(util(meta2)), module(meta2).") 114% ?- time(repeat(1000, integral(0, 1, 0.1, pred([X, 1]), R))). 115% ?- pac_meta:integral(0, 1, 0.1, pred([X, 1]), 0, R). 116% ?- qcompile(util(meta2)), module(meta2). 117% ?- meta2:integral(0, 1, 0.1, pred([X, 1]), 0, R). 118% R = 1.0999999999999999. 119% ?- integral(0, 1, 0.1, pred([X, X]), 0, R). 120% R = 0.55. 121% ?- integral(0, 1, 0.001, pred([X, X^2]), 0, R). 122% R = 0.33283350000000095. 123% ?- integral(-10, 10, 0.001, pred([X, X^2]), 0, R). 124% R = 666.7666700000648. 125% ?- integral(-10, 10, 0.001, pred([X, X^2]), 0, R). 126% R = 666.7666700000648. 127% ?- integral(-10, 10, 0.001, pred([X, X^2]), 0, R). 128% ?- time(integral(-20, 20, 0.0001, pred([X, exp(-(X^2)/2)/sqrt(2*pi)]), 0, R)). 129% ?- time(slow_integral(-100, 100, 0.0001, pred([X, exp(-(X^2)/2)/sqrt(2*pi)]), 0, R)). 130%@ % 6,000,002 inferences, 1.460 CPU in 1.471 seconds (99% CPU, 4110176 Lips) 131%@ R = 0.9999999999999251. 132 133% 134% :- meta_predicate integral(?,?,?,2,?). 135integral(L, R, S, F, V):- 136 ( F = [X, Exp] 137 -> assert('INTFUN'(X, V):- V is Exp), 138 F0 = 'INTFUN' 139 ; F0 = F 140 ), 141 integral(L, R, S, F0, 0, V). 142 143:- meta_predicate integral(,,,,,). 144integral(L, R, _S, _F, V, V):- R =< L, !. 145integral(L, R, S, F, V, V0):- call(F, L, H), 146 M is S*H+V, 147 L0 is L+S, 148 integral(L0, R, S, F, M, V0). 149 150% For comparison benchmark test only 151slow_integral(L, R, _S, _F, V, V):- R =< L, !. 152slow_integral(L, R, S, F, V, V0):- call(F, L, H), 153 M is S*H+V, 154 L0 is L+S, 155 slow_integral(L0, R, S, F, M, V0). 156 157% poly_sort(X, Y):- 158% predsort([A, _*M, _*M0]:- 159% ( gblex:compare_mono(A0, M, M0), 160% (A0 == (>) -> A = (<); A=(>)) 161% ), 162% X, X0), 163% poly_merge(X0, Y). 164 165% a la Mathematica's Table function. 166% ?- table(reverse, [[1,2],[a,b]], X). 167% ?- table(=, [[1,2],[a,b]], X). 168% X = [[[1,a],[1,b]],[[2,a],[2,b]]]. 169% ?- table([As,T]:- T=..[f|As], [[1,2],[a,b]], X). 170% ?- table([As,T]:- sumlist(As, T), [[1,2],[3,4],[5,6,7],[8,9,10]], X). 171 172:- meta_predicate table(,,), table(,,,). 173 174table(F, Is, M):- table(Is, F, [], M). 175 176table([], F, As, V):-!, call(F, As, V). 177table([I|Is], F, As, M):- maplist(table(Is, F, As), I, M). 178 179table(Is, F, As, A, M):- table(Is, F, [A|As], M). 180 181 /*************************************** 182 * file_under/2 by process macro * 183 ***************************************/ 184 185ignore_special((.)). 186ignore_special((..)). 187ignore_special('.git'). 188ignore_special('.DS_Store'). 189ignore_special(worktrees). 190 191% 192leaf_node(node(_, X)):- ignore_special(X), !. 193leaf_node(node(W, N)):- working_directory(_, W), 194 exists_file(N). 195 196% ?- children(node('/path/to/directory/', directory), L). 197% ?- pac_meta:children(node('/Users/', cantor), L). 198 199children(X, []):- leaf_node(X), !. 200children(node((.), N), Ss):- !, working_directory(W, W), 201 children(node(W, N), Ss). 202children(node(W, (.)), Ss):- !, 203 children(node(W, W), Ss). 204children(node(W, N), Ss):- 205 working_directory(_,W), 206 exists_directory(N), 207 directory_files(N, Fs), 208 working_directory(W,N), 209 working_directory(W0, W0), 210 children(Fs, W0, Ss). 211 212% 213children([], _, []). 214children([X|Y], W, Z):- (X=(.);X=(..)), !, 215 children(Y, W, Z). 216children([X|Y], W, [node(W, X)|Z]):- 217 children(Y, W, Z). 218 219% ?- pac_meta:file_under('/Users/cantor/public_html/', Y). 220file_under(W, Node):- 221 do(process(parent, leaf_node), node(W, W), Node). 222% 223parent(node((.), N), A):- !, 224 working_directory(_, .), 225 working_directory(W, W), 226 parent(node(W, N), A). 227parent(node(W, (.)), A):- !, 228 parent(node(W, W), A). 229parent(Node, A):- children(Node, Ss), 230 member(A, Ss). 231 232 /**************************************** 233 * dict_of_files by process macro. * 234 ****************************************/
sample call:
?- pac_meta:dict_of_files((.), D), length(D, N).
244dict_of_files(W, S):- 245 do(process(push_children, pred([[]])), [d(W, W, S)], _). 246 247% 248dict_of_files(S):- working_directory(W,W), 249 dict_of_files(W, S). 250 251% 252push_children([d(W, N, S)|X], Z):- 253 working_directory(_, W), 254 child_directories(N, S, Z, X). 255 256% 257child_directories(N, S, A, B):- exists_directory(N), 258 directory_files(N, S0), 259 working_directory(W, N), 260 working_directory(W0, W0), 261 residue_for_next(S0, W0, S, A, B), 262 working_directory(_, W). 263 264% 265residue_for_next([], _, [], A, A). 266residue_for_next([I|X], W, Y, A, B):- ignore_special(I),!, 267 residue_for_next(X, W, Y, A, B). 268residue_for_next([I|X], W, [I|Y], A, B):- exists_file(I), !, 269 residue_for_next(X, W, Y, A, B). 270residue_for_next([I|X], W, [I-U|Y], [d(W,I,U)|A], B):- 271 exists_directory(I), 272 !, 273 residue_for_next(X, W, Y, A, B). 274residue_for_next([I|X], W, [I|Y], A, B):- residue_for_next(X, W, Y, A, B)