Gépi órarendkészítő demonstrációs program

Az Órarend menüpontban említettem, hogy a TANFORDI több gépi órarendkészítő rutinnal is rendelkezik. Ebben a demonstrációs programban ízelítőt kaphatunk a gépi órarend-generálás nehézségeiből. A program a tantárgyfelosztást és az órarendet is automatikusan készíti. Ebből adódóan nem valószínű, hogy az előállított órarend egy valós esetre, egy az egyben alkalmazható lenne. Nem is ez a program célja, hanem az, hogy egy olyan algoritmust mutasson be, melyet finomítva, gyakorlati órarendkészítésre is alkalmassá tehetünk.

Először a program paramétereit ismertetném. Mint már említettem, magát a tantárgyfelosztást is a gép készíti. Az osztályok száma 32, a pedagógusoké 50, és minden pedagógusnak maximum heti 26 órája lehet. Az osztályok jelei: 1.a-1.h, 2.a-2.h, 3.a-3.h és 4.a-4.h. A pedagógusok neve az egyszerűség kedvéért az angol ABC nagy és kis betűi lettek a Z és z kivételével, azaz: ABC…Y és abc…y.

A program minden osztálynak 30 órát generál: egy 5-órás, kettő 4-órás, három 3-órás és négy 2-órás tantárggyal. Az osztályokban minden tantárgyat más-más pedagógus tanít, ebből adódóan a tantárgyakat a pedagógusok neve helyettesítheti, azaz a program nem tartalmaz tantárgyneveket. Ugyancsak nincs a programban tanterem (minden osztály a saját tantermében tartja óráit), nincs csoportbontás és csoportösszevonás sem (mint általában az 5.-8. évfolyamon). Az alkalmazott rendező algoritmus hatékonyságát mindezek természetesen befolyásolják, úgy gondolom, hogy könnyítik, de használhatatlanná nem teszik. Ha a valós esetnek megfelelő részek is bekerülnek, akkor az algoritmus több lépésre kényszerül, de a végső megoldáshoz elég jól konvergál akkor is. A látszólag gyengébb feltételek mellett van egy nagyon szigorú is: csak teljesen tömör órarendet fogad el megoldásnak, azaz a 32 osztály 960 óráját öt napra, napi 6 órában helyezi el (vagyis nem lehet sem lyukasóra, sem hetedik).

Az algoritmus leírásában előforduló fogalmak részletes magyarázatára térnék át. Először az órarendfeltöltést irányító paraméterekről essen szó. Az alapértékek feltöltése után minden továbbit hozzáadjuk a már benne lévőkhöz:

- Lehetőségvektor: a napi paramétereket ide töltjük be. Az órák betöltési időpontjának kiválasztása a lehetőségvektor napi maximumai közül történik.

- Napi paraméterek: a hét minden órájához tartozik egy paraméter, mely a harmadik órára a legnagyobb 3100, a második és negyedik óra értéke 2900, az első értéke 2600, az ötödik óra 2400 értékű, míg a hatodik értéke 2000. A hetedik, nem megengedett óra paramétere pedig 100. Ezek az alapértékek a lehetőségvektorok feltöltésekor.

- Hétvége paraméter: gyakorlatilag egy 5 elemű vektor, mely a hét első és utolsó napjára nullát, a többi napra egy pozitív értéket tartalmaz.

- Periodicitás paraméter: a tantárgy heti óraszámának megfelelő eltolást hoz létre. Heti egy és négy óra esetén véletlenül választ a hét napjai közül, három órás tárgynál hétfőt, szerdát és pénteket helyezi előtérbe, kétórásnál keddet és csütörtököt.

- Szomszédossági paraméter: a pedagógusok tömörebb órarendjének létrehozását segíti. Ha egy pedagógusnak van valahol már órája, akkor a következőt a meglévők mellé szeretné tenni.

- Óraszám kiegyenlítés: mivel minden pillanatban 32 órát kell ellátni, igyekezni kell a betöltés menete közben is az órák egyenletes eloszlására. Ez a paraméter ezt hivatott szolgálni.

- Kritikus időpont kiemelése: mivel minden osztálynak, minden időpontban kell órájának lenni, az algoritmus megkeresi az e tekintetben legkritikusabb időpontot és osztályt, majd erre az időpontra a lehetőségvektorban nagyon magas értéket állít be, hogy minél nagyobb valószínűséggel az időpont kiválasztódjon a betöltéshez.

Az algoritmus kiválasztási eljárásában nagyon fontos a tétel heti óraszáma. Minél több óra van a héten egy tantárgyból, annál fontosabbnak tartja és a betöltéskor, ha lehet, mindig a magasabb óraszámút választja. A másik tétel kiválasztási elv alapja a relatív betöltöttség. Ezek pedagógusokra és osztályokra értelmezett, a betöltési folyamat során folyamatosan csökkenő értékű paraméterek (természetesen tétel törlésekor nőhetnek). A relatív betöltöttség a betöltendő órák száma osztva, a betöltési lehetőségek számával. Ez az érték induláskor mindig kisebb, mint egy, és minden betöltési lépés után csökken, végül nulla lesz. Minél magasabb a relatív betöltöttsége egy pedagógusnak vagy osztálynak, annál nehezebb az órák elhelyezése. A tételek kiválasztásakor ezért mindig a lehető legnagyobb relatív betöltöttség szerinti pedagógust illetve osztályt választja a program.

