Trouble displaying constraint values - SICStus clpfd - prolog

I am trying to solve a problem for a class that consists of this:
Fill the white cells on the each barrels side with different digits from 1 to 6. Digits cannot
repeat in every horizontal and vertical directions. Each number on the barrels top must
be equal to the sum or product of the four different digits in the barrel. All top numbers
are different and less than 91.
I can achieve the results fine, but I need to display the barrel's results and when I run my base case it shows this:
[_24087,18,60,17,_24343,72,_24471,_24535,14]
[1,2,3,4,5,6,3,4,5,6,1,2,2,5,1,3,6,4,4,6,2,5,3,1,5,1,6,2,4,3,6,3,4,1,2,5]
Result achieved in 0.015 sec.
Resumptions: 6197
Entailments: 1306
Prunings: 3520
Backtracks: 62
Constraints created: 107
The 1st list is the barrels and the 2nd list the Matrix calculated with labeling.
In order to calculate the barrels I use this on a rule:
getlist(Matrix,CounterX,CounterY,InnerSize,Value), % gets the barrel sublist
all_distinct(Value),
sum(Value, #=, SSet), % sum
prod(Value, VSet), % product
Set #= SSet #\/ Set #= VSet, % chooses one
Set #=< MaxValue,
insertinto(Set, List, NewList), % inserts into the barrel list
Since SICStus doesn't have a product calculation rule, I created this one:
prod([H|T], R) :-
prod(T, H, R).
prod([], R, R).
prod([H|T], V, R) :-
NV #= H * V,
prod(T, NV, R).
I don't understand where the problem actually lies.
In my prod rule -> It seems to unify correctly but seems not to when 1 is in the sublist.
How I unify the sum or prod -> Maybe that barrel can be a sum or prod and can't unify with Set correctly.

Related

Prolog - partially ordered set

There is a partially ordered set relation le(X,Y), when Y mod X = 0
(so there are le(1,5), le(5,70), le(7,14) etc.)
I have to make predicates
max(X) is X maximum element
greatest(X) is X the greatest element
defining max(X) is simple, because
max(X) :- \+ le(X,A), le(B,X). (there isn't any greater element and X is in set)
But how about greatest(X)?
For the least upper bound (LUB), you need two sets. First the argument set S, that you are asking for the LUB, and then the partial order T where you are searching for the LUB. So input is as follows:
T the partial order
S the set, S subset T
The code is then very similar as for the max. Just use range restricted formulas, that search over the partial order. This works in ordinary Prolog for finite partial orders.
Here is your divisibility example:
?- [user].
ls(X,Y) :-
Y mod X =:= 0.
bound(M,Y) :-
\+ (member(X,M),
\+ls(X,Y)).
lub(S,T,Y) :-
member(Y,T), bound(S,Y),
\+ (member(Z,T), bound(S,Z),
\+ls(Y,Z)).
^D
And here are some example runs:
?- lub([3,2],[1,2,3,4,5,6,7,8,9,10],Y).
Y = 6 ;
false.
?- lub([5,3],[1,2,3,4,5,6,7,8,9,10],Y).
false.
?- lub([5,3],[1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,19,20],Y).
Y = 15 ;
false.
The above very general algorithm is not the efficientest, it is of order m^2*n^2, where n is the size of S and m is the size of T. For infinite partial orders you would need to invent something with CLP(X).

Sliding tile puzzle with varying tile size using logic programming

So I am trying to solve this Booth arrangement problem given here. It is basically a sliding tile puzzle where one (booth)tile has to reach a target spot and in the end all other (booths)tiles should be in their original location. Each tile/booth has a dimension and following are the input fact and relation descriptions:
One fact of the form room(W,H), which specifies the width W and
height H of the room (3 ≤ W, H ≤ 20).
One fact booths(B), which
specifies the number of booths (1 ≤ B ≤ 20).
A relation that consists
of facts of the form dimension(B, W, H), which specifies the width W
and height H of booth B.
A relation consisting of facts of the form
position(B, W, H), specifying the initial position (W, H) of booth B.
One fact target(B, W, H), specifying the destination (W, H) of the
target booth B.
An additional fact horizon(H) gives an upper bound on
the number of moves to be performed.
The program is supposed to read input facts from a file but I am just trying to do the solving so I have just copy pasted one possible input for now, and I have written some basic clauses:
room(3, 3).
booths(3).
dimension(1, 2, 1).
dimension(2, 2, 1).
dimension(3, 1, 1).
position(1, 0, 1).
position(2, 1, 2).
position(3, 0, 0).
target(3, 0, 2).
horizon(10).
xlim(X) :- room(X,_).
ylim(X) :- room(_,X).
sum(X,Y,Z) :- Z is X+Y .
do(position(B,X,Y),movedown,position(B,X,Z)) :- Y > 0 , sum(Y,-1,Z) .
do(position(B,X,Y),moveup,position(B,X,Z)) :- ylim(L), Y < L , sum(Y,1,Z) .
do(position(B,X,Y),moveleft,position(B,Z,Y)) :- X > 0 , sum(X,-1,Z) .
do(position(B,X,Y),moveright,position(B,Z,Y)) :- xlim(L), X < L, sum(X,1,Z) .
noverlap(B1,B2) :-
position(B1,X1,Y1),
position(B2,X2,Y2),
ends(Xe1,Ye1,B1),
ends(Xe2,Ye2,B2),
( Xe1 < X2 ;
Xe2 < X1 ;
Ye1 < Y2 ;
Ye2 < Y1 ).
ends(Xe,Ye,B) :-
dimension(B,W,H),
position(B,X,Y),
Xe is X+W-1,
Ye is Y+H-1.
between(X,Y,Z) :-
X > Y ,
X < Z .
validMove(M,B) :- do(position(B,X,Y),M,position(B,Xn,Yn)) .
I am new to Prolog and I am stuck on how to go from here, I have the no_overlap rule so I can test if a move is valid or not but I am not sure how with the current clauses that I have. My current clauses for moves do/3 probably needs some modification. Any pointers?.
You need to express the task in terms of relations between states of the puzzle. Your current clauses determine the validity of a single move, and can also generate possible moves.
However, that is not sufficient: You need to express more than just a single move and its effect on a single tile. You need to encode, in some way, the state of the whole puzzle, and also encode how a single move changes the state of the whole task.
For a start, I recommend you think about a relation like:
world0_move_world(W0, M, W) :- ...
and express the relation between a given "world" W0, a possible move M, and the resulting world W. This relation should be so general as to generate, on backtracking, each move M that is possible in W0. Ideally, it should even work if W0 is a free variable, and for this you may find clpfd useful: Constraints allow you to express arithmetic relations in a much more general way than you are currently using.
Once you have such a relation, the whole task is to find a sequence Ms of moves such that any initial world W0 is transformed to a desired state W.
Assuming you have implemented world0_move_world/3 as a building block, you can easily lift this to lists of moves as follows (using dcg):
moves(W0) --> { desired_world(W0) }.
moves(W0) --> [M], { world0_move_world(W0, M, W) }, moves(W).
You can then use iterative deepening to find a shortest sequence of moves that solves the puzzle:
?- length(Ms, _), initial_world(W0), phrase(moves(W0), Ms).

How to maximize the goal in prolog?

I am trying to solve the knapsack problem in prolog. Following is my implementation.
% 'ks' is compound term which has 4 argumets
% 1 - List of items to be chosen from.
% 2 - Maximum weight a knapsack can carry.
% 3 - Selected items which sum of weights is less than or equal to knapsack capacity.
% 4 - The gain after choosing the selected item.
% base conditions where input list contains only one items and
% it is either selected or excluded.
ks([item(W1, V1)], W, [item(W1, V1)], V1):- W1 =< W.
ks([item(W1, _)], W, [], 0):- W1 > W.
% An item from the input list is chosen in the knapsack.
% In that case, we recurse with smaller list with reduced weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append(Prefix, [item(W1, V1)|Suffix], ItemList),
append(Prefix, Suffix, RemList),
NewWeight is MaxWeight - W1,
W1 =< MaxWeight,
append([item(W1, V1)], SelectItems1, SelectItems),
ks(RemList, NewWeight, SelectItems1, Gain1),
Gain is V1 + Gain1.
% An item from the input list is not chosen in the knapsack.
% In that case, we recurse with smaller list but with the same weight constraint.
ks(ItemList, MaxWeight, SelectItems, Gain) :-
append([P1|Prefix], [item(W1, V1)|Suffix], ItemList),
append([P1|Prefix], Suffix, RemList),
not(member(item(W1, V1), SelectItems)),
ks(RemList, MaxWeight, SelectItems, Gain).
The input to the program will be list of items as below. in term item(W, V) W is weight of the item while V is value of the item. Goal to maximize the value for the given weight constraint.
ks([item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)], 20, List, Gain).
List = [item(2, 3), item(3, 4), item(4, 5), item(5, 8)],
Gain = 20 ;
While I am able to generate all the combinations of items with above program, I am not able to code to find out the maximum gain only.
Could any one please point me the right direction?
Thanks.
I think that to find reusable abstractions it's an important point of studying programming. If we have a subset_set/2 that yields on backtracking all subsets, ks/4 becomes really simple:
subset_set([], _).
subset_set([H|T], Set) :-
append(_, [H|Rest], Set),
subset_set(T, Rest).
ks(Set, Limit, Choice, Gain) :-
subset_set(Choice, Set),
aggregate((sum(W), sum(G)), member(item(W, G), Choice), (TotWeight, Gain)),
TotWeight =< Limit.
and then
ks_max(Items, Limit, Sel, WMax) :-
aggregate(max(W,I), ks(Items,Limit,I,W), max(WMax,Sel)).
despite its simplicity, subset_set/2 is not really easy to code, and library available alternatives (subset/2, ord_subset/2) don't enumerate, but only check for the relation.
There are at least two things you can do, depending on how you want to approach this.
You could simply collect all solutions and find the maximum. Something along the lines of:
?- Items = [item(2,3), item(3,4), item(4,5), item(5,8), item(9,10)],
findall(Gain-List, ks(Items, 20, List, Gain), Solutions),
sort(Solutions, Sorted),
reverse(Sorted, [MaxGain-MaxList|_]).
% ...
MaxGain = 26,
MaxList = [item(9, 10), item(5, 8), item(4, 5), item(2, 3)].
So you find all solutions, sort them by Gain, and take the last. This is just one way to do it: if you don't mind collecting all solutions, it is up to you how you want to pick out the solution you need from the list. You might also want to find all maximum solutions: see this question and answers for ideas how to do that.
The cleaner approach would be to use constraints. As the comment to your questions points out, it is not very clear what you are actually doing, but the way to go would be to use a library like CLP(FD). With it, you could simply tell labeling/2 to look for the maximum Gain first (once you have expressed your problem in terms of constraints).
greedy Approximation algorithm :
pw((P,W),Res) :- PW is P/W, Res=(PW,P,W).
pws(Ps_Ws,PWs) :- maplist(pw,Ps_Ws,PWs).
sort_desc(List,Desc_list) :-
sort(List,Slist),
reverse(Slist,Desc_list).
ransack_([],_,_,[]).
ransack_([(_,P,W)|PWs],Const,Sum,Res) :-
Sum1 is W+Sum,
Sum1 < Const ->
Res=[(P,W)|Res1],
ransack_(PWs,Const,Sum1,Res1)
;ransack_(PWs,Const,Sum,Res).
% ransack(+[(P,W)|..],+W,,Res)
ransack(L_PWs,W,Res) :-
pws(L_PWs,Aux),
sort_desc(Aux,PWs),
ransack_(PWs,W,0,Res).
Test
item(W, V)-->(V,W)
| ?- ransack([(3,2),(4,3),(5,4),(8,5),(10,9)],20,Res).
Res = [(8,5),(3,2),(4,3),(5,4)] ? ;
no

Prolog: Exam schedule generator - How to avoid permutations in solutions

I'm building an exam scheduler in Prolog.
The scheduler is based on this example:
https://metacpan.org/source/DOUGW/AI-Prolog-0.741/examples/schedule.pl
How can I make sure there are no permutations in my solution?
For example solution
-> ((exam1, teacher1, time1, room1), (exam2, teacher2, time2, room2))
Later solution:
-> ((exam2, teacher2, time2, room2),(exam1, teacher1, time1, room1))
How can I avoid this?
Thanks!
1) The closest/easiest from what you've got is to check that the course you've chosen is strictly bigger in order than the previous one.
For example by adding an extra predicate which also includes the previous course in the combination.
%%makeListPrev(PreviousTakenCourse, ResultCombinationOfCourses, NrOfCoursesToAdd)
makeListPrev(_,[], 0).
makeListPrev(course(Tprev,Ttime,Troom),[course(Teacher,Time,Room)|Rest], N) :-
N > 0,
teacher(Teacher),
classtime(Time),
classroom(Room),
course(Tprev,Ttime,Troom) #< course(Teacher,Time,Room), %% enforce unique combinations
is(M,minus(N,1)),
makeListPrev(course(Teacher,Time,Room),Rest,M).
In this way you eliminate all duplicate permutations of the same combination by always taking the lexographically smallest.
E.g if you have 4 courses:
(a,b,c,d)
(a,b,d,c) % d can't be before c
(a,c,b,d) % c can't be before b
...
2) Another way to solve this quite easily is to first create a list of all possible courses. And then take out all possible combinations of N sequentially.
scheduler(L) :-
%% Find all possible courses
findall(course(Teacher,Time,Room),(teacher(Teacher),classtime(Time),classroom(Room)),Courses),
makeList(Courses,4,L),
different(L).
makeList([],0,[]) :- !. %% list completed
makeList([H|T],N,[H|Res]) :- %% list including H
M is N-1,
makeList(T,M,Res).
makeList([_|T], N, Res) :- makeList(T, N, Res). %% list without H

