/* ------------------------------------------------------------ */ % set (list) operators % edited: 12 Jan 2003. % modified: 8 Feb 2003. % modified: 13-14 Feb 2003. % modified: 16,22-25 Mar 2003. % modified: 5 Apr 2003. tree_formation, analysis_of_list, and subtree. % modified: 7 Apr 2003. asymmetric_difference. % modified: 10 Apr 2003. identified_subtree. % modified: 27 May 2003. a simplified version of nth1. (mess) % modified: 20 Aug 2003. some basic list operations. % modified: 15 Jan 2003. sort by a list of ordering. % modified: 19 Jan 2004. seteq/2. case of generating equivalent set. % modified: 23 Jan 2004. subset/3. case of bound subset. % modified: 10 Sep 2004. permutation/2. referred the code in "The Art of Prolog." % modified: 24 Sep 2004. modified demo run for concat_dl/3. % modified: 15 Feb 2005. intersection_of_lists/2, sup_projection/2, and so on cited from kglp01. % modified: 3 Mar 2005. another simple asymmetric difference. % modified: 21 Sep 2005. find_subset/4. % modified: 2 Nov 2006. sort_by_list/3. % modified: 3 Feb 2012. permutation/2, assign_goods/3. /* ------------------------------------------------------------ */ % find a subcollection of items as a term of the given goal. % ----------------------------------------------------------- % % 21 Sep 2005 (from: price.pl) find_subset(Item, Goal, F, C):- findall( Item, Goal, F), list_projection( _, F, C). % intersection_of_lists/2 and so on % ----------------------------------------------------------- % % 15 Feb 2005 (cited from kglp01.pl) inductive_numbers([]). inductive_numbers([N|H]):- length(H,N), inductive_numbers(H). make_pairs([],[],[]). make_pairs([A-X|Z],[A|B],[X|Y]):- length(B,N), length(Y,N), length(Z,N), make_pairs(Z,B,Y). % intersection of list %---------------------------------------------------% % 6 Feb 2005. intersection_of_lists([],_). intersection_of_lists([X|H],Z):- intersection_of_lists(H,Y), intersection(X,Y,Z). % a simple asymmetric difference. % ----------------------------------------------------------- % % added: 2 Mar 2005. asymmetric_differences(A,B,D):- subtract(A,B,D1), subtract(B,A,D2), D=(D1,D2). % hexa and bits (intended for abbreviation of event) %---------------------------------------------------% % this part has also copied to moji.pl separatedly. % 5-6 Feb 2005. hexa_list(X,N,[Tx|Hx]):- \+ var(X), length(X,N), R is N mod 4, hexa_list_residual(R,X,Y,Tx), hexa_list_0(Y,Hx). hexa_list_0([],[]). hexa_list_0([A,B,C,D|X],[Hx|Y]):- hexa_list_0(X,Y), hexa_1([A,B,C,D],Hx). hexa_list_residual(0,[A,B,C,D|X],X,Hx):- hexa_1([A,B,C,D],Hx). hexa_list_residual(3,[A,B,C|X],X,Hx):- hexa_1([0,A,B,C],Hx). hexa_list_residual(2,[A,B|X],X,Hx):- hexa_1([0,0,A,B],Hx). hexa_list_residual(1,[A|X],X,Hx):- hexa_1([0,0,0,A],Hx). hexa_1(FourBits,Hx):- list_projection(FourBits,[a,b,c,d],_), bits(FourBits,Decimal,_B), hexa_pattern(Hx,Decimal). hexa_pattern(Hx,Hx):- Hx <10, !. hexa_pattern(Hx,D):- member((D,Hx),[ (10,a),(11,b),(12,c),(13,d),(14,e),(15,f) ]). hexa(L,Decimal,Hx):- concat_list(Hx,[0,x|L]), atom_chars(Hx,Atoms), number_chars(Decimal,Atoms). bits(L,Decimal,B):- concat_list(B,[0,b|L]), atom_chars(B,Atoms), number_chars(Decimal,Atoms). % concat list %---------------------------------------------------% % cited and modified from moji.pl(July 2003) concat_list(A,[A]). concat_list(Z,[L|R]):- concat_list(Q,R), concat(L,Q,Z). /* % ISO definition: 0[box]. % binary, octal hexadecimal numbers. ?- A is 0x101. A = 257 Yes ?- % system predicates ?- atom_chars(123,A),number_chars(B,A). A = ['1', '2', '3'] B = 123 Yes ?- number_chars(B,['0','x','1','1']). B = 17 Yes ?- */ %---------------------------------------------------% % 28 Jan 2005. forall_write(A):- forall(member(X,A),(nl,write(X))). forall_write_goals(A,B):- B,nl,write(A),fail. forall_write_goals(_,_):- nl,write(complete). % super set projection %---------------------------------------------------% % 1 Feb 2005. sup_projection([],[]). sup_projection([W|Z],[X|Y]):- member((X,W),[(1,1),(0,0),(0,1)]), sup_projection(Z,Y). % a naive program of distribution (index function). % this is not useful for generate a long list. %---------------------------------------------------% project_N_things_of(N,O,P,Q):- integer(N), length(O,U), N==N) ->!,true ; ( inductive_numbers([U|M]), member(N,[U|M]) )), length(P,U), choose_N_units_0(P,N,_L). % validation of bit sequence is_a_bounded_bit_sequence_of_length(P,L):- length(P,L), forall(member(X,P), ( \+ var(X), member(X,[0,1]) ) ). /************************************************* ?- choose_N_units_among(5000,2,[1,1|X]). X = [0, 0, 0, 0, 0, 0, 0, 0, 0|...] Yes *************************************************/ % generation of bit sequence choose_N_units_0([],0,0). choose_N_units_0(Z,0,0):- length(Z,R), zeros(Z,R). choose_N_units_0(Z,M,L):- length(Z,R), M>=R, ones(Z,R), L is M -R. choose_N_units_0([X|Y],M,L1):- length([X|Y],R), M >0, M U=0;integer(U)), inductive_numbers([U|M]), !, reverse([U|M],[0|R]), list_projection(P,R,W). /************************************************* ?- assign_values(A,[0,1,2],4,(sum(A,N),N = 5)). A = [2, 2, 1, 0] N = 5 ; A = [2, 1, 2, 0] N = 5 ; A = [1, 2, 2, 0] N = 5 ; ... ?- replace_sublist_with_values(A,[x],true,[a,b,c,d,e],[1,3,4]). A = [x, b, x, x, e] ; No ?- replace_sublist_with_values(A,[x,y],true,[a,b,c,d,e],[1,3,4]). A = [x, b, x, x, e] ; A = [y, b, x, x, e] ; A = [x, b, y, x, e] ; A = [y, b, y, x, e] ; A = [x, b, x, y, e] ; A = [y, b, x, y, e] ; A = [x, b, y, y, e] ; A = [y, b, y, y, e] ; No ?- subsequence_of_inductive_numbers(2,P,R,W). P = [0, 0] R = [1, 2] W = [] ; P = [0, 1] R = [1, 2] W = [2] ; P = [1, 0] R = [1, 2] W = [1] ; P = [1, 1] R = [1, 2] W = [1, 2] ; No ?- *************************************************/ % priority-considered version of bag0 %---------------------------------------------------% variation_seek_sequence([],_A,0). variation_seek_sequence([C|B],A,N):- length([C|B],N), member(C,A), subtract(A,[C],D), append(D,[C],E), variation_seek_sequence(B,E,_N1). :- dynamic temp_vss/1. update_temp_vss(C):- retract(temp_vss(H)), assert(temp_vss([C|H])). % ----------------------------------------------------------- % % distribution of goods among sites or people % ----------------------------------------------------------- % % added: 3 Feb 2012 % count frequency count( G, N):- findall( 1, G, L), length( L, N). % assign_colors( X -> Y, A). % A: a plan assigns a set of sites X a given set of colors Y. % X: a list % Y: a list assign_colors( X -> Y, A):- length( X, _N), length( Y, _M), assign_colors0( X, Y, A). assign_colors0( [], _, []). assign_colors0( [X | L], H, [ X->C | A]):- assign_colors0( L, H, A), member( C, H). % assign_goods( X -> Y, A). % A: a plan assigns a set of sites X a given set of goods Y. % X: a list % Y: a list assign_goods( X -> Y, A):- length( X, _N), length( Y, _M), assign_goods0( X, Y, A). assign_goods0( [], _, []). assign_goods0( [X | L], [], [ X->[] | A]):- assign_goods0( L, [], A). assign_goods0( [X | L], H, [ X->C | A]):- append( B, [C | D], H), \+ member( C, B), append( B, D, W), assign_goods0( L, W, A). % ----------------------------------------------------------- % % some basic list operations. % ----------------------------------------------------------- % % added: 20 Aug 2003. % len/2 : alternative to the length/2 len(A,B):- len_0(A,B). % length/2 of SWI-prolog fails at the case of both unbound variables. len_0(A,B):- var(A), var(B), !, fail. len_0([],0). len_0([_|A],N):- ((integer(N),N>0)->N0 is N -1; true), len_0(A,N0), ((integer(N0))->true; !,fail), N is N0 + 1. % kth/3 : alternative to the nth1/3 nth_1(K,Y,X):- kth_member(K,Y,X). kth(K,Y,X):- kth_member(K,Y,X). kth_member(1,[X|_],X). kth_member(K,[_|Y],X):- kth_member(K1,Y,X), K is K1 + 1. % rev/2 : alternative to the reverse/2 rev(A,B):- len(A,L), len(B,L), rev(A,[],B), !. rev(A,A,[]):-!. rev(A,B,[C|D]):- rev(A,[C|B],D). % descending/ascending natural number sequence less than N. % ----------------------------------------------------------- % dnum_seq([],N):-N<0,!. dnum_seq([0],1). dnum_seq([A|Q],N):- A is N - 1, length(Q,A), dnum_seq(Q,A). anum_seq(Aseq,N):-dnum_seq(Dseq,N),sort(Dseq,Aseq). dnum_seq1(Q,N):- M is N + 1, dnum_seq(Q0,M), subtract(Q0,[0],Q). anum_seq1(Q,N):- M is N + 1, anum_seq(Q0,M), subtract(Q0,[0],Q). % count frequency of occurence of the specified value of variable, M. % ----------------------------------------------------------- % % note: Both of M and L have to be specified. counter(N,M,L):- length(L,_), findall(M,member(M,L),Mx), length(Mx,N). % multiplicity of successful goals. % ----------------------------------------------------------- % sea_multiple(Goal,Cond,N,M):- Clause=..Goal, findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M). % equality for pair of set % ----------------------------------------------------------- % % edited: 15 Nov 2002. % edited: 14 Feb 2003. % edited: 19 Jan 2004. case of generating equivalent set. % % equality for pair of set % ----------------------------------------------------------- % seteq(X,Y):- \+ var(X), length(X,N), \+ var(Y), length(Y,N), sort(X,Sort), sort(Y,Sort). seteq(X,Y):- \+ var(X), length(X,N), var(Y), bag1(Y,X,N). /* % older versions. seteq(X,Y,L):- length(X,L), length(Y,L), forall(member(Z,X),member(Z,Y)), forall(member(Z,Y),member(Z,X)). % edited: 15 Nov 2002. seteq(X,Y):- sort(X,Sort), sort(Y,Sort). */ % % bag0/3 : allow multiplicity % ----------------------------------------------------------- % bag0( [], _A, 0). bag0( [C | B], A, N):- length( [C | B], N), bag0( B, A, _N1), member( C, A). zeros(Zero,N):-bag0(Zero,[0],N). ones(One,N):-bag0(One,[1],N). % % bag1/3 : do not allow multiplicity % ----------------------------------------------------------- % % modified: 15 Oct 2002. bag fixed for unboundness. % modified: 27 Feb 2003. bag (asc_nnseq->anum_seq). bag1([],_A,0). bag1([C|B],A,N1):- \+var(A), length(A,L), anum_seq(Q,L), member(N,Q), length(B,N),bag1(B,A,N),N1 is N + 1, member(C,A),\+member(C,B). % % ordering/3 % ----------------------------------------------------------- % ordering(A,B,C):-bag1(A,B,C). % % sort without removal of duplicates %-------------------------------------------------- asort(A,B):- sort(A,C), bagof(CK, J^K^( nth1(J,C,CK), nth1(K,A,CK) ), B). % sort by a list of ordering %-------------------------------------------------- % revised: 2 Oct 2006. (cited from sp06d.pl) % sort_by_list( Object, +List, Result). sort_by_list(_,[],[]). sort_by_list(L,[X|O],R):- \+ var(O), \+ var(L), (\+ member(X,L)->R=R1; R=[X|R1]), subtract(L,[X],L1), sort_by_list(L1,O,R1). sort_by_list(L,O,R):- \+ var(O), var(L), (\+ var(R)->subset(R,O);true), sort_by_list(R,O,R). /* % depreciated % added: 14 Jan 2004. % modified: 16 Jan 2004. sort_by_list(X,OL,Y):- (var(X)->bag1(X,OL,_);true), list_projection(_,OL,Y), seteq(X,Y). */ % % a sequence of binary choice for a list: %-------------------------------------------------- % projection(3rd ar) of vector(2nd ar) using a sequence of digits(1st ar). % you must specify the second ('a base set') argument. % this predicate is important so that it is used in subset_of /3. % modified: 8 Feb 2003. list_projection([],[],[]). list_projection([X|Y],[_|B],C):- list_projection(Y,B,C), X = 0. list_projection([X|Y],[A|B],[A|C]):- list_projection(Y,B,C), X = 1. % % complementary list projection %-------------------------------------------------- % added: 10 Jan 2003. % modified: 22 Mar 2003. the earlier version has come back. % complementary list projection %-------------------------------------------------- c_list_projection([],[],[]). c_list_projection([X|Y],[_|B],C):- c_list_projection(Y,B,C), X = 1. c_list_projection([X|Y],[A|B],[A|C]):- c_list_projection(Y,B,C), X = 0. /* % 10 Jan 2003 version. c_list_projection(X,Y,Z):- list_complement(X,XC,_N), list_projection(XC,Y,Z). list_complement(X,XC,N):- \+ (var(X),var(N)), bag0(X,[1,0],N), zeros(Zero,N), ones(One,N), replace(X,Zero,One,XC). */ % % subset_of/3 : subset-enumeration % ----------------------------------------------------------- % % modified: 23 Jan 2004. to divide the case of subset-bound. subset_of(A,N,As):- var(A), length(As,L), length(D,L), list_projection(D,As,B), length(B,N), sort(B,A). subset_of(A,N,As):- \+ var(A), length(A,N), subset(A,As). % complement and symmetric complement % ----------------------------------------------------------- % % added: 22 Mar 2003. complement(AC,A,As):- subset_of(A,_N,As), subtract(As,A,AC). complement_1(AC,A,As):- list_projection(P,As,A), c_list_projection(P,As,AC). symmetric_complement(AC,A,As):- list_projection(P,As,A), c_list_projection(P,As,AC), list_projection(P1,As,AC), P @< P1. %subset_of(A,N,As):-multiple_subset_of(A,N,As). % % subset allowing multiple membership % ----------------------------------------------------------- % multiple_subset_of([],0,_):-!. multiple_subset_of([X|A],N,As):- length([X|A],N), multiple_subset_of(A,N1,As), member(X,As), N is N1 + 1. % an alternative, but not so aesthetic. % ----------------------------------------------------------- % % added: 22 Mar 2003. sub_list([],[]). sub_list(A,B):- \+ var(B), length(B,_), sub_list0(C,[],B), reverse(C,A). sub_list0([],A,A). sub_list0([X|B],Y,A):- length(A,N), length(Y,M), M < N, sublist0(B,[X|Y],A). sub_list0(B,Y,A):- length(A,N), length(Y,M), M < N, sub_list0(B,[_X|Y],A). % % index for table(=tuples). % ----------------------------------------------------------- % % 1) only mention for a direct product of sets. index_of_tuples(B,A,Index):- \+ var(B), \+ var(A), length(B,LN), % base sets length(A,LN), length(Index,LN), findall(L, ( nth1(K,B,BJ), %write(a(K,B,BJ)), nth1(L,BJ,AJ),%write(b(L,BJ,AJ)), nth1(K,A,AJ) %,write(c(K,A,AJ)),nl ), Index). index_of_tuples(B,A,Index):- \+ var(B), \+ var(Index), var(A), length(B,LN), % base sets length(Index,LN), length(A,LN), findall(AJ, ( nth1(K,B,BJ), nth1(K,Index,L), nth1(L,BJ,AJ) ), A). % % characteristic_vector/3 % ----------------------------------------------------------- % % modified: 8 Feb 2003. without using nth1. % modified: 13 Feb 2003. bug fix. without using member. characteristic_vector(X,B,Index):- \+ var(B), %member(X,B), list_projection(Index,B,[X]). characteristic_vector(1,X,[X|B],[1|DX]):- characteristic_vector(X,[X|B],[1|DX]). characteristic_vector(K,X,[_|B],[0|DX]):- characteristic_vector(K1,X,B,DX), K is K1 + 1. /* % an alternative characteristic_vector(N,N,[1|O]):- integer(N), N1 is N - 1, length(O,N1), zeros(O,N1). characteristic_vector(K,N,[0|V]):- integer(N), N1 is N - 1, length(V,N1), characteristic_vector(K,N1,V). % old version characteristic_vector(K,N,V):- integer(N), length(V,N), nth_1(K,V,1), findall(X,(nth_1(J,V,X),(J=K->X=1;X=0)),V). */ % % my nth %-------------------------------------------------- % added: 8 Feb 2003. nth1a(K,A,X):- \+ var(A), characteristic_vector(K,_,A,V), list_projection(V,A,[X]). nth0a(K,A,X):- nth1a(K1,A,X), K is K1 - 1. % added: 27 May 2003. nth1b(1,[A|_],A). nth1b(K,[_|B],A):- nth1b(K1,B,A), K is K1 + 1. /* nth0 and nth1 of SWI-prolog. nth1(A, B, C) :- integer(A), !, D is A - 1, nth0_1(D, B, C). nth1(A, B, C) :- var(A), nth0_2(D, B, C), A is D + 1. nth0(A, B, C) :- integer(A), !, nth0_1(A, B, C). nth0(A, B, C) :- var(A), !, nth0_2(A, B, C). nth0_1(0, [A|B], A) :- !. nth0_1(A, [B|C], D) :- E is A - 1, nth0(E, C, D). nth0_2(0, [A|B], A). nth0_2(A, [B|C], D) :- nth0_2(E, C, D), succ(E, A). */ % % replace(Project,Goal,Base,Goal1):- % ----------------------------------------------------------- % % added: 15 Oct 2002. % a sequence of replacement of a subset of elements in Goal % which specified by a list, Project, 0-1^n, over Base % a list of length n, which brings about Goal1. % summary: % X=1 --> preserve the value of Base. % X=0 --> do replace with Goal1. replace([],[],[],[]). replace([X|A],[_|B],[Z|C],[Z|D]):- X = 0, replace(A,B,C,D). replace([X|A],[Y|B],[_|C],[Y|D]):- X = 1, replace(A,B,C,D). % % replace/4 % ----------------------------------------------------------- % % modified: 14 Feb 2003. bug fix. replace(K/N,L,S,L1):- \+ var(S), \+ var(L), length(L,N), length(L1,N), nth1(K,L1,S), characteristic_vector(K,_S0,L,V), c_replace(V,L,L1,L1). % c_replace([],[],[],[]). c_replace([X|A],[_|B],[Z|C],[Z|D]):- X = 1, c_replace(A,B,C,D). c_replace([X|A],[Y|B],[_|C],[Y|D]):- X = 0, c_replace(A,B,C,D). % % asymmetric difference without reduction of duplicates. % ----------------------------------------------------------- % % added: 7 Apr 2003. asymmetric_difference(reduce(no),A,B,Resid,Meet):- length(A,_), length(B,_), %sort(A,Meet), findall(P, ( member(X,A), (member(X,B) -> P=0;P=1) ), ML), list_projection(ML,A,Meet), c_list_projection(ML,A,Resid). asymmetric_difference(reduce(yes),A,B,Resid,Meet):- length(A,_), length(B,_), %sort(A,Meet), findall(P, ( nth1(K,A,X), (member(X,B) -> P1=0;P1=1), ((nth1(K1,A,X),K1 P=0;P=P1) ), ML), list_projection(ML,A,Meet), c_list_projection(ML,A,Resid). % % permutation. % ----------------------------------------------------------- % % modified: 1 Sep 2002. to be used in is_neutral/2. % modified: 15 Oct 2002. add a non-variable constraint for the base set A. % modified: 10 Sep 2004. abolish the old code then replaced by the reference. % reference: % L. Sterling and E. Shapiro (1994). The Art of Prolog. 2nd edition. MIT Press, p.68. permutation([],[]). permutation(Q,[A|R]):- select(A,Q,Q1), % subtract(Q,[A],Q1) is not valid for multiple-occurence. permutation(Q1,R). % my old code for only verification. permutation_1([],[],[]). permutation_1(Q,[A->P|PoA1],R):- subtract(Q,[A],Q1),nth1(K,Q,A), subtract(R,[P],R1),nth1(K,R,P), permutation_1(Q1,PoA1,R1). % % projection operator via index set. (an exchange economy?) % ----------------------------------------------------------- % % choice1 from base1 :: choice2 from base2. % modified : 15 Oct 2002. to be order-neutral (pending:-) % pcm([Choice1,Base1],[Choice2,Base2]):- pairwise_contract_map([Choice1,Base1],[Choice2,Base2]). pairwise_contract_map([Choice1,Base1],[Choice2,Base2]):- % length(Base1,N2), % length(Base2,N2), subset_of(Choice1,N1,Base1), subset_of(Choice2,N1,Base2), list_projection(Project,Base1,Choice1), list_projection(Project,Base2,Choice2). % % ppcm /2 using plist_projection % added: 15 Oct 2002. ppcm([Choice1,Base1],[Choice2,Base2]):- subset_of(C1,N1,Base1), subset_of(C2,N1,Base2), plist_projection(Project,Base1,Choice1,C1), plist_projection(Project,Base2,Choice2,C2). % % concatenate for list elements % ----------------------------------------------------------- % concat_v([],'',0). %concat_v([b,c],Z,2):-length([c],1),concat_v([c],c,1),concat(b,c,Z). %concat_v([a,b,c],Z,3):-length([a,c],2),concat_v([b,c],bc,2),concat(a,bc,Z). concat_v([X|Y],Z,L):-concat_v(Y,Z1,L1),length(Y,L1),L is L1 + 1, concat(X,Z1,Z). % ��X�g�i�Q�l�j concat_dl(A-B,B-C,A-C). concat_dl_1(A,B,C):- concat_dl_0(A-B), concat_dl_0(B-C), concat_dl_0(A-C). concat_dl_0(A-B). /* sample executions ?- concat_dl([a,b|X]-X,[c,d|Y]-Y,R). X = [c,d|G1172] Y = G1172 R = [a,b,c,d|G1172] - G1172 Yes ?- concat_dl([a,b|X]-X,[c,d|Y]-Y,R-[]). X = [c, d] Y = [] R = [a, b, c, d] Yes ?- concat_dl([a,b|X]-X,[c,d|Y]-Y,R-[X]). X = [c, d, [c, d, [c, d, [...|...]]]] Y = [[c, d, [c, d, [c, d|...]]]] R = [a, b, c, d, [c, d, [c|...]]] Yes ?- concat_dl([a,b|X]-X,[c,d|Y]-Y,R-[Y]). X = [c, d, [[[[[[[...]]]]]]]] Y = [[[[[[[[[[...]]]]]]]]]] R = [a, b, c, d, [[[[[...]]]]]] Yes ?- */ % % cited from the system predicates of SWI-Prolog 1.9.0 % ----------------------------------------------------------- % /* apply /2 : not found in If-Prolog */ my_apply(A,B):-C=..[A|B],C. /* same as maplist /3,select /3, and sublist / 3of SWI-prolog */ my_maplist(_A, [], []). my_maplist(A, [B|C], [D|E]) :- apply(A, [B,D]), my_maplist(A, C, E). my_select([A|B], A, B). my_select([A|B], C, [A|D]) :- my_select(B, C, D). my_sublist(_A, [], []) :- !. my_sublist(A, [B|C], D) :- apply(A, [B]), !, D = [B|E], my_sublist(A, C, E). my_sublist(A, [_B|C], D) :- my_sublist(A, C, D). % decomposition of clause %----------------------------------------------- % added: 16 Mar 2001 decomposition_of_clause((A:- true),A,[]). decomposition_of_clause(A,A,[]):- atom(A). decomposition_of_clause((A:-B),A,C):- (A:-B) =.. [(:-),A,B], decomposition_of_body(B,C). decomposition_of_body((A,B),[A|C]):- \+ var(B), decomposition_of_body(B,C). decomposition_of_body((A,B),C):- var(B), decomposition_of_body(A,D), append(D,[B],C), !. decomposition_of_body(B,[B]):- atom(B); var(B); functor(B,_,_). %----------------------------------------- % generation of partitions and trees(herarchies) %----------------------------------------- % cited from: dpfirm0.pl (25 Mar 2003) % tree formations for the input data (i.e., information items) % by partitioning the set of input items recursively. % ?- tree_formation(Mode,levels:L,items:S,tree:T). % generating partitons %----------------------------------------- partition([S],1,S):- \+ var(S), length(S,_). partition([H|H1],N,S):- \+ var(S), length(S,_), symmetric_complement(H,S1,S), \+ member([], [H,S1]), partition(H1,N1,S1), N is N1 + 1, all_elements(S1,_,H1). all_elements([],0,[]). all_elements(A,N,[H|S]):- \+ var(S), length(S,_), \+ var(H), length(H,K), all_elements(B,N1,S), append(H,B,A), N is N1 + K. % tree_formation(Mode,levels:L, items:A, tree:T). %----------------------------------------- tree_formation(list,levels:1, items:A, tree:A):- \+ var(A), length(A,_). tree_formation(list,levels:K, items: S, tree: [T1|T2] ):- \+ var(S), %symmetric_complement(H1,H2,S), partition([H1|H2],_,S), \+ member([],[H1,H2]), tree_formation(list,levels:K1, items: H1, tree: T1 ), tree_formation(list,levels:K1, items: H2, tree: T2 ), K is K1+1. % skip-reporting tree_formation(list,levels:K, items:A, tree:[T]):- number(K), tree_formation(list,levels:K1, items: A, tree: T ), K is K1 + 1. % list - binary %------------ tree_formation(blist,levels:L, items:A, tree:A):- length(A,_), (var(L)->L =1; true). tree_formation(blist,levels:K, items: S, tree: T ):- \+ var(S), T = [T1,T2], symmetric_complement(H1,H2,S), \+ member([],[H1,H2]), tree_formation(blist,levels:K1, items: H1, tree: T1 ), tree_formation(blist,levels:K2, items: H2, tree: T2 ), (K1 >= K2 -> K is K1+1; K is K2+1). % utility: depth of tree %----------------------------------------- % modified: 5 Apr 2003 slightly modified in reputate.pl analyze_list([], levels:0, items:[]). analyze_list(A, levels:0, items:[A]):- A\=[], ( atom(A); number(A); (\+ atom(A),\+ number(A),A=..[F|_],F\='.') ). analyze_list([B|T], levels:L, items:H):- analyze_list(B, levels:L1, items:H2), analyze_list(T, levels:L2, items:H1), append(H2,H1,H), (L1 + 1 >= L2 -> L is L1 + 1; L is L2), !. % utility: subtrees %----------------------------------------- subtree(T,(level:L/L,no:1/1, superior:root, items:H),T):- % 1st element of the top layer . analyze_list(T, levels:L,items:H). subtree(S,(level:L/M, no:K/N, superior:(L1,K1),items:H),T):- %(var(T)->hierarchy(T);true), subtree(S1,(level:L1/M,no:K1/_, _,_),T), (L1=0->(!,fail);true), length(S1,N), nth1(K,S1,S), analyze_list(S, levels:L,items:H). % added: 10 Apr 2003. identified_subtree(T,[],H,T):- subtree(T,H,T). identified_subtree(S,[X|Path],I,T):- identified_subtree(S1,Path,I1,T), I1 = (level:L1/M,no:K1/_N1, superior:X,_), (L1=0->(!,fail);true), length(S1,N), nth1(K,S1,S), analyze_list(S, levels:L,items:H), I = (level:L/M, no:K/N, superior:(L1,K1),items:H). % ---- end of set operators.