A tétel kiválasztási rendet öt szakaszra osztottam, melyet a lépésszám 5-ös modulusával vezérlek.

- 0-ra: a legnagyobb relatív betöltöttségű osztályt választjuk,

- 1-re: a legnagyobb relatív betöltöttségű pedagógust választjuk,

- 2-re: kritikus osztály időpontot keresünk,

- 3-ra: azt a pedagógust, aki miatt a legtöbbször kellett az órarendet törölni,

- 4-re: azt az osztályt, amelyik miatt a legtöbbször kellett az órarendet törölni.

Az algoritmus olyan, hogy a kiválasztás után mindenképp beírja az órarendbe a tanítási tételt. Utána ellenőrzi, hogy nem került-e hetedik órára. Ha igen, akkor az érintett osztály teljes órarendjét törli. Így nem képzelhető el, hogy hetedik óra maradjon az órarendben. A törlést felváltva könyveli egyszer a pedagógusnak, egyszer az osztálynak.

A program a betöltés közben számolja, hogy az egyes osztályok és pedagógusok hányszor szerepeltek betöltésben. Azért, hogy az algoritmus ne ragadjon bent egy állandóan (újra meg újra) kiválasztott pedagógusnál vagy osztálynál, teljes törlést hajt végre az órarendre. Ezt akkor teszi, ha pedagógusnál a kezelési szám meghaladja az osztályok számának a négyzetét, osztályoknál pedig az osztályok száma négyzetének a kétszeresét.

Természetesen a paraméterekkel kísérletezhetünk. Ha egy feltételt fontosabbnak tartunk, akkor a listában lévő értéktől nagyobbat adatunk neki. Hasonlóan módosíthatjuk a pedagógusok, illetve a pedagógusok heti maximális óraszámát is. Ha a pedagógusok számát csökkentjük, akkor a keresési lépésszám növekedni kezd. Ezzel a változatással óvatosan bánjunk, a programba nincs beépítve a lehetetlen tantárgyfelosztás esete, és végtelen ciklusba eshet a program. Ne állítsunk be például 20 pedagógust, mert azok nem tudnak 960 órát megtartani. Ha az előző futtatáshoz képest a pedagógusok számát módosítottuk, akkor a TFO.DAT állományt a futtatási mappából el kell távolítani, hiszen a megváltozott rekordszám miatt az állományt nem tudja a program elolvasni. Arra az esetre, ha a program nagyon hosszú időt venne igénybe a feltöltéshez, egy 2000*(osztályok száma) limit van beállítva a maximális lépésszámra, mely természetesen szintén módosítható.

Futtatás után a program a teljes pedagógus tantárgyfelosztást és órarendet lemezre menti, melyet a következő futtatáskor betölt. A képernyőn váltani lehet a pedagógus tantárgyfelosztás, pedagógus órarend és osztály órarend látványa közül. Órarend generálásakor valamelyik órarend és a relatív betöltöttségek látszanak. A gyorsabb futás érdekében csak minden századik lépésre frissül a képernyő. A listabeli értékekre a betöltési lépésszám 1600-16000 között van, egy közepes teljesítményű mai PC-n ez 16-160 másodperc. A képernyőn feltöltés közben látszik a lépésszám és az újraindítások száma. Nyomógombbal új tantárgyfelosztást kérhetünk, törölhetünk csak órarendeket és válthatunk a imént említett nézetek között.

A program formja tervező nézetben:

A program futási képei. Pedagógus tantárgyfelosztás:

Elkészült pedagógus órarend:

Elkészült osztályórarend:

A program listája:

{**********************************************
**                                           **
** Gépi órarendkészítő demonstrációs program **
**     Készítette: Görbe Mihály (GM-Soft)    **
**                2010. Július               **
**                                           **
**********************************************}

unit UGOD;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

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

Const OSz= 32;                       //osztályok száma

type
  TfmGOD = class(TForm)
    btKilepes: TButton;
    btTFGeneral: TButton;
    sgTF: TStringGrid;
    btTFOR: TButton;
    sgOR: TStringGrid;
    btFeltolt: TButton;
    edLepes: TEdit;
    btOrarendTorlo: TButton;
    edReset: TEdit;
    lbLepes: TLabel;
    lbRestart: TLabel;
Procedure Lemezrol;
Procedure Lemezre;
Procedure OTFeORTolt;
Procedure OraTorlo;
Procedure PTFKepre;
Procedure PedORKepre;
Procedure OszORKepre;
Function PRelBet(P: Word): Real;
Function MaxPRelBet: Word;
Function ORelBet(O: Word): Real;
Function MaxORelBet: Word;
Function OszMaxP(O: Word): Word;
Function PedMaxO(P: Word): Word;
Procedure OPLehetoseg;
Procedure OPLMin(Var O, D, H: Word);
Function MaxPORelBet(O, D, H: Word): Word;
Procedure OTorlo(O: Word);
Function MaxPUjra: Word;
Function MaxOUjra: Word;
Procedure ReStart;
Procedure GepiBetolto;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btTFGeneralClick(Sender: TObject);
procedure btTFORClick(Sender: TObject);
procedure btFeltoltClick(Sender: TObject);
procedure btOrarendTorloClick(Sender: TObject);
procedure sgORDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure sgTFDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure sgTFClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

  St1=String[1];                     //1 karakter hosszú string típus
  St3=String[3];                     //3 karakter hosszú string típus

  TTTetel=Record //tanítási tétel
    OSza: Word;                      //óraszám
    Beir: Boolean;                   //beírt esetén TRUE egyébként FALSE
