Thema: Delphi Ordung muss sein

Einzelnen Beitrag anzeigen

Benutzerbild von negaH
negaH

Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
 
#51

Re: Ordung muss sein

  Alt 6. Okt 2003, 15:28
Die Idee von Hansa über eine verlinkte Liste zu arbeiten ist gut.
Allerdings benötigt man keinen "Ring" oder eine verlinkte Liste über zB. 49 Kugeln.
Ich habe meinen Algorithmus dahingehend umgeschrieben damit er mit einer verlinkten Liste arbeitet. Dies optimiert nochmals den vorher beschriebenen Algorithmus, da nun das sortierte Einfügen der gezogenen Kugeln ohne Kopieroperationen auskommt. D.h. Speicherzugriffsmäßig gesehen ist der Algo. nun effizienter.

Delphi-Quellcode:
type
  PKugel = ^TKugel;
  TKugel = packed record
    Wert: Integer; // Zahlenwert der Kugel
    Naechste: PKugel; // nächsthöhere Kugel
  end;

  TKugeln = array of TKugel;

function Lotto(var Kugeln: TKugeln; Ziehungen: Integer = 6; Elemente: Integer = 49): PKugel;
// Lotto-Ziehung, korrekte Simulation der Wahrscheinlichkeiten einer realen Lotto-Ziehung
// Dieser Algo. vermeidet das Umsortierung und somit Kopieren im Speicher über die Nutzung
// einer verlinkten Liste von Kugeln.
var
  I,Index: Integer;
  Erste: PKugel; // Wurzel der verlinkten Liste, erstes sortiertes Element
  Naechste: PKugel; // aktuell untersuchtes Element
  Vorherige: PKugel; // vorheriges Element von Aktuelle
begin
  Kugeln := nil;
  if Ziehungen > Elemente then
    raise Exception.Create('Man kann nicht mehr Kugeln ziehen als in der Urne sind');

  Erste := nil;
  SetLength(Kugeln, Ziehungen);
  for I := 0 to Ziehungen -1 do
  begin
 // ziehe Index der Kugel aus Urne, 1 basierter Index
    Index := Random(Elemente) +1;
    Dec(Elemente);
 // berechne Zahlenwert der Kugel mit Index
    Vorherige := nil;
    Naechste := Erste;
    while (Naechste <> nil) and (Index >= Naechste.Wert) do
    begin
      Inc(Index);
      Vorherige := Naechste;
      Naechste := Naechste.Naechste;
    end;
 // trage Kugel in Kugeln ein und aktualisiere die sortierte verlinkte Liste
    Kugeln[I].Wert := Index;
    Kugeln[I].Naechste := Naechste;
    if Vorherige <> nil then Vorherige.Naechste := @Kugeln[I]
      else Erste := @Kugeln[I];
  end;
  Result := Erste;
end;

procedure TestLotto;
var
  Kugeln: TKugeln;
  Kugel,Erste: PKugel;
  I: Integer;
begin
  Erste := Lotto(Kugeln, 6, 49);

// Ausgabe
  Write('gezogene : ');
  for I := Low(Kugeln) to High(Kugeln) do
    Write(Kugeln[I].Wert:4);
  WriteLn;

  Write('sortiert : ');
  Kugel := Erste;
  while Kugel <> nil do
  begin
    Write(Kugel.Wert:4);
    Kugel := Kugel.Naechste;
  end;
  WriteLn;
end;
Gruß Hagen

PS: die Moderatoren sollten nun diesen Thread auf's Wesentliche zusammenstreichen und in der CodeLib veröffentlichen. Denn in spätesten 3-4 Wochen kommt diese Frage wieder.
  Mit Zitat antworten Zitat