Related
My main task - build a new list of elements (numbers) that appear in the old list more than three times.
Asking query: res([1,2,2,3,3,3,4,4,4,4,5,5,5,5,5],X).
Expected result: X = [4, 5]
I have a code that counts the number of occurrences of each number:
count(_, [], 0).
count(Num, [H|T], X) :- dif(Num,H), count(Num, T, X).
count(Num, [H|T], X) :- Num = H, count(Num, T, X1), X is X1 + 1.
res(A, X) :- findall(X,count(_,A,X),X).
But it works little bit wrong - it gives X = [0, 5, 4, 3, 2, 1] instead X = [1, 2, 3, 4, 5].
I ignored this problem for while and tried this to finish main task:
count(_, [], 0).
count(Num, [H|T], X) :- dif(Num,H), count(Num, T, X).
count(Num, [H|T], X) :- Num = H, count(Num, T, X1), X is X1 + 1, X<3, X is Num.
res(A, X) :- findall(X,count(_,A,X),X).
But gives strange result: X = [0, 1]
Where i'm wrong? Thank you.
Reusing your first count predicate,
%countElement(Element, List, Nb_Element_in_List)
countElement(_, [], 0).
countElement(Num, [H|T], X) :- dif(Num,H), countElement(Num, T, X).
countElement(Num, [H|T], X) :- Num = H, countElement(Num, T, X1), X is X1 + 1.
Here is the predicate query/1
query(X) :-
L = [1,2,2,3,3,3,4,4,4,4,5,5,5,5,5],
countOneByOne(L, L, [], X).
%countOneByOne(A1,A2,In,Out)
%For each Element of A1, if it satisfies countElement(Element,A2,N) & N>4, is accumulated with In, to give Out
%Out is the list of Elements of A1 that satisfies countElement(Element,A2,N) & N>4, added to In
countOneByOne([], _, X, X).
countOneByOne([H|Xs], L, X1, X2) :-
countElement(H, L, N), N<4, !,
countOneByOne(Xs, L, X1, X2).
countOneByOne([H|Xs], L, X1, X2) :-
removeElement(Xs, H, Ss),
countOneByOne(Ss, L, [H|X1], X2).
%remove(List, Element, List_Without_Element)
removeElement( [], _, []).
removeElement([X|Xs], H, [X|R1]) :-
dif(X,H), removeElement(Xs, H, R1).
removeElement([X|Xs], X, R1) :-
removeElement(Xs, X, R1).
Not an answer but another approach using foldl/4 and the dict of SWI-Prolog.
Whenever I hear "scan through a list to perform a computation with a final result at the end", the appropriate approach is probably the "accumulator idiom". One hands a data structure (the "accumulator") between the calls where something happens with a list element, "accumulating" the result. foldl/N is meant to provide boilerplate code around this.
In this case the accumulator is the SWI_prolog dict accumulating "occurrence counts", which happens at each call to inc_for_key/3. At the end, we just need to select the entries with a high enough occurence count:
filter_occurrences(List,Limit,Reacheds,Finals) :-
foldl(inc_for_key,List,_{},Finals),
findall(Key,(Finals.Key >= Limit),Reacheds).
inc_for_key(Key,DictIn,DictOut) :-
(get_dict(Key,DictIn,X) -> succ(X,XP) ; XP=1),
put_dict(Key,DictIn,XP,DictOut).
Testing using plunit
:- begin_tests(filter_occurrences_less_than_n).
test("filter empty list",true(R == [])) :-
filter_occurrences([],3,R,_).
test("filter nonempty list #1 (limit 3)",true([R,Finals] == [[a,c],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],3,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
test("filter nonempty list #2 (limit 4)",true([R,Finals] == [[a],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],4,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
test("filter nonempty list #3 (limit 5)",true([R,Finals] == [[],foo{a:4,b:2,c:3,d:1,e:1,f:1}])) :-
filter_occurrences([a,b,c,d,c,e,b,a,a,f,a,c],5,R,Finals),
dict_pairs(Finals,foo,_). % Sets the tag of the Finals dict to "foo"
:- end_tests(filter_occurrences_less_than_n).
And so:
?- run_tests.
% PL-Unit: filter_occurrences_less_than_n .... done
% All 4 tests passed
true.
I am trying to get a set of elements from a list in prolog, such that a query:
get_elems([1, 2, 4, 10], [a, b, c, d, e], X).
yields:
X = [a, b, d]
I would like to implement it without using the built in predicate nth.
I have tried using the following, but it does not work:
minus_one([], []).
minus_one([X|Xs], [Y|Ys]) :- minus_one(Xs, Ys), Y is X-1.
get_elems([], _, []).
get_elems(_, [], []).
get_elems([1|Ns], [A|As], Z) :- get_elems(Ns, As, B), [A|B] = Z.
get_elems(Ns, [_|As], Z) :- minus_one(Ns, Bs), get_elems(Bs, As, Z).
Edit: The list of indices is guaranteed to be ascending, also I want to avoid implementing my own version of nth.
Give this a go:
get_elems(Xs,Ys,Zs) :- get_elems(Xs,1,Ys,Zs).
get_elems(Xs,_,Ys,[]) :- Xs = []; Ys = [].
get_elems([N|Xs],N,[H|Ys],[H|Zs]) :- !, N1 is N + 1, get_elems(Xs,N1,Ys,Zs).
get_elems(Xs,N,[_|Ys],Zs) :- N1 is N + 1, get_elems(Xs,N1,Ys,Zs).
This just keeps counting up and when the head of the second term is equal to the current index it peels off the head and makes it the head of the current output term. If it doesn't match it just discards the head and keeps going.
I want to find the Least Common Multiple (LCM) of couples from a list. But in the following way:
For example if I have this list:
L1 = [1,2,3,4,5].
I want to produce this list:
L2 = [1,2,6,12,60].
I use the first element of L1 as first element of L2 and the rest follow this form:
L2[0] = L1[0]
L2[i+1] = lcm( L1[i+1] , L2[i] )
Here is what I've done so far, but it doesn't work. Always printing false.
%CALL_MAKE----------------------------------------
%Using call_make to append Hd to L2 list
call_make([Hd|Tail], Result) :-
make_table(Tail, [Hd], Result).
%MAKE_TABLE---------------------------------------
%Using make_table to create the rest L2
make_table([],Res,Res).
make_table([Head|Tail], List, Result) :-
my_last(X, List),
lcm(Head, X, R),
append(List, R, Res),
make_table(Tail, Res, Result).
%last element of a list---------------------------
my_last(X,[X]).
my_last(X,[_|L]):- my_last(X, L).
%GCD----------------------------------------------
gcd(X, 0, X) :- !.
gcd(X, Y, Z) :-
H is X rem Y,
gcd(Y, H, Z).
%LCM----------------------------------------------
lcm(X,Y,LCM):-
gcd(X,Y,GCD),
LCM is X*Y//GCD.
I want to run the program and get this:
?- call_make([1,2,3,4,5], Result).
Result = [1,2,6,12,60].
append/3 is taking two lists to concatenate, while here:
append(List, R, Res),
R is a scalar. Change it to
append(List, [R], Res),
How do you get the product of a list from left to right?
For example:
?- product([1,2,3,4], P).
P = [1, 2, 6, 24] .
I think one way is to overload the functor and use 3 arguments:
product([H|T], Lst) :- product(T, H, Lst).
I'm not sure where to go from here.
You can use library(lambda) found here : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
Quite unreadable :
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
product(L, R) :-
foldl(\X^Y^Z^(Y = []
-> Z = [X, [X]]
; Y = [M, Lst],
T #= X * M,
append(Lst, [T], Lst1),
Z = [T, Lst1]),
L, [], [_, R]).
Thanks to #Mike_Hartl for his advice, the code is much simple :
product([], []).
product([H | T], R) :-
scanl(\X^Y^Z^( Z #= X * Y), T, H, R).
seems like a list copy, just multiplying by last element handled. Let's start from 1 for the leftmost element:
product(L, P) :-
product(L, 1, P).
product([X|Xs], A, [Y|Ys]) :-
Y is X * A,
product(Xs, Y, Ys).
product([], _, []).
if we use library(clpfd):
:- [library(clpfd)].
product([X|Xs], A, [Y|Ys]) :-
Y #= X * A,
product(Xs, Y, Ys).
product([], _, []).
it works (only for integers) 'backward'
?- product(L, [1,2,6,24]).
L = [1, 2, 3, 4].
Probably very dirty solution (I am new to Prolog):
product([ListHead|ListTail], Answer) :-
product_acc(ListTail, [ListHead], Answer).
product_acc([ListHead|ListTail], [AccHead|AccTail], Answer) :-
Product is ListHead * AccHead,
append([Product, AccHead], AccTail, TempList),
product_acc(ListTail, TempList, Answer).
product_acc([], ReversedList, Answer) :-
reverse(ReversedList, Answer).
So basically at the beginning we call another predicate which has
extra "variable" Acc which is accumulator list.
So we take out head (first number) from original list and put it in
to Accumulator list.
Then we always take head (first number) from original list and
multiply it with head (first number) from accumulator list.
Then we have to append our new number which we got by multiplying
with the head from accumulator and later with the tail
Then we call same predicate again until original list becomes empty
and at the end obviously we need to reverse it.
And it seems to work
?- product([1,2,3,4], L).
L = [1, 2, 6, 24].
?- product([5], L).
L = [5].
?- product([5,4,3], L).
L = [5, 20, 60].
Sorry if my explanation is not very clear. Feel free to comment.
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.