Counting from database - prolog

My database consists out of predicates like these:
road(1,2,geel).
road(2,3,blauw).
road(1,3,geel).
where the first 2 numbers are points. I have to check wether every point has a even number of roads. I managed to do it with the following code, but somehow I think there's a better way of doing this.
% Count(Element, List, Occurences) => Counts the amount of occurences of Element in the given List
count(_, [], 0).
count(X, [X | T], N) :-
!, count(X, T, N1),
N is N1 + 1.
count(X, [_ | T], N) :-
count(X, T, N).
checkRoad :-
findall(Point,(weg(Point,_,_) ; weg(_,Point,_)),List),
list_to_set(List,K),
foreach( (member(P,K), count(P, List,N)), N mod 2 =:= 0 ).

I think this approach would have better performance:
checkRoad:-
findall(Point,(road(Point,_,_) ; road(_,Point,_)),List), % renamed wge/3 with road/3
msort(List, SList),
checkEven(none, SList).
checkEven(_, []).
checkEven(Item, [Item|SList]):-
!,
checkOdd(Item, SList).
checkEven(_, [Item|SList]):-
checkOdd(Item, SList).
checkOdd(Item, [Item|SList]):-
checkEven(Item, SList).
If you first sort all the points then you can just traverse this sorted list once to test whether every point appears in an even number of roads.

Related

Comparing prolog lists

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

Fact for each element of a list Prolog

I want to solve this problem in Prolog. i want give a list of natural numbers to find all the elements in the list that satisfy this condition:
All elements on the left of it are smaller than it and all the elements on the right of it are larger than it.
For example give a list [3,2,4,1,5,7,8,9,10,8] the answer would be 5,7
So far I've manage to make this function that given an element of the list it returns true or false if the element satisfises the condition described above.
check(Elem, List) :-
seperate(Elem, List, List1, List2),
lesser(Elem, List1, X1),
bigger(Elem, List2, X2),
size(X1, L1),
size(X2, L2),
size(List, L3),
match(L1, L2, L3),
Now I want to make another predicate that given a list, it does the above computations for each element of the list. Due to the fact that more than one element may satisfy it I want to create another list with all the elements that satisfy the problem.
The question would be something like ?-predicate_name([[3,2,4,1,5,7,8,9,10,8],N). and the result would be a list of elements.
Sry If I am not using the right terms of Prolog. I will describe what I want to do in sequential logic language to be more specific although it's not a good idea to think like that. If we consider a the predicate check as a function that given a list and element of the list it would return true or false whether or not the element satisfied the conditions of the problem. Now I want to parse each element of the list and for each one of it call the function check. If that would return true then I would add the element in another list a.k.a result. I want to do this in Prolog but I don't know how to iterate a list.
Here is a version using DCGs and assuming we want to compare arithmetically.
list_mid(L, M) :-
phrase(mid(M), L).
mid(M) -->
seq(Sm),
[M],
{maplist(>(M),Sm)},
seq(Gr),
{maplist(<(M),Gr)}.
seq([]) -->
[].
seq([E|Es]) -->
[E],
seq(Es).
Often it is not worth optimizing this any further. The first seq(Sm) together with the subsequent maplist/2 might be merged together. This is a bit tricky, since one has to handle separately the cases where Sm = [] and Sm = [_|_].
mid(M) -->
( [M]
| max(Mx),
[M],
{Mx < M}
),
min(M).
max(M) -->
[E],
maxi(E, M).
maxi(E, E) -->
[].
maxi(E, M) -->
[F],
{G is max(F,E)},
maxi(G, M).
min(_) -->
[].
min(M) -->
[E],
{M < E},
min(M).
I'm going to take a different approach on the problem.
We want to find all of the values that meet the criteria of being a "mid" value, which is one defined as being greater than all those before it in the list, and less than all those after.
Define a predicate mid(L, M) as meaning M is a "mid" value of L:
mid([X|T], X) :- % The first element of a list is a "mid" if...
less(X, T). % it is less than the rest of the list
mid([X|T], M) :- % M is a "mid" of [X|T] if...
mid(T, X, M). % M is a "mid" > X
% (NOTE: first element is not a "mid" by definition)
mid([X|T], LastM, X) :- % X is a "mid" > Y if...
X > LastM, % X > the last "mid"
less(X, T). % X < the rest of the list, T
mid([X|T], LastM, M) :- % Also, M is a "mid" if...
Z is max(X, LastM), % Z is the larger of X and the last "mid"
mid(T, Z, M). % M is the "mid" of T which is > Z
less(X, [Y|T]) :- % X is less than the list [Y|T] if...
X < Y, % X < Y, and
less(X, T). % X < the tail, T
less(_, []). % An element is always less than the empty list
Each query will find the next "mid":
| ?- mid([3,2,4,1,5,7,8,9,10,8], M).
M = 5 ? ;
M = 7 ? ;
no
Then they can be captured with a findall:
mids(L, Ms) :-
findall(M, mid(L, M), Ns).
| ?- mids([3,2,4,1,5,7,8,9,10,8], Ms).
Ms = [5,7]
yes
| ?- mids([2], L).
L = [2]
(1 ms) yes
This is probably not the most computationally efficient solution since it doesn't take advantage of a couple of properties of "mids". For example, "mids" will all be clustered together contiguously, so once a "mid" is found, it doesn't make sense to continue searching if an element is subsequently encountered which is not itself a "mid". If efficiency is a goal, these sorts of ideas can be worked into the logical process.
ADDENDUM
With credit to #false for reminding me about maplist, the above predicate call less(X, T) could be replaced by maplist(<(X), T) eliminating the definition of less in the above implementation.

Traverse a list in Prolog

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).

