Related
This recursion should slice IL to IR out of the list Lin and hand result LOut...
slice(_,IL,IR,LOut) :-
IR<IL,
[LOut].
slice(Lin,IL,IR,LOut) :-
nth0(IL,Lin,X),
append(LOut,[X],LOut2),
IK is IL + 1,
slice(Lin,IK,IR,LOut2).
Input / Output:
?- slice([1,2,3,4],2,3,X).
ERROR: source_sink `'3'' does not exist
ERROR: source_sink `'4'' does not exist
X = [] .
I m also new to Prolog, but I think this recursion must somehow work. Also I'm not really known to the error codes in Prolog, but after checking multiple times I just have to give up... I hope you guys can help me.
slice(_,IL,IR,LOut) :-
IR<IL,
[LOut]. % <-- this line causes source_sink error.
That syntax [name] tries to load the file name.pl as Prolog source code. By the time your code gets there, LOut is [3,4] so it tries to load the files 3.pl and 4.pl, and they don't exist (thankfully, or else who knows what they could do).
I think this recursion must somehow work
It won't; you are appending to a list as you go down into the recursion, which means you will never see the result.
The following might be a close version which works, at least one way:
slice(_,IL,IR,[]) :-
IR < IL.
slice(Lin,IL,IR,[X|LOut]) :-
IR >= IL,
nth0(IL,Lin,X),
IK is IL + 1,
slice(Lin,IK,IR,LOut).
?- slice([0,1,2,3,4,5,6,7,8,9], 2, 5, X).
X = [2, 3, 4, 5]
See how [X|LOut] in the second rule's header puts X in the result that you get, and append/3 is not needed, and LOut finishes down in the recursion eventually as [] the empty list from the first rule, and all the X's are prepended on the front of it to make the result on the way down into the recursion, which is tail recursion, so it doesn't need to go back up, only forward, since there's nothing left to be done after the recursive call.
Since the "cons" is done before the recursion, this is known as "tail recursion modulo cons" in other languages, but in Prolog it is just tail, and the list is being built top-down on the way forward, as opposed to being built bottom up on the way back:
Lin=[0,1,2,3,4,5,6,7,8,9], slice( Lin, 2, 5, R)
:-
nth0(2,Lin,X2), R=[X2|R2], slice( Lin, 3, 5, R2)
:-
nth0(3,Lin,X3), R2=[X3|R3], slice( Lin, 4, 5, R3)
:-
nth0(4,Lin,X4), R3=[X4|R4], slice( Lin, 5, 5, R4)
:-
nth0(5,Lin,X5), R4=[X5|R5], slice( Lin, 6, 5, R5)
:-
R5 = [].
I think findall/3 provides a readable readable solution for your problem:
slice(Lin,IL,IR,LOut) :-
findall(E,(nth0(P,Lin,E),between(IL,IR,P)),LOut).
yields
?- slice([1,2,3,4],2,3,X).
X = [3, 4].
If you expect a different outcome, use standard arithmetic comparison operators (=<,>=) instead of between/3.
I think you want:
list_elems_slice(Start, End, Lst, Slice) :-
list_elems_slice_(Lst, 1, Start, End, Slice).
list_elems_slice_([H|T], N, N, End, [H|Slice]) :-
list_elems_slice_capture_(T, N, End, Slice).
list_elems_slice_([_|T], N, Start, End, Slice) :-
N1 is N + 1,
list_elems_slice_(T, N1, Start, End, Slice).
list_elems_slice_capture_(_, N, N, []).
list_elems_slice_capture_([H|T], N, End, [H|Slice]) :-
N1 is N + 1,
list_elems_slice_capture_(T, N1, End, Slice).
Result in swi-prolog:
?- list_elems_slice(S, E, [a,b,c], Slice).
S = E, E = 1,
Slice = [a] ;
S = 1,
E = 2,
Slice = [a, b] ;
S = 1,
E = 3,
Slice = [a, b, c] ;
S = E, E = 2,
Slice = [b] ;
S = 2,
E = 3,
Slice = [b, c] ;
S = E, E = 3,
Slice = [c] ;
false.
Assuming that the point of this exercise is to teach you to think recursively, I would approach the problem as follows.
To get what you want is essentially two separate operations:
You first must discard some number of items from the beginning of the list, and then
Take some number of items from what's left over
That gives us discard/3:
discard( Xs , 0 , Xs ) .
discard( [_|Xs] , N , Ys ) :- N > 0 , N1 is N-1, discard(Xs,N1,Ys) .
and take/3, very nearly the same operation:
take( _ , 0 , [] ) .
take( [X|Xs] , N , [Y|Ys] ) :- N > 0 , N1 is N-1, take(Xs,N1,Ys) .
Once you have those two simple predicates, slice/4 itself is pretty trivial:
%
% slice( List , Left, Right, Sublist )
%
slice( Xs, L, R, Ys ) :- % to slice a list,
L =< R, % - the left offset must first be less than or equal to the right offset
N is R-L, % - compute the number of items required, and then
discard(Xs,L,X1), % - discard the first L items, and
take(X1,N,Ys). % - take the next N items
. % Easy!
Another approach would be to use append/3:
slice( Xs , L, R, Ys ) :-
length(Pfx,L), % - construct of list of the length to be discarded
append(Pfx,Sfx,Xs), % - use append to split Xs
N is R-L, % - compute the number of items required
length(Ys,N), % - ensure Ys is the required length
append(Ys,_,Sfx) % - use append to split off Ys
. % Easy!
Say I have these DCGs:
zorbs([H|T]) --> zorb(H), zorbs(T).
zorbs([]) --> [].
zorb(a) --> [1,2].
zorb(b) --> [3].
zorb(c) --> [6,1,2,2].
I can do this:
?- phrase(zorbs(X), [1,2,3,6,1,2,2]).
X = [a, b, c] .
I can also "reverse" this by doing:
phrase(zorbs([a,b,c]), X).
X = [1, 2, 3, 6, 1, 2, 2].
Now, what I want to do is find a list of numbers with length less than 4 (for example) which these elements "parse" into, returning the rest.
So, for example, given [a,b,c], which would normally relate to [1, 2, 3, 6, 1, 2, 2], I want it to relate to [1, 2, 3] (which has length less than 4) and also give the remainder that couldn't be "reversed," so [c]. I don't really know where to start, as it seems there's no way to reason about the number of elements you've already consumed in a DCG.
Here's a sort-of solution:
X in 0..4,
indomain(X),
Q = [_|_],
prefix(Q, [a,b,c]),
length(A, X),
phrase(zorbs(Q), A).
but I think this is very inefficient, because I think it basically iterates up from nothing, and I want to find the solution with the biggest Q.
There is no direct way how to do this in this case. So your approach is essentially what can be done. That is, you are enumerating all possible solutions and (what you have not shown) selecting them accordingly.
Questions about the biggest and the like include some quantification that you cannot express directly in first order logic.
However, sometimes you can use a couple of tricks.
Sometimes, a partial list like [a,b,c|_] may be helpful.
?- Xs = [_,_,_,_|_], phrase(zorbs(Xs),[1,2,3,6,1,2,2]).
false.
So here we have proven that there is no list of length 4 or longer that corresponds to that sequence. That is, we have proven this for infinitely many lists!
And sometimes, using phrase/3 in place of phrase/2 may help. Say, you have a number sequence that doesn't parse, and you want to know how far it can parse:
?- Ys0 = [1,2,3,6,1,2,7], phrase(zorbs(Xs),Ys0,Ys).
Ys0 = [1,2,3,6,1,2,7], Xs = [], Ys = [1,2,3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "a", Ys = [3,6,1,2,7]
; Ys0 = [1,2,3,6,1,2,7], Xs = "ab", Ys = [6,1,2,7]
; false.
(This is with the two DCG-rules exchanged)
Can use:
% Like "between", but counts down instead of up
count_down(High, Low, N) :-
integer(High),
integer(Low),
count_down_(High, Low, N).
count_down_(H, L, N) :-
compare(C, H, L),
count_down_comp_(C, H, L, N).
count_down_comp_('=', _H, L, N) :-
% All equal, final
N = L.
% Accept H as the counting-down value
count_down_comp_('>', H, _L, H).
count_down_comp_('>', H, L, N) :-
H0 is H - 1,
% Decrement H towards L, and loop
count_down_(H0, L, N).
... and then start with:
count_down(4, 1, Len), length(Lst, Len), phrase...
Another method is to use freeze to limit a list's length, element-by-element:
max_len_freeze(Lst, MaxLen) :-
compare(C, MaxLen, 0),
max_len_freeze_comp_(C, Lst, MaxLen).
max_len_freeze_comp_('=', [], 0).
max_len_freeze_comp_('>', [_|Lst], MaxLen) :-
succ(MaxLen0, MaxLen),
!,
freeze(Lst, max_len_freeze(Lst, MaxLen0)).
max_len_freeze_comp_('>', [], _).
... and then start with:
max_len_freeze(Lst, 4), phrase...
This will work to find the longest list (maximum length 4) first, since your DCG is greedy (i.e. matching [H|T] before []).
I want to exclude multiple rotations/mirrors of a list in my solutions of the predicate. I'll give an example of what I understand are rotations/mirrors of a list:
[1,2,3,4,5]
[2,3,4,5,1]
[3,4,5,1,2]
[5,4,3,2,1]
I have to find a predicate that delivers unique sequence of numbers from 1 to N, according to some constraints. I already figured out how to compute the right sequence but I can't find out how to exclude all the rotations and mirrors of 1 list. Is there an easy way to do this?
Edit:
Full predicate. clock_round(N,Sum,Yf) finds a sequence of the numbers 1 to N in such a way that no triplet of adjacent numbers has a sum higher than Sum.
clock_round(N,Sum,Yf) :-
generate(1,N,Xs),
permutation(Xs,Ys),
nth0(0,Ys,Elem1),
nth0(1,Ys,Elem2),
append(Ys,[Elem1,Elem2],Ym),
safe(Ym,Sum),
remove_duplicates(Ym,Yf).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
% generate/3 generates list [1..N]
generate(N,N,[N]).
generate(M,N,[M|List]) :-
M < N, M1 is M + 1,
generate(M1,N,List).
% permutation/2
permutation([],[]).
permutation(List,[Elem|Perm]) :-
select(Elem,List,Rest),
permutation(Rest,Perm).
safe([],_).
safe(List,Sum) :-
( length(List,3),
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum
; [_|RestList] = List, % first to avoid redundant retries
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum,
safe(RestList,Sum)
).
So what you want is to identify certain symmetries. At first glance you would have to compare all possible solutions with such. That is, in addition of paying the cost of generating all possible solutions you will then compare them to each other which will cost you a further square of the solutions.
On the other hand, think of it: You are searching for certain permutations of the numbers 1..n, and thus you could fix one number to a certain position. Let's fix 1 to the first position, that is not a big harm, as you can generate the remaining n-1 solutions by rotation.
And then mirroring. What happens, if one mirrors (or reverses) a sequence? Another sequence which is a solution is produced. The open question now, how can we exclude certain solutions and be sure that they will show up upon mirroring? Like: the number after 1 is larger than the number before 1.
At the end, rethink what we did: First all solutions were generated and only thereafter some were removed. What a waste! Why not avoid to produce useless solutions first?
And even further at the end, all of this can be expressed much more efficiently with library(clpfd).
:- use_module(library(clpfd)).
clock_round_(N,Sum,Xs) :-
N #=< Sum, Sum #=< 3*N -2-1,
length(Xs, N),
Xs = [D,E|_],
D = 1, append(_,[L],Xs), E #> L, % symmetry breaking
Xs ins 1..N,
all_different(Xs),
append(Xs,[D,E],Ys),
allsums(Ys, Sum).
allsums([], _).
allsums([_], _).
allsums([_,_], _).
allsums([A,B,C|Xs], S) :-
A+B+C #=< S,
allsums([B,C|Xs], S).
?- clock_round_(N, Sum, Xs), labeling([], [Sum|Xs]).
N = 3, Sum = 6, Xs = [1,3,2]
; N = 4, Sum = 9, Xs = [1,3,4,2]
; N = 4, Sum = 9, Xs = [1,4,2,3]
; N = 4, Sum = 9, Xs = [1,4,3,2]
; N = 5, Sum = 10, Xs = [1,5,2,3,4]
; ... .
Here is a possibility do do that :
is_rotation(L1, L2) :-
append(H1, H2, L1),
append(H2, H1, L2).
is_mirror(L1, L2) :-
reverse(L1,L2).
my_filter([H|Tail], [H|Out]):-
exclude(is_rotation(H), Tail, Out_1),
exclude(is_mirror(H), Out_1, Out).
For example
?- L = [[1,2,3,4,5],[2,3,4,5,1],[3,4,5,1,2],[5,4,3,2,1], [1,3,2,4,5]],my_filter(L, Out).
L = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [5, 4, 3, 2, 1], [1, 3, 2, 4|...]],
Out = [[1, 2, 3, 4, 5], [1, 3, 2, 4, 5]].
The point of this program is supposed to be to find the largest even number inside a list. For example, the query:
? - evenmax([1, 3, 9, 16, 25, -5, 18], X]
X = 18.
The way I thought to do this is to separate the list into two, one with just odd numbers and one with just even numbers. However, after doing that, I legitimately have no idea how to take the even-number list specifically and find the maximum integer in that.
Here is what I currently have:
seperate_list([], [], []).
separate_list([X|Xs], [X|Even], Odd) :-
0 is X mod 2,
separate_list(Xs, Even, Odd).
separate_list([X|Xs], Even, [X|Odd]) :-
1 is X mod 2,
separate_list(Xs, Even, Odd).
find_max([X|Xs], A, Max).
X > A,
find_max(Xs,X,Max).
find_max([X|Xs],A,Max) :-
X =< A,
find_max(Xs,A,Max).
find_max([],A,A).
I am still a newcomer to Prolog, so please bear with me...and I appreciate the help.
You could do it in one go. You can find the first even number in the list, then use this as seed and find the largest even number in the rest of the list.
But if you don't insist on doing it in a single traversal through the list, you can first collect all even numbers, then sort descending and take the first element of the sorted list.
evenmax(List, M) :-
include(even, List, Even),
sort(Even, Sorted),
reverse(Sorted, [M|_]).
even(E) :-
E rem 2 =:= 0.
If you want to see how include/2 is implemented, you can look here. Basically, this is a generalized and optimized version of the separate_list/3 that you have already defined in your question. sort/2 is a built-in, and reverse/2 is a library predicate, implementation is here.
There are many other ways to achieve the same, but for starters this should be good enough. You should ask more specific questions if you want more specific answers, for example:
What if the list has free variables?
What if you want to sort in decreasing order instead of sorting and then reversing?
How to do it in a single go?
and so on.
Sorry but... if you need the maximum (even) value... why don't you simply scan the list, memorizing the maximum (even) value?
The real problem that I see is: wich value return when there aren't even values.
In the following example I've used -1000 as minumum value (in case of no even values)
evenmax([], -1000). % or a adeguate minimum value
evenmax([H | T], EM) :-
K is H mod 2,
K == 0,
evenmax(T, EM0),
EM is max(H, EM0).
evenmax([H | T], EM) :-
K is H mod 2,
K == 1,
evenmax(T, EM).
-- EDIT --
Boris is right: the preceding is a bad solution.
Following his suggestions (thanks!) I've completely rewritten my solution. A little longer but (IMHO) a much better
evenmaxH([], 1, EM, EM).
evenmaxH([H | T], 0, _, EM) :-
0 =:= H mod 2,
evenmaxH(T, 1, H, EM).
evenmaxH([H | T], 1, M0, EM) :-
0 =:= H mod 2,
M1 is max(M0, H),
evenmaxH(T, 1, M1, EM).
evenmaxH([H | T], Found, M, EM) :-
1 =:= H mod 2,
evenmaxH(T, Found, M, EM).
evenmax(L, EM) :-
evenmaxH(L, 0, 0, EM).
I define evenmax like there is no member of list L which is even and is greater than X:
memb([X|_], X).
memb([_|T], X) :- memb(T,X).
even(X) :- R is X mod 2, R == 0.
evenmax(L, X) :- memb(L, X), even(X), not((memb(L, Y), even(Y), Y > X)), !.
There are already a number of good answers, but none that actually answers this part of your question:
I legitimately have no idea how to take the even-number list
specifically and find the maximum integer in that
Given your predicate definitions, it would be simply this:
evenmax(List, EvenMax) :-
separate_list(List, Evens, _Odds),
find_max(Evens, EvenMax).
For this find_max/2 you also need to add a tiny definition:
find_max([X|Xs], Max) :-
find_max(Xs, X, Max).
Finally, you have some typos in your code above: seperate vs. separate, and a . instead of :- in a clause head.
I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:
L has length 2N,
every number between 1 and N occurs exactly twice in L,
between each pair of the same element there is an even number of other elements,
the first occurrences of each number are in increasing order.
The author states that there are N! such lists.
For example, for N = 3 all solutions are:
?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.
My current solution looks like:
even_distance(H, [H | _]) :-
!.
even_distance(V, [_, _ | T]) :-
even_distance(V, T).
list(N, [], _, Length, _, _) :-
Length =:= 2*N,
!.
list(N, [New | L], Max, Length, Used, Duplicates) :-
select(New, Duplicates, NewDuplicates),
even_distance(New, Used),
NewLength is Length + 1,
list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
Max < N,
New is Max + 1,
NewLength is Length + 1,
list(N, L, New, NewLength, [New | Used], [New | Duplicates]).
list(N, L) :-
list(N, L, 0, 0, [], []).
It does two things:
if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.
It works, but it's slow and doesn't look really nice.
The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.
I have two questions:
How to improve this algorithm?
Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.
I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).
The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.
I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...
list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).
list_([D|Ds],[D|Rs]) :-
list_(Ds,Ts),
select(D,Rs,Ts).
list_([],[]).
even_(L) :-
forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).
select/3 is used in 'insert mode'.
edit to avoid arithmetic, we could use this more verbose schema
even_(L) :-
maplist(even_(L),L).
even_(L,E) :-
append(_,[E|R],L),
even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).
edit
Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.
list(N,L) :-
N2 is N*2,
length(L,N2),
numlist(1,N,Ns),
pairs(Ns,L).
pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).
first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).
even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).
My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...