Arithmetics in Prolog, represent a number using powers of 2

Question

I have two numbers, let's name them N and K, and I want to write N using K powers of 2.

For example if N = 9 and K = 4, then N could be N = 1 + 2 + 2 + 4 (2^0 + 2^1 + 2^1 + 2^2).

My program should output something like N = [1,2,2,4].

I am used to C++. I can't find a way to solve this problem in Prolog. Any help will be appreciated!

Answer 1

I thought this would be a few-liner using CLP(FD), but no dice. Can it be done simpler?

So here is the complete solution.

Don't think I came up with this in one attempt, there are a few iterations and dead ends in there.

:- use_module(library(debug)).

% ---
% powersum(+N,+Target,?Solution)
% ---
% Entry point. Relate a list "Solution" of "N" integers to the integer
% "Target", which is the sum of 2^Solution[i].
% This works only in the "functional" direction
% "Compute Solution as powersum(N,Target)"
% or the "verification" direction
% "is Solution a solution of powersum(N,Target)"?
%
% An extension of some interest would be to NOT have a fixed "N".
% Let powersum/2 find appropriate N.
%
% The search is subject to exponential slowdown as the list length
% increases, so one gets bogged down quickly.
% ---

powersum(N,Target,Solution) :- 
   ((integer(N),N>0,integer(Target),Target>=1) -> true ; throw("Bad args!")),   
   length(RS,N),                             % create a list RN of N fresh variables
   MaxPower is floor(log(Target)/log(2)),    % that's the largest power we will find in the solution
   propose(RS,MaxPower,Target,0),            % generate & test a solution into RS
   reverse(RS,Solution),                     % if we are here, we found something! Reverse RS so that it is increasing
   my_write(Solution,String,Value),          % prettyprinting
   format("~s = ~d\n",[String,Value]).

% ---
% propose(ListForSolution,MaxPowerHere,Target,SumSoFar)
% ---
% This is an integrate "generate-and-test". It is integrated
% to "fail fast" during proposal - we don't want to propose a
% complete solution, then compute the value for that solution 
% and find out that we overshot the target. If we overshoot, we
% want to find ozut immediately!
%
% So: Propose a new value for the leftmost position L of the 
% solution list. We are allowed to propose any integer for L 
% from the sequence [MaxPowerHere,...,0]. "Target" is the target
% value we must not overshoot (indeed, we which must meet
% exactly at the end of recursion). "SumSoFar" is the sum of
% powers "to our left" in the solution list, to which we already
% committed.

propose([L|Ls],MaxPowerHere,Target,SumSoFar) :- 
   assertion(SumSoFar=<Target),
   (SumSoFar=Target -> false ; true),          % a slight optimization, no solution if we already reached Target!
   propose_value(L,MaxPowerHere),              % Generate: L is now (backtrackably) some value from [MaxPowerHere,...,0]
   NewSum is (SumSoFar + 2**L),                
   NewSum =< Target,                           % Test; if this fails, we backtrack to propose_value/2 and will be back with a next L
   NewMaxPowerHere = L,                        % Test passed; the next power in the sequence should be no larger than the current, i.e. L
   propose(Ls,NewMaxPowerHere,Target,NewSum).  % Recurse over rest-of-list.

propose([],_,Target,Target).                   % Terminal test: Only succeed if all values set and the Sum is the Target!

% ---
% propose_value(?X,+Max).
% ---
% Give me a new value X between [Max,0].
% Backtracks over monotonically decreasing integers.
% See the test code for examples.
%
% One could also construct a list of integers [Max,...,0], then
% use "member/2" for backtracking. This would "concretize" the predicate's
% behaviour with an explicit list structure.
%
% "between/3" sadly only generates increasing sequences otherwise one
% could use that. Maybe there is a "between/4" taking a step value somewhere?
% ---

propose_value(X,Max) :- 
   assertion((integer(Max),Max>=0)),
   Max=X.
propose_value(X,Max) :- 
   assertion((integer(Max),Max>=0)),
   Max>0, succ(NewMax,Max), 
   propose_value(X,NewMax).

% ---
% I like some nice output, so generate a string representing the solution.
% Also, recompute the value to make doubly sure!
% ---

my_write([L|Ls],String,Value) :-
   my_write(Ls,StringOnTheRight,ValueOnTheRight),
   Value is ValueOnTheRight + 2**L,
   with_output_to(string(String),format("2^~d + ~s",[L,StringOnTheRight])).

my_write([L],String,Value) :-
   with_output_to(string(String),format("2^~d",[L])),
   Value is 2**L.



:- begin_tests(powersum).

% powersum(N,Target,Solution) 

test(pv1)       :- bagof(X,propose_value(X,3),Bag), Bag = [3,2,1,0].
test(pv2)       :- bagof(X,propose_value(X,2),Bag), Bag = [2,1,0].
test(pv2)       :- bagof(X,propose_value(X,1),Bag), Bag = [1,0].
test(pv3)       :- bagof(X,propose_value(X,0),Bag), Bag = [0].