End;

  TPTFO=Record //pedagógus tant.-felosztása és órarendje
    PRov: St1;                       //pedagógus névrövidítése
    PTFe: Array[1..OSz] Of TTTetel;  //pedagógus tantárgyfelosztása
    POra: Array[1..5,1..7] Of Word;  //pedagógus órarendje
End;

Const PSz= 50;                       //pedagógusok száma
      POMax= 26;                     //pedagógusok maximális heti óraszáma
      Oszt: Array[1..Osz] Of St3=    //alapértelmezett osztálynevek
            ('1.a','1.b','1.c','1.d','1.e','1.f','1.g','1.h',
             '2.a','2.b','2.c','2.d','2.e','2.f','2.g','2.h',
             '3.a','3.b','3.c','3.d','3.e','3.f','3.g','3.h',
             '4.a','4.b','4.c','4.d','4.e','4.f','4.g','4.h');
      PedN: String[PSz]=             //alapértelmezett pedagógusnevek
             'ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxy';
      NPar: Array[1..7] Of Word=     //napi paraméterek
            (2600,2900,3100,2900,2400,2000,100);
      PerP= 300;                     //periodicitás paraméter
      SzoP= 150;                     //szomszédossági paraméter
      HVeg= 100;                     //hétvége paraméter
      OKie=  50;                     //Napi óraszámkiegyenlítő paraméter
      HetN= 'HKSCP';                 //a hét napjai

var
  fmGOD: TfmGOD;
  ACol,ARow: Integer;
  PTFO: Array[1..PSz] Of TPTFO;      //az adatállomány
  DNev: String;                      //az adatállomány OS-beli neve
  FNev: File Of TPTFO;               //az adatállomány logikai neve
  TFPOROOR: Word;                    //1: TF, 2: POR, 3: OOR látható
  POSza: Array[1..PSz] Of Word;      //pedagógusok heti óraszáma
  OOSza: Array[1..OSz] Of Word;      //osztályok heti óraszáma
  PRelB: Array[1..PSz] Of Real;      //pedagógus relatív betöltöttség
  ORelB: Array[1..OSz] Of Real;      //osztály relatív betöltöttség
  OTFe: Array[1..OSz,1..PSz] Of TTTetel;   //osztály tantárgyfelosztás
  OOra: Array[1..OSz,1..5,1..7] Of Word;   //osztály órarend
  LVekt: Array[1..5,1..7] Of Word;   //lehetőségvektor
  OPLeh: Array[1..OSz,1..5,1..7] Of Word;  //osztály-pedagógus lehetőségek
  Faz: Word;                         //fázis: 0-4 értékek egyike
  Lep: LongInt;                      //a gépi betöltő hívási száma
  Veg: Boolean;                      //betöltést leállító
  Res: Word;                         //teljes újraindítások száma
  OKsz: Array[1..OSz] Of Word;       //osztály kiválasztási szám
  OUjr: Array[1..OSz] Of Word;       //osztály újraindítási szám
  PKsz: Array[1..PSz] Of Word;       //pedagógus kiválasztási szám
  PUjr: Array[1..PSz] Of Word;       //pedagógus újraindítási szám

implementation

{$R *.dfm}

Procedure TfmGOD.Lemezrol;           //adatok betöltése lemezről
Var I: Word;
Begin
  I:= 0;
  AssignFile(FNev,DNev); {$I-}Reset(FNev);{$I+}
If IOResult<>0 Then ReWrite(FNev) Else
While Not EOF(FNev) Do Begin Inc(I); Read(FNev,PTFO[I]) End;
  CloseFile(FNev);
End;

Procedure TfmGOD.Lemezre;            //adatok lemezre írása
Var I: Word;
Begin
  AssignFile(FNev,DNev); ReWrite(FNev);
For I:= 1 To PSz Do Write(FNev,PTFO[I]);
  CloseFile(FNev);
End;

Procedure TfmGOD.OTFeORTolt;         //osztályórarendek feltöltése
Var I, J, K: Word;
Begin
For I:= 1 To OSz Do For J:= 1 To PSz Do With OTFe[I,J] Do
Begin OSza:= 0; Beir:= False End;
For K:= 1 To PSz Do With PTFO[K] Do
Begin
For I:= 1 To OSz Do With PTFe[I] Do If OSza<>0 Then
Begin
      OTFe[I,K].OSza:= OSza;
      OTFe[I,K].Beir:= Beir;
End;
For I:= 1 To 5 Do For J:= 1 To 7 Do If POra[I,J]<>0 Then
    OOra[POra[I,J],I,J]:= K;
    PRelBet(K);
End;
For I:= 1 To OSz Do ORelBet(I);
End;

Procedure TfmGOD.OraTorlo;           //órarendek törlése
Var I, J, K: Word;
Begin
For K:= 1 To PSz Do With PTFO[K] Do
Begin
For I:= 1 To 5 Do For J:= 1 To 7 Do POra[I,J]:= 0;
For I:= 1 To OSz Do PTFe[I].Beir:= False;
End;
For K:= 1 To OSz Do
Begin
For I:= 1 To 5 Do For J:= 1 To 7 Do OOra[K,I,J]:= 0;
For I:= 1 To PSz Do OTFe[K,I].Beir:= False;
End;
With sgOR Do Cells[ColCount-1,0]:= '';
For I:= 1 To PSz Do PRelBet(I);
For I:= 1 To OSz Do ORelBet(I);
For I:= 1 To PSz Do PUjr[I]:= 0;
For I:= 1 To OSz Do OUjr[I]:= 0;
End;

