lcs([ H|L1],[ H|L2],[H|Lcs]) :-
!,
lcs(L1,L2,Lcs).
lcs([H1|L1],[H2|L2],Lcs):-
lcs( L1 ,[H2|L2],Lcs1),
lcs([H1|L1], L2 ,Lcs2),
longest(Lcs1,Lcs2,Lcs),
!.
lcs(_,_,[]).
longest(L1,L2,Longest) :-
length(L1,Length1),
length(L2,Length2),
( Length1 > Length2
-> Longest = L1
; Longest = L2
).
This is my code so far. How could I optimize it so that it prints the prefix, e.g.:
["interview", "interrupt", "integrate", "intermediate"]
should return "inte"
A bit rusty with Prolog, haven't done it in a while :)
First, let's start with something related, but much simpler.
:- set_prolog_flag(double_quotes, chars). % "abc" = [a,b,c]
prefix_of(Prefix, List) :-
append(Prefix, _, List).
commonprefix(Prefix, Lists) :-
maplist(prefix_of(Prefix), Lists).
?- commonprefix(Prefix, ["interview", "integrate", "intermediate"]).
Prefix = []
; Prefix = "i"
; Prefix = "in"
; Prefix = "int"
; Prefix = "inte"
; false.
(See this answer, how printing character lists with double quotes is done.)
This is the part that is fairly easy in Prolog. The only drawback is that it doesn't give us the maximum, but rather all possible solutions including the maximum. Note that all strings do not need to be known, like:
?- commonprefix(Prefix, ["interview", "integrate", Xs]).
Prefix = []
; Prefix = "i", Xs = [i|_A]
; Prefix = "in", Xs = [i, n|_A]
; Prefix = "int", Xs = [i, n, t|_A]
; Prefix = "inte", Xs = [i, n, t, e|_A]
; false.
So we get as response a partial description of the last unknown word. Now imagine, later on we realize that Xs = "induce". No problem for Prolog:
?- commonprefix(Prefix, ["interview", "integrate", Xs]), Xs = "induce".
Prefix = [], Xs = "induce"
; Prefix = "i", Xs = "induce"
; Prefix = "in", Xs = "induce"
; false.
In fact, it does not make a difference whether we state this in hindsight or just before the actual query:
?- Xs = "induce", commonprefix(Prefix, ["interview", "integrate", Xs]).
Xs = "induce", Prefix = []
; Xs = "induce", Prefix = "i"
; Xs = "induce", Prefix = "in"
; false.
Can we now based on this formulate the maximum? Note that this effectively necessitates some form of extra quantor for which we do not have any direct provisions in Prolog. For this reason we have to limit us to certain cases we know will be safe. The easiest way out would be to insist that the list of words does not contain any variables. I will use iwhen/2 for this purpose.
maxprefix(Prefix, Lists) :-
iwhen(ground(Lists), maxprefix_g(Prefix, Lists)).
maxprefix_g(Prefix, Lists_g) :-
setof(N-IPrefix, ( commonprefix(IPrefix, Lists_g), length(IPrefix, N ) ), Ns),
append(_,[N-Prefix], Ns). % the longest one
The downside of this approach is that we get instantiation errors should the list of words not be known.
Note that we made quite some assumptions (which I hope really hold). In particular we assumed that there is exactly one maximum. In this case this holds, but in general it could be that there are several independent values for Prefix. Also, we assumed that IPrefix will always be ground. We could check that too, just to be sure. Alternatively:
maxprefix_g(Prefix, Lists_g) :-
setof(N, IPrefix^ ( commonprefix(IPrefix, Lists_g), length(IPrefix, N ) ), Ns),
append(_,[N], Ns),
length(Prefix, N),
commonprefix(Prefix, Lists_g).
Here, the prefix does not have to be one single prefix (which it is in our situation).
The best, however, would be a purer version that does not need to resort to instantiation errors at all.
Here's the purified variant of the code proposed (and subsequently retracted) by #CapelliC:
:- set_prolog_flag(double_quotes, chars).
:- use_module(library(reif)).
lists_lcp([], []).
lists_lcp([Es|Ess], Ls) :-
if_((maplist_t(list_first_rest_t, [Es|Ess], [X|Xs], Ess0),
maplist_t(=(X), Xs))
, (Ls = [X|Ls0], lists_lcp(Ess0, Ls0))
, Ls = []).
list_first_rest_t([], _, _, false).
list_first_rest_t([X|Xs], X, Xs, true).
Above meta-predicate maplist_t/3 is a variant of maplist/2
which works with term equality/inequality reification—maplist_t/5 is just the same with higher arity:
maplist_t(P_2, Xs, T) :-
i_maplist_t(Xs, P_2, T).
i_maplist_t([], _P_2, true).
i_maplist_t([X|Xs], P_2, T) :-
if_(call(P_2, X), i_maplist_t(Xs, P_2, T), T = false).
maplist_t(P_4, Xs, Ys, Zs, T) :-
i_maplist_t(Xs, Ys, Zs, P_4, T).
i_maplist_t([], [], [], _P_4, true).
i_maplist_t([X|Xs], [Y|Ys], [Z|Zs], P_4, T) :-
if_(call(P_4, X, Y, Z), i_maplist_t(Xs, Ys, Zs, P_4, T), T = false).
First here's a ground query:
?- lists_lcp(["a","ab"], []).
false. % fails (as expected)
Here are the queries presented in #Fatalize's fine answer.
?- lists_lcp(["interview",X,"intermediate"], "inte").
X = [i,n,t,e]
; X = [i,n,t,e,_A|_B], dif(_A,r)
; false.
?- lists_lcp(["interview","integrate",X], Z).
X = Z, Z = []
; X = Z, Z = [i]
; X = Z, Z = [i,n]
; X = Z, Z = [i,n,t]
; X = Z, Z = [i,n,t,e]
; X = [i,n,t,e,_A|_B], Z = [i,n,t,e]
; X = [i,n,t,_A|_B] , Z = [i,n,t] , dif(_A,e)
; X = [i,n,_A|_B] , Z = [i,n] , dif(_A,t)
; X = [i,_A|_B] , Z = [i] , dif(_A,n)
; X = [_A|_B] , Z = [] , dif(_A,i).
?- lists_lcp([X,Y], "abc").
X = [a,b,c] , Y = [a,b,c|_A]
; X = [a,b,c,_A|_B], Y = [a,b,c]
; X = [a,b,c,_A|_B], Y = [a,b,c,_C|_D], dif(_A,_C)
; false.
?- lists_lcp(L, "abc").
L = [[a,b,c]]
; L = [[a,b,c],[a,b,c|_A]]
; L = [[a,b,c,_A|_B],[a,b,c]]
; L = [[a,b,c,_A|_B],[a,b,c,_C|_D]], dif(_A,_C)
; L = [[a,b,c],[a,b,c|_A],[a,b,c|_B]]
; L = [[a,b,c,_A|_B],[a,b,c],[a,b,c|_C]]
; L = [[a,b,c,_A|_B],[a,b,c,_C|_D],[a,b,c]]
; L = [[a,b,c,_A|_B],[a,b,c,_C|_D],[a,b,c,_E|_F]], dif(_A,_E)
…
Last, here's the query showing improved determinism:
?- lists_lcp(["interview","integrate","intermediate"], Z).
Z = [i,n,t,e]. % succeeds deterministically
Here is how I would implement this:
:- set_prolog_flag(double_quotes, chars).
longest_common_prefix([], []).
longest_common_prefix([H], H).
longest_common_prefix([H1,H2|T], P) :-
maplist(append(P), L, [H1,H2|T]),
( one_empty_head(L)
; maplist(head, L, Hs),
not_all_equal(Hs)
).
one_empty_head([[]|_]).
one_empty_head([[_|_]|T]) :-
one_empty_head(T).
head([H|_], H).
not_all_equal([E|Es]) :-
some_dif(Es, E).
some_dif([X|Xs], E) :-
if_(diffirst(X,E), true, some_dif(Xs,E)).
diffirst(X, Y, T) :-
( X == Y -> T = false
; X \= Y -> T = true
; T = true, dif(X, Y)
; T = false, X = Y
).
The implementation of not_all_equal/1 is from this answer by #repeat (you can find my implementation in the edit history).
We use append and maplist to split the strings in the list into a prefix and a suffix, and where the prefix is the same for all strings. For this prefix to be the longest, we need to state that the first character of at least two of the suffixes are different.
This is why we use head/2, one_empty_head/1 and not_all_equal/1. head/2 is used to retrieve the first char of a string; one_empty_head/1 is used to state that if one of the suffixes is empty, then automatically this is the longest prefix. not_all_equal/1 is used to then check or state that at least two characters are different.
Examples
?- longest_common_prefix(["interview", "integrate", "intermediate"], Z).
Z = [i, n, t, e] ;
false.
?- longest_common_prefix(["interview", X, "intermediate"], "inte").
X = [i, n, t, e] ;
X = [i, n, t, e, _156|_158],
dif(_156, r) ;
false.
?- longest_common_prefix(["interview", "integrate", X], Z).
X = Z, Z = [] ;
X = [_246|_248],
Z = [],
dif(_246, i) ;
X = Z, Z = [i] ;
X = [i, _260|_262],
Z = [i],
dif(_260, n) ;
X = Z, Z = [i, n] ;
X = [i, n, _272|_274],
Z = [i, n],
dif(_272, t) ;
X = Z, Z = [i, n, t] ;
X = [i, n, t, _284|_286],
Z = [i, n, t],
dif(_284, e) ;
X = Z, Z = [i, n, t, e] ;
X = [i, n, t, e, _216|_224],
Z = [i, n, t, e] ;
false.
?- longest_common_prefix([X,Y], "abc").
X = [a, b, c],
Y = [a, b, c|_60] ;
X = [a, b, c, _84|_86],
Y = [a, b, c] ;
X = [a, b, c, _218|_220],
Y = [a, b, c, _242|_244],
dif(_218, _242) ;
false.
?- longest_common_prefix(L, "abc").
L = [[a, b, c]] ;
L = [[a, b, c], [a, b, c|_88]] ;
L = [[a, b, c, _112|_114], [a, b, c]] ;
L = [[a, b, c, _248|_250], [a, b, c, _278|_280]],
dif(_248, _278) ;
L = [[a, b, c], [a, b, c|_76], [a, b, c|_100]] ;
L = [[a, b, c, _130|_132], [a, b, c], [a, b, c|_100]];
…
This previous answer presented an implementation based on if_/3.
:- use_module(library(reif)).
Here comes a somewhat different take on it:
lists_lcp([], []).
lists_lcp([Es|Ess], Xs) :-
foldl(list_list_lcp, Ess, Es, Xs). % foldl/4
list_list_lcp([], _, []).
list_list_lcp([X|Xs], Ys0, Zs0) :-
if_(list_first_rest_t(Ys0, Y, Ys) % if_/3
, ( Zs0 = [X|Zs], list_list_lcp(Xs, Ys, Zs) )
, Zs0 = []
).
list_first_rest_t([], _, _, false).
list_first_rest_t([X|Xs], Y, Xs, T) :-
=(X, Y, T). % =/3
Almost all queries in my previous answer give the same answers, so I do not show them here.
lists_lcp([X,Y], "abc"), however, does not terminate universally anymore with the new code.
A simple version:
:- set_prolog_flag(double_quotes, chars).
pref([],_,[]).
pref(_,[],[]).
pref([H|T1],[H|T2],[H|Tr]):-
pref(T1,T2,Tr).
pref([H|_],[H|_],[]).
pref([H1|_],[H2|_],[]):-
dif(H1,H2).
lcf([],[]).
lcf([W],R):-
pref(W,W,R).
lcf([W1,W2|L],R):-
pref(W1,W2,R),
lcf([W2|L],R).
Examples:
pref("interview","integrate",R).
R = [i, n, t, e] ;
R = [i, n, t] ;
R = [i, n] ;
R = [i] ;
R = [] ;
False.
lcf(["interview", "interrupt", "integrate", "intermediate"],R).
R = [i, n, t, e]
lcf(["interview", "interrupt", X, "intermediate"],R).
R = X, X = [i, n, t, e, r]
I recently had to implement this for two lists, and this is the code I came up with. It assumes the two input lists are sufficiently instantiated.
longest_common_prefix([X|Xs], [X|Ys], [X|Common]) :- !,
longest_common_prefix(Xs, Ys, Common).
longest_common_prefix(_, _, []).
This is easily extended to multiple lists:
lcs([], []).
lcs([L1|Ls], Prefix) :-
foldl(longest_common_prefix, Ls, L1, Prefix).
If you don't like using foldl:
lcs([], []).
lcs([L1|Ls], Prefix) :-
lcs(Ls, L1, Prefix).
lcs([], Prefix, Prefix).
lcs([L1|Ls], Prefix0, Prefix) :-
longest_common_prefix(L1, Prefix0, Prefix1),
lcs(Ls, Prefix1, Prefix).
I have to write a predicate: double(X,Y) to be true when Y is the list consisting of each element of X
repeated twice (e.g. double([a,b],[a,a,b,b]) is true).
I ended with sth like this:
double([],[]).
double([T],List) :- double([H|T],List).
double([H|T],List) :- count(H, List, 2).
Its working fine for lists like [a,a,b] but it shouldnt... please help.
And i need help with another predicate: repeat(X,Y,N) to be true when Y is the list consisting of each element of X
repeated N times (e.g. repeat([a,b], [a,a,a,b,b,b],3) is true).
double([],[]).
double([I|R],[I,I|RD]) :-
double(R,RD).
Here's how you could realize that "repeat" predicate you suggested in the question:
:- use_module(library(clpfd)).
Based on if_/3 and (=)/3 we define:
each_n_reps([E|Es], N) :-
aux_n_reps(Es, E, 1, N).
aux_n_reps([], _, N, N). % internal auxiliary predicate
aux_n_reps([E|Es], E0, N0, N) :-
if_(E0 = E,
( N0 #< N, N1 #= N0+1 ), % continue current run
( N0 #= N, N1 #= 1 )), % start new run
aux_n_reps(Es, E, N1, N).
Sample queries1 using SICStus Prolog 4.3.2:
?- each_n_reps(Xs, 3).
Xs = [_A,_A,_A]
; Xs = [_A,_A,_A,_B,_B,_B] , dif(_A,_B)
; Xs = [_A,_A,_A,_B,_B,_B,_C,_C,_C], dif(_A,_B), dif(_B,_C)
...
How about fair enumeration?
?- length(Xs, _), each_n_reps(Xs, N).
N = 1, Xs = [_A]
; N = 2, Xs = [_A,_A]
; N = 1, Xs = [_A,_B] , dif(_A,_B)
; N = 3, Xs = [_A,_A,_A]
; N = 1, Xs = [_A,_B,_C] , dif(_A,_B), dif(_B,_C)
; N = 4, Xs = [_A,_A,_A,_A]
; N = 2, Xs = [_A,_A,_B,_B], dif(_A,_B)
; N = 1, Xs = [_A,_B,_C,_D], dif(_A,_B), dif(_B,_C), dif(_C,_D)
...
How can [A,B,C,D,E,F] be split into runs of equal length?
?- each_n_reps([A,B,C,D,E,F], N).
N = 6, A=B , B=C , C=D , D=E , E=F
; N = 3, A=B , B=C , dif(C,D), D=E , E=F
; N = 2, A=B , dif(B,C), C=D , dif(D,E), E=F
; N = 1, dif(A,B), dif(B,C), dif(C,D), dif(D,E), dif(E,F).
Footnote 1: Answers were reformatted to improve readability.
Ok for repeat/3 i have sth like this:
repeat1([],[],0).
repeat1([A|B],[X|T],Y):- repeat1(B,T,Z), Y is 1+Z.
repeat1([A1|B],[X1|T], Z) :- A1\=A, X1\=X, repeat1(B,T,Z).
With the following piece of code in Prolog I managed to extract every third item from a list:
third([_,_,Z|L], Z).
third([_,_,C|L], Y) :-
third(L, Y).
However, I still need to append every item that I am extracting to a new list, and finally create a list with only "every third" items.
I would appreciate any hint or help!
Thank you.
How about doing it like this?
list_thirds([] , []).
list_thirds([_] , []).
list_thirds([_,_] , []).
list_thirds([_,_,E|Es], [E|Xs]) :-
list_thirds(Es, Xs).
Sample queries using SICStus Prolog 4.3.2:
| ?- list_thirds([], Xs).
Xs = [] ? ;
no
| ?- list_thirds([a,b,c], Xs).
Xs = [c] ? ;
no
| ?- list_thirds([a,b,c,d,e,f], Xs).
Xs = [c,f] ? ;
no
| ?- list_thirds([a,b,c,d,e,f,g], Xs).
Xs = [c,f] ? ;
no
How about going the "other direction"?
| ?- list_thirds(List, [x,y]).
List = [_A,_B,x,_C,_D,y] ? ;
List = [_A,_B,x,_C,_D,y,_E] ? ;
List = [_A,_B,x,_C,_D,y,_E,_F] ? ;
no % terminates universally
Last, we look at the answer sequence we get from the most general query:
| ?- list_thirds(Es, Xs).
Es = [] , Xs = [] ? ;
Es = [_A] , Xs = [] ? ;
Es = [_A,_B] , Xs = [] ? ;
Es = [_A,_B,_C] , Xs = [_C] ? ;
Es = [_A,_B,_C,_D] , Xs = [_C] ? ;
Es = [_A,_B,_C,_D,_E] , Xs = [_C] ? ;
Es = [_A,_B,_C,_D,_E,_F], Xs = [_C,_F] ? ;
...
With SWI-Prolog, and module lambda.pl, you can write
:- use_module(library(lambda)).
third(In, Out) :-
foldl(\X^Y^Z^(Y=[N,L],
( N = 2
-> append(L, [X], NL),
Z = [0,NL]
; N1 is N+1,
Z = [N1, L])),
In, [0, []], [_, Out]).
With same queries :
?- third([1,2,3,4,5,6,7,8,9,10], Out).
Out = [3, 6, 9].
?- third(X, [3,6,9]).
X = [_G103, _G180, 3, _G352, _G438, 6, _G613, _G699, 9] ;
X = [_G103, _G180, 3, _G352, _G438, 6, _G613, _G699, 9|...] .
?- third(X, Y).
X = Y, Y = [] ;
X = [_G87231],
Y = [] ;
X = [_G87231, _G87317],
Y = [] ;
X = [_G87231, _G87317, _G87403],
Y = [_G87403] ;
X = [_G87231, _G87317, _G87403, _G87489],
Y = [_G87403] ;
X = [_G87231, _G87317, _G87403, _G87489, _G87575],
Y = [_G87403] ;
X = [_G87231, _G87317, _G87403, _G87489, _G87575, _G87661],
Y = [_G87403, _G87661] .
There's a DCG approach that would also work, analogous to #repeat's answer:
thirds([]) --> [].
thirds([]) --> [_].
thirds([]) --> [_,_].
thirds([X|T]) --> [_,_,X], thirds(T).
Or more concisely (thanks #repeat):
thirds([]) --> [] | [_] | [_,_].
thirds([X|T]) --> [_,_,X], thirds(T).
Called as follows:
| ?- phrase(thirds(T), [a,b,c,d,e,f,g,h]).
T = [c,f] ? a
no
| ?- phrase(thirds(T), L).
L = []
T = [] ? ;
L = [_]
T = [] ? ;
L = [_,_]
T = [] ? ;
L = [_,_,A]
T = [A] ? ;
L = [_,_,A,_]
T = [A] ? ;
...
This will work:
bagof(Third,third(List,Third),Result).
This collects all items Third such that Third is third in List; and binds the list of them to Result.
For more on bag, see http://www.swi-prolog.org/pldoc/doc_for?object=bagof/3 .
Can you help me with this problem of backtracking in Prolog?
The string a1, ..., an is given and it consists of distinct integers.
It is required to display all sub-sets with aspect of "mountain"
(a set has a "mountain" aspect if the elements increase to a certain
point and then decrease).
Eg. 10 16 27 18 14 7.
I know how to verify if a set has mountain aspect...
but now I need to display all solutions :(
% munte(list,integer,integer)
% rezolvare(list)
munte([],2,_).
munte([H|[]],2,_).
munte([H|[H1|T]],Pas,Nr):-
Pas = 1,
H<H1,!,
L=[H1|T],
Nr1=Nr+1,
munte(L,Pas,Nr1).
munte([H|[H1|T]],Pas,Nr):-
Pas = 1,
H>H1,
Nr>1,!,
L=[H1|T],
Pas1=Pas + 1,
Nr1=Nr+1,
munte(L,Pas1,Nr1).
munte([H|[H1|T]],Pas,Nr):-
Pas = 2,
H>H1,!,
L=[H1|T],
Nr1=Nr+1,
munte(L,Pas,Nr1).
rezolvare(L1):-munte(L1,1,1).
Note that this answer deals with subsequences of lists, not subsets of sets.
In the following we use clpfd:
:- use_module(library(clpfd)).
We define hillSubseq_in/2 based on tfilter/3, (*)/2 and hill/1:
hillSubseq_in(Zs,Xs) :-
tfilter(*,Xs,Zs),
hill(Zs).
Sample query:
?- hillSubseq_in(Zs,[2,9,3,1,5,9,2]).
Zs = [2,9,3,1]
; Zs = [2,9,3,2]
; Zs = [2,9,3]
; Zs = [2,9,1]
; Zs = [2,9,5,2]
; Zs = [2,9,5]
; Zs = [2,9,2]
; Zs = [2,3,1]
; Zs = [2,3,5,9,2]
; Zs = [2,3,5,2]
; Zs = [2,3,9,2]
; Zs = [2,3,2]
; Zs = [2,5,9,2]
; Zs = [2,5,2]
; Zs = [2,9,2]
; Zs = [3,5,9,2]
; Zs = [3,5,2]
; Zs = [3,9,2]
; Zs = [1,5,9,2]
; Zs = [1,5,2]
; Zs = [1,9,2]
; Zs = [5,9,2]
; false.