获取给定数字的所有可能组合以达到给定的总和

Question

我有 5 个号码 1、2、3、4 和 5，我想获得所有可能的号码这些数字的组合达到给定的总数 10.

示例：

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...

如果这里有人能就如何解决这个问题给出一个好的解决方案，我将不胜感激？

Answer 1

虽然这可以说不是Delphi问题而是纯数学问题，但我可以给你一些提示。

首先，请注意总和中的项显然不能超过 10 个，因为如果超过 10 个项，则至少有 11 个项，因此总和至少为

11 × Lowest allowed summand = 11 × 1 = 11

已经大于 10。

因此，这个问题的单一解法自然可以表示为从0到5.

恰好10个整数的数组

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

但是请注意，两个不同的 TCandidate 值可能代表相同的解决方案：

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

由于每个被加数都是从一组基数 6 中选择的，因此有 6¹⁰ = 60466176 个可能的 TCandidate 值。对于现代计算机来说，这是一个“小”数字，因此即使是尝试每个这样的候选者（通过计算其总和！）的非常幼稚的算法也会几乎立即给你答案。

此外，由于 10 不是一个很大的数字，您可以使用十个嵌套的 for 循环，这种方法几乎是微不足道的（对吧？）。但是，这种方法太丑陋了，我拒绝使用它。相反，我将使用一种更优雅的方法，它也适用于其他值，而不是像 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;

GetNextCandidate 函数用于按照您认为是 6 进制数的顺序枚举候选项。它接受一个候选者，如 (2, 1, 3, 0, 5, 2, 1, 3, 2, 0) 并将其替换为下一个，如 (2, 1, 3, 0, 5, 2, 1, 3, 2, 1)，除非你在最后一个：(5, 5, 5, 5, 5, 5, 5, 5, 5, 5).

让我们试试这个枚举：

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

（实施 OutputCandidateVector 留作练习）产生

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
...

现在我们“完成”了：

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

使用两个更简单的帮助例程。

输出：

...
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
...

但是我们如何去除重复项呢？请注意，有两个重复来源：

首先，我们有零的位置。 0+3+3+1+0+0+0+1+1+1 和 0+3+3+1+0+0+1+0+1+1 都更自然地写成 3+3+1+1+1+1.
其次，我们有排序：3+3+1+1+1+1 与 3+1+3+1+1+1。

从你的问题中不清楚你是否认为顺序很重要，但我假设你不认为，所以 3+3+1+1+1+1 与 3+1+3+1+1+1 代表相同的解决方案。

那么，如何去除重复项呢？一种解决方案是对每个候选向量进行排序，然后删除严格的重复项。现在实在懒得用字符串字典了：

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.

这会产生

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

两三秒后，虽然这种方法效率很低！

这突出了两个一般规则：

给定一个明确的问题，通常很容易创建一个正确的算法来解决它。但是，创建高效算法需要更多工作。
现在的电脑速度真快。

附录 A：完整源代码

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

另一种方法是转换为线性方程式，其中 A、B、C、D 和 E 是 1、2、3、4 或 5 的个数。

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

确定每个变量的范围。

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)

尝试所有组合。要检查的总组合：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;

完整源代码解决方案

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.

Answer 3

构建一个有根树，其中从根开始的路径是总和为 10 的元素。

假设每个节点存储它的值和从根到它的总和（根都归零）。

def update(node):
    max_child = min(5, 10 - node.sum_from_root, node.value)
    for i in range(1, max_child):
        child = node.new(i, sum_from_root + i)
        node.add_child(child)
        update(child) if child.sum_from_root < 10

例如，

root 有 children（值，sum_from_root）：(1,1), (2,2), (3,3), (4,4), (5,5 )

root-(4,4) 有 children (1,5), (2,6), (3,7), (4,8)

root-(4,4)-(3,7) 有 children(1,8), (2,9), (3,10)

root-(4,4)-(3,7)-(2,9) 有 children(1,10)

...

而 root-(4,4)-(4,8) 有 children (1,9), (2,10)

这在输出中是线性的（路径数）。

我坚持 children <= parents（根除外）以避免相同答案的排列。如果您想要排列，请删除此限制。

Answer 4

9ms够快吗？尽管使用解释性语言（Perl）？（我不知道Delphi。）这个算法几乎没有浪费精力。没有重复；算法阻止了它们。