procedure TfmGOD.btKilepesClick(Sender: TObject);  //kilépés a programból
begin
  Lemezre;
  Close;
end;

Procedure TfmGOD.PTFKepre;           //pedagógus tantárgyfelosztás képernyőre
Var I, J, N: Word;
Begin
For I:= 1 To OSz Do OOSza[I]:= 0;
With sgTF Do
Begin
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
For I:= 1 To PSz Do With PTFO[I] Do
Begin
      Cells[0,I]:= PRov; N:= 0;
For J:= 1 To OSz Do With PTFe[J] Do
Begin
        Inc(N,OSza); Inc(OOSza[J],OSza);
If OSza<>0 Then Cells[J,I]:= IntToStr(OSza);
End;
      Cells[ColCount-1,I]:= IntToStr(N); POsza[I]:= N;
End;
For I:= 1 To OSz Do Cells[I,RowCount-1]:= IntToStr(OOSza[I]);
End;
For I:= 1 To PSz Do PRelBet(I);
For I:= 1 To OSz Do ORelBet(I);
End;

Procedure TfmGOD.PedORKepre;         //pedagógus órarend képernyőre
Var I, J, K: Word;
Begin
With sgOR Do
Begin
    sgTF.Visible:= False; Visible:= True;
    Cells[0,0]:= 'POR';
For I:= 0 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
For K:= 1 To PSz Do With PTFO[K] Do
Begin
      Cells[0,K]:= PRov; Cells[ColCount-1,K]:= FloatToStr(PRelB[K]);
For I:= 1 To 5 Do For J:= 1 To 7 Do If POra[I,J]<>0 Then
      Cells[7*(I-1)+J,K]:= Oszt[POra[I,J]];
End;
End;
End;

Procedure TfmGOD.OszORKepre;         //osztály órarend képernyőre
Var I, J, K: Word;
Begin
With sgOR Do
Begin
    sgTF.Visible:= False; Visible:= True;
    Cells[0,0]:= 'OOR';
For I:= 0 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
For K:= 1 To OSz Do
Begin
      Cells[0,K]:= Oszt[K]; Cells[ColCount-1,K]:= FloatToStr(ORelB[K]);
For I:= 1 To 5 Do For J:= 1 To 7 Do If OOra[K,I,J]<>0 Then
      Cells[7*(I-1)+J,K]:= PTFO[OOra[K,I,J]].PRov;
End;
End;
End;

Function TfmGOD.PRelBet(P: Word): Real; //P pedagógus relativ betöltöttsége
Var I, J, K, Bs, Ls: Word; Pr: Real;    //Bs: beírt, Ls: lehetőségek száma
    Lv: Array[1..5,1..7] Of Word;
Begin
  PRelBet:= 0; If P=0 Then Exit;
  Bs:= 0; Ls:= 0; For I:= 1 To 5 Do For J:= 1 To 7 Do Lv[I,J]:= 0;
With PTFO[P] Do
Begin
For I:= 1 To OSz Do //beírt órák száma
If PTFe[I].Beir Then Inc(Bs, PTFe[I].OSza);
For K:= 1 To OSz Do //lehetőségek száma
If (PTFe[K].OSza>0) And Not PTFe[K].Beir Then
For I:= 1 To 5 Do For J:= 1 To 7 Do
If (OOra[K,I,J]=0) And (POra[I,J]=0) Then Inc(Lv[I,J]);
For I:= 1 To 5 Do For J:= 1 To 7 Do If Lv[I,J]>0 Then Inc(Ls);
    Pr:= 0;
End;
If Ls>0 Then Pr:= Round(10000*(POSza[P]-Bs)/Ls)/10000;
  PRelB[P]:= Pr; PRelBet:= Pr;
//PRelBet:= be nem irt órák száma/ahány helyen még be tud menni osztályba
End;

Function TfmGOD.ORelBet(O: Word): Real;  //O osztály relatív betöltöttsége
Var I, J, K, Bs, Ls: Word; Pr: Real;
    Lv: Array[1..5,1..7] Of Word;
Begin
  ORelBet:= 0; If O=0 Then Exit;
  Bs:= 0; Ls:= 0; For I:= 1 To 5 Do For J:= 1 To 7 Do Lv[I,J]:= 0;
For I:= 1 To PSz Do //beírt órák száma
If OTFe[O,I].Beir Then Inc(Bs,OTFe[O,I].OSza);
For K:= 1 To PSz Do //lehetőségek száma
If Not OTFe[O,K].Beir Then With PTFO[K] Do
For I:= 1 To 5 Do For J:= 1 To 7 Do
If (OOra[O,I,J]=0) And (POra[I,J]=0) Then Inc(Lv[I,J]);
For I:= 1 To 5 Do For J:= 1 To 7 Do If Lv[I,J]>0 Then Inc(Ls); Pr:= 0;
If Ls>0 Then Pr:= Round(1000*(OOSza[O]-Bs)/Ls)/1000;
  ORelB[O]:= Pr; ORelBet:= Pr;
