Einzelnen Beitrag anzeigen

ThomasNds

Registriert seit: 16. Sep 2008
4 Beiträge
 
Delphi 5 Standard
 
#8

Re: Zahlenreihe in zwei Teile zerlegen -> gleiche Summen

  Alt 2. Aug 2009, 21:41
Hallo,

wie mein Vorposter schon sagte: das Problem ist bekannt als subset-sum-problem oder binärer Knapsack, z.B.: http//www.cs.umu.se/kurser/TDBA77/VT06/algorithms/BOOK/BOOK4/NODE145.HTM oder http://www.brpreiss.com/books/opus4/html/page447.html. Google-Suchwörter sind Knapsack, subset sum, Teilsummenproblem, Untersummenproblem, Partitionieren, Balancing Scales problem.
Das Problem ist NP-schwer. Bei kleinen Problemen ist die beste und einfachste Lösung ein Ausprobieren aller sinnvollen(!) Partitionen.

Man reduziert das Problem darauf, aus einer gegebenen Menge zahlen solche auszuwählen, daß eine bestimmte Zielsumme das Ergebnis ist. Sinnvoll ist es, mit den größten Kandidaten anzufangen. Erster Schritt also: Sortieren. Dann Summe der Werte bilden. Zielsumme ist die Hälfte. Lösung per Backtracking.

Ziesumme null: Lösung ist die leere Menge
Sonst: wähle den ersten Kandidaten, suche Lösung
für Zielsumme-Kandidat(gibt Lösungen, die Kandidat enthalten)
dann schließe aktuellen Kandidaten aus, suche Lösung für
Zielsumme (gibt Lösüngen, die Kandidat nicht enthalten).

Wenn die verbleibenden Kandidaten nicht ausreichen, um die Zielsumme zu ergeben, kann man abbrechen.

Mal so aus der hohlen Hand:


Code:
werte: Array [1 .. N] of Integer = {16,14,6,7,2,1}
Kandidaten: Array [1 .. N ] of Bolean =
{false,false,false,false,false,false}
Kandindex:Integer = 1;
SummerestKandidaten: Integer;

Function löse(kandidat:Integer; Zielsumme:Integer):Boolean

Begin
if Kandidat >N then return false;

if Summe < 0 then return false;
If Summerestkandidaten<Zielsumme return false;
(*Auch wenn alle übrigen Kandidaten gewählt werden,
erreichen wir die Zielsumme nicht->weitermachen lohnt
nicht*)

if summe=0 then
    Lösung ausgeben
    return true
endif

(*Kandidat einschließen*)
Kandidaten[Kandidat]=true;
Summerestkandidaten:=Summerestkandidanten - wert[Kandidat];
if löse(Kandidat +1, Zielsumme - werte[Kandidat]) then
    return true (*Abbruch der weiteren Suche, da Lösung
gefunden*)

(*Mit Kandidat keine Lösung gefunden, also mal ohne ihn
versuchen*)
Kandidaten[Kandidat]:=false;
if löse(Kandidat+1, zielsumme) then return true

(*auch ohne Kandidat keine Lösung gefunden*)
(*Änderungen rückgängig machen, damit obere Ebenen nicht
irritiert werden*)
Kandidaten[Kandidat]=false;
Summerestkandidaten:=Summerestkandidanten + wert[Kandidat];
return false
endfunc

Begin Main
Setze Summe =Summe(werte)
Summerestkandidaten:=Summe;
Zielsumme=Summe/2
löse(1, Zielsumme)
Enthält bestimmt noch Fehler.

Gruß

T.

[edit=mkinzler]Code-Tag eingefügt Mfg, mkinzler[/edit]
  Mit Zitat antworten Zitat