test(one)       :- bagof(S,powersum(1,1,S),Bag), Bag = [[0]].
test(two)       :- bagof(S,powersum(3,10,S),Bag), Bag = [[0,0,3],[1,2,2]].
test(three)     :- bagof(S,powersum(3,145,S),Bag), Bag = [[0,4,7]].
test(four,fail) :- powersum(3,8457894,_).
test(five)      :- bagof(S,powersum(9,8457894,S), Bag), Bag = [[1, 2, 5, 7, 9, 10, 11, 16, 23]]. %% VERY SLOW

:- end_tests(powersum).

rt :- run_tests(powersum).

Running test of 2 minutes due to the last unit testing line...

?- time(rt).
% PL-Unit: powersum ....2^0 = 1
.2^0 + 2^0 + 2^3 = 10
2^1 + 2^2 + 2^2 = 10
.2^0 + 2^4 + 2^7 = 145
..2^1 + 2^2 + 2^5 + 2^7 + 2^9 + 2^10 + 2^11 + 2^16 + 2^23 = 8457894
. done
% All 9 tests passed
% 455,205,628 inferences, 114.614 CPU in 115.470 seconds (99% CPU, 3971641 Lips)
true.

Answer 2

EDIT: With some suggestive comments from repeat, here is a complete, efficient CLP(FD) solution:

