Ordung muss sein

[negaH]

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.

[Billa]

@Hagen:

1. Du hast Recht: Mischen muß man nicht mehr, das wäre genauso verfälschend, wie es das "Zurücklegen" der Kugel wäre.

2. Ich glaube, die "Ring"-Idee ist von mir ?! :mrgreen: Aber ok, ok Hansa hats's codiert!

@Mods: Ja bitte: das gehört bestimmt in die CodeLib. Man denke nur an andere (bereits erwähnte) Fallstellungen: Kartenspiele, "Abzählreime" u.a.

[negaH]

Zitat:

1. Du hast Recht: Mischen muß man nicht mehr, das wäre genauso verfälschend, wie es das "Zurücklegen" der Kugel wäre.

Nich ganz. Man kann sehr wohl eine Liste von 49 Zahlen erzeugen. Diese Liste wird gemischt und das 1. Element wird aus der Liste entfernt.
Nun sind 48 Elemente in der Liste. Die Liste wird erneut gemischt und das 1. Element wird entfernt.
Nun 47 Elemente mischen und 1. entfernen, usw. usw.
Wichtig ist nur das
1.) die Anzahl der Elemente nach rausnehmen reduziert wird
2.) das immer an festem Index das Element gezogen wird
3.) das nach dem Ziehen die Liste immer wieder neu gemischt wird
4.) das das Mischen der Liste die Anzahl der Elemente in der Liste berücksichtig, also man berechnet bei einer Liste mit 46 Elemente zwei Indexe mit Random(46) und tauscht diese aus.
Man darf NICHT bei einer Liste mit 46 Elemente per Random(49) diese Indexe berechnen. Eigentlich logisch, da Random(46) eben mit 1/46 Wahrscheinlichkeit eine Zahl aus 0 bis 45 erzeugt.

Zitat:

2. Ich glaube, die "Ring"-Idee ist von mir ?! Aber ok, ok Hansa hats's codiert!

Sorry, da Hansa immer wieder sehr gerne mit verlinkten Listen und Zeigern arbeitet, dachte ich es käme von ihm :)

Gruß Hagen

[Billa]

...Full Ack... :thuimb:

[Hansa]

Toll, wenn die Urheber schon klar sind und keiner was macht. Das hier soll ein Ring werden, aber irgendwo ist ein Fehler:

Delphi-Quellcode:

procedure VorLottoZiehung;  // Lottotrommel mit 49 Kugeln füllen
var i : byte;
    neu : PKugel;
begin
  anfang := nil;
  i := 1;
  new (neu);
  neu^.wert := i;
  neu^.naechst := anfang;
  anfang := neu;
  kugel := anfang;
  for i := 2 to MaxKugeln do begin
    new (neu);
    neu^.wert := i;
    neu^.naechst := kugel;
    new (kugel);
    kugel := neu;
  end;
  new (ende);                    // verkettete Liste ist fertig
  ende := kugel;
  ende^.naechst := anfang;       // jetzt ist der Kreis geschlossen !!
end;

Muß ein dummer Fehler sein. Auf Anhieb sehe ich ihn aber nicht. Wer wollte den Ring noch bauen ? Dürfte einfach zu finden sein, aber ich habe mich jetzt verhackstückelt.

Und so wollte ich mal die "sich drehende Lottotrommel" simulieren (vorerst sortiert) :

Delphi-Quellcode:

procedure KugelnPruefen (e : integer);  // Ziehungsbeamter, haha
var i,
    ElementeWeiter : integer;
begin
  randomize;
  Kugel := anfang;
  while kugel <> ende do begin
    form1.memo2.Lines.Add(IntToStr (Kugel^.wert));
    Kugel := Kugel^.naechst;
  end;
end;

Ich vermute mal, mit dem anfang und dem ende, da stimmt was nicht.

[axelf98]

Meine Lösung für das Problem:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i      :    integer;
    X      :    Cardinal;
    S      :    String;
    Zahlen :    Array[1..6] of Cardinal;
    Wahr   :    Array[1..49] of Boolean;
