You selected set.pl
/* ------------------------------------------------------------ */
% 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).
% 差分リスト（参考）
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.
return to front page.