I'm doing an exercise in Prolog and I'm stuck.
I need to swap three adjacent items in a list with another three elements.
That is:
| ?- swap([c,g,g,a,t,t,g,c,a,a], X).
X = [a,t,t,c,g,g,g,c,a,a]
X = [g,c,a,a,t,t,c,g,g,a]
X = [c,g,g,g,c,a,a,t,t,a]
X = [c,a,a,a,t,t,g,c,g,g]
.
.
.
This is what I have so far:
swap([H1, H2, H3, H4, H5, H6|T1], X) :-
X = [H4, H5, H6, H1, H2, H3|T1];
swap([H2, H3, H4, H5, H6|T1], X);
swap([H1, H2, H3, H4, H5|T1], X).
And the output for this is:
| ?- swap([c,g,g,a,t,t,g,c,a,a], X).
X = [a, t, t, c, g, g, g, c, a, a] ;
X = [t, t, g, g, g, a, c, a, a] ;
X = [t, g, c, g, a, t, a, a] ;
X = [g, c, a, a, t, t, a] ;
X = [c, a, a, t, t, g] ;
X = [c, a, a, a, t, t] ;
X = [g, c, a, g, a, t, a] ;
X = [c, a, a, a, t, g] ;
X = [c, a, a, g, a, t] ;
X = [t, g, c, g, g, a, a, a] ;
X = [g, c, a, g, a, t, a] ;
X = [c, a, a, a, t, g] ;
X = [c, a, a, g, a, t] ;
X = [g, c, a, g, g, a, a] ;
X = [c, a, a, g, a, g] ;
X = [c, a, a, g, g, a] ;
X = [t, t, g, c, g, g, c, a, a] ;
X = [t, g, c, g, g, t, a, a] ;
X = [g, c, a, g, t, t, a] ;
X = [c, a, a, t, t, g] ;
X = [c, a, a, g, t, t] ;
X = [g, c, a, g, g, t, a] ;
X = [c, a, a, g, t, g] ;
X = [c, a, a, g, g, t] ;
X = [t, g, c, c, g, g, a, a] ;
X = [g, c, a, g, g, t, a] ;
X = [c, a, a, g, t, g] ;
X = [c, a, a, g, g, t] ;
X = [g, c, a, c, g, g, a] ;
X = [c, a, a, g, g, g] ;
X = [c, a, a, c, g, g] ;
false.
The only problem that I have is that with every recursion I lose some part of the list and I don't know how to put it back.
It seems you are interested in describing RNA-sequences. Triples, that sounds much like anticodons. To make those sequences more readable, use:
:- set_prolog_flag(double_quotes, chars).
which permits you to write "attac" in place of [a,t,t,a,c]. See this how to get also compact answers.
Now for the swap. The easiest way is to first sketch what you want:
... Triple1 ... Triple2 ... is the OldSequence
... Triple2 ... Triple1 ... is the NewSequence
Where the ... are the same for both sequences. All of this can be readily translated using DCGs.
tripleswap(OldSequence, NewSequence) :-
dif(T1,T2),
phrase( ( seq(A), triple(T1), seq(B), triple(T2), seq(C) ), OldSequence),
phrase( ( seq(A), triple(T2), seq(B), triple(T1), seq(C) ), NewSequence).
seq([]) --> [].
seq([B|Bs]) --> [B], seq(Bs).
triple([A,B,C]) --> [A,B,C].
Whenever you distrust a DCG-definition, just try it out with phrase/2. Like
?- phrase(triple(T1), Bs).
T1 = Bs, Bs = [_A,_B,_C].
The non-terminal triple//1 describes a sequence of 3 elements (presumably nucleotides).
seq//1 is an arbitrarily long sequence.
There are solutions with better termination conditions, but they are less readable and often require certain assumptions that are difficult to maintain in the general case. Here is such a simple improvement:
samelength([], []).
samelength([_|Xs], [_|Ys]) :-
samelength(Xs, Ys).
and add samelength(OldSequence, NewSeqence) as the first goal. Now, tripleswap/2 terminates iff samelength/2 terminates. So one of the arguments should be a list of fixed length.
Also note that I think that "cccccc" has no swap. That's why I added dif(T1,T2).
?- tripleswap("cggattgcaa", Bs).
Bs = "attcgggcaa"
; Bs = "ttgacggcaa"
; Bs = "tgcatcggaa"
; Bs = "gcaattcgga"
; Bs = "caaattgcgg"
; Bs = "cttgggacaa"
; Bs = "ctgctggaaa"
; Bs = "cgcattggaa"
; Bs = "ccaattggga"
; Bs = "cgtgcgataa"
; Bs = "cggcatgata"
; Bs = "cgcaatggat"
; Bs = "cgggcaatta"
; Bs = "cggcaagatt"
; Bs = "cggacaattg"
; false.
BTW, dcgs are used in Molecular Biology since the 1980s. Start with
David B. Searls, Investigating the Linguistics of DNA with Definite Clause Grammars, NACLP 1989
and other work by the same author as well as Ross Overbeek around that time. All of this happened in the dawn of the Human Genome Project.
Basically this can be split into two subproblems:
first take a sequence of three elements; and
take another sequence of three elements and produce a list where we swapped these.
We can thus implement the two problems as follows:
swap(L, X) :-
swap1(L, S1, S2, T, X, Q),
swap2(T, S1, S2, Q).
where L is the list where we need to perform the swaps, X the list that is unified with the results, S1 and S2 the sequences that we select to swap, T the remaining elements after the first selection, and Q the part after the second sequence of the list to swap.
The first swap1 can thus be implemented as:
swap1([A1, A2, A3|T], [A1, A2, A3], [B1, B2, B3], T, [B1, B2, B3|Q], Q).
swap1([A1|T], A, B, R, [A1|Rest], S) :-
swap1(T, A, B, R, Rest, S).
For the given sample list, this will thus yield:
?- swap1([c,g,g,a,t,t,g,c,a,a], A, [B1, B2, B3], T, X, R).
A = [c, g, g],
T = [a, t, t, g, c, a, a],
X = [B1, B2, B3|R] ;
A = [g, g, a],
T = [t, t, g, c, a, a],
X = [c, B1, B2, B3|R] ;
A = [g, a, t],
T = [t, g, c, a, a],
X = [c, g, B1, B2, B3|R] ;
A = [a, t, t],
T = [g, c, a, a],
X = [c, g, g, B1, B2, B3|R] ;
A = [t, t, g],
T = [c, a, a],
X = [c, g, g, a, B1, B2, B3|R] ;
A = [t, g, c],
T = [a, a],
X = [c, g, g, a, t, B1, B2, B3|R] ;
A = [g, c, a],
T = [a],
X = [c, g, g, a, t, t, B1, B2, B3|...] ;
A = [c, a, a],
T = [],
X = [c, g, g, a, t, t, g, B1, B2|...] ;
false.
Here it thus proposes eight ways to pick three adjacent sequences that can be used to swap.
Then the second swap need to find three adjacent elements in the remaining lists to swap, and put the ones that have been picked by swap1/6 at the places where it picks elements from, like:
swap2([B1,B2,B3|R], [A1,A2,A3], [B1, B2, B3], [A1,A2,A3|R]).
swap2([B1|R], As, Bs, [B1|T]) :-
swap2(R, As, Bs, T).
For the given sample data, this thus gives us:
?- swap([c,g,g,a,t,t,g,c,a,a], X).
X = [a, t, t, c, g, g, g, c, a, a] ;
X = [t, t, g, a, c, g, g, c, a, a] ;
X = [t, g, c, a, t, c, g, g, a, a] ;
X = [g, c, a, a, t, t, c, g, g, a] ;
X = [c, a, a, a, t, t, g, c, g, g] ;
X = [c, t, t, g, g, g, a, c, a, a] ;
X = [c, t, g, c, t, g, g, a, a, a] ;
X = [c, g, c, a, t, t, g, g, a, a] ;
X = [c, c, a, a, t, t, g, g, g, a] ;
X = [c, g, t, g, c, g, a, t, a, a] ;
X = [c, g, g, c, a, t, g, a, t, a] ;
X = [c, g, c, a, a, t, g, g, a, t] ;
X = [c, g, g, g, c, a, a, t, t, a] ;
X = [c, g, g, c, a, a, g, a, t, t] ;
X = [c, g, g, a, c, a, a, t, t, g] ;
false.
Here the places that are swapped are written in boldface.
I think permutation/2 will help:
swap(Es,Sw) :- triples(Es,Ts),permutation(Ts,Sw0),append(Sw0,Sw).
triples([A,B,C|Es],[[A,B,C]|Ts]) :- !, triples(Es,Ts).
triples([],[]) :- !.
triples(R,[R]).
yields
?- swap([c,g,g, a,t,t, g,c,a], X).
X = [c, g, g, a, t, t, g, c, a] ;
X = [c, g, g, g, c, a, a, t, t] ;
X = [a, t, t, c, g, g, g, c, a] ;
X = [a, t, t, g, c, a, c, g, g] ;
X = [g, c, a, c, g, g, a, t, t] ;
X = [g, c, a, a, t, t, c, g, g] ;
false.
note: triples/2 allows for not triple data in tail, but you can drop this (maybe unwanted) feature just deleting the last clause:
triples(R,[R]). % drop this
Then the cuts become useless, just drop drop them:
triples([],[]). % just for style in this case, move to first clause
triples([A,B,C|Es],[[A,B,C]|Ts]) :- triples(Es,Ts).
I am having trouble starting this Prolog program that takes two lists and returns true if all members in the first list are members of the second list, and false otherwise.
Examples:
?- members([a, c], [a, b, c, d])
true
?- members([d, a, c, a], [a, b, c, d, e])
true
?- members([b, e], [a, b, c, d])
false
?- members([], [a, b, c, d])
true
How do I go about doing this? Any help is appreciated.
You can use maplist on this kind of problem since it follows a standard recursive list traversal:
mem(L, X) :- memberchk(X, L).
subset(S, L) :- maplist(mem(L), S).
Results:
| ?- subset([a,c], [a,b,c,d]).
yes
| ?- subset([c,a], [a,b,c,d]).
yes
| ?- subset([e], [a,b,c,d]).
no
| ?- subset([], [a,b,c,d]).
yes
| ?- subset(S, [a,b,c,d]), S=[_|_].
S = [a] ? ;
S = [a,a] ? ;
S = [a,a,a] ? ;
...
Note that the original problem definition does not rule out the case where the subset can have duplicate elements from the superset. If you want to restrict the subsets to having counts of elements less than or equal to the superset, you can use select/3:
subset([], _).
subset([X|Xs], L) :-
select(X, L, L1),
subset(Xs, L1).
Results:
| ?- subset([a,c], [a,b,c,d,e]).
true ? ;
no
| ?- subset([a,f], [a,b,c,d,e]).
no
| ?- subset([a,a], [a,b,c,d,e]).
no
| ?- subset(S, [a,b,c]), S=[_|_].
S = [a] ? ;
S = [a,b] ? ;
S = [a,b,c] ? ;
S = [a,c] ? ;
S = [a,c,b] ? ;
S = [b] ? ;
S = [b,a] ? ;
...
S = [c,b] ? ;
S = [c,b,a] ? ;
no
You'll note that the list [c,b,a] is considered a different list in Prolog versus [a,b,c] so it is a separate solution. If you want to make the lists behave truly as sets, then that's a different solution.
"We tried nothing and we're all out of ideas"
I would suggest you find a predicate that does that, then look at its implementation.
$ swipl
?- subset([a, c], [a, b, c, d]).
true.
?- subset([d, a, c, a], [a, b, c, d, e]).
true.
?- subset([b, e], [a, b, c, d]).
false.
?- subset([], [a, b, c, d]).
true.
It is documented here: http://www.swi-prolog.org/pldoc/doc_for?object=subset/2
You can click on the little yellow circle with the colon and the dash to see how it is implemented: http://www.swi-prolog.org/pldoc/doc/SWI/library/lists.pl?show=src#subset/2
713 subset([], _) :- !.
714 subset([E|R], Set) :-
715 memberchk(E, Set),
716 subset(R, Set).
This definition is about the same as:
maplist([M]>>memberchk(M, Set), Subset)
This definition always succeeds or fails only once. This is by design.
It could also have been implemented like this:
maplist([M]>>member(M, Set), Subset)
And it behaves like the suggestion in the comments:
?- maplist([M]>>member(M, [a,b]), Subset).
Subset = [] ;
Subset = [a] ;
Subset = [a, a] ;
Subset = [a, a, a] ;
Subset = [a, a, a, a] .
?- length(Subset, _), maplist([M]>>member(M, [a,b]), Subset).
Subset = [] ;
Subset = [a] ;
Subset = [b] ;
Subset = [a, a] ;
Subset = [a, b] ;
Subset = [b, a] ;
Subset = [b, b] ;
Subset = [a, a, a] ;
Subset = [a, a, b] .
I've wrapped my mind a lot and couldn't figure it out.
Is it possible to make a script that with backtrack generates lists in this format:
[a]
[a,b]
[a,b,a]
[a,b,a,b]
...
I've made one that generates two elements at a time but my head started to hurt trying to make one that generates "a" and the next time "b" and the next "a" and so on.
Here is the script for two elements at a time:
ab([a]).
ab([b,a|T]):-ab([a|T]).
ab([a,b|T]):-ab([b|T]).
When describing lists, always consider using DCG notation.
This makes it very convenient to focus an the essence of what you want to describe, without so many additional variables and arguments.
For example, consider:
abs --> [a], abs_rest.
abs_rest --> [].
abs_rest --> [b], ( [] | abs ).
Sample query and answer:
?- phrase(abs, ABs).
ABs = [a] ;
ABs = [a, b] ;
ABs = [a, b, a] ;
ABs = [a, b, a, b] ;
ABs = [a, b, a, b, a] ;
ABs = [a, b, a, b, a, b] .
See dcg for more information about this convenient formalism!
I agree with #mat that one should use dcg when possible for these type of problems.
Here is a different set of rules.
abs --> [a].
abs --> [a,b].
abs --> [a,b], abs.
?- phrase(abs, Ls).
Ls = [a] ;
Ls = [a, b] ;
Ls = [a, b, a] ;
Ls = [a, b, a, b] ;
Ls = [a, b, a, b, a] ;
Ls = [a, b, a, b, a, b] ;
Ls = [a, b, a, b, a, b, a] ;
Ls = [a, b, a, b, a, b, a, b] ;
Ls = [a, b, a, b, a, b, a, b, a]
Interestingly those rules started from this variation
abs2 --> [].
abs2 --> [a].
abs2 --> [a,b], abs2.
?- phrase(abs2, Ls).
Ls = [] ;
Ls = [a] ;
Ls = [a, b] ;
Ls = [a, b, a] ;
Ls = [a, b, a, b] ;
Ls = [a, b, a, b, a] ;
Ls = [a, b, a, b, a, b] ;
Ls = [a, b, a, b, a, b, a] ;
Ls = [a, b, a, b, a, b, a, b]
which is one of the exercises from Using Definite Clause Grammars in SWI-Prolog
If you prefer not to use DCG, then I agree with #mat and suggest that you use listing/1 to see the DCG in standard Prolog syntax.
listing(abs).
abs([a|A], A).
abs([a, b|A], A).
abs([a, b|A], B) :-
abs(A, B).
listing(abs2).
abs2(A, A).
abs2([a|A], A).
abs2([a, b|A], B) :-
abs2(A, B).
As normal Prolog rules they can be used as such:
abs(X,[]).
X = [a] ;
X = [a, b] ;
X = [a, b, a] ;
X = [a, b, a, b] ;
X = [a, b, a, b, a] ;
X = [a, b, a, b, a, b] ;
X = [a, b, a, b, a, b, a]
abs2(X,[]).
X = [] ;
X = [a] ;
X = [a, b] ;
X = [a, b, a] ;
X = [a, b, a, b] ;
X = [a, b, a, b, a] ;
X = [a, b, a, b, a, b]
The predicate you wrote is too general:
?- ab([b,a]).
true
The cause is the following rule
ab([b,a|T]) :-
ab([a|T]).
One could say that you describe an intermediate result which is no solution to your actual problem. To fix this, you could state than an ab sequence starts with a and the rest bust be a ba sequence, where ba sequences are again defined in terms of ab sequences:
ab([a]).
ab([a|Xs]) :-
ba(Xs).
ba([b]).
ba([b|Xs]) :-
ab(Xs).
Alternatively, you could think of abs as a state machine which
produces a whenever the last element was b and vice versa.
If we introduce an additional argument to trace the history, we arrive at:
abs(a,[a]).
abs(b,[b]).
abs(a,[a|Xs]) :-
abs(b,Xs).
abs(b,[b|Xs]) :-
abs(a,Xs).
Now we define an ab sequence as one which last prepended an a:
ab(Xs) :-
abs(a,Xs).
Have fun :)
I have written the following code to check whether it is a palindrome or not. I have also created the logic to insert elements when the list is not a palindrome
reverse_list(Inputlist, Outputlist) :-
reverse(Inputlist, [], Outputlist).
reverse([], Outputlist, Outputlist).
reverse([Head|Tail], List1, List2) :-
reverse(Tail, [Head|List1], List2).
printList([]).
printList([X|List]) :-
write(X),
write(' '),
printList(List).
palindrome(List1) :-
reverse_list(List1, List2),
compareLists(List1, List1, List2, List2).
compareLists(L1, [], [], L2) :-
write("\nList is Palindrome").
compareLists(L1, [X|List1], [X|List2], L2) :-
compareLists(L1, List1, List2, L2),
!.
compareLists(L1, [X|List1], [Y|List2], [Z|L2]) :-
write("\nList is not Palindrome. "),
append(L1, L2, L),
printList(L).
The code gives the correct output for
palindrome([a,b,c,a]).
List is not Palindrome. a b c a c b a
palindrome([a,b,c]).
List is not Palindrome. a b c b a
However, for an input such as
palindrome([a,b,c,b]).
List is not Palindrome. a b c b c b a
The optimal solution however should be
a b c b a
What changes should I incorporate to be able to achieve this?
The first 3 equations of a DCG capture the palindrome pattern.
Add a fourth, covering the mismatch, to complete the specification:
p([]) --> [].
p([T]) --> [T].
p([T|R]) --> [T], p(P), [T], {append(P,[T],R)}.
p([T|R]) --> [T], p(P), {append(P,[T],R)}.
?- phrase(p(L), [a,b,c,b]).
L = [a, b, c, b, a] ;
L = [a, b, c, c, b, a] ;
L = [a, b, c, b, c, b, a] ;
L = [a, b, c, b, b, c, b, a] ;
false.
I think you need a predicate with two Args, In and Out :
pal([], []).
pal([X], [X]).
pal(In, Out) :-
% first we check if the first and last letter are the same
( append([H|T], [H], In)
% we must check that the middle is a palindrome
-> pal(T, T1),
append([H|T1], [H], Out)
; % if not, we remove the first letter
% and we work with the rest
In = [H|T],
% we compute the palindrome from T
pal(T,T1),
% and we complete the palindrome to
% fit the first letter of the input
append([H|T1], [H], Out)).
EDIT1
This code looks good but there is a bug for
? pal([a,b,c,a], P).
P = [a, b, c, b, a] .
Should be [a,b,c,a,c,b,a]
I'll try to fix it.
EDIT2
Looks correct :
build_pal([H|T], Out):-
pal(T,T1),
append([H|T1], [H], Out).
pal([], []).
pal([X], [X]).
pal(In, Out) :-
( append([H|T], [H], In)
-> pal(T, T1),
( T = T1
-> append([H|T1], [H], Out)
; build_pal(In, Out))
; build_pal(In, Out)).
with output :
?- pal([a,b,c], P).
P = [a, b, c, b, a] .
?- pal([a,b,a], P).
P = [a, b, a] .
?- pal([a,b,c,b], P).
P = [a, b, c, b, a] .
?- pal([a,b,c,a], P).
P = [a, b, c, a, c, b, a] .
?- pal([a,b,a,c,a], P).
P = [a, b, a, c, a, b, a] .
I have a list of tuples:
L = [{1, [a, b, c]}, {2, [d, e, f]}, {3, [[h, i, j], [k, l, m]]}]
this is what I have
lists:map(fun({_, B}-> B end, L).
the output is
[[a, b, c], [d, e, f], [[h, i, j], [k, l, m]]]
what I want is:
[[a, b, c], [d, e, f], [h, i, j], [k, l, m]]
it seems a pretty easy problem, but I can't figure out how to do it.
Please help!
Let's see...
1> L = [{1, [a, b, c]}, {2, [d, e, f]}, {3, [[h, i, j], [k, l, m]]}].
[{1,[a,b,c]},{2,[d,e,f]},{3,[[h,i,j],[k,l,m]]}]
Trivial and straightforward, but not tail-recursive:
2> lists:foldr(fun ({_,[X|_]=E},A) when is_list(X) -> lists:append(A,E);
({_,E},A) -> [E|A] end,
[], L).
[[a,b,c],[d,e,f],[h,i,j],[k,l,m]]
Not being tail-recursive is not very nice, though, but...
3> lists:reverse(lists:foldl(fun ({_,[X|_]=E},A) when is_list(X) ->
lists:reverse(E,A);
({_,E},A) -> [E|A] end,
[], L)).
[[a,b,c],[d,e,f],[h,i,j],[k,l,m]]
...the tail-recursive version also works (thanks to Zed for pointing out lists:reverse/2).
For your specific example case, you can define the following function:
group3([], Acc) ->
Acc;
group3([A,B,C|Tl], Acc) ->
group3(Tl, [[A,B,C]] ++ Acc).
group3(L) ->
lists:reverse(group3(L, [])).
and invoke it like this:
group3(lists:flatten(lists:map(fun({_, B}) -> B end, L))).
Hopefully that's enough to give you a general strategy.
-module(z).
-export([do/1]).
do([{_,[X|_] = L}|Tl]) when is_list(X) -> L ++ do(Tl);
do([{_, L} |Tl]) -> [L|do(Tl)];
do([]) -> [].
test:
1> z:do(L).
[[a,b,c],[d,e,f],[h,i,j],[k,l,m]]