Related
In predicate logic, why does P(x) and P(f(x)) have no unifiers? One of my solutions is replacing x with f(x), but I'm not sure why I am wrong.
Let's see what happens if you replace x with f(x):
P(x) becomes P(f(x))
P(f(x)) becomes P(f(f(x)))
And the result isn't the same; so it's not a unifier.
In general when the difference term involves itself as in this case (i.e., x differing from f(x)) you cannot unify them since whatever you substitute for x would change both terms in an unequal way, assuming they are not equal to start with.
Another way to think about this the so called occurs-check. Since x occurs in f(x) you cannot unify these two terms. You can read about the occurs-check here: https://en.wikipedia.org/wiki/Occurs_check
Consider the PROLOG predicate f(list,integer) with flow model (i,o).
f([],0).
f([H|T],S):-
f(T,S1),
S1 is S-H.
Give the result of the evaluation f([1,2,3,4,5,6,7,8],S)?Justify the answer.
I've seen that we get the error "Arguments are not sufficiently instantied" and that is because the value of S is not updated in the end(only when the list is empty). Is this a good justification?
I've seen that we get the error "Arguments are not sufficiently
instantied" and that is because the value of S is not updated in the
end(only when the list is empty). Is this a good justification?
If this code is supposed to fail, yes.
The correct wording is:
This predicate is called with an unbound variable on second position, either at the top or recursively vai f(T,S1) (where S1 is fresh and thus unbound).
Then the arithmetic evaluation
S1 is S-H.
will have an unbound variable on the right-hand side of is/2 and cannot proceed (i.e. it will throw).
But note that it works if you switch to "constraint satisfaction over finite domains":
?- use_module(library(clpfd)).
true.
Then replacing is/2 by #=:
f([],0).
f([H|T],S):-
f(T,S1),
S1 #= S-H.
yields a working program:
?- f([1,2,3,4,5,6,7,8],S).
S = 36.
I'd like someone to explain this procedure if possible (from the book 'learn prolog now'). It takes two numerals and adds them together.
add(0,Y,Y).
add(s(X),Y,s(Z)) :- add(X,Y,Z).
In principle I understand, but I have a few issues. Lets say I issue the query
?- add(s(s(0)), s(0), R).
Which results in:
R = s(s(s(0))).
Step 1 is the match with rule 2. Now X becomes s(0) and Y is still s(0). However Z (according to the book) becomes s(_G648), or s() with an uninstantiated variable inside it. Why is this?
On the final step the 1st rule is matched which ends the recursion. Here the contents of Y somehow end up in the uninstantiated part of what was Z! Very confusing, I need a plain english explanation.
First premises:
We have s(X) defined as the successor of X so basically s(X) = X+1
The _G### notation is used in the trace for internal variables used for the recursion
Let's first look at another definition of addition with successors that I find more intuitive:
add(0,Y,Y).
add(s(A),B,C) :- add(A,s(B),C).
this does basically the same but the recursion is easier to see:
we ask
add(s(s(0)),s(0),R).
Now in the first step prolog says thats equivalent to
add(s(0),s(s(0)),R)
because we have add(s(A),B,C) :- add(A,s(B),C) and if we look at the question A = s(0) and B=s(0). But this still doesn't terminate so we have to reapply that equivalency with A=0 and B=s(s(0)) so it becomes
add(0,s(s(s(0))),R)
which, given add(0,Y,Y). this means that
R = s(s(s(0)))
Your definition of add basically does the same but with two recursions:
First it runs the first argument down to 0 so it comes down to add(0,Y,Y):
add(s(s(0)),s(0),R)
with X=s(0), Y = s(0) and s(Z) = R and Z = _G001
add(s(0),s(0),_G001)
with X = 0, Y=s(0) and s(s(Z)) = s(G_001) = R and Z = _G002
add(0,s(0),_G002)
So now it knows that _G002 is s(0) from the definition add(0,Y,Y) but has to trace its steps back so _G001 is s(_G002) and R is s(_G001) is s(s(_G002)) is s(s(s(0))).
So the point is in order to get to the definition add(0,Y,Y) prolog has to introduce internal variables for a first recursion from which R is then evaluated in a second one.
If you want to understand the meaning of a Prolog program, you might concentrate first on what the relation describes. Then you might want to understand its termination properties.
If you go into the very details of a concrete execution as your question suggests, you will soon be lost in the multiplicity of details. After all, Prolog has two different interlaced control flows (AND- and OR-control) and in addition to that it has unification which subsumes parameter passing, assignment, comparison, and equation solving.
Brief: While computers execute a concrete query effortlessly for zillions of inferences, you will get tired after a screenful of them. You can't beat computers in that. Fortunately, there are better ways to understand a program.
For the meaning, look at the rule first. It reads:
add(s(X),Y,s(Z)) :- add(X,Y,Z).
See the :- in between? It is meant to symbolize an arrow. It is a bit unusual that the arrow points from right-to-left. In informal writing you would write it rather left-to-right. Read this as follows:
Provided, add(X,Y,Z) is true, then also add(s(X),Y,s(Z)) is true.
So we assume that we have already some add(X,Y,Z) meaning "X+Y=Z". And given that, we can conclude that also "(X+1)+Y=(Z+1)" holds.
After that you might be interested to understand it's termination properties. Let me make this very brief: To understand it, it suffices to look at the rule: The 2nd argument is only handed further on. Therefore: The second argument does not influence termination. And both the 1st and 3rd argument look the same. Therefore: They both influence termination in the same manner!
In fact, add/3 terminates, if either the 1st or the 3rd argument will not unify with s(_).
Find more about it in other answers tagged failure-slice, like:
Prolog successor notation yields incomplete result and infinite loop
But now to answer your question for add(s(s(0)), s(0), R). I only look at the first argument: Yes! This will terminate. That's it.
Let's divide the problem in three parts: the issues concerning instantiation of variables and the accumulator pattern which I use in a variation of that example:
add(0,Y,Y).
add(s(X),Y,Z):-add(X,s(Y),Z).
and a comment about your example that uses composition of substitutions.
What Prolog applies in order to see which rule (ie Horn clause) matches (whose head unifies) is the Unification Algorithm which tells, in particular, that if I have a variable, let's say, X and a funtor, ie, f(Y) those two term unify (there is a small part about the occurs check to...check but nevermind atm) hence there is a substitution that can let you convert one into another.
When your second rule is called, indeed R gets unified to s(Z). Do not be scared by the internal representation that Prolog gives to new, uninstantiated variables, it is simply a variable name (since it starts with '_') that stands for a code (Prolog must have a way to express constantly newly generated variables and so _G648, _G649, _G650 and so on).
When you call a Prolog procedure, the parameters you pass that are uninstantiated (R in this case) are used to contain the result of the procedure as it completes its execution, and it will contain the result since at some point during the procedure call it will be instantied to something (always through unification).
If at some point you have that a var, ie K is istantiated to s(H) (or s(_G567) if you prefer), it is still partilally instantiated and to have your complete output you need to recursively instantiate H.
To see what it will be instantiated to, have a read at the accumulator pattern paragraph and the sequent one, tho ways to deal with the problem.
The accumulator pattern is taken from functional programming and, in short, is a way to have a variable, the accumulator (in my case Y itself), that has the burden to carry the partial computations between some procedure calls. The pattern relies on recursion and has roughly this form:
The base step of the recursion (my first rule ie) says always that since you have reached the end of the computation you can copy the partial result (now total) from your accumulator variable to your output variable (this is the step in which, through unification your output var gets instantiated!)
The recursive step tells how to create a partial result and how to store it in the accumulator variable (in my case i 'increment' Y). Note that in the recursive step the output variable is never changed.
Finally, concerning your exemple, it follows another pattern, the composition of substitutions which I think you can understand better having thought about accumulator and instantiation via unification.
Its base step is the same as the accumulator pattern but Y never changes in the recursive step while Z does
It uses to unify the variable in Z with Y by partially instantiating all the computation at the end of each recursive call after you've reached the base step and each procedure call is ending. So at the end of the first call the inner free var in Z has been substituted by unification many times by the value in Y.
Note the code below, after you have reached the bottom call, the procedure call stack starts to pop and your partial vars (S1, S2, S3 for semplicity) gets unified until R gets fully instantiated
Here is the stack trace:
add(s(s(s(0))),s(0),S1). ^ S1=s(S2)=s(s(s(s(0))))
add( s(s(0)) ,s(0),S2). | S2=s(S3)=s(s(s(0)))
add( s(0) ,s(0),S3). | S3=s(S4)=s(s(0))
add( 0 ,s(0),S4). | S4=s(0)
add( 0 ,s(0),s(0)). ______|
I start to learn Prolog and first learnt about the successor notation.
And this is where I find out about writing Peano axioms in Prolog.
See page 12 of the PDF:
sum(0, M, M).
sum(s(N), M, s(K)) :-
sum(N,M,K).
prod(0,M,0).
prod(s(N), M, P) :-
prod(N,M,K),
sum(K,M,P).
I put the multiplication rules into Prolog. Then I do the query:
?- prod(X,Y,s(s(s(s(s(s(0))))))).
Which means finding the factor of 6 basically.
Here are the results.
X = s(0),
Y = s(s(s(s(s(s(0)))))) ? ;
X = s(s(0)),
Y = s(s(s(0))) ? ;
X = s(s(s(0))),
Y = s(s(0)) ? ;
infinite loop
This result has two problems:
Not all results are shown, note that the result X=6,Y=1 is missing.
It does not stop unless I Ctrl+C then choose abort.
So... my questions are:
WHY is that? I tried switching "prod" and "sum" around. The resulting code gives me all results. And again, WHY is that? It still dead-loops though.
HOW to resolve that?
I read the other answer on infinite loop. But I'd appreciate someone answer basing on this scenario. It greatly helps me.
If you want to study termination properties in depth, programs using successor-arithmetics are an ideal study object: You know a priori what they should describe, so you can concentrate on the more technical details. You will need to understand several notions.
Universal termination
The easiest way to explain it, is to consider Goal, false. This terminates iff Goal terminates universally. That is: Looking at tracers is the most ineffective way - they will show you only a single execution path. But you need to understand all of them at once! Also never look at answers when you want universal termination, they will only distract you. You have seen it above: You got three neat and correct answers, only then your program loops. So better "turn off" answers with false. This removes all distraction.
Failure slice
The next notion you need is that of a failure slice. Take a pure monotonic logic program and throw in some goals false. If the resulting failure slice does not terminate (universally), also the original program won't. In your exemple, consider:
prod(0,M,0) :- false.
prod(s(N), M, P) :-
prod(N,M,K), false,
sum(K,M,P).
These false goals help to remove irrelevant adornments in your program: The remaining part shows you clearly, why prod(X,Y,s(s(s(s(s(s(0))))))). does not terminate. It does not terminate, because that fragment does not care about P at all! You are hoping that the third argument will help to make prod/3 terminate, but the fragment shows you it is all in vain, since P does not occur in any goal. No need for chatty tracers.
Often it is not so easy to find minimal failure slices. But once you found one, it is next to trivial to determine its termination or rather non-termination properties. After some time you can use your intuition to imagine a slice, and then you can use your reason to check if that slice is of relevance or not.
What is so remarkable about the notion of a failure slice is this: If you want to improve the program, you have to modify your program in the part visible in above fragment! As long as you do not change it, the problem will persist. A failure slice is thus a very relevant part of your program.
Termination inference
That is the final thing you need: A termination inferencer (or analyzer) like cTI will help you to identify the termination condition rapidly. Look at the inferred termination conditions of prod/3 and the improved prod2/3 here!
Edit: And since this was a homework question I have not posted the final solution. But to make it clear, here are the termination conditions obtained so far:
prod(A,B,C)terminates_if b(A),b(B).
prod2(A,B,C)terminates_if b(A),b(B);b(A),b(C).
So the new prod2/3 is strictly better than the original program!
Now, it is up to you to find the final program. Its termination condition is:
prod3(A,B,C)terminates_if b(A),b(B);b(C).
To start with, try to find the failure slice for prod2(A,B,s(s(s(s(s(s(0)))))))! We expect it to terminate, but it still does not. So take the program and add manuallyfalse goals! The remaining part will show you the key!
As a final hint: You need to add one extra goal and one fact.
Edit: Upon request, here is the failure slice for prod2(A,B,s(s(s(s(s(s(0))))))):
prod2(0,_,0) :- false.
prod2(s(N), M, P) :-
sum(M, K, P),
prod2(N,M,K), false.
sum(0, M, M).
sum(s(N), M, s(K)) :- false,
sum(N,M,K).
Please note the significantly simplified definition of sum/3. It only says: 0 plus anything is anything. No more. As a consequence even the more specialized prod2(A,0,s(s(s(s(s(s(0))))))) will loop whileprod2(0,X,Y) elegantly terminates ...
The first question (WHY) is fairly easy to spot, specially if know about left recursion. sum(A,B,C) binds A and B when C is bound, but the original program prod(A,B,C) doesn't use that bindings, and instead recurse with still A,B unbound.
If we swap sum,prod we get 2 useful bindings from sum for the recursive call:
sum(M, K, P)
Now M is bound, and will be used to terminate the left-recursion. We can swap N and M, because we know that product is commutative.
sum(0, M, M).
sum(s(N), M, s(K)) :-
sum(N, M, K).
prod3(0, _, 0).
prod3(s(N), M, P) :-
sum(M, K, P),
prod3(M, N, K).
Note that if we swap M,K (i.e. sum(K,M,P)), when prod3 is called with P unknown we again have a non terminating loop, but in sum.
?- prod3(X,Y,s(s(s(s(s(s(0))))))).
X = s(s(s(s(s(s(0)))))),
Y = s(0) ;
X = s(s(s(0))),
Y = s(s(0)) ;
X = s(s(0)),
Y = s(s(s(0))) ;
X = s(0),
Y = s(s(s(s(s(s(0)))))) ;
false.
OT I'm perplexed by cTI report: prod3(A,B,C)terminates_if b(A),b(B);b(A),b(C).
In the query below, firstly I'm getting X = H128, where does that come from? Also why is it returning yes? Is it because the variable X is actually not defined and we are testing for that condition?
?- not(X==3).
X = H128
yes
Your query is using an uninstantiated variable (X).
When checking whether X is instantiated with the term 3 it (X==3) it fails because X is uninstantiated.
Therefore, not(X==3) will succeed as the prolog engine cannot prove X==3.
Your prolog interpreter is thus returning 'yes' (due to the negation as failure approach of the interpreter), and X remains uninstantiated.
That is why the interpreter shows X = H128, where H128 is a dummy uninstantiated variable.
What was your original intention? It could be that you wanted to state that X is not equal to 3. For inequality many Prolog systems offer dif/2:
?- dif(X,3).
dif(X,3).
In this query we ask for values for X that are not equal to 3. So which values are not equal? Actually, quite a lot: Think of 1, 2, the term 3+3, c, the list [2,3,4] and many more. So giving a concrete answer like X = 4 would exclude many other valid answers. The answer here is however: The query holds for all X that are not equal to 3. The actual evaluation is therefore delayed to a later moment.
?- dif(X,3), X = 3.
false.
Here we got in a situation where X got the value 3 - which does not hold.
?- dif(X,3), X = 4.
X = 4.
And here a concrete valid value is accepted, and the restriciton dif(4,3) is removed.
Yes, it is because the variable X is not bound by the first goal, not(X==3). Actually the not/1 metapredicate can never produce a binding, even if it succeeds. That's because success of not means the inner goal fails. Note that not(X=3) would fail because X=3 can succeed when X is free (and can be bound to value 3).