Left associative evaluation of a right recursive grammar in Prolog - prolog

I have an issue with evaluating a parsetree derived from a grammar. The parsetree is derived from this pice of code:
parse(block(LEFT_CURLY, STMTS, RIGHT_CURLY)) -->
left_curly(LEFT_CURLY),
statements(STMTS),
right_curly(RIGHT_CURLY).
statements(statements) -->
[].
statements(statements(ASSIGNMENT, STMTS)) -->
assignment(ASSIGNMENT),
statements(STMTS).
assignment(assignment(ID, ASSIGN_OP, EXPR, SEMICOLON)) -->
ident(ID),
assign_op(ASSIGN_OP),
expression(EXPR),
semicolon(SEMICOLON).
expression(expression(TERM)) -->
term(TERM).
expression(expression(TERM, SUB_OP, EXPR)) -->
term(TERM),
sub_op(SUB_OP),
expression(EXPR).
expression(expression(TERM, ADD_OP, EXPR)) -->
term(TERM),
add_op(ADD_OP),
expression(EXPR).
term(term(TERM)) -->
factor(TERM).
term(term(FACTOR, MULT_OP ,TERM)) -->
factor(FACTOR),
mult_op(MULT_OP),
term(TERM).
term(term(FACTOR, DIV_OP ,TERM)) -->
factor(FACTOR),
div_op(DIV_OP),
term(TERM).
factor(factor(FACTOR)) -->
int(FACTOR).
factor(factor(FACTOR)) -->
ident(FACTOR).
factor(factor(LEFT_PAR, EXPR, RIGHT_PAR)) -->
left_par(LEFT_PAR),
expression(EXPR),
right_par(RIGHT_PAR).
assign_op(assign_op) --> [=].
mult_op(mult_op) --> [*].
add_op(add_op) --> [+].
sub_op(sub_op) --> [-].
div_op(div_op) --> [/].
left_par(left_paren) --> ['('].
right_par(right_paren) --> [')'].
left_curly(left_curly) --> ['{'].
right_curly(right_curly) --> ['}'].
semicolon(semicolon) --> [;].
ident(ident(Y)) --> [Y] , {atom(Y)}.
int(int(X)) --> [X], {integer(X)}.
The resulting parseTree from parse/3 looks like this (ex. inpt { b = 4 - 2 - 1; }:)
T = block(left_curly,statements(assignment(ident(b),assign_op,expression(term(factor(int(4))),sub_op,expression(term(factor(int(2))),sub_op,expression(term(factor(int(1)))))),semicolon),statements),right_curly)
I've had some success with evaluating the expression, and saving variable results. But I am for now evaluating "bottom up" resulting in a right associative evaluation (3), which is not how math works. 4 - 2 - 1 != 3.
An example of the evaluation which evaluates 4 - 2 - 1 to 3:
evaluate(expression(TERM, SUBOP, EXPR), OtherVariables, RESULT) :-
SUBOP = sub_op,
!,
evaluate(TERM, OtherVariables, LHSResult),
evaluate(EXPR, OtherVariables, RHSResult),
RESULT is LHSResult - RHSResult.
evaluate(term(FACTOR), OtherVariables, RESULT) :-
evaluate(FACTOR, RESULT).
evaluate(factor(INT), RESULT) :-
evaluate(INT, RESULT).
evaluate(int(X), X).
Is there anyone who could give me a hint on how to move forward with this issue? I have been able to do this in Java, but my Prolog knowledge is not as good. Unfortunately I am not allowed to change the grammar or the parsing.

