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.
Related
Suppose, I wanted to write a program in prolog, which accepts a number input X, and outputs all value pairs for which the sum is X.
some_pred(X,X1,X2) :-
X1 + X2 = X.
This does not work, because X1 + X2 is not evaluated arithmetically.
some_pred(X,X1,X2) :-
Xtemp is X1 + X2,
Xtemp = X.
The other option I have also doesn't work, because X1 and X2 are not instantiated.
How would someone solve this?
Yes, unification doesn't evaluate arithmetic expressions, and if it did that wouldn't help you because X1 and X2 are undefined so adding them together is meaningless.
You need either to write a search yourself such as a brute force nested loop:
sum_a_b(X, A, B) :-
between(1, X, A),
between(1, X, B),
X is A + B.
Or a more nuanced one where you encode something about arithmetic into it, start with 1+(X-1) and then (2+X-2), etc:
sum_a_b(X, A, B) :-
between(0, X, A),
B is X - A.
Or more generally, learn about clpfd (link1, link2) which can do arithmetic evaluating and solving for missing variables in equations, as well as searching through finite domains of possible values:
:- use_module(library(clpfd)).
sum_a_b(X, A, B) :-
[A, B] ins 1..X,
X #= A + B.
? sum_a_b(5, A, B), label([A, B]).
A = 1,
B = 4 ;
A = 2,
B = 3 ;
...
NB. I'm assuming positive integers, otherwise with negatives and decimals you'll get infinite pairs which sum to any given X.
Here's something very similar, using a list:
pos_ints_sum(Sum, L) :-
compare(C, Sum, 1),
pos_ints_sum_(C, L, Sum).
% 0 means the list has ended
pos_ints_sum_(<, [], 0).
% 1 means there is only 1 possible choice
pos_ints_sum_(=, [1], 1).
pos_ints_sum_(>, [I|T], Sum) :-
% Choose a number within the range
between(1, Sum, I),
% Loop with the remainder
Sum0 is Sum - I,
pos_ints_sum(Sum0, T).
Result in swi-prolog:
?- pos_ints_sum(5, L).
L = [1, 1, 1, 1, 1] ;
L = [1, 1, 1, 2] ;
L = [1, 1, 2, 1] ;
L = [1, 1, 3] ;
L = [1, 2, 1, 1] ;
L = [1, 2, 2] ;
L = [1, 3, 1] ;
L = [1, 4] ;
L = [2, 1, 1, 1] ;
L = [2, 1, 2] ;
L = [2, 2, 1] ;
L = [2, 3] ;
L = [3, 1, 1] ;
L = [3, 2] ;
L = [4, 1] ;
L = [5].
Note: X is a poor choice of variable name, when e.g. Sum can easily be used instead, which has far more meaning.
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.
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]
...
?-
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.
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]
...