Many prolog guides use the following definition of negation as failure.
% negation as failure
negation(G) :- call(G), !, fail.
negation(_).
Question: is it necessary to wrap G in call/1?
In the following definition, G is written without wrapping it with a call/1, and it seems to work.
% negation as failure
negation2(G) :- G, !, fail.
negation2(_).
Testing with swi-prolog (swish):
?- negation2(true)
false
?- negation2(false)
true
I also tested it with a short prolog program.
Question 2: Are there scenarios when we must write call(G) and not simply G?
First of all, these examples are about programs that go beyond first order logic, for you now permit variables to be in the place of goals. Inevitably, this transition will lead to some quirks on its way.
The common way to resolve this in ISO (and also in many systems that are not ISO like SWI) is to define an exact moment where first-order terms are converted into a goal or body of a clause (7.6.2). In this moment, a variable G_0 that occurs in the place of a goal is wrapped into call(G_0).
Thus, to answer Q1: No, it is not necessary to wrap that variable in your definition of negation/1, since the term-to-body conversion is happening here at the time of the preparation for execution of this Prolog text.
So essentially there will never be a variable that is called directly. Instead, call/1 is used always.
Your question 2 thus boils down to: What is the difference between a non-variable term as a goal and that term just wrapped with call/1?
Terms that cannot be converted to a goal/body.
?- false, call(1).
false.
?- false, 1.
error(type_error(callable,(false,1)),(',')/2).
?- G_0 = ( false, call(1)), G_0.
false.
?- G_0 = ( false, 1), G_0.
error(type_error(callable,(false,1)),(',')/2).
Control constructs cut and if-then-else no longer cut.
?- ( !, false ; true ).
false.
?- ( call(!), false ; true ).
true.
?- ( A = 1 -> B = 2 ; C = 3 ).
A = 1, B = 2.
?- ( ( A = 1 -> B = 2 ) ; C = 3 ).
A = 1, B = 2.
?- ( call(( A = 1 -> B = 2 )) ; C = 3 ).
A = 1, B = 2
; C = 3.
Note that in SWI, the toplevel has its own extra error checking which sometimes shows. With an extra indirection this can be circumvented. Here is such a case:
?- false, unknown.
false. % result in Scryer etc
?- false, unknown.
ERROR: Unknown procedure: unknown/0 (DWIM could not correct goal)
% SWI result only
?- G_0 = ( false, unknown ), G_0.
false. % same result everywhere
Related
Playing around with DCGs and stubled upon the following problem:
I want to parse as well as produce an exact amount of spaces (" "). My trivial approach of simply doing this:
trivial_nat_space(0) --> [].
trivial_nat_space(N) -->
{ N > 0, N is M+1 },
" ",
trivial_nat_space(M).
failed terribly, because of insufficient instantiation of N and M depending on whether i do
?- String=" ", my_string_codes(String,Codes), phrase(trivial_nat_space(Anz_Spaces), Codes, [])
or
?- Anz_Spaces=3,my_string_codes(String,Codes), phrase(trivial_nat_space(Anz_Spaces), Codes, [])
where (for convenience)
my_string_codes(S,C) :-
when((ground(S);ground(C)), string_codes(S,C)).
searching for a nice solution to the problem I made a version that depends on self defined nats:
z.
s(z).
s(s(O)) :-
s(O).
nat_num(S,C) :-
when((ground(S);ground(C)),nat_num_(S,C)).
nat_num_(z,0) :- !.
nat_num_(s(N),X) :-
nonvar(X),
!,
X > 0,
Y is X-1,
nat_num_(N,Y).
nat_num_(s(N),X) :-
var(X),
nat_num_(N,Y),
X is Y+1.
n_space(z) --> [].
n_space(s(N)) -->
" ",
n_space(N).
which I would like to avoid because the additional encoding of the natural number is kind of already present in the builtin numbers.
and this:
nat_space(0) --> [].
nat_space(N) -->
{ var(N) },
" ",
nat_space(M),
{ N is M+1 }.
nat_space(M) -->
{ nonvar(M), M>0 },
" ",
{ N is M-1 },
nat_space(N).
which does work fine:
?- Anz_Spaces=3,my_string_codes(String,Codes), once(phrase(nat_space(Anz_Spaces), Codes, [])).
Anz_Spaces = 3,
String = " ",
Codes = [32, 32, 32].
?- String=" ",my_string_codes(String,Codes), once(phrase(nat_space(Anz_Spaces), Codes, [])).
String = " ",
Codes = [32, 32, 32],
Anz_Spaces = 3.
However the encoding of nat_spaces is (in my opinion) far from nice: it depends on meta-predicates to enforce a specific execution sequence, and (more seriously): if the parser were more complex than just " ", the logic would have to be defined in a seperate DCG predicate/rule resulting in the logic for a single parser/generator to be split into two definitions (the separated one and the one enforcing the correct execution sequence).
Is this the canonical/standard way of solving problems like this or is there a more general, elegant solution that I am missing right now?
Additional Info:
I am using SWI-Prolog version 8.3.9 for x86_64-linux
with :- [library(dcg/basics)] and no additional arguments when starting the runtime. Nor do I set any settings in the file with the definitions.
Frankly, your original definition doesn't fail that terribly. No, it does not fail. For the most general query, it produces one solution,
?- phrase(trivial_nat_space(0), Cs).
Cs = [] % pure perfect logic!
; false.
?- phrase(trivial_nat_space(-1), Cs).
false. % it's right to be false!
?- phrase(trivial_nat_space(1), Cs).
error(instantiation_error,(is)/2). % er...
?- phrase(trivial_nat_space(N), Cs). % most general query
Cs = [], N = 0 % again, pure logic
; error(instantiation_error,(is)/2). % mmh...
... and otherwise an instantiation error. Instantiation errors are not the worst that can happen. They clearly and honestly state that more information (= instantiations) must be provided before we can continue. That is much better than to pretend everything is fine when it is not. Think of a clerk who asks for more information as producing an instantiation error. And then compare this to one that just fills out your IRS forms with some bold default assumptions1.
To localize the reason for an instantiation error, we will use a failure-slice. So I will throw in some false goals and also an additional instantiation to make it even easier:
trivial_nat_space(0) --> [], {false}.
trivial_nat_space(N) --> {N = 1},
{ N > 0, N is M+1, false },
" ",
trivial_nat_space(M).
?- phrase(trivial_nat_space(1), Cs).
error(instantiation_error,(is)/2).
This is a pretty disfunctional program! And still it produces an instantiation error. In order to fix your original program we have to modify something in the remaining visible part. In N is M+1 only the M can cause that error. In fact, it occurs here for the first time. We can replace it by M is N-1 which improves your program:
?- phrase(trivial_nat_space(1), Cs).
Cs = " " % see section double quotes
; false.
?- phrase(trivial_nat_space(2), Cs).
Cs = " "
; false.
?- phrase(trivial_nat_space(N), Cs).
Cs = [], N = 0
; error(instantiation_error,(is)/2). % still ...
?- phrase(trivial_nat_space(N), " ").
error(instantiation_error,(is)/2).
Our program now works at least when the concrete number of spaces is known. Even better, we can also use arithmetic expressions!
?- phrase(trivial_nat_space(4*1), Cs). % let's indent by four spaces
Cs = " "
; false.
?- phrase(trivial_nat_space(4*2), Cs). % ... twice ...
Cs = " "
; false.
?- phrase(trivial_nat_space(4*0), Cs). % ... none?
false.
?- phrase(trivial_nat_space(0), Cs).
Cs = [] % here it works
; false.
So N may be an arithmetic integer expression, and it works as expected, except for 0 which must be stated literally. That is not really a deep problem, no algebraic properties are violated. But elegant it is not. Let's remember that.
Back to the instantiation errors. To handle these cases as well we need some way to deal with this variable N. The easiest way is to use library(clpz) or its predecessor in SWI library(clpfd) as proposed in another answer. And yes, you can do such things manually, but thereby you are duplicating the work that has been invested into that library. It might make sense for performance reasons sometimes, but it will come at a hefty (bug ridden) price.
So let's look at #gusbro's solution and don't forget to add
:- use_module(library(clpz)). % SICStus or Scryer
:- use_module(library(clpfd)). % SWI
?- phrase(trivial_nat_space(N), Cs).
Cs = [], N = 0
; Cs = " ", N = 1 % finally, logic!
; Cs = " ", N = 2
; Cs = " ", N = 3
; ... .
?- phrase(trivial_nat_space(N), " ").
N = 2
; false.
?- N = 1+1, phrase(trivial_nat_space(N), " ").
N = 1+1 % nice like is/2
; false.
?- phrase(trivial_nat_space(N), " "), N = 1+1.
false. % and out, why?
Everything is nice and dandy, up to the last query. So that extension with arithmetic expressions did not work out so nicely. Effectively it boils down to the following problem:
?- N = 1+1, N #= 2.
N = 1+1.
?- N #= 2, N = 1+1.
false.
In the first query, we solve the integer-equation 1+1 #= 2 which succeeds, and in the second query, we solve N #= 2 which succeeds with N = 2 and then we try to solve 2 = 1+1 which fails.
In other words, that extension into general arithmetic expressions did not work so well for constraints. Before, instantiation errors hid the problem. Now we need to draw somehow the line. And violating commutativity as above is not a nice option2.
The solution is to separate expression variables and integer variables explicitly and insist on fully instantiated expressions.
?- N = 1+1, #N #= 2.
error(type_error(integer,1+1),must_be/2)
?- #N #= 2, N = 1+1.
false.
?- assertz(clpz:monotonic).
true.
?- N #= 2, N = 1+1.
error(instantiation_error,instantiation_error(unknown(_102),1)).
So now #gusbro's program gets some slight modification:
trivial_nat_space(0) --> [].
trivial_nat_space(N) -->
{ #N #> 0, #M #= #N-1 },
" ",
trivial_nat_space(M).
double_quotes
Since you want elegant code, consider to use as a single representation for text: lists of characters. In this manner you avoid all this converting code which will never be elegant. In some systems like Tau, Trealla, and Scryer, double quoted items are chars by default. In SWI proceed like so:
?- L = "ab", L = [_,_].
false.
?- phrase("ab","ab").
false.
?- set_prolog_flag(double_quotes, chars).
true.
?- L = "ab", L = [_,_].
L = [a, b].
?- phrase("ab","ab").
true.
And with library(double_quotes)
?- L = "ab", L = [_,_].
L = "ab".
Grammars
Finally, there is something to note about multi-directional grammar rules in general. Think of a predicate text_ast/2. For one Abstract Syntax Tree, there is an infinity of valid program texts which all differ by trivial paraphernalia like layout text. Therefore, this general relation must not terminate when only the AST is given. So you would need an extra parameter indicating whether the text should be canonical or not.
1 And in fact in DEC10 Prolog the default assumption for variables in arithmetic expressions was the value zero. ISO Prolog has defined instantiation errors for those situations.
2 In SICStus' native library clpfd, the same problem appears with ?- N = 1+1, call(N #= 2). instead.
For your specific example, you can use CLP(fd) to be able to use the DCG in both ways:
trivial_nat_space(0) --> [].
trivial_nat_space(N) -->
{ N #> 0, M #= N-1 },
" ",
trivial_nat_space(M).
In the following sample runs I will use backticks (`) to use coded strings:
?- phrase(trivial_nat_space(Anz_Spaces), ` `, []).
Anz_Spaces = 3 ;
false.
?- phrase(trivial_nat_space(3), Spaces, []).
Spaces = [32, 32, 32] ;
false.
?- phrase(trivial_nat_space(N), Spaces, []).
N = 0,
Spaces = [] ;
N = 1,
Spaces = [32] ;
N = 2,
Spaces = [32, 32] ;
N = 3,
Spaces = [32, 32, 32]
...
In this case we can avoid explicit arithmetic altogether, and let unification do the work:
:- set_prolog_flag(double_quotes, chars).
spaces --> "".
spaces --> " ", spaces.
n_spaces(N, Spaces) :-
length(Spaces, N),
phrase(spaces, Spaces).
?- n_spaces(N, S).
N = 0,
S = [] ;
N = 1,
S = [' '] ;
N = 2,
S = [' ', ' ']
?- n_spaces(2, S).
S = [' ', ' '].
?- n_spaces(N, " ").
N = 2.
We need the double_quotes flag here because (at least in SWI-Prolog 8.0.2) it seems that strings have to be either ground or var, unlike lists which can have variable entries/tails, so I don't think it's possible to use this unification technique with SWI-style strings:
?- string_length(String, Length).
ERROR: Arguments are not sufficiently instantiated
ERROR: In:
ERROR: [8] string_length(_10886,_10888)
ERROR: [7] <user>
I'm learning the basics of Prolog and I was wondering why the following line prints X = 1 instead of true?
?- X=1,1=X.
X = 1.
--
The first X=1 in my command is an assignment, and the second one will be a check of equality.
There are no assignments or equality tests in your query, only unification of terms. The query succeeds by unifying the variable X with 1 and that's what the top-level reports: it tells which variable bindings makes the query true.
After the first goal in the conjunction, X = 1, succeeds, the second goal is the unification 1 = 1, which trivially succeeds.
P.S. Also note that Prolog systems differ in the way they report successful queries. Some print true, others print yes (the traditional way that successful queries are reported).
When the answer is true and a value is bound to variable at the top level, the value of the variable is displayed, which implies the result was true.
Here are some examples.
test_01 :-
X = 1,
X = 1.
test_02 :-
X = 1,
X = 2.
test_03(X) :-
X = 1,
X = 1.
test_04(X) :-
X = 1,
X = 2.
and when the examples are run from the top level using SWI-Prolog
?- test_01.
true.
?- test_02.
false.
?- test_03(X).
X = 1.
?- test_04(X).
false.
Here are some examples that are done only in the top level
?- X=1.
X = 1.
?- 1=1.
true.
?- 1=0.
false.
?- 1==0.
false.
The first X=1 in my command is an assignment, and the second one will be a check of equality.
X=1 is not an assignment it is a unification of the integer 1 to the variable X. The second X=1 is not a check of the equality, it is another unification of X to 1, but since X is bound to 1 by this time, it is really a different unification.
To do equality checking in Prolog use ==, e.g.
?- 1 == 1.
true.
?- 1 == 2.
false.
Also , is the logical and, so if
?- X = 1.
X = 1.
then 1 is bound to X and is true and similar for the second line in your question.
However the code has to be also viewed as
?- true,true.
true.
as opposed to
?- true,false.
false.
While ; is logical or
?- true;true.
true ;
true.
?- true;false.
true ;
false.
?- true;false;true.
true ;
true.
?- false;true.
true.
?- false;false.
false.
Notice that the first 3 answers have 2 results, but the last two answers have 1 result.
In Prolog, is it possible to check if the variable is certain value only if the variable is instantiated.
? - my_rule(X).
my_rule(X):-
X = 4,
write('continue').
Here I am trying to check if the X is 4, if the X is 4 then we continue, but I also want the rule to continue if the X is _, but when it is called with something else, like X is 3 then it should not continue.
So the results would look like this:
?- my_rule(X).
continue
true.
?- my_rule(4).
continue
true.
?- my_rule(3).
false.
Have a look at var/1, atom/1 and ground/1:
var(X) is true if and only if X is a variable.
?- var(X), X= 1.
X = 1.
?- X=1, var(X).
false.
?- X=f(Y), var(X).
false.
atom(X) is true if X is an atom.
?- atom(a).
true.
?- atom(f(a)).
false.
?- atom(X).
false.
ground(X) is true if X is ground (does not contain variables).
?- ground(f(a)).
true.
?- ground(f(X)).
false.
The three predicates are deterministic (i.e. do not backtrack) and you can safely negate them.
Your code become something like this:
my_rule(4) :-
% handle the 4 case
my_rule(X) :-
var(X),
% general case
I'm just not sure if this is, what you want. In most programs, there should be no necessity to handle the variable only case separately. Also be aware that such meta-logical tests are outside the scope of classical logic. If compare the queries X = 1, var(X) and var(X), X = 1, you can see that the conjunction is not commutative anymore but in logic A ∧ B = B ∧ A holds.
You can use double negation ( \+(\+(...)) ):
In your example:
my_rule(X):-
\+(\+(X = 4)),
write('continue').
my_rule(X):-
check(X),
write('continue').
% A fact used to check a value.
check(4).
% A predicate that checks if X is unbound, e.g. a variable.
check(X) :-
var(X).
Verification of desired results.
?- my_rule(X).
continue
X = 4 ;
continue
true.
?- my_rule(4).
continue
true ;
false.
?- my_rule(3).
false.
Can you help me understand the engine of answering the next queries?
?- _ = _.
?- _ = 1.
?- A = _, B = _, C = A + B + 1.
And some extra query (not related to anonymous variables):
?- B = A + 1, A = C, C = B - 1.
I know the answers to above queries, but I want to understand how prolog find those answers :)
Thanks!
_ is called the _anonymous variable. Each occurrence of _ is a different variable. You can observe it easily by using the standard write_canonical/1 built-in predicate. For example:
| ?- write_canonical(_ = _).
=(_279,_280)
yes
A variable can be unified with any term, including other variable, as you observe in your queries. Note that the standard =/2 built-in predicate performs unification, not equality or arithmetic expression evaluation. Unification takes two terms and succeeds if the two terms are the same or can be made the same by unifying any variables in the terms. For example:
| ?- A + 1 = 2 + B.
A = 2
B = 1
(1 ms) yes
A query such as:
| ?- write_canonical(B = A + 1), nl, B = A + 1, write_canonical(B).
=(_279,+(_280,1))
+(_280,1)
B = A+1
yes
unifies the variable B with the compound term +(A,1). _279 and _280 are the internal variable representation for, respectively, B and A. Different Prolog systems print these internal representation differently. For example, using SWI-Prolog:
?- write_canonical(B = A + 1), nl, B = A + 1, write_canonical(B).
=(_,+(_,1))
+(_,1)
B = A+1.
Regarding your extra query, B = A + 1, A = C, C = B - 1, it creates cyclic terms. Consider the simpler query:
| ?- X = f(X).
The result and consequent variable binding report by the Prolog top-level depends on a specific Prolog system handles cyclic terms. For example, in GNU Prolog you will get:
| ?- X = f(X).
cannot display cyclic term for X
yes
while SICStus Prolog reports:
| ?- X = f(X).
X = f(f(f(f(f(f(f(f(f(f(...)))))))))) ?
Cyclic terms are useful for some applications, e.g. coinductive logic programming. But the handling of cyclic terms is not standardized and varies among Prolog systems. The ISO Prolog standard provides a built-in predicate, unify_with_occurs_check/2, that checks if unification will create a cyclic term, preventing it. For example:
| ?- unify_with_occurs_check(X, f(X)).
no
| ?- unify_with_occurs_check(X, Y).
Y = X
(1 ms) yes
I have an upcoming Logic exam and have been studying some past papers from my course. I've come across a question regarding reification and have posted it below;
Illustrate reification by using it to express the property that a variable B can
either take the value of 1 or 8.
After reading some resources and looking at the SWI Prolog manual, I still find the concept of reification quite confusing (primarily studying Java so the switch to learning Prolog has been difficult). It's quite confusing having to use boolean logic within the prolog query.
Without reification, I would have to write the following code (which I know is far too long to be the correct answer);
B in 1..8, B #\= 2,B #\= 3,B #\= 4,B #\= 5,B #\= 6,B #\= 7.
Would really appreciate if someone could show me the above query, but using reification.
From the documentation:
The constraints in/2, #=/2, #\=/2, #/2, #==/2 can be reified, which means reflecting their truth values into Boolean values represented by the integers 0 and 1. Let P and Q denote reifiable constraints or Boolean variables, then:
...
P #\/ Q True iff either P or Q
...
For you, it seems P is B #= 1 and Q is B #= 8, so you end up with:
?- B #= 1 #\/ B #= 8.
B in 1\/8.
As you see, you are not really using the reified values. You are just using reification as a round-about way of declaring the domain of your variable. The answer to your query, B in 1 \/ 8, is what you would probably use directly if you wanted to say that "B is either 1 or 8". If you look carefully at the documentation of in/2, you should see that the domain can be either an integer, a range Lower .. Upper, or the union of Domain1 \/ Domain2. In your case both domains are a single integer, 1 and 8.
PS: Once you go down that road, why not:
?- B in 1..8 #/\ #\ B in 2..7.
B in 1\/8.
B is in [1,8] AND B is not in [2,7].
The possibilities are endless :)
First, try out your query:
?- B in 1..8, B #\= 2,B #\= 3,B #\= 4,B #\= 5,B #\= 6,B #\= 7.
B in 1\/8.
This tells you that your query is equivalent to the single goal B in 1\/8.
From this, you see that you don't need reification to express that a finite domain variable is either equal to 1 or 8.
Reification allows you to reify the truth value of the constraint. For example, you can say:
?- T #<==> B in 1\/8.
T in 0..1,
B in 1\/8#<==>T.
?- T #<==> B in 1\/8, B = 3.
T = 0,
B = 3.
From the second query, you see that if B = 3, then T = 0, because the constraint B in 1\/8 doesn't hold in that case.
Reifying a constraint can be useful if you want to reason about constraints themselves. For example, this allows you to express that a certain number of list elements must be equal to a given integer. I leave solving this as a more meaningful exercise to understand reification.
Initially I was thinking along the same lines as #Boris and #mat. But after pondering the question for a while, another possible interpretation of the task occured to me. However, keep in mind that I am not familiar with your course material, so this is highly speculative. That being said, maybe the task description is asking to write a predicate that evaluates to true if the above property holds or to false otherwise. A predicate like that could be defined as:
val_either_or_t(X,Y,Z,true) :-
( X#=Y ; X#=Z).
val_either_or_t(X,Y,Z,false) :-
X #\= Y,
X #\= Z.
I admit the name is a little clumsy but I couldn't really come up with a better one. Anyway, it does the job according to the task interpretation I described above:
?- val_either_or_t(X,1,8,T).
T = true,
X = 1 ? ;
T = true,
X = 8 ? ;
T = false,
X in inf..0\/2..7\/9..sup
?- val_either_or_t(X,Y,Z,T).
T = true,
X = Y,
X in inf..sup ? ;
T = true,
X = Z,
X in inf..sup ? ;
T = false,
X#\=Z,
X#\=Y
I came up with this idea because lately I was playing around with some reifying predicates that I found on Stackoverflow, and it popped into my mind that the task might be aimed in a direction where the described property could be used as a condition with such predicates. For example with if_/3 that I used a lot with (=)/3 in the condition, but why not use it with something like val_either_or_t/4. Consider the following minimal example:
a(condition_was_true).
b(condition_was_false).
somepredicate(X,Y) :-
if_(val_either_or_t(X,1,8),a(Y),b(Y)).
With the respective query:
?- somepredicate(X,Y).
X = 1,
Y = condition_was_true ? ;
X = 8,
Y = condition_was_true ? ;
Y = condition_was_false,
X in inf..0\/2..7\/9..sup
This example is of course not very meaningful and only intended to illustrate how reification of the given property might be used. Also, I am using the atoms true and false to reify the thruth values with regard to using them with if_/3. However, you can also use 1 and 0 to reify truth values like in #mat's example. Just replace the 4th argument in the definition of val_either_or_t/4 by 1 and 0 respectively. Furthermore you might find the refinement of this idea that was suggested by #repeat in the comments interesting as well.