I'm trying to make a prolog predicate "comprueba(A,B,C,D,E)" that do the next statements:
All arguments are lists.
List D contains only the elements that are on A and B at the same time.
List D elements number of ocurrences must be the same ocurrences in A.
List E contains only the elements of A that are not on C and not on D.
List E elements number of ocurrences must be three times the occurrences in A.
There are no more elements than these in D or E.
The predicate must be true even if the order of D or E differs from A.
So here is my code:
comprueba(A,B,C,D,E) :- lista([A]),
lista([B]),
lista([C]),
lista([D]),
lista([E]),
inter(A,B,D),
checko(D,D,A,1).
%checke2(A,C,D,E),
%checko(E,E,A,3).
lista([]).
lista([_|T]) :-lista(T).
inter([], _, []).
inter([H1|T1], L2, [H1|Res]) :- memberof(H1, L2), inter(T1, L2, Res).
inter([_|T1], L2, Res) :- inter(T1, L2, Res).
checke2([],_,_,_).
checke2(A,C,D,E) :- subtract(A,D,X), subtract(A,C,Y), inter(X,Y,E).
count(_, [], N) :- N is 0.
count(X, [X|T], N1) :- count(X, T, N2), N1 is N2 + 1.
count(X, [Y|T], N) :- X \= Y, count(X, T, N).
memberof(X, [X|_]).
memberof(X, [_|T]) :- memberof(X,T).
checko([],_,_,_).
checko([H|T],L1,L2,N) :- count(H,L1,N1), count(H,L2,N2), N3 is N * N2, N1 = N3, checko(T,L1,L2,N).
After doing some testing I'm stucked, because I cannot get it true, if the list are not on the same order, e.g:
17 ?- comprueba([1,2,3,4,2,5,8,9],[2,3,4,7],[1,2,3,8],[2,2,3,4],[5,5,5,9,9,9]).
false.
18 ?- comprueba([1,2,3,4,2,5,8,9],[2,3,4,7],[1,2,3,8],[2,3,4,2],[5,5,5,9,9,9]).
true
So I really ask you for help to try to solve it, and continue with the next part, with E list.
Thanks you in advance.
PD:
sorry if the format is not the properly, it's my first post here :)
You could add a goal that describes D as any permutation of the 4th list (in the below example D2).
comprueba(A,B,C,D,E) :- lista([A]),
lista([B]),
lista([C]),
lista([D2]),
lista([E]),
inter(A,B,D2),
checko(D2,D2,A,1),
permutation(D2,D).
If you are not allowed to use permutation/2 from library(lists) permutation could look something like this:
% permutation(List1,List2)
% List2 is a permutation of List1
permutation([],[]).
permutation(Xs,[Z|Zs]) :-
element(Z,Xs,Ys),
permutation(Ys,Zs).
% element(X,List1,List2)
% X is element of List1, List2 = List1 without X
element(X,[X|Xs],Xs).
element(X,[Y|Ys],[Y|Zs]) :-
element(X,Ys,Zs).
With this additional goal your predicate comprueba/5 works with both of your queries.
?- comprueba([1,2,3,4,2,5,8,9],[2,3,4,7],[1,2,3,8],[2,2,3,4],[5,5,5,9,9,9]).
yes
?- comprueba([1,2,3,4,2,5,8,9],[2,3,4,7],[1,2,3,8],[2,3,4,2],[5,5,5,9,9,9]).
yes
Related
I am writing a predicate in prolog that will break a list with an even number of variables into two halves and swap them. For example [a,b,c,d] --> [c,d,a,b].
append([], List, List).
append([Head|Tail], List, [Head|Rest]) :-
append(Tail, List, Rest).
divide(L, X, Y) :-
append(X, Y, L),
length(X, N),
length(Y, N).
swap([], []).
swap([A], D) :-
divide(A, B, C),
append(C, B, D).
I would expect this to work by dividing [A] into two smaller equal sized lists, then appending them together in the reverse order, and then assigning the variable "D" to the list.
What I am getting is "false", why does this not work?
I'm very new to prolog so this might be a silly/simple question, thanks!
Your question is why swap([a,b,c,d],[c,d,a,b]) fails. And here is the actual reason:
?- swap([_/*a*/,_/*b*/|_/*,c,d*/],_/*[c,d,a,b]*/).
:- op(950, fy, *).
*(_).
swap([], _/*[]*/).
swap([A], D) :-
* divide(A, B, C),
* append(C, B, D).
So, not only does your original query fail, but even this generalization fails as well. Even if you ask
?- swap([_,_|_],_).
false.
you just get failure. See it?
And you can ask it also the other way round. With above generalization, we can ask:
?- swap(Xs, Ys).
Xs = []
; Xs = [_A].
So your first argument must be the empty list or a one-element list only. You certainly want to describe also longer lists.
Maybe this helps
:- use_module(library(lists), []).
divide(L, X, Y) :-
append(X, Y, L),
length(X, N),
length(Y, N).
swap([], []).
swap(L, D) :-
divide(L, B, C),
append(C, B, D).
In Python you can do
>>> import from collections counter
>>> Counter(['a','b','b','c'])
>>> Counter({'b': 2, 'a': 1, 'c': 1})
Is there something similar in Prolog? Like so:
counter([a,b,b,c],S).
S=[a/1,b/2,c/1].
This is my implementation:
counter([],List,Counts,Counts).
counter([H|T],List,Counts0,[H/N|Counts]):-
findall(H, member(H,List), S),
length(S,N),
counter(T,List,Counts0,Counts).
counter(List,Counts):-
list_to_set(List,Set),
counter(Set,List,[],Counts).
It's rather verbose, so I wondered if there was a builtin predicate or a more terse implementation.
There is no builtin predicate, here is another way to do that :
counter([X], [X/1]).
counter([H | T], R) :-
counter(T, R1),
( select(H/V, R1, R2)
-> V1 is V+1,
R = [H/V1 | R2]
; R = [H/1 | R1]).
I like #joel76's solution. I will add a few more variations on the theme.
VARIATION I
Here's another simple approach, which sorts the list first:
counter(L, C) :-
msort(L, S), % Use 'msort' instead of 'sort' to preserve dups
counter(S, 1, C).
counter([X], A, [X-A]).
counter([X,X|T], A, C) :-
A1 is A + 1,
counter([X|T], A1, C).
counter([X,Y|T], A, [X-A|C]) :-
X \= Y,
counter([Y|T], 1, C).
Quick trial:
| ?- counter([a,b,b,c], S).
S = [a-1,b-2,c-1] ?
yes
This will fail on counter([], C). but you can simply include the clause counter([], []). if you want it to succeed. It doesn't maintain the initial order of appearance of the elements (it's unclear whether this is a requirement). This implementation is fairly efficient and is tail recursive, and it will work as long as the first argument is instantiated.
VARIATION II
This version will maintain order of appearance of elements, and it succeeds on counter([], []).. It's also tail recursive:
counter(L, C) :-
length(L, N),
counter(L, N, C).
counter([H|T], L, [H-C|CT]) :-
delete(T, H, T1), % Remove all the H's
length(T1, L1), % Length of list without the H's
C is L - L1, % Count is the difference in lengths
counter(T1, L1, CT). % Recursively do the sublist
counter([], _, []).
With some results:
| ?- counter([a,b,a,a,b,c], L).
L = [a-3,b-2,c-1]
yes
| ?- counter([], L).
L = []
yes
VARIATION III
This one uses a helper which isn't tail recursive, but it preserves the original order of elements, is fairly concise, and I think more efficient.
counter([X|T], [X-C|CT]) :-
remove_and_count(X, [X|T], C, L), % Remove and count X from the list
counter(L, CT). % Count remaining elements
counter([], []).
% Remove all (C) instances of X from L leaving R
remove_and_count(X, L, C, R) :-
select(X, L, L1), !, % Cut to prevent backtrack to other clause
remove_and_count(X, L1, C1, R),
C is C1 + 1.
remove_and_count(_, L, 0, L).
This implementation will work as long as the first argument to counter is instantiated.
SIDEBAR
In the above predicates, I used the Element-Count pattern rather than Element/Count since some Prolog interpreters, SWI in particular, offer a number of predicates that know how to operate on associative lists of Key-Value pairs (see SWI library(pairs) and ISO predicate keysort/2).
I also like #joel76 solution (and #mbratch suggestions, also). Here I'm just to note that library(aggregate), if available, has a count aggregate operation, that can be used with the ISO builtin setof/3:
counter(L, Cs) :-
setof(K-N, (member(K, L), aggregate(count, member(K, L), N)), Cs).
yields
?- counter([a,b,b,c], L).
L = [a-1, b-2, c-1].
If the selection operation was more complex, a nice way to avoid textually repeating the code could be
counter(L, Cs) :-
P = member(K, L),
setof(K-N, (P, aggregate(count, P, N)), Cs).
edit
Since I'm assuming library(aggregate) available, could be better to task it the set construction also:
counter(L, Cs) :-
P = member(E,L), aggregate(set(E-C), (P, aggregate(count,P,C)), Cs).
I'm trying to write a Prolog predicate (SWI) that would select N elements from a List, like this:
selectn(+N, ?Elems, ?List1, ?List2) is true when List1, with all Elems removed, results in List2.
selectn(N,Lps,L1s,[]) :- length(L1s,L), N >= L, permutation(L1s,Lps).
selectn(0,[],L1s,Lps) :- permutation(L1s,Lps).
selectn(N,[E|Es],L1s,L2s) :-
select(E,L1s,L0s),
N0 is N-1,
selectn(N0,Es,L0s,L2s).
My problem is that in some cases, I get duplicated results and I don't know how to avoid them:
?- findall(L,selectn(2,Es,[a,b,c],L),Ls),length(Ls,Solutions).
Ls = [[c], [b], [c], [a], [b], [a]],
Solutions = 6.
This is no homework, but if you want to help me as if it was, I'll be pleased as well.
this could answer your question (albeit I don't understand your first clause selectn/4, permutation is already done by 'nested' select/3)
selectn(0, [], Rest, Rest).
selectn(N, [A|B], C, Rest) :-
append(H, [A|T], C),
M is N-1,
selectn(M, B, T, S),
append(H, S, Rest).
yields
?- findall(L,selectn(2,Es,[a,b,c],L),Ls),length(Ls,Solutions).
Ls = [[c], [b], [a]],
Solutions = 3.
I have a problem like this: find all elements in a list such that all element(s) immediately besides it is/are odd numbers.
For example
?- find([20,1,2,3,4,5,6,7,8,10], L).
L = [20, 2, 4, 6]
Normally in other languages I would traverse the list and check the condition, but I don't know how to "think" in Prolog in this scenario. How should I approach this?
visit the list considering the pair of head elements:
find([A,B|R], [A|T]) :-
is_odd(B),
... etc etc
You'll need to add obviously the base recursion case and the case when A must be discarded.
EDIT: a better solution based on CapelliCs suggestion (this uses the isodd predicate from below):
% if N0 and N2 are odd, cut, add N1 to the result and recurse
ff([N0,N1,N2|T], [N1|R]) :- isodd(N0), isodd(N2), !, ff([N1,N2|T], R).
% for any other case where the list has at least three members, cut and recurse
ff([_,N1,N2|T], R) :- !, ff([N1,N2|T], R).
% this is reached if the list has less that three members - we're done
ff(_, []).
% append and prepend '1' to the list to deal with the edges, call ff.
find(L, R) :- append(L, [1], L1), ff([1|L], R).
My old solution which keept track of the two previous values with extra arguments:
% isodd(+N)
% helper predicate that succeds for odd numbers.
isodd(N) :- mod(N, 2) =:= 1.
% find(+I, +N1, +N2, +R, -L)
% find/5 is the predicate doing the actual work.
% I is the input list, N1 and N2 are the numbers before the current one,
% R is the intermediate result list and L the result.
% we're done if the input list is empty
find([], _, _, R, R) :- !.
% check if N0 and N2 are odd to see if N1 should be appended to the list.
% if yes, do a cut, append N1 to the result and recurse.
find([N0|T], N1, N2, R, L) :-
isodd(N0), isodd(N2), !,
append(R, [N1], R1), find(T, N0, N1, R1, L).
% if N0 and N2 are not odd (and thus the cut in the previous clause isn't
% reached) just continue the recursion.
find([N0|T], N1, _, R, L) :- find(T, N0, N1, R, L).
% find(+I, -L)
% this predicate is the entry point - initialize the result list and the first
% values for N1 and N2, and append 1 to the input list so we don't need an extra
% predicate for dealing with the last item.
find(I, L) :- append(I, [1], I1), find(I1, 1, 0, [], L).
I have made two programs in Prolog for the nqueens puzzle using hill climbing and beam search algorithms.
Unfortunately I do not have the experience to check whether the programs are correct and I am in dead end.
I would appreciate if someone could help me out on that.
Unfortunately the program in hill climbing is incorrect. :(
The program in beam search is:
queens(N, Qs) :-
range(1, N, Ns),
queens(Ns, [], Qs).
range(N, N, [N]) :- !.
range(M, N, [M|Ns]) :-
M < N,
M1 is M+1,
range(M1, N, Ns).
queens([], Qs, Qs).
queens(UnplacedQs, SafeQs, Qs) :-
select(UnplacedQs, UnplacedQs1,Q),
not_attack(SafeQs, Q),
queens(UnplacedQs1, [Q|SafeQs], Qs).
not_attack(Xs, X) :-
not_attack(Xs, X, 1).
not_attack([], _, _) :- !.
not_attack([Y|Ys], X, N) :-
X =\= Y+N,
X =\= Y-N,
N1 is N+1,
not_attack(Ys, X, N1).
select([X|Xs], Xs, X).
select([Y|Ys], [Y|Zs], X) :- select(Ys, Zs, X).
I would like to mention this problem is a typical constraint satisfaction problem and can be efficiency solved using the CSP module of SWI-Prolog. Here is the full algorithm:
:- use_module(library(clpfd)).
queens(N, L) :-
N #> 0,
length(L, N),
L ins 1..N,
all_different(L),
applyConstraintOnDescDiag(L),
applyConstraintOnAscDiag(L),
label(L).
applyConstraintOnDescDiag([]) :- !.
applyConstraintOnDescDiag([H|T]) :-
insertConstraintOnDescDiag(H, T, 1),
applyConstraintOnDescDiag(T).
insertConstraintOnDescDiag(_, [], _) :- !.
insertConstraintOnDescDiag(X, [H|T], N) :-
H #\= X + N,
M is N + 1,
insertConstraintOnDescDiag(X, T, M).
applyConstraintOnAscDiag([]) :- !.
applyConstraintOnAscDiag([H|T]) :-
insertConstraintOnAscDiag(H, T, 1),
applyConstraintOnAscDiag(T).
insertConstraintOnAscDiag(_, [], _) :- !.
insertConstraintOnAscDiag(X, [H|T], N) :-
H #\= X - N,
M is N + 1,
insertConstraintOnAscDiag(X, T, M).
N is the number of queens or the size of the board (), and , where , being the position of the queen on the line .
Let's details each part of the algorithm above to understand what happens.
:- use_module(library(clpfd)).
It indicates to SWI-Prolog to load the module containing the predicates for constraint satisfaction problems.
queens(N, L) :-
N #> 0,
length(L, N),
L ins 1..N,
all_different(L),
applyConstraintOnDescDiag(L),
applyConstraintOnAscDiag(L),
label(L).
The queens predicate is the entry point of the algorithm and checks if the terms are properly formatted (number range, length of the list). It checks if the queens are on different lines as well.
applyConstraintOnDescDiag([]) :- !.
applyConstraintOnDescDiag([H|T]) :-
insertConstraintOnDescDiag(H, T, 1),
applyConstraintOnDescDiag(T).
insertConstraintOnDescDiag(_, [], _) :- !.
insertConstraintOnDescDiag(X, [H|T], N) :-
H #\= X + N,
M is N + 1,
insertConstraintOnDescDiag(X, T, M).
It checks if there is a queen on the descendant diagonal of the current queen that is iterated.
applyConstraintOnAscDiag([]) :- !.
applyConstraintOnAscDiag([H|T]) :-
insertConstraintOnAscDiag(H, T, 1),
applyConstraintOnAscDiag(T).
insertConstraintOnAscDiag(_, [], _) :- !.
insertConstraintOnAscDiag(X, [H|T], N) :-
H #\= X - N,
M is N + 1,
insertConstraintOnAscDiag(X, T, M).
Same as previous, but it checks if there is a queen on the ascendant diagonal.
Finally, the results can be found by calling the predicate queens/2, such as:
?- findall(X, queens(4, X), L).
L = [[2, 4, 1, 3], [3, 1, 4, 2]]
If I read your code correctly, the algorithm you're trying to implement is a simple depth-first search rather than beam search. That's ok, because it should be (I don't see how beam search will be effective for this problem and it can be hard to program).
I'm not going to debug this code for you, but I will give you a suggestion: build the chess board bottom-up with
queens(0, []).
queens(N, [Q|Qs]) :-
M is N-1,
queens(M, Qs),
between(1, N, Q),
safe(Q, Qs).
where safe(Q,Qs) is true iff none of Qs attack Q. safe/2 is then the conjunction of a simple memberchk/2 check (see SWI-Prolog manual) and your not_attack/2 predicate, which on first sight seems to be correct.
A quick check on Google has found a few candidates for you to compare with your code and find what to change.
My favoured solution for sheer clarity would be the second of the ones linked to above:
% This program finds a solution to the 8 queens problem. That is, the problem of placing 8
% queens on an 8x8 chessboard so that no two queens attack each other. The prototype
% board is passed in as a list with the rows instantiated from 1 to 8, and a corresponding
% variable for each column. The Prolog program instantiates those column variables as it
% finds the solution.
% Programmed by Ron Danielson, from an idea by Ivan Bratko.
% 2/17/00
queens([]). % when place queen in empty list, solution found
queens([ Row/Col | Rest]) :- % otherwise, for each row
queens(Rest), % place a queen in each higher numbered row
member(Col, [1,2,3,4,5,6,7,8]), % pick one of the possible column positions
safe( Row/Col, Rest). % and see if that is a safe position
% if not, fail back and try another column, until
% the columns are all tried, when fail back to
% previous row
safe(Anything, []). % the empty board is always safe
safe(Row/Col, [Row1/Col1 | Rest]) :- % see if attack the queen in next row down
Col =\= Col1, % same column?
Col1 - Col =\= Row1 - Row, % check diagonal
Col1 - Col =\= Row - Row1,
safe(Row/Col, Rest). % no attack on next row, try the rest of board
member(X, [X | Tail]). % member will pick successive column values
member(X, [Head | Tail]) :-
member(X, Tail).
board([1/C1, 2/C2, 3/C3, 4/C4, 5/C5, 6/C6, 7/C7, 8/C8]). % prototype board
The final link, however, solves it in three different ways so you can compare against three known solutions.