Prolog: Matching One or More Anonymous Variables

[_, [ X , _ ],_] will match a list like [d, [X,a], s]. Is there a way to match it to any pattern where there is one or more anonymous variables? ie. [[X,a],s] and [[d,a],[p,z], [X,b]] would match?
I am trying to write a program to count the elements in a list ie. [a,a,a,b,a,b] => [[a,4],[b,2]] but I am stuck:
listcount(L, N) :- listcountA(LS, [], N).
listcountA([X|Tail], [? [X, B], ?], N) :- B is B+1, listcountA(Tail, [? [X,B] ?], N).
listcountA([X|Tail], AL, N) :- listcountA(Tail, [[X,0]|AL], N).
Thanks.
A variable match a term, and the anonimus variable is not exception. A list is just syntax sugar for a binary relation, between head and tail. So a variable can match the list, the head, or the tail, but not an unspecified sequence.
Some note I hope will help you:
listcount(L, N) :- listcountA(LS, [], N).
In Prolog, predicates are identified by name and num.of.arguments, so called functor and arity. So usually 'service' predicates with added arguments keep the same name.
listcountA([X|Tail], [? [X, B], ?], N) :- B is B+1, listcountA(Tail, [? [X,B] ?], N).
B is B+1 will never succeed, you must use a new variable. And there is no way to match inside a list, using a 'wildcard', as you seem to do. Instead write a predicate to find and update the counter.
A final note: usually pairs of elements are denoted using a binary relation, conveniently some (arbitrary) operator. For instance, most used is the dash.
So I would write
listcount(L, Counters) :-
listcount(L, [], Counters).
listcount([X | Tail], Counted, Counters) :-
update(X, Counted, Updated),
!, listcount(Tail, Updated, Counters).
listcount([], Counters, Counters).
update(X, [X - C | R], [X - S | R]) :-
S is C + 1.
update(X, [H | T], [H | R]) :-
update(X, T, R).
update(X, [], [X - 1]). % X just inserted
update/3 can be simplified using some library predicate, 'moving inside' the recursion. For instance, using select/3:
listcount([X | Tail], Counted, Counters) :-
( select(X - C, Counted, Without)
-> S is C + 1
; S = 1, Without = Counted
),
listcount(Tail, [X - S | Without], Counters).
listcount([], Counters, Counters).
I'll preface this post by saying that if you like this answer, consider awarding the correct answer to #chac as this answer is based on theirs.
Here is a version which also uses an accumulator and handles variables in the input list, giving you the output term structure you asked for directly:
listcount(L, C) :-
listcount(L, [], C).
listcount([], PL, PL).
listcount([X|Xs], Acc, L) :-
select([X0,C], Acc, RAcc),
X == X0, !,
NewC is C + 1,
listcount(Xs, [[X0, NewC]|RAcc], L).
listcount([X|Xs], Acc, L) :-
listcount(Xs, [[X, 1]|Acc], L).
Note that listcount/2 defers to the accumulator-based version, listcount/3 which maintains the counts in the accumulator, and does not assume an input ordering or ground input list (named/labelled variables will work fine).
[_, [X, _], _] will match only lists which have 3 elements, 1st and 3rd can be atoms or lists, second element must be list of length 2, but i suppore you know that. It won't match to 2 element list, its better to use head to tail recursion in order to find element and insert it into result list.
Heres a predicate sketch, wich i bet wont work if copy paste ;)
% find_and_inc(+element_to_search, +list_to_search, ?result_list)
find_and_inc(E, [], [[E, 1]]);
find_and_inc(E, [[E,C]|T1], [[E,C1]|T2]) :- C1 is C+1;
find_and_inc(E, [[K,C]|T1], [[K,C]|T2]) :- find_and_inc(E, T1, T2).

Prolog Programming

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.

Resources