use strict;
for my $a (1..5) {
for my $b ($a..5) {
if ($a + $b == 10) { print "$a + $b\n"; next }
for my $c ($b..10-$b) {
if ($a + $b + $c == 10) { print "$a + $b + $c\n"; next }
for my $d ($c..10-$c) {
if ($a + $b + $c + $d == 10) { print "$a + $b + $c + $d\n"; next }
for my $e ($d..10-$d) {
if ($a + $b + $c + $d + $e == 10) { print "$a + $b + $c + $e + $e\n"; next }
for my $f ($e..10-$e) {
if ($a + $b + $c + $d + $e + $f == 10) { print "$a + $b + $c + $d + $e + $f\n"; next }
for my $g ($f..10-$f) {
if ($a + $b + $c + $d + $e + $f + $g == 10) { print "$a + $b + $c + $d + $e + $f + $g\n"; next }
for my $h ($g..10-$g) {
if ($a + $b + $c + $d + $e + $f + $g + $h == 10) { print "$a + $b + $c + $d + $e + $f + $g + $h\n"; next }
for my $i ($h..10-$f) {
if ($a + $b + $c + $d + $e + $f + $g + $h + $i == 10) { print "$a + $b + $c + $d + $e + $f + $g + $h + $i\n"; next }
for my $j ($i..10-$g) {
if ($a + $b + $c + $d + $e + $f + $g + $h + $i + $j == 10) { print "$a + $b + $c + $d + $e + $f + $g + $h + $i + $j\n"; next }
}}}}}}}}}}

输出：

1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1
1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 2
1 + 1 + 1 + 1 + 1 + 1 + 1 + 3
1 + 1 + 1 + 1 + 1 + 1 + 2 + 2
1 + 1 + 1 + 1 + 1 + 1 + 4
1 + 1 + 1 + 1 + 1 + 2 + 3
1 + 1 + 1 + 1 + 1 + 5
1 + 1 + 1 + 1 + 2 + 2 + 2
1 + 1 + 1 + 1 + 2 + 4
1 + 1 + 1 + 1 + 3 + 3
1 + 1 + 1 + 6 + 6
1 + 1 + 1 + 2 + 2 + 3
1 + 1 + 1 + 5 + 5
1 + 1 + 1 + 4 + 4
1 + 1 + 1 + 7
1 + 1 + 2 + 2 + 2 + 2
1 + 1 + 2 + 4 + 4
1 + 1 + 2 + 3 + 3
1 + 1 + 2 + 6
1 + 1 + 3 + 5
1 + 1 + 4 + 4
1 + 1 + 8
1 + 2 + 2 + 3 + 3
1 + 2 + 2 + 5
1 + 2 + 3 + 4
1 + 2 + 7
1 + 3 + 3 + 3
1 + 3 + 6
1 + 4 + 5
2 + 2 + 2 + 2 + 2
2 + 2 + 2 + 4
2 + 2 + 3 + 3
2 + 2 + 6
2 + 3 + 5
2 + 4 + 4
3 + 3 + 4
5 + 5

（37 行）

Answer 5

这是一个受戴夫回答启发的递归解决方案。虽然它不会构建树：

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils, Math;

type
  TSolution = array[1..10] of integer;

procedure PrintSolution(var Solution:TSolution; Size:integer);
var
  s: string;
  i: integer;
begin
  s := '';
  for i:=1 to Size do
    s := s + IntToStr(Solution[i]) + ' ';
  Writeln(s);
end;

procedure Search(var Solution:TSolution; Size, Sum, Target:integer);
var
  i, j, k, Sum2:integer;
begin
  if Size = 0 then
     j := 1
  else
    j := Solution[Size];
  k := Min(Target - Sum, 5);
  Inc(Size);
  for i:=j to k do
  begin
    Solution[Size] := i;
    Sum2 := Sum + i;
    if Sum2<Target then
      Search(Solution, Size, Sum2, Target)
    else
      PrintSolution(Solution, Size);
  end;
end;

var
  Solution:TSolution;
begin
  Search(Solution, 0, 0, 10);
  Readln;
end.

输出：

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

获取给定数字的所有可能组合以达到给定的总和

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

delphi

algorithm

附录 A：完整源代码