Get all the possible combinations of the given numbers to reach at a given sum

Question

I have 5 numbers 1, 2, 3, 4, and 5, and I would like to get all of the possible combinations of those numbers to arrive at a given total of 10.

Example:

1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + = 10
1 + 2 + 2 + 3 + 2 = 10
7 + 3 = 10
4 + 5 + 1 = 10
2 + 2 + 2 + 1 + 3 = 10
and so on...

I will appreciate it if anyone here could give a good solution on how to solve this problem?

Answer 1

Although this is arguably not a Delphi question but a question about pure mathematics, I can give you a few hints.

First, notice that you clearly cannot have more than 10 terms in the sum, because if you have more than ten terms, then you have at least eleven terms and so the sum becomes at least

11 × Lowest allowed summand = 11 × 1 = 11

which is already greater than 10.

Therefore, a single solution to this problem can naturally be represented as an array of exactly 10 integers from 0 to 5.

type
  TTerm = 0..5;
  TCandidate = array[0..9] of TTerm;

Please note, however, that two distinct TCandidate values might represent the same solution:

5, 3, 2, 0, 0, 0, 0, 0, 0, 0
3, 2, 5, 0, 0, 0, 0, 0, 0, 0
5, 3, 0, 0, 0, 0, 0, 0, 2, 0

Since each summand is chosen from a set of cardinality 6, there are 6¹⁰ = 60466176 possible TCandidate values. For a modern computer, this is a "small" number, so even a very naïve algorithm which tries every such candidate (by computing its sum!) will give you the answer almost immediately.

Furthermore, since 10 is not a huge number, you could use ten nestled for loops and that approach is almost trivial (right?). However, that approach is so ugly that I refuse to use it. Instead, I'll use a more elegant approach which would also work for other values than fixed small ones like 10.

const
  FirstCandidate: TCandidate = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

function GetNextCandidate(var ANext: TCandidate): Boolean;
begin
  for var p := High(ANext) downto Low(ANext) do
    if ANext[p] < High(TTerm) then
    begin
      Inc(ANext[p]);
      for var p2 := Succ(p) to High(ANext) do
        ANext[p2] := 0;
      Exit(True);
    end;
  Result := False;
end;

The GetNextCandidate function is used to enumerate the candidates in the order you get if you consider them to be base-6 numbers. It accepts a candidate, like (2, 1, 3, 0, 5, 2, 1, 3, 2, 0) and replaces it with the next one, like (2, 1, 3, 0, 5, 2, 1, 3, 2, 1), unless you are at the last one: (5, 5, 5, 5, 5, 5, 5, 5, 5, 5).

Let's try this enumeration:

var CurrentCandidate := FirstCandidate;
while GetNextCandidate(CurrentCandidate) do
  OutputCandidateVector(CurrentCandidate);

(implementing OutputCandidateVector is left as an exercise) produces

0, 0, 0, 0, 0, 0, 0, 0, 0, 0
0, 0, 0, 0, 0, 0, 0, 0, 0, 1
0, 0, 0, 0, 0, 0, 0, 0, 0, 2
0, 0, 0, 0, 0, 0, 0, 0, 0, 3
0, 0, 0, 0, 0, 0, 0, 0, 0, 4
0, 0, 0, 0, 0, 0, 0, 0, 0, 5
0, 0, 0, 0, 0, 0, 0, 0, 1, 0
0, 0, 0, 0, 0, 0, 0, 0, 1, 1
0, 0, 0, 0, 0, 0, 0, 0, 1, 2
0, 0, 0, 0, 0, 0, 0, 0, 1, 3
0, 0, 0, 0, 0, 0, 0, 0, 1, 4
0, 0, 0, 0, 0, 0, 0, 0, 1, 5
0, 0, 0, 0, 0, 0, 0, 0, 2, 0
0, 0, 0, 0, 0, 0, 0, 0, 2, 1
0, 0, 0, 0, 0, 0, 0, 0, 2, 2
0, 0, 0, 0, 0, 0, 0, 0, 2, 3
0, 0, 0, 0, 0, 0, 0, 0, 2, 4
0, 0, 0, 0, 0, 0, 0, 0, 2, 5
0, 0, 0, 0, 0, 0, 0, 0, 3, 0
0, 0, 0, 0, 0, 0, 0, 0, 3, 1
0, 0, 0, 0, 0, 0, 0, 0, 3, 2
0, 0, 0, 0, 0, 0, 0, 0, 3, 3
0, 0, 0, 0, 0, 0, 0, 0, 3, 4
0, 0, 0, 0, 0, 0, 0, 0, 3, 5
...

