A very nifty way of solving arithmetic constraints in Prolog

symbolic_decade_solver.pl

%  This is a pretty neat program.
%  Here I'm able to accomplish some lazy constraint programming with very few lines of code
%  The trick is to make sure that terms in the base-case rules are grounded
%  But this means using binary so that we only have to code for two grounded symbols (0, and 1)
%  It also means representing the numbers in reverse ( and as lists )
%  so that the least significant bits can be processed first at the top of the call stack
%
%  The result is a generator (prolog generator) that can be placed into a 'findall' to enumerate answers
%  It doesn't require any meta programming or search algorithms.
%
%  It does rely upon backtracking search and so will probably remain a toy.
%  But because of the way it solves, it should be useful if ever there is a situation where
%  you only want to find one solution and you would like that to happen somewhat quickly

%lt = less than
lt([],[1|_]).
lt([0|As],[1|As]).
lt([0|As],[0|Bs]):-lt(As,Bs).
lt([1|As],[0|Bs]):-lt(As,Bs).
lt([0|As],[1|Bs]):-lt(As,Bs).
lt([1|As],[1|Bs]):-lt(As,Bs).

%NOTE: code like this will not work
%      because it is not grounded
%      and you will get "numbers" as
%      answers that indeed satisfy all
%      constraints, but whose last place
%      is some _G1234 value.
%lt([_|As],[_|Bs]):-lt(As,Bs).

%add(A,B,C,CarryIn,CarryOut).
add(0,0,0,0,0).
add(0,1,1,0,0).
add(1,0,1,0,0).
add(1,1,0,0,1).
add(0,0,1,1,0).
add(0,1,0,1,1).
add(1,0,0,1,1).
add(1,1,1,1,1).

%PL=plus
pl(A,B,C):-
  pl(A,B,C,0,0)
  .
pl([1],[1],[0,1],0,0).
pl([1],[1],[1,1],1,0).
pl([1],[B|Bs],[C|Cs],Y1,0):-
  add(1,B,C,Y1,Y2)
, prop_carry(Bs,Cs,Y2)
.
pl([A|As],[1],[C|Cs],Y1,0):-
  add(A,1,C,Y1,Y2)
, prop_carry(As,Cs,Y2)
.
pl([A|As],[B|Bs],[C|Cs],Y1,Y2):-
  add(A,B,C,Y1,Y)
, pl(As,Bs,Cs,Y,Y2)
.
%propagate the carry bit as far as it will go
%in the case when one of the two numbers
%being added runs out of bits of increaing
%significance
prop_carry([1],[0,1],1).
prop_carry([1],[1],0).
prop_carry([B|Bs],[C|Cs],Y1):-
  add(0,B,C,Y1,Y2)
, prop_carry(Bs,Cs,Y2)
.

gt(A,B):-lt(B,A).
r(L,R):-reverse(L,R).

%Tests
:-r([1,1],Three)
, r([1,0,1],Five)
, pl(Three,Five,R)
, r(R,Sum)
, writeln('3 + 5 : ')
, writeln(Sum)
.

:-findall(X,pl([1,1],X,[0,0,0,1]),Xs)
, writeln('3 + X = 8:')
, writeln(Xs)
.

:-findall(X,pl(X,[1,0,1],[0,0,0,1]),Xs)
, writeln('X + 5 = 8:')
, writeln(Xs)
.

:-r([0,1,1],Three)
, r([1,1,0],Six)
, r([0,1,0,1,0],Ten)
, findall(X,(
    lt(Three,Xr)
  , lt(Xr,Ten)
  , gt(Xr,Six)
  , r(Xr,X)
  ),Xs)
, writeln('3 < X < 10; X > 6 :')
, writeln(Xs)
.

:-r([1,1],Three)
, r([1,0,1],Five)
, r([1,1,0,0],Twelve)
, findall(X,(
    pl(Three,Five,RightEdge)
  , lt(Xr,Twelve)
  , lt(RightEdge,Xr)
  , r(Xr,X)
  ),Xs)
, writeln('3 + 5 = R; R < X < 12 :')
, writeln(Xs)
.

:-halt.

%:!swipl %
%
%  Should yield output similar to the following:
%    3 + 5 : 
%    [1,0,0,0]
%    3 + X = 8:
%    [[1,0,1]]
%    X + 5 = 8:
%    [[1,1]]
%    3 < X < 10; X > 6 :
%    [[0,1,0,0,0],[0,1,0,0,1],[1,1,1]]
%    3 + 5 = R; R < X < 12 :
%    [[1,0,1,0],[1,0,0,1],[1,0,1,1]]
%