begin

  Randomize;

  for i := 1 to 6 do
  begin
   Repeat X := Random(49) + 1  until not Wahr[X];
   Zahlen[i] := X;
   Wahr[X] := true;
  end;
  
  for i := 1 to 6 do S := S + '   ' + inttostr(Zahlen[i]);  
  edit1.Text := S;   // Ausgabe

end;

[negaH]

Zitat:

(M)keine Lösung für das Problem:

Hast du wirklich die Positings in diesem Thread gelesen ?

[Hansa]

hat er nicht. :mrgreen:

[Billa]

Hallo zusammen,

@negaH: Sorry, aber ich hatte wirklich viel zu tun und war ein paar Tage nicht up-to-date.... :oops:

Hier ist jetzt meine kleine "Spontanlösung". Die hat sicherlich noch reichlich Mängel, und ich habe nicht alle Eure Postings berücksichtigt. Aber sei's drum:

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  MaxKugeln = 49;

type
  PElement = ^TElement;
  TElement = record
            Wert : integer;
            Text : string;
            Next : PElement;
          end;

var
  Anfang : PElement;
  AnzKugeln : Integer;

procedure RingErzeugen( var Anfang : PElement; var AnzElemente : Integer; MaxElemente : integer );
var
  i : integer;
  Element : PElement;
begin

  // 1.Element auf alle Fälle erzeugen erzeugen
  try
    New( Anfang );
    with Anfang^ do
    begin
      Wert := 1;
      Text := IntToStr( Wert ); // beliebig, aber beim Lotto eben ein Zahlensymbol
      New( Next );
      Next := Anfang;   // Ring schließen
    end;
    AnzElemente := 1;
  except
  end;

  // falls erfolgreich, folgende Elemente erzeugen und in den Ring "einklinken"
  if AnzElemente = 1 then
  for i := 2 to MaxElemente do
  begin
    try
      New( Element );     //erzeugen
      with Element^ do
      begin
        Wert := i;
        Text := IntToStr( Wert );   // benennen
        New( Next );
        Next := Anfang^.Next;   // Ring schließen
      end;
      Anfang^.Next := Element;
      Inc( AnzElemente );
    except
    end;
  end;
  // kleiner "Schönheitsfehler": die Reihe ist absteigend geordnet, aber es müssen ja 
  // keine Zahlen sein...
end;

procedure EntnehmeElement( var Anfang : PElement; var Ergebnis : TElement; var AnzElemente : integer );
var
  Hilfszeiger : PElement;
  i,
  Zufallszahl : Integer;
begin
  if AnzElemente <> 0 then
  begin

    // Es ist nützlich, nicht das gesuchte Element,
    // sondern seinen Vorgänger zu finden, da sonst
    // wegen der einfachen Verkettung der Vorgänger
    // mühsam gesucht werden müsste ...
    // ( also nicht wie üblich Random(X)+1 )
    // ...und damit sich auf jeden Fall etwas "bewegt"
    // wird einfach die Anzahl der Elemente addiert.
    // Das ist beim Durchlaufen des Rings neutral.
    // ( und nur Spielerei )
    Zufallszahl := Random( AnzElemente ) + AnzElemente;

    // bewege den Zeiger zum ausgelosten Element
    for i := 1 to Zufallszahl do
      Anfang := Anfang^.Next;
    // Wert zuweisen
    Ergebnis := Anfang^.Next^;

    // Element aus dem Ring entfernen
    Hilfszeiger := Anfang^.Next;
    Anfang^.Next := Hilfszeiger^.Next;
    try
      Dispose( Hilfszeiger );
      Dec( AnzElemente );
    except
    end;

  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Run : integer;
  Ergebnis : TElement;
begin

  // Vorbereitung
  Randomize;
  Memo1.Lines.Clear;

  // Aufbauen  ....
  RingErzeugen( Anfang, AnzKugeln, MaxKugeln );

  // Lotto spielen  ....
  for Run := 1 to 7 do
  begin
    EntnehmeElement( Anfang, Ergebnis, AnzKugeln );
    Memo1.Lines.Add( Ergebnis.Text );
  end;

  // Abräumen  ....
  while AnzKugeln > 0 do
    EntnehmeElement( Anfang, Ergebnis, AnzKugeln );

end;

end.

...und jetzt werden die Bestien mich zerreissen... :mrgreen:

[axelf98]

Na dann eben nicht!