Your parse tree is very explicit about whether the input contains parentheses. For example:
?- phrase(expression(Expr), [4, -, 2, -, 1]).
Expr = expression(term(factor(int(4))), sub_op, expression(term(factor(int(2))), sub_op, expression(term(factor(int(1)))))) .
?- phrase(expression(Expr), [4, -, '(', 2, -, 1, ')']).
Expr = expression(term(factor(int(4))), sub_op, expression(term(factor(left_paren, expression(term(factor(int(2))), sub_op, expression(term(factor(int(1))))), right_paren)))) .
This is good, because we can tell where the user really wanted us to evaluate 4 - (2 - 1), or whether the input was 4 - 2 - 1 and should really be interpreted as (4 - 2) - 1.
By far the simplest way of doing this is by thinking about the problem not as "left-associative evaluation of a right-associative tree", but about the two separate problems of "evaluation of a tree" and "getting a left-associative tree into right-associative form". That is, don't try to be clever inside your evaluate predicate, but first reassociate the tree and then evaluate that new tree.
A sketch:
op_associativity(add_op, right).
op_associativity(sub_op, left).
op_associativity(mult_op, right).
op_associativity(div_op, left).
expression_reassociated(expression(X, Op, expression(Y, Op, Z)),
expression(expression(X, Op, Y), Op, Z)) :-
op_associativity(Op, left),
!.
expression_reassociated(Expression, Expression).
With a slightly massaged version of your evaluate, this already gives:
?- phrase(expression(Expr), [4, -, 2, -, 1]), expression_reassociated(Expr, Reassociated), evaluate(Reassociated, Result).
Expr = expression(term(factor(int(4))), sub_op, expression(term(factor(int(2))), sub_op, expression(term(factor(int(1)))))),
Reassociated = expression(expression(term(factor(int(4))), sub_op, term(factor(int(2)))), sub_op, expression(term(factor(int(1))))),
Result = 1 ;
false.
Note that expression_reassociated needs more work: It must reassociate sub-expressions as well. Once you have a complete working solution, you can think about reassociating "on the fly" during evaluation without building the intermediate tree. But it's probably not worth it, unless explicitly requested by your professor.
All that said, it would really be best if the DCG produced the correctly associated parse tree from the start, but I understand that you have constraints.

Related

Termination of prolog query using using dcgs

Given the program
foo([]) --> [].
foo([Start|Rest]) --> alphanum(Start), foo(Rest).
alphanum(Ch) --> [Ch], { char_type(Ch, alnum) }.
How can I make the query length(I, 2), phrase(foo(C), I), false. terminate?
I am using SWI-Prolog version 8.4.3 for x86_64-linux
The non-termination seems to be originating from the last dcg rule. With the following program (not what I want), the query terminates.
foo([]) --> [].
foo([Start|Rest]) --> alphanum(Start), foo(Rest).
alphanum(Ch) --> [Ch].
I don't mind any other formulation of the program that achieves the same results
It will terminate - but there's a lot of Unicode character combinations to loop through.
You probably want instead (note that this is using usually-preferable codes instead of chars):
foo([]) --> [].
foo([Start|Rest]) --> alnum(Start), foo(Rest).
alnum(Digit) --> [Digit], { between(0'0, 0'9, Digit) }.
alnum(Lower) --> [Lower], { between(0'a, 0'z, Lower) }.
alnum(Upper) --> [Upper], { between(0'A, 0'Z, Upper) }.
Result in swi-prolog:
?- length(I, 2), phrase(foo(C), I), writeln(I), false.
...
[90,88]
[90,89]
[90,90]
false.

DCG reversing a string of binary bits

I want to write a (Prolog) DCG which takes in strings of the form a2rev(a) where a is a string of binary bits, e.g. 1012101, 001121100, 0111002001110. My idea was the following :
reverse([]) --> [].
reverse([H|T]) --> reverse(T), [H].
s--> [2].
s--> a,2,b.
a--> [0];[1].
reverse(a,b).
This doesn't work - I am unsure whether I am calling the reverse function incorrectly or if a --> [0];[1] makes sense.
Any help appreciated
You are not mixing the dcg and code properly. Here b//1 extracts a binary sequence and s//1 extracts a binary sequence which has your required property.
b([]) --> [].
b([0 | X]) --> [0], b(X).
b([1 | X]) --> [1], b(X).
s(X) --> b(X), [2], {reverse(X, Y)}, b(Y).
The reverse constraint is added in a {} block using the reverse/2 predicate. If instead you want to use reverse//1 dcg itself you can replace s//1 above with:
s(X) --> b(X), [2], reverse(X).
This gives
?- phrase(s(X), [1, 1, 0, 2, 0, 1, 1]).
X = [1, 1, 0]
For better clarity of what is going on when mixing code and dcg try checking listing(b) and listing(s).

first order logic creating terms for arithmetic expressions using prolog

