Lotto Systemspiele berechnen

[Bjoerk]

Hab’s mir mal gegeben. Sollte funktionieren.

Delphi-Quellcode:

unit uLottoTipp;

interface

uses
  Classes;

type
  TLottoVektor = array of integer;
  TLottoMatrix = array of array of integer;

  TLottotipp = class(TObject)
  private
    FList: TList;
    FTipp: TLottoVektor;
    FTipps: TLottoMatrix;
    FCount, FN1, FN2: integer;
    function GetFTipp(I: integer): integer;
    function GetFTipps(I, J: integer): integer;
  public
    property Count: integer read FCount;
    property N1: integer read FN1;
    property N2: integer read FN2;
    property Tipp[I: integer]: integer read GetFTipp;
    property Tipps[I, J: integer]: integer read GetFTipps;
    procedure GetTipp(const Index: integer);
    constructor Create(const Count, N1, N2: integer); overload;
    constructor Create(const N1, N2: integer); overload;
    destructor Destroy; override;
  end;

  TSystemLottotipp = class(TObject)
  private
    FList: TList;
    FTipp: TLottoVektor;
    FTipps: TLottoMatrix;
    FCount, FN, FN1, FN2: integer;
    function GetFTipp(I: integer): integer;
    function GetFTipps(I, J: integer): integer;
    procedure SetTipp;
  public
    property Count: integer read FCount;
    property N: integer read FN;
    property N1: integer read FN1;
    property N2: integer read FN2;
    property Tipp[I: integer]: integer read GetFTipp;
    property Tipps[I, J: integer]: integer read GetFTipps;
    procedure GetTipps;
    constructor Create(const N, N1, N2: integer);
    destructor Destroy; override;
  end;

  function NueberK(const N, K: integer): integer;

implementation

function NueberK(const N, K: integer): integer;
var
  I: integer;
begin
  Result:= 1;
  for I:= 1 to K do
    Result:= Result*(N-I+1) div I;
end;

function InTippsList(const Index, N1: integer; const Tipps: TLottoMatrix): boolean;
var
  I, J: integer;
begin
  Result:= false;
  for I:= 0 to Index-1 do
  begin
    J:= 0;
    while (J <= N1-1) and (Tipps[Index, J] = Tipps[I, J]) do
    begin
      if J = N1-1 then
      begin
        Result:= true;
        Exit;
      end
      else
        Inc(J);
    end;
  end;
end;


{ TLottotipp }


constructor TLottotipp.Create(const Count, N1, N2: integer);
begin
  // N1 <= N2
  // Count <= N2 über N1
  inherited Create;
  FList:= TList.Create;
  FCount:= Count;
  FN1:= N1;
  FN2:= N2;
  SetLength(FTipp, FN1);
  SetLength(FTipps, FCount, FN1);
  Randomize;
end;

constructor TLottotipp.Create(const N1, N2: integer);
begin
  Create(1, N1, N2);
end;

destructor TLottotipp.Destroy;
begin
  FList.Free;
  SetLength(FTipp, 0);
  SetLength(FTipps, 0);
  inherited Destroy;
end;

function TLottotipp.GetFTipp(I: integer): integer;
begin
  Result:= FTipp[I];
end;

function TLottotipp.GetFTipps(I, J: integer): integer;
begin
  Result:= FTipps[I, J];
end;

procedure TLottotipp.GetTipp(const Index: integer);
var
  I, J, T: integer;
begin
  repeat
    FList.Clear;
    for I:= 1 to FN2 do
      FList.Add(Pointer(I));
    for I:= 0 to FN1-1 do
    begin
      J:= Random(FList.Count);
      FTipp[I]:= Integer(FList[J]);
      FList.Delete(J);
    end;
    for I:= 0 to FN1-2 do
      for J:= I+1 to FN1-1 do
      if FTipp[I] > FTipp[J] then
      begin
        T:= FTipp[I];
        FTipp[I]:= FTipp[J];
        FTipp[J]:= T;
      end;
    for J:= 0 to FN1-1 do
      FTipps[Index, J]:= FTipp[J];
  until not InTippsList(Index, FN1, FTipps);
end;


{ TSystemLottotipp }


constructor TSystemLottotipp.Create(const N, N1, N2: integer);
begin
  // N1 <= N2
  // N >= N1, N <= N2
  inherited Create;
  FList:= TList.Create;
  FN:= N;
  FN1:= N1;
  FN2:= N2;
  SetLength(FTipp, FN);
  FCount:= NueberK(FN, FN1);
  SetLength(FTipps, FCount, FN1);
  Randomize;
end;

