We all know that the Pythagorean theorem formula is: a2 + b2 = c2. I wanted to implement this formula, for calculating the distance between two points. This is my data of the coordinates of the cities (in km):
city(amsterdam, 121.813/487.362).
city(breda, 112.095/398.291).
city(eindhoven, 161.871/382.839).
city(groningen, 233.871/582.030).
city(haarlem, 103.690/488.416).
city(hertogenbosch, 149.225/412.119).
city(leeuwarden, 182.605/583.855).
city(maastricht, 176.830/318.793).
city(rotterdam, 92.548/437.734).
city(utrecht, 135.923/456.419).
city(zwolle, 203.252/503.130).
I implemented a program for this cause, but it doesn't seem to work:
estimate(State/NextState, Estimate) :-
city(State, X/Y),
city(NextState, X1/Y1),
X2 is X1 - X,
Y2 is Y1 - Y,
Estimate is X2^2 + Y2^2,
DifferentVar is sqrt(Estimate),
estimate(State/NextState, DifferentVar).
If a query something like this it returns false:
?- estimate(amsterdam/utrecht, X).
false.
?- estimate(utrecht/amsterdam, X).
false.
I also tried this, but it doesn't work:
estimate(State/NextState, Estimate) :-
city(State, X/Y),
city(NextState, X1/Y1),
Estimate is sqrt((X1 - X)^2 + sqrt(Y1 - Y)^2).
I have checked each 'subgoal' and I can't find the mistake or the wrong implementation. In my eyes it seems to me that each 'subgoal' has been reached, but it still returns false. I would really appreciate it if somebody could help me further!
The estimation rule should be:
estimate(State/NextState, Estimate) :-
city(State, X/Y),
city(NextState, X1/Y1),
X2 is X1 - X,
Y2 is Y1 - Y,
Estimate is sqrt(X2^2 + Y2^2).
Note that only the last line changed (and the next 2 lines were deleted).
Related
I have some clauses where the head represents the names and values of a set of variables in a linear equation and the body the actual equation. Like so:
:-use_module(library(clpr)).
relation(
independents([
var(x1, X1),
var(x2, X2),
var(x3, X3)
]),
dependent(
var(y, Y)
)
):- {Y = 3 + 0.5 * X1 + 0.6 * X2 + 0.7 * X3}.
Is there a straightforward way to (indirectly) get the coefficients for this equation? I.e. a rule which returns coefficient(VARNAME, COEFFICIENT) e.g. coefficient(x1, 0.5), coefficient(x2, 0.6) and so on.
I know this might seem like a stupid question given that it would be easy to just put all coefficients in the head of the clause. But in my application i want the head of these clauses to strictly show the values of each variable (and not their coefficients). I.e. to avoid ambiguity.
My current solution is a convoluted and unelegant one involving member/2, subtract/3, maplist/2 and setting X1, X2, X3 to one or zero to figure out each slope.
Related question:
Representing linear functions in prolog
Thanks!
/JC
This is my first use of clpr so if this is unhelpful to you I plead insanity, but to me, the key here seems to be using dump/3 to convert the constraint back into a Prolog expression and then traversing it like any other structure. So I obtain the constraint again by doing this:
?- relation(independents([var(x1,X1),var(x2,X2),var(x3,X3)]),
dependent(var(y,Y))),
dump([X1,X2,X3,Y],[x1,x2,x3,y], [y=Eqn]).
Eqn = 3.0+0.5*x1+0.6*x2+0.7*x3
I think it's worth remembering what this looks like under the hood using write_canonical:
+(+(+(3.0,*(0.5,x1)),*(0.6,x2)),*(0.7,x3))
Traversing a polynomial you should be covered by only a few simple cases; the following may actually be overkill:
coefficient(X=Y, Var, Coeff) :-
coefficient(X, Var, Coeff) ; coefficient(Y, Var, Coeff).
coefficient(X+Y, Var, Coeff) :-
coefficient(X, Var, Coeff) ; coefficient(Y, Var, Coeff).
coefficient(X-Y, Var, Coeff) :-
coefficient(X, Var, Coeff) ; coefficient(Y, Var, Coeff).
coefficient(X*Y, X, Y) :-
atomic(X), atomic(Y).
coefficient(X*Y, Var, Coeff) :-
coefficient(X, Var, Coeff) ; coefficient(Y, Var, Coeff).
Your base case really is the X*Y case where they are both atomic. The rest of the clauses are really just there to unwrap nesting. This appears to do what you want:
?- relation(independents([var(x1,X1),var(x2,X2),var(x3,X3)]),
dependent(var(y,Y))),
dump([X1,X2,X3,Y],[x1,x2,x3,y], [y=Eqn]),
coefficient(Eqn, Var, Coeff).
Eqn = 3.0+0.5*x1+0.6*x2+0.7*x3,
Var = 0.5,
Coeff = x1,
{Y=3.0+0.5*X1+0.6*X2+0.7*X3} ;
Eqn = 3.0+0.5*x1+0.6*x2+0.7*x3,
Var = 0.6,
Coeff = x2,
{Y=3.0+0.5*X1+0.6*X2+0.7*X3} ;
Eqn = 3.0+0.5*x1+0.6*x2+0.7*x3,
Var = 0.7,
Coeff = x3,
{Y=3.0+0.5*X1+0.6*X2+0.7*X3} ;
false.
To really generalize this you probably will need to use maplist et. al. to convert your independents/dependents lists into the variables you will need to pass to dump/3 and then handle the case where you have multiple equations in the result, but I don't think this will be very challenging for you.
Hope this helps!
I'm currently trying to solve this puzzle houses using only constraints provided by the clpfd prolog library, which means I cannot use backtracking!
Basically I want to find out which pairs of houses should be made in order to only have 2 distances between all the connections.
My input is a list of coordinates like this [[0,0],[0,3],[2,0],[3,0],[2,1],[3,1],[2,2],[3,3]] And a solution for it would be:
[
[[0,0],[0,3]],
[[2,0],[3,1]],
[[2,1],[3,0]],
[[2,2],[3,3]]
]
My current progress is this one:
connect(Houses):-
%There are only 2 distances and they're different
length(Distances, 2),
all_distinct(Distances),
%One connection per 2 houses (pairs) means half the number of houses as connections
length(Houses, NHouses),
NConnections #= NHouses // 2,
length(Connections, NConnections),
restrictDistances(Connections, Distances), %restrict every connection to have one of the two distances
%All the houses must be connected
append(Connections, ConnectedHouses),
ensureAllConnected(Houses, ConnectedHouses), %table
removeSymmetries(Connections), %avoid symmetries
%flatten list and labeling
append(ConnectedHouses, HousesCoordinates),
labeling([], HousesCoordinates),
write(Connections).
/*
All distances of all connections are one of the two distances
Distance is kept squared to keep it an integer i.e. dist(connection) = dist([[x1, y1], [x2, y2]]) = (x2-x1)^2 + (y2-y1)^2
*/
restrictDistances([], _).
restrictDistances([[[X1, Y1], [X2, Y2]]|Connections], Distances):-
DiffX #= X2 - X1,
DiffY #= Y2 - Y1,
Dis #= DiffX * DiffX + DiffY * DiffY,
% element(Idx, Distances, Dis), %element
member(Dis, Distances), %element
restrictDistances(Connections, Distances).
/*
Ensures all houses are connected
*/
ensureAllConnected([], _).
ensureAllConnected([H|Houses], ConnectedHouses):-
member(H, ConnectedHouses),
% element(_, ConnectedHouses, H),
ensureAllConnected(Houses, ConnectedHouses).
/*
Remove symmetries and connection permutations in final result
*/
removeSymmetries([_]).
removeSymmetries([[[X1, _], [X2, _]], [[X3, Y3], [X4, Y4]]|Connections]):-
X1 #=< X2,
X1 #=< X3,
X3 #=< X4,
removeSymmetries([[[X3, Y3], [X4, Y4]]|Connections]).
The worst part is that this code works, however the predicate member cannot be used because it uses backtracking... And yes, the predicate element exists, but I am unable to replace with it because if I replace first one the output is different, and if I replace the second one I get an instantiation error.
Strictly speaking, the problem is underspecified, because there are more than one kind of distance, e.g. Euclidean distance and Hamiltonian distance. Apparently, Euclidean distances are intended, otherwise you get multiple solutions for this instance.
For this puzzle, it is useful to think about what subtasks might be encoded with global constraints. Here are some hints:
You need to find a matching - that can be encoded with
assignment(Xs,Xs).
You can use table/2 to encode the (house,house,distance) relation.
You can use nvalue/2 to constrain
the number of distinct distances.
These are global constraints in SICStus Prolog.
This is My First Logic Programming Language course so this is a really Dumb Question But I cannot for the life of me figure out how does this power predicate work I've tried making a search tree to trace it But I still cannot understand how is it working
mult(_ , 0 ,0).
mult(X , Y, Z):-
Y > 0,
Y1 is Y - 1,
mult(X,Y1,Z1),
Z is Z1 + X.
exp2(_ ,0 , 1).
exp2(X,Y,Z):-
Y > 0,
Y1 is Y - 1,
exp2(X , Y1 , Z1),
mult(X,Z1,Z).
I so far get that I'm going to call the exp2 predicate till I reach the point where the Y is going to be Zero then I'm going to start multiplying from there, but At the last call when it's at exp2(2 , 1 , Z) what is the Z value and how does the predicate work from there?
Thank you very much =)
EDIT: I'm really sorry for the Late reply I had some problems and couldn't access my PC
I'll walk through mult/3 in more detail here, but I'll leave exp2/3 to you as an exercise. It's similar..
As I mentioned in my comment, you want to read a Prolog predicate as a rule.
mult(_ , 0 ,0).
This rule says 0 is the result of multiplying anything (_) by 0. The variable _ is an anonymous variable, meaning it is not only a variable, but you don't care what its value is.
mult(X, Y, Z) :-
This says, Z is the result of multiplying X by Y if....
Y > 0,
Establish that Y is greater than 0.
Y1 is Y - 1,
And that Y1 has the value of Y minus 1.
mult(X, Y1, Z1),
And that Z1 is the result of multiplying X by Y1.
Z is Z1 + X.
And Z is the value of Z1 plus X.
Or reading the mult(X, Y, Z) rule altogether:
Z is the result of multiplying X by Y if Y is greater than 0, and Y1 is Y-1, and Z1 is the result of multiplying X by Y1, and Z is the result of adding Z1 to X.
Now digging a little deeper, you can see this is a recursive definition, as in the multiplication of two numbers is being defined by another multiplication. But what is being multiplied is important. Mathematically, it's using the fact that x * y is equal to x * (y - 1) + x. So it keeps reducing the second multiplicand by 1 and calling itself on the slightly reduced problem. When does this recursive reduction finally end? Well, as shown above, the second rule says Y must be greater than 0. If Y is 0, then the first rule, mult(_, 0, 0) applies and the recursion finally comes back with a 0.
If you are not sure how recursion works or are unfamiliar with it, I highly recommend Googling it to understand it. That is, indeed, a concept that applies to many computer languages. But you need to be careful about learning Prolog via comparison with other languages. Prolog is fundamentally different in it's behavior from procedural/imperative languages like Java, Python, C, C++, etc. It's best to get used to interpreting Prolog rules and facts as I have described above.
Say you want to compute 2^3 as assign result to R.
For that you will call exp2(2, 3, R).
It will recursively call exp2(2, 2, R1) and then exp2(2, 1, R2) and finally exp(2, 0, R3).
At this point exp(_, 0, 1) will match and R3 will be assigned to 1.
Then when call stack unfolds 1 will be multiplied by 2 three times.
In Java this logic would be encoded as follows. Execution would go pretty much the same route.
public static int Exp2(int X, int Y) {
if (Y == 0) { // exp2(_, 0, 1).
return 1;
}
if (Y > 0) { // Y > 0
int Y1 = Y - 1; // Y1 is Y - 1
int Z1 = Exp2(X, Y1); // exp2(X, Y1, Z1);
return X * Z1; // mult(X, Z1, Z).
}
return -1; // this should never happen.
}
I am new to PROLOG and am trying some simple exercises to familiarize myself with it. However I am stuck in making an addition of 2x2matrix with another, more specifically lists within lists.
This is my code, the output using SWI-Prolog is False, and I have no idea why. Any help is appreciated!
matrixAdd([X],[Y],[S]) :- S is X + Y.
matrixAdd([[H|A],[I|B]],[[J|C],[K|D]],[[S1|Sum1],[S2|Sum2]]) :-
S1 = H + J,
S2 = I + K,
matrixAdd([A,B],[C,D],[Sum1,Sum2]).
Elaborating:
?- A = 2 + 3.
A = 2+3.
?- A = 2 + 3, A == 5.
false.
?- A = 2 + 3, A = 5.
false.
?- A is 2 + 3, A =:= 10/2.
A = 5.
?- A is 2 + 3, A = 10/2.
false.
Figure out why you get each of these answers.
Furthermore, think about how you want to represent your matrix. Does it need to be a nested list? For example, it could be something like matrix(dim(2,2), [1,2,3,4]). Then, adding two matrices would be as easy as:
matrix_sum(matrix(D, V1), matrix(D, V2), matrix(D, Sum)) :-
maplist(add, V1, V2, Sum).
add(X, Y, Sum) :-
Sum is X + Y.
(You could get fancy and use a constraint library for the add operation. For example, with library(clpr) you could write {Sum = X+Y} and use the same predicate for addition and for subtraction.)
This uses unification in the head to make sure that the two matrices have the same dimensions, while the maplist take care of V1 and V2 being the same length.
Or you prefer a list of lists. Then, figure out the general predicate that adds lists of lists together (see the other answer!). Now you have a weird mix where you kind of know the magnitude of one dimension in advance, but still attempt to traverse the other dimension. As your code is at the moment, it is your base case that always fails. It should be:
matrixAdd([[],[]],[[],[]],[[],[]]).
(so many lists!) and without any body. Try replacing it in your original code and see what happens.
You first need to know the following:
There is a difference between = and is/2
Check your list syntax [Head|Tail] is different from [Element1,Element2]
Unification of [X] will only work when you pass a list with exactly 1 element. Just like [[A,B],[C,D]] will only match a 2 by 2 matrix. (Note that the elements A,B,.. could be lists as well in that case)
For you hardcode solution, fixing all these issues should work, but I want to leave that to you for now.
matrixAddHardcode([[A1,A2],[A3,A4]],[[B1,B2],[B3,B4]],[[S1,S2],[S3,S4]]) :-
S1 is A1 + B1,
S2 is A2 + B2,
S3 is A3 + B3,
S4 is A4 + B4.
Solution for any X by Y
matrixAddFix([],[],[]).
matrixAddFix([L1|T1],[L2|T2],[S1|TS]) :-
listSum(L1,L2,S1),
matrixAddFix(T1,T2,TS).
listSum([],[],[]).
listSum([H1|T1],[H2|T2],[S1|TS]) :-
S1 is H1+H2,
listSum(T1,T2,TS).
Why does this work:
power(_,0,1) :- !.
power(X,Y,Z) :-
Y1 is Y - 1,
power(X,Y1,Z1),
Z is X * Z1.
And this gives a stack overflow exception?
power(_,0,1) :- !.
power(X,Y,Z) :-
power(X,Y - 1,Z1),
Z is X * Z1.
Because arithmetic operations are only performed on clauses through the is operator. In your first example, Y1 is bound to the result of calculating Y - 1. In the later, the system attempts to prove the clause power(X, Y - 1, Z1), which unifies with power(X', Y', Z') binding X' = X, Y' = Y - 1, Z' = Z. This then recurses again, so Y'' = Y - 1 - 1, etc for infinity, never actually performing the calculation.
Prolog is primarily just unification of terms - calculation, in the "common" sense, has to be asked for explicitly.
Both definitions do not work properly.
Consider
?- pow(1, 1, 2).
which loops for both definitions because the second clause can be applied regardless of the second argument. The cut in the first clause cannot undo this. The second clause needs a goal Y > 0 before the recursive goal. Using (is)/2 is still a good idea to get actual solutions.
The best (for beginners) is to start with successor-arithmetics or clpfd and to avoid prolog-cut altogether.
See e.g.: Prolog predicate - infinite loop