//ORelBet:= be nem irt órák száma/ahány helyen még ráérnek pedagógusok
End;

procedure TfmGOD.FormCreate(Sender: TObject);  //rendszer-start
Var I, J: Word;
begin
With sgTF Do
Begin
    Top:= 40;
    Left:= 8;
    Width:= 881;
    Height:= 666;
    ColCount:= 34;
    RowCount:= 52;
    ColWidths[0]:= 32;
    ColWidths[ColCount-1]:= 28;
    Cells[0,0]:= 'PTF';
    Cells[ColCount-1,0]:= 'Osz';
For I:= 1 To OSz Do Cells[I,0]:= Oszt[I];
    Visible:= True;
End;
  ACol:= 1; ARow:= 1;
With sgOR Do
Begin
    Top:= 40;
    Left:= 8;
    Width:= 881;
    Height:= 666;
    ColCount:= 37;
    RowCount:= 51;
    ColWidths[0]:= 32;
    ColWidths[36]:= 55;
For I:= 1 To 5 Do For J:= 1 To 7 Do
    Cells[7*(I-1)+J,0]:= HetN[I]+IntToStr(J);
    Visible:= False;
End;
  DNev:= 'TFO.dat';
  Lemezrol;
  Randomize;
  TFPOROOR:= 1;
  OTFeORTolt;
  PTFKepre;
end;

procedure TfmGOD.btTFGeneralClick(Sender: TObject); //TF generálása
Var I, J, K, L, N, P: Word;
begin
  btOrarendTorloClick(Sender);
If TFPOROOR>1 Then Begin TFPOROOR:= 3; btTFORClick(Sender) End;

For I:= 1 To PSz Do With PTFO[I] Do//pedagógus tantárgyfelosztás törlése
For J:= 1 To OSz Do With PTFe[J] Do Begin OSza:= 0; Beir:= False End;
For I:= 1 To PSz Do POSza[I]:= 0;  //pedagógusok óraszámának törlése
For I:= 1 To OSz Do OOSza[I]:= 0;  //osztályok óraszámának törlése
For I:= 1 To OSz                   //osztály tantárgyfelosztás törlése
Do For J:= 1 To PSz Do With OTFe[I,J] Do Begin OSza:= 0; Beir:= False End;
For I:= 1 To PSz Do PUjr[I]:= 0;   //újraindítási számok törlése
For I:= 1 To OSz Do OUjr[I]:= 0;
For I:= 1 To PSz Do PKSz[I]:= 0;   //kezelési számok törlése
For I:= 1 To OSz Do OKSz[I]:= 0;

For I:= 1 To PSz Do PTFO[I].PRov:= PedN[I]; //pedagógus névrövidítés töltése
//a tantárgyfelosztás generálása, minden osztályban:
//5+4+4+3+3+3+2+2+2+2=30 óra van, 10 tétel, összesen 320 tétel
For I:= 1 To OSz Do For J:= 1 To 4 Do For K:= 1 To J Do
Begin //egy osztályban egy pedagógus
Repeat //legfeljebb egy tárgyat taníthat
      P:= Random(PSz)+1;
      N:= 0; For L:= 1 To OSz Do Inc(N,PTFO[P].PTFe[L].OSza);
Until (PTFO[P].PTFe[I].OSza=0) And (N+(6-J)<=POMax);
    PTFO[P].PTFe[I].OSza:= 6-J;
End;
For I:= 1 To PSz Do With PTFO[I] Do//áttöltés az osztály-tantárgyfelosztásba
For J:= 1 To OSz Do With PTFe[J] Do OTFe[J,I].OSza:= OSza;

For I:= 1 To PSz Do With PTFO[I] Do//pedagógusok óraszáma
For J:= 1 To OSz Do Inc(POSza[I],PTFe[J].OSza);

For I:= 1 To OSz Do //osztályok óraszáma
For J:= 1 To PSz Do Inc(OOsza[I],OTFe[I,J].OSza);

For I:= 1 To PSz Do PRelBet(I);    //relatív betöltöttségek
For I:= 1 To OSz Do ORelBet(I);

  PTFKepre;
end;

procedure TfmGOD.btTFORClick(Sender: TObject); //váltás TF és OR képek között
begin
  Inc(TFPOROOR); If TFPOROOR>3 Then TFPOROOR:= 1;
Case TFPOROOR Of
    1: Begin sgTF.Visible:= True; sgOR.Visible:= False End;
    2: PedORKepre;
    3: OszORKepre;
End;
end;

Function TfmGOD.MaxORelBet: Word;    //maximális relatív betöltöttségű osztály
Var I, J, Ao: Word;
    Rb: Real;
Begin
  J:= Random(OSz)+1; Rb:= 0; Ao:= 0;
For I:= J To OSz Do If ORelB[I]>Rb Then Begin Rb:= ORelB[I]; Ao:= I End;
For I:= 1 To J-1 Do If ORelB[I]>Rb Then Begin Rb:= ORelB[I]; Ao:= I End;
  MaxORelBet:= Ao;
End;

Function TfmGOD.OszMaxP(O: Word): Word; //osztályhoz max. óraszámú pedagógus
Var I, J, Sp, Pp: Word;
Begin
  OszMaxP:= 0; If O=0 Then Exit;
  Sp:=0; Pp:= 0;
  J:= Random(PSz)+1;
