Mam 5 numerów 1, 2, 3, 4, 4 i 5 i chciałbym uzyskać wszystkie możliwe kombinacje tych liczb dotrzeć do danej suma 10.

Przykład:

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

Doceniam to, jeśli ktoś tutaj może dać dobre rozwiązanie, jak rozwiązać ten problem?

6
RickyBelmont 12 marzec 2021, 17:36

5 odpowiedzi

Najlepsza odpowiedź

Innym podejściem będzie przekształcić się na równanie liniowe, w którym A, B, C, D i E są liczbą 1,2,3,4 lub 5-tych.

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

Określ zakres każdej zmiennej.

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)

Wypróbuj wszystkie kombinacje. Całkowite kombinacje do sprawdzenia: 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;

Pełne rozwiązanie źródła

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.
4
Brian 12 marzec 2021, 19:14

Chociaż prawdopodobnie nie jest to pytanie Delphi, ale pytanie o czystą matematykę, mogę dać ci kilka wskazówek.

Po pierwsze, zauważ, że wyraźnie nie możesz mieć więcej niż 10 warunków w sumy, ponieważ jeśli masz więcej niż dziesięć terminów, masz co najmniej jedenaście warunków, więc suma staje się przynajmniej

11 × Lowest allowed summand = 11 × 1 = 11

Który jest już większy niż 10.

Dlatego pojedyncze rozwiązanie tego problemu może być naturalnie reprezentowane jako tablicę dokładnie 10 liczb całkowitych z 0 do 5.

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

Należy jednak pamiętać, że dwa odrębne wartości TCandidate mogą reprezentować to samo rozwiązanie:

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

Ponieważ każdy nadwydełny jest wybrany z zestawu kardynalności 6, jest 6 10 = 60466176 możliwe TCandidate. Dla nowoczesnego komputera jest to "mały" numer, więc nawet bardzo naiwny algorytm, który próbuje każdego takiego kandydata (poprzez obliczanie sumy!) Daje ci odpowiedź niemal natychmiast.

Ponadto, ponieważ 10 nie jest ogromną liczbą, ty może stosować dziesięć sended {x0}} pętle, a podejście jest prawie trywialne (prawda?). Jednakże podejście jest tak brzydkie, że odmawiam go używania. Zamiast tego użyję bardziej eleganckiego podejścia, które również pracuje dla innych wartości niż stałe małe, takie jak 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;

Funkcja GetNextCandidate służy do wyliczeń kandydatów w kolejności, w jakiej otrzymasz, jeśli uważasz je za numery bazowe 6. Akceptuje kandydata, jak (2, 1, 3, 0, 5, 2, 1, 3, 2, 0) i zastępuje go z następnym, jak (2, 1, 3, 0, 5, 2, 1, 3, 2, 1), chyba że jesteś w ostatniej: (5, 5, 5, 5, 5, 5, 5, 5, 5, 5).

Spróbujmy tego wyliczenia:

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

(Wdrożenie OutputCandidateVector pozostawia się jako ćwiczenie) produkuje

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

Teraz jesteśmy "gotowe":

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

Korzystanie z dwóch kolejnych trywiologicznych procedur pomocniczych.

Wynik:

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

Ale jak pozbyć się duplikatów? Zauważ, że istnieją dwa źródła duplikatów:

  • Po pierwsze, mamy pozycje zera. 0+3+3+1+0+0+0+1+1+1 i 0+3+3+1+0+0+1+0+1+1 są bardziej naturalnie napisane 3+3+1+1+1+1.

  • Po drugie, mamy zamawianie: 3+3+1+1+1+1 vs {x1}}.

Z twojego pytania nie jest jasne, jeśli uważasz za ważne zamówienie, ale zakładam, że nie, tak, że 3+3+1+1+1+1 versus 3+1+3+1+1+1 reprezentuje to samo rozwiązanie.

Jak więc pozbyć się duplikatów? Jednym rozwiązaniem jest sortować każdego wektora kandydującego, a następnie usunąć ścisłe duplikaty. Teraz jestem naprawdę leniwy i użyj słownika ciągów:

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.

To daje

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

Po dwóch lub trzech sekundach, nawet jeśli podejście to jest bardzo nieefektywne!

Podkreśla to dwie ogólne zasady:

  • Biorąc pod uwagę dobrze określony problem, często łatwo jest utworzyć prawidłowy algorytm, który go rozwiązuje. Jednak tworzenie algorytmu wydajnej wymaga większej pracy.

  • Komputery są naprawdę szybkie w tych dniach.

Dodatek A: Pełny kod źródłowy

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.
8
Andreas Rejbrand 12 marzec 2021, 16:17

Zbuduj zakorzenione drzewo, gdzie ścieżki korzenia są elementami, które sumą do 10.

Powiedz, że każdy węzeł przechowuje swoją wartość i sumę z korzenia do niego (z korzeniem mającym zarówno zerowane).

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

Na przykład.,

Root ma dzieci (wartość, sum_from_root): (1,1), (2,2), (3,3), (4,4), (5,5)

Root- (4,4) ma dzieci (1,5), (2,6), (3,7), (4,8)

Root- (4,4) - (3,7) ma dzieci (1,8), (2,9), (3,10)

Root- (4,4) - (3,7) - (2,9) ma dzieci (1,10)

...

Mając na uwadze, że root- (4,4) - (4,8) ma dzieci (1,9), (2,10)

Jest to liniowy na wyjściu (liczba ścieżek).

Nalegam na dzieciom bycie <= rodzice (inni niż korzeń), aby uniknąć permutacji tej samej odpowiedzi. Jeśli chcesz, usuń, usuń to ograniczenie.

3
Dave 12 marzec 2021, 16:41

Czy 9 ms wystarczająco szybko? Pomimo stosowania języka interpretacyjnego (PERL)? (Nie znam Delphi.) W tym algorytmie jest bardzo mało zmarnowany. Bez dups; Algorytm zapobiega im.

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

Wynik:

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 linii)

1
Rick James 13 marzec 2021, 05:59

Oto rekurencyjne rozwiązanie inspirowane odpowiedzią Dave'a. Nie buduje jednak drzewa:

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.

Wynik:

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
1
Olivier 14 marzec 2021, 08:27