destructor TSystemLottotipp.Destroy;
begin
  FList.Free;
  SetLength(FTipp, 0);
  SetLength(FTipps, 0);
  inherited Destroy;
end;

function TSystemLottotipp.GetFTipp(I: integer): integer;
begin
  Result:= FTipp[I];
end;

function TSystemLottotipp.GetFTipps(I, J: integer): integer;
begin
  Result:= FTipps[I, J];
end;

procedure TSystemLottotipp.SetTipp;
var
  I, J, T: integer;
begin
  FList.Clear;
  for I:= 1 to FN2 do
    FList.Add(Pointer(I));
  for I:= 0 to FN-1 do
  begin
    J:= Random(FList.Count);
    FTipp[I]:= Integer(FList[J]);
    FList.Delete(J);
  end;
  for I:= 0 to FN-2 do
    for J:= I+1 to FN-1 do
    if FTipp[I] > FTipp[J] then
    begin
      T:= FTipp[I];
      FTipp[I]:= FTipp[J];
      FTipp[J]:= T;
    end;
end;

procedure TSystemLottotipp.GetTipps;
var
  I, J, Index, T: integer;
  A: boolean;
  ATipp: TLottoVektor;
begin
  SetTipp;
  SetLength(ATipp, FN1);
  Index:= 0;
  repeat
    repeat
      FList.Clear;
      for I:= 0 to FN-1 do
        FList.Add(Pointer(I));
      for I:= 0 to FN1-1 do
      begin
        J:= Random(FList.Count);
        T:= Integer(FList[J]);
        ATipp[I]:= FTipp[T];
        FList.Delete(J);
      end;
      for I:= 0 to FN1-2 do
        for J:= I+1 to FN1-1 do
        if ATipp[I] > ATipp[J] then
        begin
          T:= ATipp[I];
          ATipp[I]:= ATipp[J];
          ATipp[J]:= T;
        end;
      for J:= 0 to FN1-1 do
        FTipps[Index, J]:= ATipp[J];
      A:= InTippsList(Index, FN1, FTipps);
      if not A then Inc(Index);
    until not A;
  until Index = FCount;
end;

end.

Delphi-Quellcode:

unit LottoTippUnit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  uLottoTipp;

function LottoTippString(const LottoTipp: TLottoTipp; const I: integer): string;
var
  J: integer;
begin
  Result:= '';
  for J:= 0 to LottoTipp.N1-1 do
    Result:= Result + IntToStr(LottoTipp.Tipps[I, J])+'   ';
  Result:= TrimRight(Result);
end;

function SystemLottoTippString(const LottoTipp: TSystemLottoTipp; const I: integer): string;
var
  J: integer;
begin
  Result:= '';
  for J:= 0 to LottoTipp.N1-1 do
    Result:= Result + IntToStr(LottoTipp.Tipps[I, J])+'   ';
  Result:= TrimRight(Result);
end;

function TheSystemLottoTippString(const LottoTipp: TSystemLottoTipp): string;
var
  I: integer;
begin
  Result:= '';
  for I:= 0 to LottoTipp.N-1 do
    Result:= Result + IntToStr(LottoTipp.Tipp[I])+'   ';
  Result:= TrimRight(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LottoTipp: TLottoTipp;
  I: integer;
begin
  // LottoTipp:= TLottoTipp.Create(NueberK(49, 6), 6, 49); // AUA
  LottoTipp:= TLottoTipp.Create(100, 6, 49);
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  try
    for I:= 0 to LottoTipp.Count-1 do
      LottoTipp.GetTipp(I);
    Caption:= IntToStr(LottoTipp.Count)+' Tipps';
    for I:= 0 to LottoTipp.Count-1 do
      Memo1.Lines.Add(LottoTippString(LottoTipp, I));
  except
    on E: Exception do
      ShowMessage('Fehler vom Typ: '+E.ClassName+', Meldung: '+E.Message);
  end;
  LottoTipp.Free;
  Memo1.Lines.EndUpdate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LottoTipp: TSystemLottoTipp;
  I: integer;
begin
  LottoTipp:= TSystemLottoTipp.Create(16, 6, 49);
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  try
    LottoTipp.GetTipps;
    Caption:= IntToStr(LottoTipp.Count)+' Tipps';
    Memo1.Lines.Add(TheSystemLottoTippString(LottoTipp));
    Memo1.Lines.Add('');
    for I:= 0 to LottoTipp.Count-1 do
      Memo1.Lines.Add(SystemLottoTippString(LottoTipp, I));
  except
    on E: Exception do
      ShowMessage('Fehler vom Typ: '+E.ClassName+', Meldung: '+E.Message);
  end;
  LottoTipp.Free;
  Memo1.Lines.EndUpdate;
end;

end.