Now we are "done":

var CurrentCandidate := FirstCandidate;
while GetNextCandidate(CurrentCandidate) do
  if Sum(CurrentCandidate) = 10 then
    Display(CurrentCandidate);

using two more trivial helper routines.

Output:

...
0+3+3+0+2+0+0+1+0+1
0+3+3+0+2+0+0+1+1+0
0+3+3+0+2+0+0+2+0+0
0+3+3+0+2+0+1+0+0+1
0+3+3+0+2+0+1+0+1+0
0+3+3+0+2+0+1+1+0+0
0+3+3+0+2+0+2+0+0+0
0+3+3+0+2+1+0+0+0+1
0+3+3+0+2+1+0+0+1+0
0+3+3+0+2+1+0+1+0+0
0+3+3+0+2+1+1+0+0+0
0+3+3+0+2+2+0+0+0+0
0+3+3+0+3+0+0+0+0+1
0+3+3+0+3+0+0+0+1+0
0+3+3+0+3+0+0+1+0+0
0+3+3+0+3+0+1+0+0+0
0+3+3+0+3+1+0+0+0+0
0+3+3+0+4+0+0+0+0+0
0+3+3+1+0+0+0+0+0+3
0+3+3+1+0+0+0+0+1+2
0+3+3+1+0+0+0+0+2+1
0+3+3+1+0+0+0+0+3+0
0+3+3+1+0+0+0+1+0+2
0+3+3+1+0+0+0+1+1+1
0+3+3+1+0+0+0+1+2+0
...

But how do we get rid of duplicates? Notice that there are two sources of duplicates:

• First, we have the positions of the zeros. 0+3+3+1+0+0+0+1+1+1 and 0+3+3+1+0+0+1+0+1+1 are both more naturally written 3+3+1+1+1+1.

• Second, we have ordering: 3+3+1+1+1+1 versus 3+1+3+1+1+1.

It's not clear from your question if you consider order important, but I'll assume you don't, so that 3+3+1+1+1+1 versus 3+1+3+1+1+1 represent the same solution.

How, then, to get rid of duplicates? One solution is to sort each candidate vector and then remove strict duplicates. Now I am really lazy and use a string dictionary:

begin
  var SolutionStringsDict := TDictionary<string, Pointer>.Create;
  var SolutionStringsList := TList<string>.Create;
  try

    var CurrentCandidate := FirstCandidate;
    while GetNextCandidate(CurrentCandidate) do
      if Sum(CurrentCandidate) = 10 then
      begin
        var CandidateSorted := SortCandidateVector(CurrentCandidate);
        var CandidateString := PrettySumString(CandidateSorted);
        if not SolutionStringsDict.ContainsKey(CandidateString) then
        begin
          SolutionStringsDict.Add(CandidateString, nil);
          SolutionStringsList.Add(CandidateString);
        end;
      end;

    for var SolutionString in SolutionStringsList do
      Writeln(SolutionString);

  finally
    SolutionStringsList.Free;
    SolutionStringsDict.Free;
  end;
end.

This yields

5+5
5+4+1
5+3+2
4+4+2
4+3+3
5+3+1+1
4+4+1+1
5+2+2+1
4+3+2+1
3+3+3+1
4+2+2+2
3+3+2+2
5+2+1+1+1
4+3+1+1+1
4+2+2+1+1
3+3+2+1+1
3+2+2+2+1
2+2+2+2+2
5+1+1+1+1+1
4+2+1+1+1+1
3+3+1+1+1+1
3+2+2+1+1+1
2+2+2+2+1+1
4+1+1+1+1+1+1
3+2+1+1+1+1+1
2+2+2+1+1+1+1
3+1+1+1+1+1+1+1
2+2+1+1+1+1+1+1
2+1+1+1+1+1+1+1+1
1+1+1+1+1+1+1+1+1+1

after two or three seconds, even though this approach is very inefficient!

This highlights two general rules:

• Given a well-specified problem, it is often easy to create a correct algorithm that solves it. However, creating an efficient algorithm requires more work.

• Computers are really fast these days.

Appendix A: Full source code