For I:= J To PSz Do IF Not OTFe[O,I].Beir And (OTFe[O,I].OSza>Sp) Then
Begin Sp:= OTFe[O,I].OSza; Pp:= I End;
For I:= 1 To J-1 Do IF Not OTFe[O,I].Beir And (OTFe[O,I].OSza>Sp) Then
Begin Sp:= OTFe[O,I].OSza; Pp:= I End;
  OszMaxP:= Pp;
End;

Function TfmGOD.MaxPRelBet: Word;    //legnagyobb relatív betöltöttségű ped.
Var I, J, Ap: Word; Rb: Real;
Begin
  J:= Random(PSz)+1; Rb:= 0; AP:= 0;
For I:= J To PSz Do If PRelB[I]>Rb Then Begin Rb:= PRelB[I]; Ap:= I End;
For I:= 1 To J-1 Do If PRelB[I]>Rb Then Begin Rb:= PRelB[I]; Ap:= I End;
  MaxPRelBet:= Ap;
End;

Function TfmGOD.PedMaxO(P: Word): Word; //pedagógus még be nem írt,
Var I, J, Sp, Op: Word;                 //maximális óraszámú osztálya
Begin
  PedMaxO:= 0; If P=0 Then Exit;
  Sp:= 0; Op:= 0;
With PTFO[P] Do
Begin
    J:= Random(OSz)+1;
For I:= J To OSz Do IF Not PTFe[I].Beir And (PTFe[I].OSza>Sp) Then
Begin Sp:= PTFe[I].OSza; Op:= I End;
For I:= 1 To J-1 Do IF Not PTFe[I].Beir And (PTFe[I].OSza>Sp) Then
Begin Sp:= PTFe[I].OSza; Op:= I End;
End;
  PedMaxO:= Op;
End;

Procedure TfmGOD.OPLehetoseg;        //az osztályokban óránként,
Var I, J, K, L: Word;                //hány pedagógus tudna órát tartani
Begin
For K:= 1 To OSz Do For I:= 1 To 5 Do For J:= 1 To 7 Do OPleh[K,I,J]:= 0;
For K:= 1 To OSz Do For L:= 1 To PSz Do With OTFe[K,L] Do
If (OSza>0) And Not Beir Then For I:= 1 To 5 Do For J:= 1 To 7 Do
If (PTFO[L].POra[I,J]=0) And (OOra[K,I,J]=0) Then Inc(OPLeh[K,I,J]);
End;

Procedure TfmGOD.OPLMin(Var O, D, H: Word); //OPLeh minimuma
Var I, J, K, L, Pm: Word;
Begin
  O:= 0; D:= 0; H:= 0;               //D: nap, H: óra
  L:= Random(OSz)+1; Pm:= 65535;
For K:= L To OSz Do For I:= 1 To 5 Do For J:= 1 To 7 Do
If (OPLeh[K,I,J]>0) And (OPLeh[K,I,J]<Pm) Then
Begin O:= K; D:= I; H:= J; Pm:= OPLeh[K,I,J]; End;
For K:= 1 To L-1 Do For I:= 1 To 5 Do For J:= 1 To 7 Do
If (OPLeh[K,I,J]>0) And (OPLeh[K,I,J]<Pm) Then
Begin O:= K; D:= I; H:= J; Pm:= OPLeh[K,I,J]; End;
End;

Function TfmGOD.MaxPORelBet(O, D, H: Word): Word;
Var I, J: Word;                      //osztályhoz és kritikus időponthoz
    Pm: Real;                        //max. rel. betöltöttségű pedagógus
Begin
  MaxPORelBet:= 0; If O=0 Then Exit;
  J:= Random(PSz)+1; Pm:= 0;
For I:= J To PSz Do
If (OTFe[O,I].OSza>0) And Not OTFe[O,I].Beir And (PRelBet(I)>Pm) And
  (PTFO[I].POra[D,H]=0) Then Begin Pm:= PRelBet(I); MaxPORelBet:= I End;
For I:= 1 To J-1 Do
If (OTFe[O,I].OSza>0) And Not OTFe[O,I].Beir And (PRelBet(I)>Pm) And
  (PTFO[I].POra[D,H]=0) Then Begin Pm:= PRelBet(I); MaxPORelBet:= I End;
End;

Procedure TfmGOD.OTorlo(O: Word);    //egy osztály óráinak törlése
Var I, J, K: Word;
Begin
If O=0 Then Exit;
  Inc(OUjr[O]);
For K:= 1 To PSz Do If OTFe[O,K].OSza>0 Then
Begin
    OTFe[O,K].Beir:= False; PTFO[K].PTFe[O].Beir:= False;
With PTFO[K] Do For I:= 1 To 5 Do For J:= 1 To 7 Do
If POra[I,J]=O Then Begin POra[I,J]:= 0; OOra[O,I,J]:= 0 End;
    PRelBet(K);
End;
  ORelBet(O);
End;

Function TfmGOD.MaxPUjra: Word;      //pedagógus aki miatt a legtöbb restart
Var I, J, P, Pm: Word;
Begin
  P:= 0; Pm:= 0;
  J:= Random(PSz)+1;
For I:= J To PSz Do If PRelB[I]>0 Then If PUjr[I]>=Pm Then
Begin P:= I; Pm:= PUjr[I] End;
For I:= 1 To J-1 Do If PRelB[I]>0 Then If PUjr[I]>=Pm Then
Begin P:= I; Pm:= PUjr[I] End;
  MaxPUjra:= P;
