附录 A：完整源代码

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 有孩子 (value, sum_from_root): (1,1), (2,2), (3,3), (4,4), (5,5)

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

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

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

...

而 root-(4,4)-(4,8) 有子节点 (1,9), (2,10)

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

我坚持让孩子成为 <= 父母（根除外），以避免排列相同的答案。如果您想要排列，请取消此限制。

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

这是一个受 Dave 回答启发的递归解决方案。但它不会构建一棵树：

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

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

5 个答案:

附录 A：完整源代码