Latin négyzet (3. verzió)

Az előző két Latin négyzet-generáló programokhoz képest ez a program kész meglepetés. A megengedett maximális oldalméret 100 x 100. Bármilyen oldalméretet is választunk, a program észrevétlenül gyorsan generál véletlen Latin négyzetet. A trükk felfedezését érdeklődő olvasóimra bízom. A generált táblázatot itt is lemezre menthetjük.

A Latin négyzetek nagy segítséget nyújtanak az egyik kedvelt rejtvény, a Soduku tábláinak előállításában. Nem lehetetlen, hogy az órarendkészítő programok is használni tudnak, elég nagy oldalszámú Latin négyzetet.

A program futási képe:

A program listája:

unit ULUjLatin;

interface

uses
  Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

type
TfmLUJLatin = class(TForm)
lbLatin: TLabel;
edN: TEdit;
btStart: TButton;
btKilep: TButton;
sgLatin: TStringGrid;
btMentes: TButton;
edNev: TEdit;
procedure btKilepClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure btMentesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const Max=100;
var
fmLUJLatin: TfmLUJLatin;
  N: Word;
  T: Array[1..Max,1..Max] Of Word;
P: Array[1..Max] Of Word;
DNev: String;
FText: Text;

implementation

{$R *.DFM}

procedure TfmLUJLatin.btKilepClick(Sender: TObject);
begin
Close;
end;

procedure TfmLUJLatin.FormCreate(Sender: TObject);
begin
Randomize;
end;

procedure TfmLUJLatin.btStartClick(Sender: TObject);
Var I, J, K, L, PP, M: Word;
begin
  N:= StrToInt(edN.Text); If N>Max Then Exit;
edNev.Text:= edN.Text;
For I:= 1 To N Do P[I]:= I; M:= Max+Random(Max);
For I:= 1 To M Do
Begin
    K:= Random(N)+1; L:= Random(N)+1;
    PP:= P[K]; P[K]:= P[L]; P[L]:= PP;
End;
For I:= 1 To N Do T[I,1]:= P[I];
For J:= 2 To N Do
Begin
For I:= 1 To N-1 Do T[I,J]:= T[I+1,J-1];
    T[N,J]:= T[1,J-1];
End;
  M:= Max+Random(Max);
For I:= 1 To M Do
Begin
    K:= Random(N)+1; L:= Random(N)+1;
For J:= 1 To N Do P[J]:= T[K,J];
For J:= 1 To N Do T[K,J]:= T[L,J];
For J:= 1 To N Do T[L,J]:= P[J];
End;
  M:= Max+Random(Max);
For I:= 1 To M Do
Begin
    K:= Random(N)+1; L:= Random(N)+1;
For J:= 1 To N Do P[J]:= T[J,K];
For J:= 1 To N Do T[J,K]:= T[J,L];
For J:= 1 To N Do T[J,L]:= P[J];
End;
With sgLatin Do
Begin
ColCount:= N+1; RowCount:= N+1;
For I:= 1 To N Do
Begin
Cells[I,0]:= IntToStr(I);
Cells[0,I]:= IntToStr(I);
End;
For I:= 1 To N Do For J:= 1 To N Do Cells[I,J]:= IntToStr(T[I,J]);
End;
end;

procedure TfmLUJLatin.btMentesClick(Sender: TObject);
Var I, J: Word;
begin
DNev:= edNev.Text+'.csv';
AssignFile(FText,DNev); ReWrite(FText);
With sgLatin Do
For I:= 1 To RowCount-1 Do
Begin
For J:= 1 To ColCount-1 Do Write(FText,Cells[J,I],';');
WriteLn(FText);
End;
CloseFile(FText);
end;

end.