End;

Function TfmGOD.MaxOUjra: Word;      //osztály amely miatt a legtöbb restart
Var I, J, O, Om: Word;
Begin
  O:= 0; Om:= 0;
  J:= Random(OSz)+1;
For I:= J To OSz Do If ORelB[I]>0 Then If OUjr[I]>=Om Then
Begin O:= I; Om:= OUjr[I] End;
For I:= 1 To J-1 Do If ORelB[I]>0 Then If OUjr[I]>=Om Then
Begin O:= I; Om:= OUjr[I] End;
  MaxOUjra:= O;
End;

Procedure TfmGOD.ReStart;            //betöltés előlről, teljes törlés után
Var I, J, K: Word;
Begin
  Inc(Res); edReset.Text:= IntToStr(Res);
For I:= 1 To OSz Do For J:= 1 To PSz Do OTFe[I,J].Beir:= False;
For I:= 1 To PSz Do For J:= 1 To OSz Do PTFO[I].PTFe[J].Beir:= False;
For K:= 1 To OSz Do For I:= 1 To 5 Do For J:= 1 To 7 Do OOra[K,I,J]:= 0;
For K:= 1 To PSz Do For I:= 1 To 5 Do For J:= 1 To 7 Do PTFO[K].POra[I,J]:= 0;
For I:= 1 To OSz Do ORelBet(I);
For I:= 1 To PSz Do PRelBet(I);
For I:= 1 To OSz Do OKSz[I]:= 0;
For I:= 1 To PSz Do PKSz[I]:= 0;
End;

Procedure TfmGOD.GepiBetolto;        //gépi betöltő
Var I, J, O, P, K, L, M, Ap, Ao, Nm, Pm, V, W, D, H: Word;
    Vt: Array[1..5,1..2] Of Word;
Begin
  Inc(Faz); Faz:= Faz Mod 5; Ao:= 0; Ap:= 0;

Case Faz Of
    0: Begin //max relatív betöltöttségű osztály
         Ao:= MaxORelBet; Ap:= OszMaxP(Ao);
End;
    1: Begin //max relatív betöltöttségű pedagógus
         Ap:= MaxPRelBet; Ao:= PedMaxO(Ap);
End;
    2: Begin //kritikus osztályidőpont
         OPLehetoseg; OPLMin(Ao,D,H); Ap:= MaxPORelBet(Ao,D,H);
End;
    3: Begin //pedagógus miatt legtöbbször újraindít
         Ap:= MaxPUjra; Ao:= PedMaxO(Ap);
End;
    4: Begin //osztály miatt legtöbbször újraindít
         Ao:= MaxOUjra; Ap:= OszMaxP(Ao);
End;
End;

If Ao*AP=0 Then Begin Veg:= True; Exit End;

//lehetőségvektor alapértékei
For I:= 1 To 5 Do For J:= 1 To 7 Do LVekt[I,J]:= NPar[J];

//hétvége paraméterek
For I:= 2 To 4 Do For J:= 1 To 6 Do Inc(LVekt[I,J], HVeg);

//periodicitás
Case PTFO[Ap].PTFe[Ao].OSza Of //5-re minden napra kell egy óra
    1: Begin //1
         Pm:= Random(5)+1; For I:= 1 To 5 Do For J:= 1 To 7 Do
If I=Pm Then Inc(LVekt[I,J], PerP);
End;
    2: For I:= 1 To 7 Do //2
Begin Inc(LVekt[2,I], PerP); Inc(LVekt[4,I], PerP) End;
    3: For I:= 1 To 7 Do //3
Begin
         Inc(LVekt[1,I], PerP); Inc(LVekt[3,I], PerP); Inc(LVekt[5,I], PerP)
End;
    4: Begin //4
         Pm:= Random(5)+1; For I:= 1 To 5 Do For J:= 1 To 7 Do
If I<>Pm Then Inc(LVekt[I,J], PerP);
End;
End;

//szomszédossági paraméter
With PTFO[Ap] Do
For I:= 1 To 5 Do For J:= 2 To 5 Do
Begin
If POra[I,J-1]>0 Then Inc(LVekt[I,J],SzoP);
If POra[I,J+1]>0 Then Inc(LVekt[I,J],SzoP);
End;

//óraszámkiegyenlítés
For I:= 1 To 5 Do
Begin
    Nm:= 0; For J:= 1 To 7 Do If OOra[Ao,I,J]>0 Then Inc(Nm);
For J:= 1 To 7 Do Inc(LVekt[I,J],(7-Nm)*OKie);
End;

//törlések a pedagógus és az osztály foglaltsága alapján
With PTFO[Ap] Do
For I:= 1 To 5 Do For J:= 1 To 7 Do If POra[I,J]>0 Then LVekt[I,J]:= 0;
For I:= 1 To 5 Do For J:= 1 To 7 Do If OOra[Ao,I,J]>0 Then LVekt[I,J]:= 0;

//kritikus időpont kiemelése
If (Faz=2) And (LVekt[D,H]<>0) Then LVekt[D,H]:= 30000;

