Prolog Constraints -> Solving Puzzle Grid - prolog

So guys, I'm learning constraints with prolog, and trying to implement a little puzzle using this new knowledge.
The goal of the puzzle is simple: I have a square grid with some numbers on top/below each column and on the right/left of each row.
The domain of values goes from 0 to Gridsize -1, wich means, a grid 7x7 can have numbers from 0 to 6.
The constraints are as follow:
Each number can only apear once each row and once each column
The number on top/right are the sum of the First and Last digits on the column/row respectively
The number on bottom/left are the sum of the Second and SecondLast digits on the column/row respectively
Zeros don't count as digits, are only on the program to represent blank spaces
For an example:
TopConstraint = [7, 6, 4, 7, 3]
RightConstraint = [5, 5, 5, 5, 5]
BottomConstraint = [3, 4, 6, 3, 7]
LeftConstraint = [5, 5, 5, 5, 5]
This constraints can have a 0 too, wich make the program simple ignore (the sum can be any number, if it goes accordingly with the other restrictions).
One solution to the above lists would be the matrix:
3 | 4 | 1 | | 2
1 | 3 | 2 | 4 |
2 | | 4 | 1 | 3
| 1 | 3 | 2 | 4
4 | 2 | | 3 | 1
Now the problem is: my constraints somehow aren't applying, and the program isn't giving me the solution.
After puting the right domain and putting all column/row cells different(wich without any other restrictions it gives me the expected solution), I have this code to apply to each cell, the sum restrictions:
put_restrictions(Sol, Gridsize, SumT, SumR, SumB, SumL):-
put_restrictions_row(Sol, Gridsize, SumR, SumL, 1),
put_restrictions_col(Sol, Gridsize, SumT, SumB, 1).
Where Gridsize is the Gridsize to make iterations upon it, SumT, SumR, SumB, SumL, are the above constraint lists respectively, and 1 to start the iteration counter.
So this predicates are where my problem resides
put_restrictions_col(_, Gridsize, _, _, X):- X > Gridsize, write('end put_restrictions_col'),nl.
put_restrictions_col(Grid, Gridsize, [SumTH|SumTT], [SumBH|SumBT], X):-
get_cell(Grid, FirstInCol, X, 1, Gridsize),
get_cell(Grid, LastInCol, X, Gridsize, Gridsize),
get_cell(Grid, SecondInCol, X, 2, Gridsize),
SecondLastIndex is Gridsize-1,
get_cell(Grid, SecondLastInCol, X, SecondLastIndex, Gridsize),
get_cell(Grid, ThirdInCol, X, 3, Gridsize),
ThirdLastIndex is Gridsize-2,
get_cell(Grid, ThirdLastInCol, X, ThirdLastIndex, Gridsize),
(SumTH #> 0) #=>
(
(((FirstInCol #> 0) #/\ (LastInCol #> 0)) #=> (SumTH #= FirstInCol + LastInCol))
#\/
((FirstInCol #= 0) #=> (SumTH #= SecondInCol + LastInCol))
#\/
((LastInCol #= 0) #=> (SumTH #= FirstInCol + SecondLastInCol))
),
(SumBH #> 0) #=>
(
(((SecondInCol #> 0) #/\ (SecondLastInCol #> 0)) #=> (SumBH #= SecondInCol + SecondLastInCol))
#\/
((SecondInCol #= 0) #=> (SumBH #= ThirdInCol + SecondLastInCol))
#\/
((SecondLastInCol #= 0) #=> (SumBH #= SecondInCol + ThirdLastInCol))
),
X1 is X+1,
put_restrictions_col(Grid, Gridsize, SumTT, SumBT, X1).
put_restrictions_row([], _, _,_,_):- write('end put_restrictions_row'),nl.
put_restrictions_row([H|T], Gridsize, [SumRH|SumRT],[SumLH|SumLT], N):-
element(1, H, FirstInRow),
element(Gridsize, H, LastInRow),
element(2, H, SecondInRow),
SecondLastIndex is Gridsize -1,
element(SecondLastIndex, H, SecondLastInRow),
element(3, H, ThirdInRow),
ThirdLastIndex is Gridsize -2,
element(ThirdLastIndex, H, ThirdLastInRow),
(SumRH #> 0) #=>
(
(((FirstInRow #> 0) #/\ (LastInRow #> 0)) #/\ (FirstInRow + LastInRow #= SumRH))
#\/
((FirstInRow #= 0) #/\ (SecondInRow + LastInRow #= SumRH))
#\/
((LastInRow #= 0) #/\ (FirstInRow + SecondLastInRow #= SumRH))
),
(SumLH #> 0) #=>
(
(((SecondInRow #> 0) #/\ (SecondLastInRow #> 0)) #/\ (SumLH #= SecondInRow + SecondLastInRow))
#\/
((SecondInRow #= 0) #/\ (SumLH #= ThirdInRow + SecondLastInRow))
#\/
((SecondLastInRow #= 0) #/\ (SumLH #= SecondInRow + ThirdLastInRow))
),
N1 is N+1,
put_restrictions_row(T, Gridsize, SumRT, SumLT, N1).
I think the code is pretty self explanatory, if not, what I'm trying to do:
If there is a constraint on the right side:
If the 1st and last cells of the row aren't 0, then their sum is = to the restriction
If the 1st cell on the row is 0, then the sum of 2nd cell of the row and the last = to the restriction -> makes the left restriction being the sum of the 3rd cell from the left and the secondlast
And so on...
I'm not getting any solution on the problem.
What am I doing wrong associating the constraints?
Any help is welcome. Thanks in advance for helping the prologNoob here :P

I tried to solve, with simpler code...
restrictions :-
T = [7, 6, 4, 7, 3], % TopRestriction
R = [5, 5, 5, 5, 5], % RightRestriction
B = [3, 4, 6, 3, 7], % BottomRestriction
L = [5, 5, 5, 5, 5], % LeftRestriction
restrictions(T, R, B, L, Sol),
maplist(writeln, Sol).
restrictions(T, R, B, L, Rows) :-
% check all restrictions are properly sized
maplist(length_(N), [T, R, B, L]),
% solution is a square
length_(N, Rows),
maplist(length_(N), Rows),
transpose(Rows, Cols),
% main constraints
append(Rows, Vs),
N1 is N-1,
Vs ins 0..N1,
maplist(all_different, Rows),
%maplist(all_different, Cols),
% apply restrictions
maplist(restriction, Rows, L, R),
maplist(restriction, Cols, T, B),
% if constraints are not enough strong for an unique solution
label(Vs).
restriction(Tile, S1, S2) :-
append([A,B], R, Tile),
append(_, [C,D], R),
S1 #= 0 #\/ A #= 0 #\/ D #= 0 #\/ S1 #= A + D,
S2 #= 0 #\/ B #= 0 #\/ C #= 0 #\/ S2 #= B + C.
length_(N, L) :- length(L, N).
Note the second all_different constraint is commented out, since when I post it, no solution is found. Removing constraints (so, 'weakening' solutions), it's the only 'real' debugging tool that I've been able to find so far by myself.
Solutions sample:
?- restrictions.
[3,0,1,4,2]
[1,0,2,3,4]
[0,1,2,4,3]
[2,1,4,0,3]
[4,2,0,3,1]
true ;
[3,0,1,4,2]
[1,0,2,3,4]
[0,1,2,4,3]
[2,1,4,0,3]
[4,2,3,0,1]
...

Related

Turn List into number, increment the number, and then turn the number into a list

I have my head stuck in this exercise in prolog, I ve been trying to do it on my own but it just won't work. Example: ?-succesor([1,9,9],X) -> X = [2,0,0]. Had tried first to reverse the list and increment it with 1 and then do a if %10 = 0 the next element should be incremented too. Thing is that I m too used with programming syntax and I can't get my head wrapped around this.Any help would be appreciated.
I have done this so far, but the output is false.
%[1,9,9] -> 199 +1 -> 200;
numbers_atoms([],[]).
numbers_atoms([X|Y],[C|K]) :-
atom_number(C, X),
numbers_atoms(Y,K).
%([1,2,3],X)
digits_number(Digits, Number) :-
numbers_atoms(Digits, Atoms),
number_codes(Number, Atoms).
number_tolist( 0, [] ).
number_tolist(N,[A|As]) :-
N1 is floor(N/10),
A is N mod 10,
number_tolist(N1, As).
addOne([X],[Y]):-
digits_number(X,Y1), %[1,9,9] -> 199
Y1 is Y1+1, % 199 -> 200
number_tolist(Y1,[Y]), % 200 -> [2,0,0]
!.
You can solve this problem similarly to how you would solve it manually: traverse the list of digits until you reach the rightmost digit; increment that digit and compute the carry-on digit, which must be recursively propagated to the left. At the end, prepend the carry-on digit if it is equal to 1 (otherwise, ignore it).
% successor(+Input, -Output)
successor([X0|Xs], L) :-
successor(Xs, X0, C, Ys),
( C = 1 % carry-on
-> L = [C|Ys]
; L = Ys ).
% helper predicate
successor([], X, C, [Y]) :-
Z is X + 1,
Y is Z mod 10,
C is Z div 10. % carry-on
successor([X1|Xs], X0, C, [Y|Ys]) :-
successor(Xs, X1, C0, Ys),
Z is X0 + C0,
Y is Z mod 10,
C is Z div 10. % carry-on
Examples:
?- successor([1,9,9], A).
A = [2, 0, 0].
?- successor([2,7],A), successor(A,B), successor(B,C), successor(C,D).
A = [2, 8],
B = [2, 9],
C = [3, 0],
D = [3, 1].
?- successor([7,9,9,8], A), successor(A, B).
A = [7, 9, 9, 9],
B = [8, 0, 0, 0].
?- successor([9,9,9,9], A), successor(A, B).
A = [1, 0, 0, 0, 0],
B = [1, 0, 0, 0, 1].
Here's a version which doesn't use is and can work both ways:
successor(ListIn, ListOut) :-
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
ripple_inc([], [1]).
ripple_inc([0|T], [1|T]).
ripple_inc([1|T], [2|T]).
ripple_inc([2|T], [3|T]).
ripple_inc([3|T], [4|T]).
ripple_inc([4|T], [5|T]).
ripple_inc([5|T], [6|T]).
ripple_inc([6|T], [7|T]).
ripple_inc([7|T], [8|T]).
ripple_inc([8|T], [9|T]).
ripple_inc([9|T], [0|Tnext]) :-
ripple_inc(T, Tnext).
e.g.
?- successor([1,9,9], X).
X = [2, 0, 0]
?- successor([1,9,9], [2,0,0]).
true
?- successor(X, [2,0,0]).
X = [1, 9, 9]
although it's nicely deterministic when run 'forwards', it's annoying that if run 'backwards' it finds an answer, then leaves a choicepoint and then infinite loops if that choicepoint is retried. I think what causes that is starting from the higher number then reverse(ListIn, ListInRev) has nothing to work on and starts generating longer and longer lists both filled with empty variables and never ends.
I can constrain the input and output to be same_length/2 but I can't think of a way to constrain them to be the same length or ListOut is one item longer ([9,9,9] -> [1,0,0,0]).
This answer tries to improve the previous answer by #TessellatingHacker, like so:
successor(ListIn, ListOut) :-
no_longer_than(ListIn, ListOut), % weaker than same_length/2
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
The definition of no_longer_than/2 follows. Note the similarity to same_length/2:
no_longer_than([],_). % same_length([],[]).
no_longer_than([_|Xs],[_|Ys]) :- % same_length([_|Xs],[_|Ys]) :-
no_longer_than(Xs,Ys). % same_length(Xs,Ys).
The following sample queries still succeed deterministically, as they did before:
?- successor([1,9,9], X).
X = [2,0,0].
?- successor([1,9,9], [2,0,0]).
true.
The "run backwards" use of successor/2 now also terminates universally:
?- successor(X, [2,0,0]).
X = [1,9,9]
; false.

How to write a prolog program to print between a given range?

How can I write a a program in prolog to print even and odd numbers between a range?
Sample output:
Enter first number:2
Enter Second number:15
Even numbers:
2
4
6
8
10
12
14
Odd numbers:
1
3
5
7
9
11
13
15
Here's one way to do it:
odds_and_evens( H , H , [H] , [] ) :- % if lo and hi have converged,
0 =\= H rem 2 % and it's odd
. % then park it with the odds and succeed.
odds_and_evens( H , H , [] , [H] ) :- % if lo and hi have conveged,
0 =:= H rem 2 % and it's even
. % then park it with the evens and succeed.
odds_and_evens( L , H, [L|Odds] , Evens ) :- % else... park lo with the odds
L < H, % - if lo is less than hi
0 =\= L rem 2, % - and lo is odd
L1 is L+1, % - increment lo
odds_and_evens(L1, H, Odds, Evens ) % - and recurse down
. %
odds_and_evens( L , H, Odds , [H|Evens] ) :- % else... park lo with the evens
L < H, % - if lo is less than hi
0 =:= L rem 2, % - and lo is even
L1 is L+1, % - incement lo
odds_and_evens(L1, H, Odds, Evens ) % - and recurse down
. % Easy!
But... Prolog has an in-built between/3 that generates a range of integers. And findall/3 finds all the solutions to a query as a list. So one could also — and more succinctly and declaratively! — say:
odds_and_evens( L , H , Odds , Evens ) :-
findall( X , odds( L , H , X ) , Odds ),
findall( X , evens( L , H , X ) , Evens )
.
odds( L , H , N ) :- between(L,H,N), 0 =\= N rem 2 .
evens( L , H , N ) :- between(L,H,N), 0 =:= N rem 2 .
Once you have odds_and_evens/4 defined, you can than do this:
print_odds_and_evens( Lo, Hi ) :-
odds_and_evens(Lo,Hi,Odds,Evens),
write_to_console('Odd Numbers', Odds ),
write_to_console('Even Numbers', Evens )
.
write_to_console(Label, Ns ) :-
write(Label), writeln(':'),
write_to_console(Ns)
,
write_to_console([]) .
write_to_console([N|Ns]) :- writeln(N), write_to_console(Ns).
If that's too much recursion for you, you could also say (cribbing odds/3 and evens/3 from above):
print_odds_and_evens(Lo,Hi) :-
writeln('Odd Numbers:'),
odd(Lo,Hi,N),
writeln(N),
fail
.
print_odds_and_evens(Lo,Hi) :-
writeln('Even Numbers:'),
even(Lo,Hi,N),
writeln(N),
fail
.
print_odds_and_evens(_,_).
odd( L , H , N ) :- between(L,H,N), 0 =\= N rem 2 .
even( L , H , N ) :- between(L,H,N), 0 =:= N rem 2 .
Here is an answer based on SWI-Prolog partition/4.
example_1(Odd,Even) :-
numlist(1,15,List),
partition(is_even,List,Even,Odd).
is_even(N) :-
0 is N mod 2.
Example run
?- example_1(Odd,Even).
Odd = [1, 3, 5, 7, 9, 11, 13, 15],
Even = [2, 4, 6, 8, 10, 12, 14].
Here is a variation that puts the support predicate into a Lambda.
example_2(Odd,Even) :-
numlist(1,15,List),
partition([N]>>(0 is N mod 2),List,Even,Odd).
Example run
?- example_2(Odd,Even).
Odd = [1, 3, 5, 7, 9, 11, 13, 15],
Even = [2, 4, 6, 8, 10, 12, 14].
For answers to the other part of your multi-part question about entering the starting and ending values I would suggest using read_string/5.
See:
How to get user console input into a Prolog list (Answer)
Prolog: How to read data from console and store into database. (Answer)
Other Answers
Here is a solution that only uses Prolog ISO standard built-in predicates. It's also a fast solution as it avoid meta-predicates and appending lists:
print_even_odd(Lower, Upper) :-
even_odd(Lower, Upper, Even, Odd),
write('Even: '), write(Even), nl,
write('Odd: '), write(Odd), nl.
even_odd(Lower, Upper, Even, Odd) :-
Lower =< Upper,
( Lower mod 2 =:= 0 ->
even_odd_lists(Lower, Upper, Even, Odd)
; even_odd_lists(Lower, Upper, Odd, Even)
).
even_odd_lists(Upper, Upper, [Upper], []) :-
!.
even_odd_lists(N, Upper, [N| Even], Odd) :-
M is N + 1,
even_odd_lists(M, Upper, Odd, Even).
Sample calls:
| ?- print_even_odd(1, 24).
Even: [2,4,6,8,10,12,14,16,18,20,22,24]
Odd: [1,3,5,7,9,11,13,15,17,19,21,23]
yes
| ?- print_even_odd(2, 24).
Even: [2,4,6,8,10,12,14,16,18,20,22,24]
Odd: [3,5,7,9,11,13,15,17,19,21,23]
yes
| ?- print_even_odd(1, 35).
Even: [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34]
Odd: [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35]
yes
There are several possible solutions. Here a, naive, without using higher order predicates:
print_even_odd(Lower,Upper,[],[]):-
Lower > Upper, !.
print_even_odd(Lower,Upper,Lodd,Leven):-
Res is Lower mod 2,
( Res =:= 0 ->
Leven = [Lower | LE1], LO1 = Lodd ;
Lodd = [Lower | LO1], LE1 = Leven
),
L1 is Lower + 1,
print_even_odd(L1,Upper,LO1,LE1).
?- print_even_odd(1,15,LE,LO).
LE = [1, 3, 5, 7, 9, 11, 13, 15],
LO = [2, 4, 6, 8, 10, 12, 14]
You can write more compact solutions using higher order predicates as sugggested in the comments.
Here is another possible solution:
% range(+Start, +Stop, +Step, -List)
range(Start, Stop, Step, List) :-
( Start > Stop
-> List = []
; List = [Start|Rest],
Next is Start + Step,
range(Next, Stop, Step, Rest) ).
% even_odd_lists(+Lower, +Upper, -EList, -OList)
even_odd_lists(Lower, Upper, EList, OList) :-
FirstEven is Lower + Lower mod 2,
FirstOdd is Lower + (Lower-1) mod 2,
range(FirstEven, Upper, 2, EList),
range(FirstOdd, Upper, 2, OList).
Some sample queries are:
?- range(1, 10, 3, R).
R = [1, 4, 7, 10].
?- range(1, 10, 2, R).
R = [1, 3, 5, 7, 9].
?- range(2, 10, 2, R).
R = [2, 4, 6, 8, 10].
?- even_odd_lists(1, 15, LE, LO).
LE = [2, 4, 6, 8, 10, 12, 14],
LO = [1, 3, 5, 7, 9, 11, 13, 15].
?- even_odd_lists(2, 15, LE, LO).
LE = [2, 4, 6, 8, 10, 12, 14],
LO = [3, 5, 7, 9, 11, 13, 15].

Prolog - merge digits to number

I want to merge list of digits to number.
[1,2,3] -> 123
My predicate:
merge([X], X).
merge([H|T], X) :-
merge(T, X1),
X is X1 + H * 10.
But now I get:
[1,2,3] -> 33
Another way to do it would be to multiply what you've handled so far by ten, but you need an accumulator value.
merge(Digits, Result) :- merge(Digits, 0, Result).
merge([X|Xs], Prefix, Result) :-
Prefix1 is Prefix * 10 + X,
merge(Xs, Prefix1, Result).
merge([], Result, Result).
The math is off. You're rule says you have to multiply H by 10. But really H needs to be multiplied by a power of 10 equivalent to its position in the list. That would be * 100 for the 1, and * 10 for the 2. What you get now is: 10*1 + 10*2 + 3 which is 33. The problem is that your recursive clause doesn't know what numeric "place" the digit is in.
If you structure the code differently, and use an accumulator, you can simplify the problem. Also, by using CLP(FD) and applying some constraints on the digits, you can have a more general solution.
:- use_module(library(clpfd)).
digits_number(Digits, X) :-
digits_number(Digits, 0, X).
digits_number([], S, S).
digits_number([D|Ds], S, X) :-
D in 0..9,
S1 #= S*10 + D,
digits_number(Ds, S1, X).
?- digits_number([1,2,3], X).
X = 123
?- digits_number(L, 123).
L = [1, 2, 3] ;
L = [0, 1, 2, 3] ;
L = [0, 0, 1, 2, 3] ;
L = [0, 0, 0, 1, 2, 3] ;
L = [0, 0, 0, 0, 1, 2, 3]
...
?-

Equivalent of nvalue/2 from SICStus in SWIProlog

The SICStus manual for the CLP(FD) library says:
nvalue(?N, +Variables) where Variables is a list of domain variables with finite bounds or integers, and N is an integer or a
domain variable. True if N is the number of distinct values taken by
Variables.
This is particularly useful when one wants to minimize the number of distinct values in the solution. For example, if one is trying to distribute stuff into bags of different sizes, and want to minimize the number of bags.
Is there an equivalent predicate (or way) for achieving the same in SWI Prolog?
After #jschimpf comment, I've rethought the algorithm.
nvalue(1, [_]).
nvalue(C, [V|Vs]) :-
count_equals(V, Vs, E),
E #= 0 #/\ C #= R+1 #\/ E #> 0 #/\ C #= R,
nvalue(R, Vs).
count_equals(_, [], 0).
count_equals(V, [U|Vs], E) :-
V #= U #/\ E #= E1+1 #\/ V #\= U #/\ E #= E1,
count_equals(V, Vs, E1).
further cleanup
again, after #jschimpf note, I've tweaked the code: now it's very compact, thanks to libraries apply and yall.
nvalue(1, [_]).
nvalue(C, [V|Vs]) :-
maplist({V}/[U,Eq]>>(Eq#<==>V#=U), Vs, Es),
sum(Es, #=, E),
E #= 0 #/\ C #= R+1 #\/ E #> 0 #/\ C #= R,
nvalue(R, Vs).
old answer, buggy
my naive attempt, based on reification:
% nvalue(?N, +Variables)
nvalue(N, Vs) :-
nvalues(Vs, [], VRs),
sum(VRs, #=, N).
nvalues([], Acc, Acc).
nvalues([V|Vs], Acc, VRs) :-
nvalues_(V, Vs, Acc, Upd),
nvalues(Vs, Upd, VRs).
nvalues_(_V, [], Acc, Acc).
nvalues_(V, [U|Vs], Acc, Upd) :-
V #\= U #<==> D,
nvalues_(V, Vs, [D|Acc], Upd).
running your example query:
?- length(Vs, 3), Vs ins 1..3, nvalue(2, Vs), label(Vs).
Vs = [1, 1, 2] ;
Vs = [1, 1, 3] ;
Vs = [1, 2, 1] ;
Vs = [1, 2, 2] ;
Vs = [1, 3, 1] ;
Vs = [1, 3, 3] ;
Vs = [2, 1, 1] ;
Vs = [2, 1, 2] ;
Vs = [2, 2, 1] ;
Vs = [2, 2, 3] ;
Vs = [2, 3, 2] ;
Vs = [2, 3, 3] ;
Vs = [3, 1, 1] ;
Vs = [3, 1, 3] ;
Vs = [3, 2, 2] ;
Vs = [3, 2, 3] ;
Vs = [3, 3, 1] ;
Vs = [3, 3, 2].
edit
my code was a bit pedantic, of course could be more compact (and clear ?):
nvalue(N, Vs) :-
bagof(D, X^H^T^V^(append(X, [H|T], Vs), member(V, T), V #\= H #<==> D), VRs),
sum(VRs, #=, N).
note that findall/3 will not work, since the copy of reified variable D would lose the posted constraints.

Evaluate a number in (a few) natural language

Assume a list, each element can be:
a) a number 1,2,...9
b) a number 10, 100, 10000, ... (numbers of the form 10^(2^n) with n>=0).
It is need a (as much simple as possible) rule that evaluates this list to one integer number. Examples of this evaluation are:
[1] => 1
[2] => 2
[10 1] => 11
[2 10 1] => 21
[2 100 1 10 4] => 214
[2 10 1 100 4] => 2104
[2 10 1 100 10000] => 21000000
In other words, numbers 10, 100, ... are the equivalent of tenths, hundreds, million, ... in english and the rule to evaluate is the usual in english and other languages: 10, 100 "multiplies" the values before them, numbers after them are added.
(I know this definition is not an exact one, but finding a good definition is part of the problem. Do not hesitate to requests for more examples if necessary).
Note than, in the same way than in natural language, the number zero is not necessary. Even, like initial languages, is not present in the grammar.
Addendum
The major difficulty in this problem is an expression like [2 10000 3 10] that can not be taken as (2*10000+3)*10, but as 2*10000+3*10. Another example is [2 10 1 10000 3 10] that is (2*10+1)*10000+3*10.
Proof of not homework: Interest on this numbering (and, in general, in natural language) is that, in some context, they are more error-safe than binary. By example, in a context of a supermarket prices, "two thousands blah" keeps some meaning, while 1001blah is totally undefined.
With ingenuity, I would start covering the patterns...
test :- forall(member(L=R, [
[1] = 1,
[2] = 2,
[10, 1] = 11,
[2, 10, 1] = 21,
[2, 100, 1, 10, 4] = 214,
[2, 10, 1, 100, 4] = 2104,
[2, 10, 1, 100, 10000] = 21000000
]), test(L, R)).
test(L, R) :-
pattern(L, E), R =:= E -> writeln(ok(L,R)) ; writeln(ko(L,R)).
pattern([A], A) :- dig(A).
pattern([A, B], A+B) :- ten(A), dig(B).
pattern([A, B, C], A*B+C) :- mul_ten(A, B), dig(C).
pattern([A, B, C, D, E], A*B + C*D + E) :- mul_ten(A,B), mul_ten(C,D), B > D, dig(E).
pattern([A, B, C, D, E], ((A*B+C)*D)+E) :- mul_ten(A,B), ten(D), dig(E). % doubt...
pattern([A, B, C, D, E], (A*B+C)*D*E) :- mul_ten(A,B), ten(D), ten(E). % doubt...
dig(D) :- between(1,9,D).
ten(T) :- between(0,10,E), T =:= 10^(2^E). % 10 -> inappropriate (too much zeroes ?)
mul_ten(M,T) :- between(1,9,M), ten(T). % 9 -> inappropriate ?
plain pattern matching. Running:
?- test.
ok([1],1)
ok([2],2)
ok([10,1],11)
ok([2,10,1],21)
ok([2,100,1,10,4],214)
ok([2,10,1,100,4],2104)
ok([2,10,1,100,10000],21000000)
true.
I think that there is little space for recursion, afaik idioms cover frequently used cases, but without 'smart' evaluation... Anyway, I cannot really find my way in (that is, I would never use) this pattern
[2 10 1 100 4] => 2104
edit now, with DCG and CLP(FD) :
:- use_module(library(clpfd)).
test :- forall(member(L=R, [
[1] = 1,
[2] = 2,
[10, 1] = 11,
[2, 10, 1] = 21,
[2, 100, 1, 10, 4] = 214,
[2, 10, 1, 100, 4] = 2104,
[2, 10, 1, 100, 10000] = 21000000
]), test(L, R)).
test(L, R) :-
phrase(pattern(E), L), R #= E -> writeln(ok(L,R)) ; writeln(ko(L,R)).
pattern(A) --> dig(A).
pattern(A+B) --> ten(A), dig(B).
pattern(A*B+C) --> mul_ten(A, B), dig(C).
pattern(A*B+C*D) --> mul_ten(A, B), mul_ten(C, D).
pattern(A*B + C*D + E) --> mul_ten(A,B), mul_ten(C,D), dig(E).
pattern(((A*B+C)*D)+E) --> mul_ten(A,B), [C], ten(D), dig(E). % doubt...
pattern((A*B+C)*D*E) --> mul_ten(A,B), [C], ten(D), ten(E). % doubt...
dig(D) --> [D], {D #>= 1, D #=< 9}.
ten(T) --> [T], {T #>= 1, T #= (10^(2^E)), E #> 0, E #=< 10}.
mul_ten(M,T) --> dig(M), ten(T).
edit I like the op/3 directive, also...
:- op(100,fx, dig).
:- op(100,fx, ten).
:- op(100,xfx, mul).
pattern(A) --> dig A.
pattern(A+B) --> ten A, dig B.
pattern(A*B+C) --> A mul B, dig(C).
pattern(A*B+C*D) --> A mul B, C mul D.
pattern(A*B+C*D+E) --> A mul B, C mul D, dig E.
pattern(((A*B+C)*D)+E) --> A mul B, [C], ten D, dig E. % doubt...
pattern((A*B+C)*D*E) --> A mul B, [C], ten D, ten E. % doubt...
dig D --> [D], {D #>= 1, D #=< 9}.
ten T --> [T], {T #>= 1, T #= (10^(2^E)), E #> 0, E #=< 10}.
M mul T --> dig M, ten T.

Resources