program EnumSums;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils,
  Math,
  Generics.Defaults,
  Generics.Collections;

type
  TTerm = 0..5;
  TCandidate = array[0..9] of TTerm;

const
  FirstCandidate: TCandidate = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

function GetNextCandidate(var ANext: TCandidate): Boolean;
begin
  for var p := High(ANext) downto Low(ANext) do
    if ANext[p] < High(TTerm) then
    begin
      Inc(ANext[p]);
      for var p2 := Succ(p) to High(ANext) do
        ANext[p2] := 0;
      Exit(True);
    end;
  Result := False;
end;

function Sum(const ACandidate: TCandidate): Integer;
begin
  Result := 0;
  for var Term in ACandidate do
    Inc(Result, Term);
end;

procedure Display(const ACandidate: TCandidate);
begin
  var S := '';
  for var i := Low(ACandidate) to High(ACandidate) do
    if S.IsEmpty then
      S := IntToStr(ACandidate[i])
    else
      S := S + '+' + IntToStr(ACandidate[i]);
  Writeln(S);
end;

function SortCandidateVector(const ACandidate: TCandidate): TCandidate;
begin
  var L: TArray<Integer>;
  SetLength(L, Length(ACandidate));
  for var i := 0 to High(L) do
    L[i] := ACandidate[i];
  TArray.Sort<Integer>(L);
  for var i := 0 to High(L) do
    Result[i] := L[High(L) - i];
end;

function PrettySumString(const ACandidate: TCandidate): string;
begin
  Result := '';
  for var i := Low(ACandidate) to High(ACandidate) do
    if ACandidate[i] = 0 then
      Exit
    else if Result.IsEmpty then
      Result := IntToStr(ACandidate[i])
    else
      Result := Result + '+' + IntToStr(ACandidate[i]);
end;


begin

  var SolutionStringsDict := TDictionary<string, Pointer>.Create;
  var SolutionStringsList := TList<string>.Create;
  try

    var CurrentCandidate := FirstCandidate;
    while GetNextCandidate(CurrentCandidate) do
      if Sum(CurrentCandidate) = 10 then
      begin
        var CandidateSorted := SortCandidateVector(CurrentCandidate);
        var CandidateString := PrettySumString(CandidateSorted);
        if not SolutionStringsDict.ContainsKey(CandidateString) then
        begin
          SolutionStringsDict.Add(CandidateString, nil);
          SolutionStringsList.Add(CandidateString);
        end;
      end;

    for var SolutionString in SolutionStringsList do
      Writeln(SolutionString);

  finally
    SolutionStringsList.Free;
    SolutionStringsDict.Free;
  end;

  Readln;

end.

Answer 2

Another approach would be to convert to a linear equation where A,B,C,D and E are the number of 1,2,3,4 or 5's.

A + B*2 + C*3 + D*4 + E*5 = 10

Determine the range of each variable.

A = (0..10)   // can be 0 to 10 1's
B = (0..5)    // can be 0 to 5 2's
C = (0..3)    // etc
D = (0..2)
E = (0..2)

Try all combinations. Total combinations to check: 11 * 6 * 4 * 3 * 3 = 2,376.

  for var A : integer := 0 to 10 do
    for var B : integer := 0 to 5 do
      for var C : integer := 0 to 3 do
        for var D : integer := 0 to 2 do
          for var E : integer := 0 to 2 do
            if A * 1 + B * 2 + C * 3 + D * 4 + E * 5 = 10 then
            begin
              // output a solution
            end;

Full Source Solution

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.StrUtils;

begin
  for var A : integer := 0 to 10 do
    for var B : integer := 0 to 5 do
      for var C : integer := 0 to 3 do
        for var D : integer := 0 to 2 do
          for var E : integer := 0 to 2 do
            if A * 1 + B * 2 + C * 3 + D * 4 + E * 5 = 10 then
            begin
              Var AResult : string := '';
              for Var I :integer := 1 to E do AResult := AResult + ' + 5';
              for Var I :integer := 1 to D do AResult := AResult + ' + 4';
              for Var I :integer := 1 to C do AResult := AResult + ' + 3';
              for Var I :integer := 1 to B do AResult := AResult + ' + 2';
              for Var I :integer := 1 to A do AResult := AResult + ' + 1';
              writeln(RightStr( AResult,length(AResult) -3) + ' = 10');
            end;
  readln;
end.