How to add polynoms in Prolog?

I have the following task:
Write a method that will add two polynoms. I.e 0+2*x^3 and 0+1*x^3+2*x^4 will give 0+3*x^3+2*x^4.
I also wrote the following code:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
(
B1=B2,
B3 = B2,
A3 is A1+A2,
add_poly(P1,P2,P3)
;
B1<B2,
B3=B1,
A3=A1,
add_poly(P1,+A2*x^B2+P2,P3)
;
B1>B2,
B3=B2,
A3=A2,
add_poly(+A1*x^B1+P1,P2,P3)
).
add_poly(X+P1,Y+P2,Z+P3):-
Z is X+Y,
add_poly(P1,P2,P3).
My problem is that I don't know how to stop. I would like to stop when one the arguments is null and than to append the second argument to the third one. But how can I check that they are null?
Thanks.
Several remarks:
Try to avoid disjunctions (;)/2 in the beginning. They need special indentation to be readable. And they make reading a single rule more complex — think of all the extra (=)/2 goals you have to write and keep track of.
Then, I am not sure what you can assume about your polynomials. Can you assume they are written in canonical form?
And for your program: Consider the head of your first rule:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
I will generalize away some of the arguments:
add_poly(+A1*x^B1+P1,_,_):-
and some of the subterms:
add_poly(+_+_,_,_):-
This corresponds to:
add_poly(+(+(_),_),_,_) :-
Not sure you like this.
So this rule applies only to terms starting with a prefix + followed by an infix +. At least your sample data did not contain a prefix +.
Also, please remark that the +-operator is left associative. That means that 1+2+3+4 associates to the left:
?- write_canonical(1+2+3+4).
+(+(+(1,2),3),4)
So if you have a term 0+3*x^3+2*x^4 the first thing you "see" is _+2*x^4. The terms on the left are nested deeper.
For your actual question (how to stop) - you will have to test explicitly that the leftmost subterm is an integer, use integer/1 - or maybe a term (*)/2 (that depends on your assumptions).
I assume that polynomials you are speaking of are in 1 variable and with integer exponents.
Here a procedure working on normal polynomial form: a polynomial can be represented as a list (a sum) of factors, where the (integer) exponent is implicitly represented by the position.
:- [library(clpfd)].
add_poly(P1, P2, Sum) :-
normalize(P1, N1),
normalize(P2, N2),
append(N1, N2, Nt),
aggregate_all(max(L), (member(M, Nt), length(M, L)), LMax),
maplist(rpad(LMax), Nt, Nn),
clpfd:transpose(Nn, Tn),
maplist(sumlist, Tn, NSum),
denormalize(NSum, Sum).
rpad(LMax, List, ListN) :-
length(List, L),
D is LMax - L,
zeros(D, Z),
append(List, Z, ListN).
% the hardest part is of course normalization: here a draft
normalize(Ts + T, [N|Ns]) :-
normalize_fact(T, N),
normalize(Ts, Ns).
normalize(T, [N]) :-
normalize_fact(T, N).
% build a list with 0s left before position E
normalize_fact(T, Normal) :-
fact_exp(T, F, E),
zeros(E, Zeros),
nth0(E, Normal, F, Zeros).
zeros(E, Zeros) :-
length(Zeros, E),
maplist(copy_term(0), Zeros).
fact_exp(F * x ^ E, F, E).
fact_exp(x ^ E, 1, E).
fact_exp(F * x, F, 1).
fact_exp(F, F, 0).
% TBD...
denormalize(NSum, NSum).
test:
?- add_poly(0+2*x^3, 0+1*x^3+2*x^4, P).
P = [0, 0, 0, 3, 2]
the answer is still in normal form, denormalize/2 should be written...

Resources