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

sample call: ?- pac_meta:dict_of_files((.), D), length(D, N).

  258dict_of_files(W, S):-
  259	do(process(push_children, pred([[]])), [d(W, W, S)], _).
  260
  261%
  262dict_of_files(S):-  working_directory(W,W),
  263			dict_of_files(W, S).
  264
  265%
  266push_children([d(W, N, S)|X], Z):-
  267	working_directory(_, W),
  268	child_directories(N, S, Z, X).
  269
  270%
  271child_directories(N, S, A, B):- exists_directory(N),
  272			 directory_files(N, S0),
  273			 working_directory(W, N),
  274			 working_directory(W0, W0),
  275			 residue_for_next(S0, W0, S, A, B),
  276			 working_directory(_, W).
  277
  278%
  279residue_for_next([], _, [], A, A).
  280residue_for_next([I|X], W, Y, A, B):- ignore_special(I),!,
  281		residue_for_next(X, W, Y, A, B).
  282residue_for_next([I|X], W, [I|Y], A, B):- exists_file(I), !,
  283		residue_for_next(X, W, Y, A, B).
  284residue_for_next([I|X], W, [I-U|Y], [d(W,I,U)|A], B):-
  285		exists_directory(I),
  286		!,
  287		residue_for_next(X, W, Y, A, B).
  288residue_for_next([I|X], W, [I|Y], A, B):- residue_for_next(X, W, Y, A, B)