given a signature (0,Z,{plus(2),minus(2),times(2)}, constants are integers and functions are plus, minus and times with arity 2 for each. I wanted to write a two predicates arth/2 and printarth/1 which takes terms in the above signature and do the necessary arithmetic calculations addition, subtraction and multiplication.arth/2 will print the results and printarth/1 should results out the evaluation expression as shown below.
I wanted to achieve two things
first:
?- arth( plus(minus(8,2), times(4,-3)), N).
N = -6
N is evaluated as ((8−2) + (4∗−3)) = (6 +−12) =−6
second:
?- printarth(plus(minus(8,2), times(4,-3)), N).
((8 - 2) + (4 * -3))
true.
I understand that the use of Terms, Ops and complex terms are used for this and started my code as below
arithmetic_operator('+').
arithmetic_operator('-').
arithmetic_operator('*').
arithmetic_expression(N) :- integer(N).
arithmetic_expression(Term) :-
Term =..[Functor,Component1,Component2],
arithmetic_operator(Functor),
arithmetic_expression(Component1),
arithmetic_expression(Component2).
From here I find it difficult on how to create arth/2 and printarth/1 as I cannot call arithmetic_expression(Term) and throws me an error when I call it.
?- arithmetic_expression(..[+,5,7]).
ERROR: Syntax error: Operator expected
ERROR: arithmetic_expression(.
ERROR: ** here **
ERROR: .[+,5,7]) .
any resources on this task is very useful.
If you want to take a term that looks like this:
minus(2, 3)
and turn it into an arithmetic expression -(2, 3) which is equivalent to 2 - 3 (with the default definition of - as an operator), then evaluate it, you could do it like this:
term_arithmetic_expression(T, E) :-
T =.. [Name, X, Y],
binary_op(Name, Op),
E =.. [Op, X, Y].
eval_arithmetic_expression(T, R) :-
term_arithmetic_expression(T, E),
R is E.
binary_op(minus, -).
% add more binary operations
Now this at least works:
?- eval_arithmetic_expression(minus(2, 3), R).
R = -1.
As you see, both term_arithmetic_expression/2 and eval_arithmetic_expression/2 have two arguments. This is what you need to map minus(2, 4) to 2 - 4.
Your arithmetic_expression/1 is correctly traversing, but not mapping from the one representation to the other. Your arithmetic_operator has the same problem. With minimal changes:
arithmetic_operator(plus, +).
arithmetic_operator(minus, -).
arithmetic_operator(times, *).
arithmetic_expression(N, N) :- integer(N).
arithmetic_expression(Term, Expr) :-
Term =.. [Functor,Component1,Component2],
arithmetic_operator(Functor, Operator),
arithmetic_expression(Component1, Expr1),
arithmetic_expression(Component2, Expr2),
Expr =.. [Operator, Expr1, Expr2].
and then:
?- arithmetic_expression(plus(minus(8,2), times(4,-3)), Expr).
Expr = 8-2+4* -3 ;
false.
?- arithmetic_expression(plus(minus(8,2), times(4,-3)), Expr),
Result is Expr.
Expr = 8-2+4* -3,
Result = -6 ;
false.
?- arithmetic_expression(plus(minus(8,2), times(4,-3)), Expr),
Result is Expr,
display(Expr).
+(-(8,2),*(4,-3))
Expr = 8-2+4* -3,
Result = -6 ;
false.
The display is what is outputting +(-(8,2),*(4,-3)) in the last query.

DCG prolog returning multiple variable answers [duplicate]

If I have the below piece of code, how would I make it produce Answer= 5 and Answer2= 10?. I run the goal ?- test(Data),lpsolve(Data, [Answer1,Answer2]).
:-use_module(library(clpfd)).
test([the, variable, X, is, five,fullstop,
the,variable, Y, is, ten, fullstop]).
lpsolve(Data, [Answer,Answer2]):- sentence(Answer, Data,[]).
sentence(X) --> nounphrase, verbphrase(X).
nounphrase --> [the], [variable].
verbphrase(X) --> [X], [is], [five],[fullstop], {X = 5}.
sentence(Y) --> nounphrase, verbphrase(Y).
nounphrase --> [the], [variable].
verbphrase(Y) --> [Y], [is], [ten],[fullstop], {Y = 10}.
Example of a program that actually runs and is closely related is the following:
:-use_module(library(clpfd)).
test([the, variable, X, is, five,fullstop]).
lpsolve(Data, Answer):- sentence(Answer, Data,[]).
sentence(X) --> nounphrase, verbphrase(X).
nounphrase --> [the], [variable].
verbphrase(X) --> [X], [is], [five],[fullstop], {X = 5}.
I have just one sentence to test and the goal succeeds as shown below.
?- test(Data),lpsolve(Data, Answer).
Data = [the, variable, 5, is, five],
Answer = 5.
EDIT
I try the following as per the first comment:
:-use_module(library(clpfd)).
test([the, variable, x, is, five,fullstop,
the,variable, y, is, ten, fullstop]).
lpsolve(Data, Answer):- sentence(Answer, Data,[]).
sentence(X) --> nounphrase, verbphrase(X).
nounphrase --> [the], [variable].
verbphrase(X) --> [x], [is], [five],[fullstop], {X = 5}.
verbphrase(Y) --> [y], [is], [ten],[fullstop], {Y = 10}.
I get the following:
-? test(Data),lpsolve(Data, Answer).
false.
I'm not really sure what you're trying to do here, but I feel your DCG is broken down in completely strange ways and you may benefit from seeing another way to arrange it.
You have a list of variable bindings, so you should already be thinking in terms of obtaining a list of results rather than a single result:
sentences([S|Ss]) --> sentence(S), sentences(Ss).
sentences([]) --> [].
What is a sentence? It is a noun phrase and a verb phrase, in your simple system. But you have broken the noun and verb phrases apart incorrectly for English, where a sentence like "The variable X is 5" should be broken into a noun phrase subject "The variable X" and a verb phrase "is 5". Ideally, the verb phrase should be decomposed further into a verb another noun phrase, but we're ignoring that detail for now. I am looking for the verb "is" to relate it to the Prolog predicate =/2, and handling fullstop here:
sentence(N1=N2) --> nounphrase(N1), verbphrase(is, N2), [fullstop].
OK, so now we need your noun phrase:
nounphrase(N) --> [the, variable, N].
And your verb phrase:
verbphrase(is, V) --> [is], value(V).
I'm only handling the two decodings and I'm doing it implicitly in the DCG definition:
value(5) --> [five].
value(10) --> [ten].
You'll find this works for the use case you've defined above:
?- phrase(sentences(S), [the,variable,X,is,five,fullstop,the,variable,Y,is,ten,fullstop]).
S = [X=5, Y=10] ;
false.

How do I build an interpreter for an abstract syntax tree like this?

cal(cal(1, plus, 2), minus, 3)
I need to get a result from it. How could I do that?
I'm pretty damaged by prolog. T.T
the AST is generated by calling:
?- calculations(Tree,[1,+,2,-,3],[]).
Tree = cal(cal(1, plus, 2), minus, 3) .
on the following DCG code:
calculations(VV) -->
vv(VV).
calculations(ResultTree) -->
vv(VV1), more_calculations(VV1,ResultTree).
more_calculations(VV1,cal(VV1,Operator,VV2)) -->
more_calculation(Operator,VV2).
more_calculations(VV1,ResultTree) -->
more_calculation(Operator1,VV2),
more_calculations(cal(VV1,Operator1,VV2),ResultTree).
more_calculation(Operator,VV) -->
operator(Operator),vv(VV).
vv(Name) --> var_name(Name).
vv(Value) --> var_value(Value).
operator(plus) --> [+].
operator(minus) --> [-].
var_name(Name) -->
[Name],{check_name(Name),\+member(Name,[write,read,begin,end,while])}.
var_value(Value) -->[Value],{number(Value)}.
check_name(N):-
catch(atom_chars(N, L), _, fail),
is_lower(L).
is_lower([]).
is_lower([H|T]) :-
catch(char_type(H, lower), _, fail),
is_lower(T).
There are many ways to do this, depending upon the bigger picture of what you're doing and what your goals are. But here is one possibility:
evaluate(cal(X, Op, Y), Result) :-
evaluate(X, Xr),
evaluate(Y, Yr),
Exp =.. [Op, Xr, Yr, Result],
call(Exp).
evaluate(X, X) :- number(X).
plus(X, Y, R) :- R is X + Y.
minus(X, Y, R) :- R is X - Y.
evaluate/2 assumes that you pass it something that looks like a number or a cal/3 where the parameters to cal/3 are an operand, an operator, and another operand, respectively. You write a predicate to evaluate each individual operator, and they assume the operands have been reduced to numbers.
Example:
evaluate(cal(cal(2, plus, 3), minus, 8), Result).
Gives:
Result = -3.
In the stated example:
| ?- calculations(Tree,[1,+,2,-,3],[]), evaluate(Tree, Result).
Result = 0
Tree = cal(cal(1,plus,2),minus,3) ? a
no

Resources