powersum2_(N, Target, Exponents, Solution) :-
    length(Exponents, N),
    MaxExponent is floor(log(Target) / log(2)),
    Exponents ins 0..MaxExponent,
    chain(Exponents, #>=),
    maplist(exponent_power, Exponents, Solution),
    sum(Solution, #=, Target).

exponent_power(Exponent, Power) :-
    Power #= 2^Exponent.

powersum2(N, Target, Solution) :-
    powersum2_(N, Target, Exponents, Solution),
    labeling([], Exponents).

Ordering exponents by #>= cuts down the search space by excluding redundant permutations. But it is also relevant for the order of labeling (with the [] strategy).

The core relation powersum2_/4 posts constraints on the numbers:

?- powersum2_(5, 31, Exponents, Solution).
Exponents = [_954, _960, _966, _972, _978],
Solution = [_984, _990, _996, _1002, _1008],
_954 in 0..4,
_954#>=_960,
2^_954#=_984,
_960 in 0..4,
_960#>=_966,
2^_960#=_990,
_966 in 0..4,
_966#>=_972,
2^_966#=_996,
_972 in 0..4,
_972#>=_978,
2^_972#=_1002,
_978 in 0..4,
2^_978#=_1008,
_1008 in 1..16,
_984+_990+_996+_1002+_1008#=31,
_984 in 1..16,
_990 in 1..16,
_996 in 1..16,
_1002 in 1..16.

And then labeling searches for the actual solutions:

?- powersum2(5, 31, Solution).
Solution = [16, 8, 4, 2, 1] ;
false.

This solution is considerably more efficient than the other answers so far:

?- time(powersum2(9, 8457894, Solution)).
% 6,957,285 inferences, 0.589 CPU in 0.603 seconds (98% CPU, 11812656 Lips)
Solution = [8388608, 65536, 2048, 1024, 512, 128, 32, 4, 2].

Original version follows.

Here is another CLP(FD) solution. The idea is to express "power of two" as a "real" constraint, i.e, not as a predicate that enumerates numbers like lurker's power_of_2/1 does. It helps that the actual constraint to be expressed isn't really "power of two", but rather "power of two less than or equal to a known bound".

So here is some clumsy code to compute a list of powers of two up to a limit:

powers_of_two_bound(PowersOfTwo, UpperBound) :-
    powers_of_two_bound(1, PowersOfTwo, UpperBound).

powers_of_two_bound(Power, [Power], UpperBound) :-
    Power =< UpperBound,
    Power * 2 > UpperBound.
powers_of_two_bound(Power, [Power | PowersOfTwo], UpperBound) :-
    Power =< UpperBound,
    NextPower is Power * 2,
    powers_of_two_bound(NextPower, PowersOfTwo, UpperBound).

?- powers_of_two_bound(Powers, 1023).
Powers = [1, 2, 4, 8, 16, 32, 64, 128, 256|...] ;
false.

... and then to compute a constraint term based on this...

power_of_two_constraint(UpperBound, Variable, Constraint) :-
    powers_of_two_bound(PowersOfTwo, UpperBound),
    maplist(fd_equals(Variable), PowersOfTwo, PowerOfTwoConstraints),
    constraints_operator_combined(PowerOfTwoConstraints, #\/, Constraint).

fd_equals(Variable, Value, Variable #= Value).

constraints_operator_combined([Constraint], _Operator, Constraint).
constraints_operator_combined([C | Cs], Operator, Constraint) :-
    Constraint =.. [Operator, C, NextConstraint],
    constraints_operator_combined(Cs, Operator, NextConstraint).

?- power_of_two_constraint(1023, X, Constraint).
Constraint =  (X#=1#\/(X#=2#\/(X#=4#\/(X#=8#\/(X#=16#\/(X#=32#\/(X#=64#\/(X#=128#\/(... #= ... #\/ ... #= ...))))))))) ;
false.

... and then to post that constraint:

power_of_two(Target, Variable) :-
    power_of_two_constraint(Target, Variable, Constraint),
    call(Constraint).

?- power_of_two(1023, X).
X in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512 ;
false.

(Seeing this printed in this syntax shows me that I could simplify the code computing the constraint term...)

And then the core relation is:

powersum_(N, Target, Solution) :-
    length(Solution, N),
    maplist(power_of_two(Target), Solution),
    list_monotonic(Solution, #=<),
    sum(Solution, #=, Target).

list_monotonic([], _Operation).
list_monotonic([_X], _Operation).
list_monotonic([X, Y | Xs], Operation) :-
    call(Operation, X, Y),
    list_monotonic([Y | Xs], Operation).

We can run this without labeling:

?- powersum_(9, 1023, S).
S = [_9158, _9164, _9170, _9176, _9182, _9188, _9194, _9200, _9206],
_9158 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9158+_9164+_9170+_9176+_9182+_9188+_9194+_9200+_9206#=1023,
_9164#>=_9158,
_9164 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9170#>=_9164,
_9170 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9176#>=_9170,
_9176 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9182#>=_9176,
_9182 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9188#>=_9182,
_9188 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9194#>=_9188,
_9194 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9200#>=_9194,
_9200 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9206#>=_9200,
_9206 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512 ;
false.

And it's somewhat quick when we label:

?- time(( powersum_(8, 255, S), labeling([], S) )), format('S = ~w~n', [S]), false.
% 561,982 inferences, 0.055 CPU in 0.055 seconds (100% CPU, 10238377 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,091,295 inferences, 0.080 CPU in 0.081 seconds (100% CPU, 13557999 Lips)
false.

Contrast this with lurker's approach, which takes much longer even just to find the first solution:

?- time(binary_partition(255, 8, S)), format('S = ~w~n', [S]), false.
% 402,226,596 inferences, 33.117 CPU in 33.118 seconds (100% CPU, 12145562 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,569,157 inferences, 0.130 CPU in 0.130 seconds (100% CPU, 12035050 Lips)
S = [1,2,4,8,16,32,64,128]
% 14,820,953 inferences, 1.216 CPU in 1.216 seconds (100% CPU, 12190530 Lips)
S = [1,2,4,8,16,32,64,128]
% 159,089,361 inferences, 13.163 CPU in 13.163 seconds (100% CPU, 12086469 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,569,155 inferences, 0.134 CPU in 0.134 seconds (100% CPU, 11730834 Lips)
S = [1,2,4,8,16,32,64,128]
% 56,335,514 inferences, 4.684 CPU in 4.684 seconds (100% CPU, 12027871 Lips)
S = [1,2,4,8,16,32,64,128]
^CAction (h for help) ? abort
% 1,266,275,462 inferences, 107.019 CPU in 107.839 seconds (99% CPU, 11832284 Lips)
% Execution Aborted  % got bored of waiting

However, this solution is slower than the one by David Tonhofer:

?- time(( powersum_(9, 8457894, S), labeling([], S) )), format('S = ~w~n', [S]), false.
% 827,367,193 inferences, 58.396 CPU in 58.398 seconds (100% CPU, 14168325 Lips)
S = [2,4,32,128,512,1024,2048,65536,8388608]
% 1,715,107,811 inferences, 124.528 CPU in 124.532 seconds (100% CPU, 13772907 Lips)
false.

versus:

?- time(bagof(S,powersum(9,8457894,S), Bag)).
2^1 + 2^2 + 2^5 + 2^7 + 2^9 + 2^10 + 2^11 + 2^16 + 2^23 = 8457894
% 386,778,067 inferences, 37.705 CPU in 37.706 seconds (100% CPU, 10258003 Lips)
Bag = [[1, 2, 5, 7, 9, 10, 11, 16|...]].

There's probably room to improve my constraints, or maybe some magic labeling strategy that will improve the search.

EDIT: Ha! Labeling from the largest to the smallest element changes the performance quite dramatically:

?- time(( powersum_(9, 8457894, S), reverse(S, Rev), labeling([], Rev) )), format('S = ~w~n', [S]), false.
% 5,320,573 inferences, 0.367 CPU in 0.367 seconds (100% CPU, 14495124 Lips)
S = [2,4,32,128,512,1024,2048,65536,8388608]
% 67 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 2618313 Lips)
false.

So this is now about 100x as fast as David Tonhofer's version. I'm content with that :-)