DCG reversing a string of binary bits - prolog

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).

Related

Left associative evaluation of a right recursive grammar in 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.

Find an "infix" of a list in Prolog - order matters

A question from someone who knows Prolog for a week=)
I am writing some prolog command infix(Inf,List)
to check if one list is, as our prof formulated, "an infix" of another list. The order matters+ it shouldn't be right at the beginning or the end of the List.
That means for example:
If we have Inf=[1,2] and List=[1,2,3,4] then is is false.
If we have Inf=[3,4] and List=[1,2,3,4] then is is also false.
If we have Inf=[2,3] and List=[1,2,3,4] then it is true.
If it is Inf=[3,2] and List=[1,2,3,4] then is is false.
If it is Inf=[2,4] and List=[1,2,3,4,5] then is is false.
I wrote some rules already and with them I seem to manage to solve the problem of order and not counting the first element of a List.
infix(Inf,List):- length(Inf,L1),length(List,L2), L1>L2, !, fail.
infix(Inf,List):- length(Inf,L1),length(List,L2), L1=L2, !, fail.
infix(Inf,List):- length(Inf,L1),length(List,L2), L1<L2, delete_first(Inf,List).
delete_first(Inf,[_L|List]):- sublist(Inf,List).
sublist([El|Sub],[El|List]):- checksublist(Sub,List).
sublist([S|Sub],[L|List]):- sublist([S|Sub],List).
checksublist([], L).
checksublist([El|Sub],[El|List]):- checksublist(Sub,List).
However, I can't formulate it in a way, so that the last element is not counted =(. According to my intuitive logic the conditionchecksublist([], L).should be smth like checksublist([], [_|[]]). But it doesn't work this way- I get false for everything.
Does anybody know how to get rid of the last element in this situation? Thanks in advance!
Grammars to the rescue! But I would not call this infix. It's a certain subsequence, actually even a certain substring.
infix(Inf, List) :-
Inf = [_|_],
phrase(([_], ..., seq(Inf), [_], ...), List).
% The following are frequently predefined
... --> [] | [_], ... .
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
(Edit) Since you insist that both the prefix and the postfix are non-empty, you probably want this to hold for the infix too. Thus Inf = [_|_] added.
This is the result using Scryer's top level:
?- infix(Inf,"abcdef").
Inf = "b"
; Inf = "bc"
; Inf = "bcd"
; Inf = "bcde"
; Inf = "c"
; Inf = "cd"
; Inf = "cde"
; Inf = "d"
; Inf = "de"
; Inf = "e"
; false.
See this how to print lists of characters as double quoted chars in other systems.
This is too imperative.
You can let Prolog solve it with append/2. It's search-assisted programming, let's use it.
infix(Inf,List) :- append([Prefix,Inf,Suffix],List),Prefix\=[],Suffix\=[].
This is completely declarative, in the sense that
it is formulated as constraint that a solution must fulfill (very mathematical).
Test it using the Unit Test framework:
:- begin_tests(infix).
test(one,[fail]) :- infix([1,2],[1,2,3,4]).
test(two,[fail]) :- infix([3,4],[1,2,3,4]).
test(three) :- infix([2,3],[1,2,3,4]).
test(four,[fail]) :- infix([3,2],[1,2,3,4]).
test(five,[fail]) :- infix([2,4],[1,2,3,4,5]).
:- end_tests(infix).
rt:-run_tests(infix).
Then
?- rt.
% PL-Unit: infix ..
Warning: user://1:12:
PL-Unit: Test three: Test succeeded with choicepoint
.. done
% All 5 tests passed
true.
Sadly, Prolog does not do deep reasoning and theorem proving but employs brute force: it tries possible solutions until one passes or there are no more. Weel, it's sufficient for this case.
For example:
?- append([Prefix,[3,4],Suffix],[1,2,3,4,5,3,4,6]).
Prefix = [1, 2],
Suffix = [5, 3, 4, 6] ;
Prefix = [1, 2, 3, 4, 5],
Suffix = [6] ;
false.

Turning 1's and 0's to a list of characters in Prolog