//aktuális óraszámszor kiválasztjuk a legnagyobbat
For I:= 1 To 5 Do For J:= 1 To 2 Do Vt[I,J]:= 0; M:= 1;
For K:= 1 To PTFO[Ap].PTFe[Ao].OSza Do
Begin
    V:= 1; W:= 1; Nm:= LVekt[V,W];   //V: Nap, W: óra, Nm: Max érték
For I:= 1 To 5 Do For J:= 1 To 7 Do If LVekt[I,J]>Nm Then
Begin Nm:= LVekt[I,J]; V:= I; W:= J End;
    Vt[M,1]:= V; Vt[M,2]:= W; Inc(M); For L:= 1 To 7 Do LVekt[V,L]:= 0;
End;
For I:= 1 To 5 Do For J:= 1 To 7 Do LVekt[I,J]:= 0; M:= 1;
While (M<6) And (Vt[M,1]<>0) Do Begin LVekt[Vt[M,1],Vt[M,2]]:= 1; Inc(M) End;

//beírás az órarendekbe
  PTFO[Ap].PTFe[Ao].Beir:= True; OTFe[Ao,Ap].Beir:= True;
For I:= 1 To 5 Do For J:= 1 To 7 Do If LVekt[I,J]>0 Then
Begin
    PTFO[Ap].POra[I,J]:= Ao; OOra[Ao,I,J]:= Ap; Inc(OKSz[Ao]); Inc(PKSz[Ap]);
    PRelBet(Ap); ORelBet(Ao);
End;

//hetedik óra miatti törlés
For I:= 1 To 5 Do If OOra[Ao,I,7]<>0 Then
Begin OTorlo(Ao); If Odd(Faz) Then Inc(PUjr[Ap]) Else Inc(OUjr[Ao]) End;

//magas osztály-kezelési szám miatti újrakezdés
If (OKSz[Ao]>2*OSz*OSz) And (PKSz[AP]>OSz*OSz) Then
Begin ReStart; Inc(OUjr[Ao]) End;

//magas pedagógus-kezelési szám miatti újrakezdés
If (PKSz[Ap]>2*OSz*OSz) And (OKSz[Ao]>OSz*OSz) Then
Begin ReStart; Inc(PUjr[Ap]) End;

End;

procedure TfmGOD.btFeltoltClick(Sender: TObject); //gépi betöltő indítója
Var I, J, K, S: Word;
begin
  btOrarendTorloClick(Sender);
  Lep:= 0; Faz:= 0; Lep:= 0; Res:= 0; Veg:= False;
  btTFGeneral.Enabled:= False; btTFOR.Enabled:= False;
For I:= 1 To PSz Do PRelBet(I);
For I:= 1 To OSz Do ORelBet(I);
For I:= 1 To PSz Do PKSz[I]:= 0;
For I:= 1 To OSz Do OKSz[I]:= 0;
For I:= 1 To PSz Do PRelBet(I);
For I:= 1 To OSz Do ORelBet(I);
For I:= 1 To PSz Do PUjr[I]:= 0;
For I:= 1 To OSz Do OUjr[I]:= 0;

If TFPOROOR=1 Then btTFORClick(Sender);

Repeat
Begin
    GepiBetolto; Inc(Lep); edLepes.Text:= IntToStr(Lep);
If Lep Mod 100=0 Then Repaint;
Case TFPOROOR Of
      2: PedORKepre;
      3: OszORKepre;
End;
End;
Until Veg Or (Lep>2000*OSz);

  S:= 0; For K:= 1 To OSz Do For I:= 1 To 5 Do For J:= 1 To 7 Do
If OOra[K,I,J]<>0 Then Inc(S); With sgOR Do Cells[ColCount-1,0]:= IntToStr(S);

  btTFGeneral.Enabled:= True;
  btTFOR.Enabled:= True;
end;

procedure TfmGOD.btOrarendTorloClick(Sender: TObject);
begin
  OraTorlo;
If TFPOROOR=1 Then btTFORClick(Sender);
Case TFPOROOR Of
    2: PedORKepre;
    3: OszORKepre;
End;
end;

procedure TfmGOD.sgORDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgOR.Canvas.Brush Do
If gdSelected In State Then Color:= clYellow
Else If gdFixed In State Then Color:= clBtnFace Else
Begin
Case Col Of
           7,      14,       21,       28,       35,36: Color:= clWindow;
      1..6,  8..13,   15..20,   22..27,   29..34: Color:= clAqua;
End;
End;
  sgOR.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top+1,sgOR.Cells[Col,Row]);
If gdFocused In State Then sgOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmGOD.sgTFClick(Sender: TObject);
begin
With sgTF Do Begin ACol:= Col; ARow:= Row; RePaint End;
end;

procedure TfmGOD.sgTFDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTF.Canvas.Brush Do
Begin
If (gdFixed In State) And ((Col=ACol) Or (Row=ARow))
Then Color:= clYellow Else Color:= clBtnFace;

If gdSelected In State Then Color:= clLime;

If Not((gdSelected In State) Or (gdFixed In State)) Then
//ha nincs beírva a tétel, akkor a cella clAqua színű
If (Col<sgTF.ColCount-1) And (Pos(sgTF.Cells[Col,Row],'123456789')>0) And
Not OTFe[Col,Row].Beir Then Color:= clAqua Else Color:= clWindow;
End;
  sgTF.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top+1,sgTF.Cells[Col,Row]);
With sgTF Do If gdFocused In State Then Canvas.DrawFocusRect(Rect);
end;

end.