I have a homework assignment using prolog and I'm translating a set of 1's and 0's to a different set of characters. For example, here are my facts
analog([1], .).
analog([1, 1, 1], -).
analog([0], "").
analog([0, 0, 0], ^).
analog([0, 0, 0, 0, 0, 0, 0], #).
An example input would be a list like
[1,1,1,0,1,1,1,
0,0,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,1,0,1,1,1,
0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,
1,1,1,0,1,0,1,1,1,0,1,0,0,0,1,1,1,0,1,1,1,
0,1,1,1]
I have the following code :
signal_morse([], []). %base case
signal_morse([A, B, C | Rest, R) :-
analog([A, B, C], H),
signal_morse(Rest, T),
append([H], T, R).
It only currently checks the first three elements in a list and I want to be able to check for 1 element if the first three don't match with any of the facts.
For example, say I have [1, 0, 0], since that doesn't match with any of my rules I want the program to check [1] instead and keep looking through the rest of the list.
So I wanted to know if there is any sort of pattern matching I can do so if the code analog([A, B, C], H) fails to find a match, the code would then try to match just the first character like analog([A], H).
I realize this probably doesn't help you with your homework, but this is such a perfect problem for DCGs I can't help but show you what it would look like.
analog(.) --> [1].
analog(-) --> [1,1,1].
analog("") --> [0].
analog(^) --> [0,0,0].
analog(#) --> [0,0,0,0,0,0,0].
analogs([]) --> [].
analogs([A|As]) --> analog(A), analogs(As).
Usage:
?- phrase(analogs(X), [1,1,1,0,1,1,1, 0,0,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,1,0,1,1,1, 0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0, 1,1,1,0,1,0,1,1,1,0,1,0,0,0,1,1,1,0,1,1,1, 0,1,1,1]).
X = ['.', '.', '.', "", '.', '.', '.', "", ""|...] ;
Anyway, to answer your actual question, Prolog can figure out the lengths on its own with something like this:
signal_morse([], []).
signal_morse(Signals, [Code|RemainingMorseCodes]) :-
append(Signal, RemainingSignals, Signals),
analog(Signal, Code),
signal_morse(RemainingSignals, RemainingMorseCodes).

prefix arithmetic expressions represented as listsin prolog

Assume four operators may be used in expressions and they are +, -, *, and /. All these operators are binary, i.e., they are applied in an expression in this format: [operator, operand1, operand2], where “operator” can be +, -, *, or /, and each operand can be either a single number, or another expression. For example, the following are all legal input:
[+, 1, 2]
[-, 6, [/, 7, 0.5]]
[*, [/, 78, [-, 67, 3.5]], [+, 4, 9.0]]
But the following are not:
[+, 1] ; missing operand
[6, -, 7] ; every expression must start with an operator
[/, +, 4, 5] ; every expression can only have one operator
[*, 6, 7, 8] ; every expression must have exactly two operands
[%, 6, 7] ; unrecognizable operator
[-, 6, A] ; illegal operator
Write a predicate named “main” to check the validity of the expression and evaluate the expression. The following should be the way to run your program:
main([+, 1, 2], X)
X = 3
main([-, 6, A], X)
error
where [+, 1, 2] and [-, 6, A] are input. If the input is legal, your program should output the final result of the expression evaluation, as shown in the above example. If the input is illegal, the result is undefined, i.e., your program assumes the input is legal
==============================
I try with
expr(Z) --> num(Z).
expr(Z) --> [+], num(X), expr(Y), {Z is X+Y}.
expr(Z) --> [-], num(X), expr(Y), {Z is X-Y}.
expr(Z) --> [*], num(X), expr(Y), {Z is X*Y}.
expr(Z) --> [/], num(X), expr(Y), {Z is X/Y}.
num(D) --> [D], {number(D)}.
main(L, M) :- phrase(expr(M), L).
but when i write main([-, 6, [+, 7, 0.5]], X). false.
and when main([-, 6, A], X).
do nothing
please help
Nested expressions: I answered here a solution for such problem, please read that.
After adding the rule required for handling nested lists, you will need to add a whole set of rules for error handling, checking ill formed input.
Note that proper error handling can be a difficult theme in parsing. For instance, in Prolog you don't have ready access to the 'input position', then generating meaningful error messages can be tricky. But for your case, simply attempt to output the appropriate message. For instance, add a rule like
expr(_) --> ['%'], num(_), expr(_), { write('unrecognizable operator'), nl}.
(since % introduces comments, you need to quote it, at least in most - all?- Prologs)
You will need to experiment to find the right place where to write the added rules. Mainly, put them after what you already have, but keep them together.

convert string to list in prolog

I am a Prolog newbie and am stuck at parsing a string to a list.
I have a string of the form
1..2...3..4
I wish to convert it into a list which looks like
[1, _, _, 2, _, _, _, 3, _, _, 4]
How can I achieve this functionality?
Another solution is to use DCG's. The code is straightforward:
digit(N) -->
[ D ], { member(D, "0123456789"), number_codes(N, [D]) }.
dot(_) --> ".".
token(T) --> digit(T).
token(T) --> dot(T).
tokens([T|Ts]) --> token(T), tokens(Ts).
tokens([]) --> "".
parse_codes(In, Out):-
phrase(tokens(Out), In, "").
parse_atom(In, Out):-
atom_codes(In, Codes),
parse_codes(Codes, Out).
Testing on SWI-Prolog with "string" (which is actually just a list of codes):
?- parse_codes("1..24.4", Out).
Out = [1, _G992, _G995, 2, 4, _G1070, 4] .
And with an atom (which is just converted to codes before using the same predicate):
?- parse_atom('1..22.4', Out).
Out = [1, _G971, _G974, 2, 2, _G1049, 4] .
SWI-Prolog prints anonymous variables (_) in a bit fancier notation but otherwise it should be the same result you need.
Yet another way.. take advantage of the fact that ascii numbers for 0..9 are known/fixed, then no type conversions or checks are needed, just subtractions.
% case 1: char is in decimal range 0-9, ie ascii 48,49,50,51,52,53,54,55,56,57
% so eg. char 48 returns integer 0
onechar(Char, Out) :-
between(48, 57, Char),
Out is Char -48.
% case 2: case 1 failed, dot '.' is ascii 46, use anonymous variable
onechar(46, _).
% execution
go(InString, OutList) :-
maplist(onechar, InString, OutList).
Execution:
?- go("1..2...3..4", X).
X = [1, _G5638, _G5641, 2, _G5650, _G5653, _G5656, 3, _G5665, _G5668, 4]
Edit: forgot to say that this works because strings are represented as a list of ascii numbers, so string "0123456789" is represented internally as [48,49,50,51,52,53,54,55,56,57].
onechar does the calc for 1 of those list items, then maplist calls the same predicate on all list items.
Edit 2: the 2nd rule was originally:
% case 2: case 1 failed, output is an anon variable
onechar(_, _).
This is too generous - presumably if the input does not contain 0.9 or a dot, then the predicate should fail.
A predicate that describes the relationship between a character in your string and an element of the list could be:
char_to_el(DigitChar, Digit) :- % a character between '0' and '9'
DigitChar >= 0'0, DigitChar =< 0'9,
number_codes(Digit, [DigitChar]).
char_to_el(0'., _). % the element is the '.' characther
The first clause checks whether the character is indeed a digit and converts it to an integer. You could also simply subtract 0'0 from the integer value of the character, so instead of using number_codes/2 you could write Digit is DigitChar - 0'0.
You should be able to use maplist/3 then, according to the gnu prolog manual:
| ?- maplist(char_to_el, "1..2...3..4", L).
L = [1,_,_,2,_,_,_,3,_,_,4]
yes
but it didn't work on my system (old gnu prolog version maybe?), so instead:
str_to_list([], []).
str_to_list([C|Cs], [E|Es]) :-
char_to_el(C, E),
str_to_list(Cs, Es).
| ?- str_to_list("1..2...3..4", L).
L = [1,_,_,2,_,_,_,3,_,_,4]
yes

Resources