Órarendrendező program

Ez az órarendkészítő program az eddigi demonstrációs programjaimnál sokkal többre képes. Minden eddigi alapvető funkciója mellett a legfontosabb újítása a csoportbontás kezelése.

Azért kezdjük az elején. Ennek az alapja is egy automatikusan generált tantárgyfelosztás, hasonlóan az eddigi demonstrációs programokhoz. Ezért valós helyzetben, változtatás nélkül az ezzel készült órarend sem lesz használható. Cél: az ütközésmentesítő algoritmus tesztelése egy, a valósághoz még közelebb álló helyzetben.

Paraméterek: Az osztályok száma 24, pedagógusoké 44. (a demonstráció miatt csak ennyi, így a képernyőn a teljes iskola látható, 32 osztály esetén a szükséges pedagóguslétszám 60 fő körüli,) Minden osztálynak heti 30 órája van. Egy osztályban egy pedagógus csak egy tantárgyat tanít (így nincs szükség tantárgyi azonosítóra és a program tantermeket sem kezel).

Minden osztálynak a következő a tantárgyfelosztása:

Egy 5-órás tantárgy.

Kettő 4-órás tantárgy.

Három 3-órás tantárgy.

Négy 2-órás tantárgy: ez összesen 30 óra (ahogyan az eddigi demonstrációkban volt).

Minden osztályban három tantárgyat csoportbontásban tartanak: két 3-órás tantárgyat (például egy idegen nyelvet és a matematikát, vagy két idegen nyelvet, ezeknek a tantárgyaknak a módosított kerettantervek szerint is valóban heti 3 az óraszáma) és egy 2-órás tantárgyat (például ilyen lehet a testnevelés, nemek szerinti bontásban).

Egy kis összesítés:

Az osztályokban összesen heti 38 pedagógus órát kell tartani (3 + 3 + 2 = 8 a plusz órák száma).

Az iskola összes pedagógus óraszáma: 24 osztály x 38 óra = 912 óra. (100%)

A nem bontott órák száma: 24 osztály x 22 óra = 528 óra, az órák 58%-a.

Csoportbontásos órák száma: 24 osztály x 16 óra = 384 óra az órák 42%-a.

Jelölések:

Az osztályok jele:

1.a, 1.b, … 1.f.

2.a, 2.b, … 2.f.

3.a, 3.b, … 3.f.

4.a, 4.b, … 4.f.

Pedagógusok neve:

AA, AB, AC, … AX, AY, AZ, BA, BB, BC, … BR. (Az Excelt idéző módon.)

Az órarend megjelenése:

Pedagógus órarend, a heti lehetséges óraszám: 5 nap x 10 napi órák száma = 50 óra hetente.

A napi órák megjelenítése:

H0, H1, … H9, K0, K1, … P7, P8, P9.

Csoportbontás megjelenítése:

Azokat az órák, amelyeket csoportbontásban kell tanítani, az osztály jelében látható betű nagybetűs alakja jelöli.

Ütközéses órák megjelenítése:

A piros háttérrel megjelenő osztályok elhelyezése hibás: vagy ütközik egy másik osztállyal, vagy nem a megengedett 1.-6. (zöldes háttérszínnel jelölve az órarenden) órákban található. Az ütközés büntetőpontja ütközésenként 1 pont, ha nem az 1.-6. órában van az óra, akkor 2 pont a büntetés. Mivel az ütközés kölcsönös, a kieső óra pedig 2 ponttal számítódik, az összesített ütközésszám mindig páros.

Követelmények:

Csak osztály oldalról nézve 100%-an tömör (24 x 30) órarend az elfogadható az algoritmus számára, azaz nem lehet egyetlen osztálynak sem lyukasórája, sem 1.-6. órákból kieső órája. A rendezés során nem helyez kétórás tantárgyat két egymás utáni napra. Ezt csak kész órarend esetén jelzi a program, ekkor a kétórás tantárgyak lila háttérszínnel jelennek meg az órarenden, így könnyű ellenőrizni.

Futtatási paraméterek:

A gyorsabb futás érdekében csak minden ezredik lépésben frissül a képernyő. Ha 5000 lépést meghaladóan sem változik az összesített ütközési szám, akkor a program visszalépéssel újrakezdi a rendezgetést. A maximális lépésszám egy Edit mezőben beírható, alapértelmezésben 200 ezer. Futás alatti visszalépések esetén a legjobb változatot a futtatás végére megőrzi és megjeleníti. Ha nem sikerül a teljes rendezés, akkor Vége, ha sikerült, akkor Kész feliratot láthatunk a képernyőn. A program méri és kijelzi a generáláshoz szükséges időt. A program újraindítása nélkül tudunk új tantárgyfelosztást kérni, illetve az órarendet összekeverni. Folyamatosan látjuk az óránkénti (táblázat utolsó sora) és az összesített ütközésszámot, ez utóbbi a visszalépések és keverések kivételével nem nőhet. Folyamatosan látjuk a már mentett, legjobb órarend ütközési számát is.

Nézzünk néhány futtatási képet. A programindítás után ezt látjuk: (piros háttér: ütközéses óra)

Szűk 5 perc után a generálásnak vége, és mint látható nem sikerült teljesen megoldani a feladatot, BD tanárnak a 3.a osztályban egy órája nincs a megfelelő helyen, S0 (szerda 0.) órában van.

Indítsuk újra a programot:

Kevesebb mint két perc múlva a gép befejezi a generálást egy minden szempontból teljes órarenddel:

Nehogy azt gondoljuk, hogy ez csak véletlen. A valós idők is mutatják, hogy nem sokkal később egy teljesen más tantárgyfelosztással is készít egy tökéletes órarendet. A start:

Majd egy percen belül a végeredmény:

A program listája:

unit UORend;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

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

Const OMax=24;
PMax=44;
HOSz=50;
OSzM=25;
      Nap='HKSCP';
KevSz= 6;

type

  St3=String[3];

TfmORend = class(TForm)
lbORend: TLabel;
sgPOR: TStringGrid;
btKilepes: TButton;
btKeveres: TButton;
btUjTF: TButton;
btRendez: TButton;
edLSz: TEdit;
edLMax: TEdit;
lbKeszVege: TLabel;
lbMaxMenet: TLabel;
edPuf: TEdit;
edStart: TEdit;
edStop: TEdit;
lbStart: TLabel;
lbStop: TLabel;
Procedure Napok;
Procedure ONevek;
Function UpONev(Nev: St3): St3;
Function Volt(O, P: Word): Boolean;
Function POrasz(P: Word): Word;
Procedure TFGen;
Procedure Csere(O1,O2,P: Word);
Procedure Keveres;
Procedure PORKepre;
Function Utkozes(O, P: Word): Word;
Procedure Utkozesek;
Procedure UtkKepre;
Procedure KetOra;
Procedure OsztOSz;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgPORDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
procedure sgPORClick(Sender: TObject);
procedure btKeveresClick(Sender: TObject);
procedure btUjTFClick(Sender: TObject);
procedure btRendezClick(Sender: TObject);
procedure edLMaxChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmORend: TfmORend;
ONev: Array[0..OMax] Of St3;
ACol, ARow: Integer;
  POR, Utk, CSO, PPOR, PCSO: Array[1..HOSz+1,0..PMax+1] Of Word;
  PTF: Array[1..PMax,1..OMax] Of Word;
Lanc: Array[1..PMax] Of Word;
  Ind, Zero: Array[1..HOSz*PMax,1..2] Of Word;
UtkOsz, OldUtkOSz, PUtkOSz: Word;
LSz, LMax: LongInt;

implementation

{$R *.dfm}

procedure TfmORend.btKilepesClick(Sender: TObject);
begin
Close;
end;

Procedure TfmORend.Napok;
Var I, J: Word;
Begin
With sgPOR Do For I:= 1 To 5 Do For J:= 0 To 9 Do
Cells[(I-1)*10+J+1,0]:= Nap[I]+IntToStr(J);
End;

Procedure TfmORend.ONevek;
Var I: Word;
Begin
ONev[0]:= ''; For I:= 1 To OMax Do
ONev[I]:= IntToStr(((I-1) Div 6+1))+'.'+Chr(96+(I-1) Mod 6+1);
End;

Function TfmORend.UpONev(Nev: St3): St3;
Var St: St3;
Begin
UpONev:= ''; If Nev='' Then Exit;
St:= Nev; St[3]:= UpCase(St[3]); UpONev:= St;
End;

Function TfmORend.Volt(O, P: Word): Boolean;
Var I: Word;
Begin
  Volt:= False; For I:= 1 To HOsz Do If POR[I,P]=O Then
Begin Volt:= True; Break End;
End;

Function TfmORend.POrasz(P: Word): Word;
Var I, S: Word;
Begin
  S:= 0; For I:= 1 To HOSz Do If POR[I,P]<>0 Then Inc(S); POrasz:= S;
End;

Procedure TfmORend.TFGen;
Var I, J, L, N, O, P, P1: Word;
Begin
For O:= 1 To HOSz+1 Do For P:= 1 To PMax+1 Do
Begin POR[O,P]:= 0; Utk[O,P]:= 0; CSO[O,P]:= 0 End;
For P:= 1 To PMax Do For O:= 1 To OMax Do PTF[P,O]:= 0;
For I:= 1 To OMax Do For J:= 1 To 4 Do For N:= 1 To J Do
If ((J=3) And (N<3)) Or ((J=4) And (N=1)) Then
Begin
    P:= Random(PMax)+1; P1:= Random(PMax)+1;
While (P=P1) Or (Volt(I,P)) Or (Volt(I,P1)) Or
          (POrasz(P)>OSzM-6) Or (POrasz(P1)>OSzM-6) Do
Begin P:= Random(PMax)+1; P1:= Random(PMax)+1 End;
For L:= 1 To 6-J Do
Begin
      O:= Random(HOSz)+1;
While (POR[O,P]<>0) Or (POR[O,P1]<>0) Do O:= Random(HOSz)+1;
      POR[O,P]:= I; POR[O,P1]:= I; CSO[O,P]:= P1; CSO[O,P1]:= P;
End;
    PTF[P,I]:= 6-J; PTF[P1,I]:= 6-J;
End
Else
Begin
    P:= Random(PMax)+1;
While (Volt(I,P)) Or (POrasz(P)>=OSzM-4) Do P:= Random(PMax)+1;
For L:= 1 To 6-J Do
Begin
      O:= Random(HOSz)+1; While POR[O,P]<>0 Do O:= Random(HOSz)+1;
      POR[O,P]:= I;
End;
    PTF[P,I]:= 6-J;
End;
End;

procedure TfmORend.btUjTFClick(Sender: TObject);
begin
PUtkOSz:= 65000; edPuf.Text:= '0';
  Napok; TFGen; Utkozesek; PORKepre; UtkKepre;
lbKeszVege.Caption:= IntToStr(UtkOSz);
end;

Procedure TfmORend.Csere(O1,O2,P: Word);
Var I, Puf: Word;
Begin
If POR[O1,P]=POR[O2,P] Then Exit;
If CSO[O1,P]+CSO[O2,P]=0 Then
Begin
Puf:= POR[O1,P]; POR[O1,P]:= POR[O2,P]; POR[O2,P]:= Puf;
Puf:= CSO[O1,P]; CSO[O1,P]:= CSO[O2,P]; CSO[O2,P]:= Puf;
Exit;
End Else
Begin
For I:= 0 To PMax Do Lanc[I]:= 0; Lanc[P]:= 1;
Puf:= CSO[O1,P]; I:= 1;
While (Puf<>0) And (I<PMax) Do
Begin
Lanc[Puf]:= 1; If Odd(I) Then Puf:= CSO[O2,Puf] Else Puf:= CSO[O1,Puf];
      Inc(I);
End;
Puf:= CSO[O2,P]; I:= 1;
While (Puf<>0) And (I<PMax) Do
Begin
Lanc[Puf]:= 1; If Odd(I) Then Puf:= CSO[O1,Puf] Else Puf:= CSO[O2,Puf];
      Inc(I);
End;
For I:= 1 To PMax Do If Lanc[I]>0 Then
Begin
Puf:= POR[O1,I]; POR[O1,I]:= POR[O2,I]; POR[O2,I]:= Puf;
Puf:= CSO[O1,I]; CSO[O1,I]:= CSO[O2,I]; CSO[O2,I]:= Puf;
End;
End;
End;

Procedure TfmORend.Keveres;
Var I, J, K, P: Word;
Begin
For P:= 1 To PMax Do For I:= 1 To KevSz Do
Begin J:= Random(HOsz)+1; K:= Random(HOSz)+1; Csere(J,K,P) End;
End;

procedure TfmORend.btKeveresClick(Sender: TObject);
begin
  Napok; Keveres; Utkozesek; PORKepre; UtkKepre;
lbKeszVege.Caption:= IntToStr(UtkOSz);
end;

Procedure TfmORend.PORKepre;
Var I, P, S, Sz: Word;
St: St3;
Begin
Sz:= 0;
With sgPOR Do
Begin
For P:= 1 To PMax Do
Begin
      S:= 0; For I:= 1 To HOSz Do
Begin
St:= ONev[POR[I,P]]; If CSO[I,P]>0 Then St:= UpONev(St);
Cells[I,P]:= St; If POR[I,P]<>0 Then Inc(S);
End;
Cells[ColCount-1,P]:= IntToStr(S); Inc(Sz,S);
End;
Cells[ColCount-1,RowCount-1]:= IntToStr(Sz);
End;
End;

procedure TfmORend.sgPORDrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
With sgPOR.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
If Col In [2..7,12..17,22..27,32..37,42..47] Then Color:= clAqua
Else Color:= clWindow;
If Utk[Col,Row]=999 Then Color:= clFuchsia Else
If Utk[Col,Row]>0 Then Color:= clRed;
End;
sgPOR.Canvas.TextRect(Rect,Rect.Left+1,Rect.Top,sgPOR.Cells[Col,Row]);
If gdFocused In State Then sgPOR.Canvas.DrawFocusRect(Rect);
end;

procedure TfmORend.sgPORClick(Sender: TObject);
begin
With sgPOR Do
Begin
ACol:= Col; ARow:= Row; RePaint;
    Csere(1,Col,Row);
End;
end;

procedure TfmORend.edLMaxChange(Sender: TObject);
Var Kod: Integer;
begin
Val(edLMax.Text,LMax,Kod);
end;

procedure TfmORend.FormCreate(Sender: TObject);
Var I, J, P: Word;
begin
With sgPOR Do
Begin
RowCount:= PMax+2;
ColWidths[0]:= 21; ColWidths[ColCount-1]:= 24; Cells[0,0]:= 'Ped'; Napok;
For P:= 1 To PMax Do Cells[0,P]:= Chr((P-1) Div 26+65)+Chr((P-1) Mod 26+65);
End;
Randomize; ONevek; ACol:= 1; ARow:= 1; LMax:= 200000; PUtkOSz:= 65000;
For I:= 1 To HOSz*PMax Do For J:= 1 To 2 Do Zero[I,J]:= 0; Ind:= Zero;
TFGen; Utkozesek; PORKepre; UtkKepre;
end;

Function TfmORend.Utkozes(O, P: Word): Word;
Var I, O1, M: Word;
Begin
Utk[O,P]:= 0; Utkozes:= Utk[O,P]; If POR[O,P]=0 Then Exit;
  M:= (O-1) Mod 10;
If (POR[O,P]<>0) And (M In [0,7..9]) Then Inc(Utk[O,P],2); //csak 2 a jó
For I:= 1 To PMax Do If (I<>P) And (POR[O,I]<>0) Then
Begin
If (CSO[O,P]=0) And (POR[O,I]=POR[O,P]) Then Inc(Utk[O,P]) Else
If (I<>CSO[O,P]) And (POR[O,I]=POR[O,P]) Then Inc(Utk[O,P]);
End;
  O1:= 10*((O-1) Div 10)+1;
For I:= O1 To O1+9 Do If (I<>O) And (POR[I,P]<>0) Then
If POR[I,P]=POR[O,P] Then Inc(Utk[O,P]);
If PTF[P,POR[O,P]]=2 Then
Begin
For I:= 1 To HOSz Do If (I<>O) And (POR[I,P]=POR[O,P]) Then Break;
If Abs(((O-1) Div 10)-((I-1) Div 10))=1 Then Inc(Utk[O,P]);
End;
Utkozes:= Utk[O,P];
End;

Procedure TfmORend.Utkozesek;
Var O, P: Word;
Begin
UtkOsz:= 0;
For O:= 1 To HOSz Do For P:= 1 To PMax Do Inc(UtkOsz,Utkozes(O,P));
End;

Procedure TfmORend.UtkKepre;
Var O, P, Sz: Word;
Begin
With sgPOR Do
For O:= 1 To HOSz Do
Begin
Sz:= 0; For P:= 1 To PMax Do Inc(Sz,Utk[O,P]);
Cells[O,RowCount-1]:= IntToStr(Sz);
End;
lbKeszVege.Caption:= IntToStr(UtkOSz);
End;

Procedure TfmORend.KetOra;
Var O, P, I: Word;
Begin
For O:= 1 To HOSz Do For P:= 1 To PMax Do Utk[O,P]:= 0;
For O:= 1 To HOSz Do For P:= 1 To PMax Do If POR[O,P]<>0 Then
If PTF[P,POR[O,P]]=2 Then For I:= 1 To HOSz Do
If POR[O,P]=POR[I,P] Then Utk[I,P]:= 999;
End;

Procedure TfmORend.OsztOSz;
Var O, P, S: Word;
Begin
With sgPOR Do
For O:= 1 To HOSz Do
Begin
    S:= 0; For P:= 1 To PMax Do If Cells[O,P]<>'' Then Inc(S);
Cells[O,RowCount-1]:= IntToStr(S);
End;
End;

procedure TfmORend.btRendezClick(Sender: TObject);
Var O, O1, K, L, P, A, Index, RIndex, Ismet: Word;
    Volt: Boolean;
begin
edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
edStop.Text:= ''; edStop.Repaint;
LSz:= 0; Volt:= False; OldUtkOSz:= 0; Ismet:= 0;
  Napok; lbKeszVege.Caption:= '';
While (UtkOSz>0) And (LSz<LMax) Do
Begin
If OldUtkOSz=UtkOSz Then
Begin
      Inc(Ismet); If Ismet>5000 Then
Begin
Ismet:= 0;
If UtkOSz<PUtkOSz Then
Begin
PUtkOSz:= UtkOSz; PPOR:= POR; PCSO:= CSO;
edPuf.Text:= IntToStr(PUtkOSz);
End;
Keveres; Utkozesek; PORKepre; UtkKepre; RePaint;
End;
End Else Ismet:= 0;
    Inc(LSz); Utkozesek; A:= UtkOSz; OldUtkOSz:= A;
    O:= Random(HOSz)+1; P:= Random(PMax)+1;
If Volt Then
Begin
      Ind:= Zero; Index:= 0;
For K:= 1 To HOSz Do For L:= 1 To PMax Do If Utk[K,L]>0 Then
Begin Inc(Index); Ind[Index,1]:= K; Ind[Index,2]:= L End;
RIndex:= Random(Index)+1; O1:= Ind[RIndex,1]; P:= Ind[RIndex,2];
End
Else
Begin
While Utk[O,P]=0 Do Begin O:= Random(HOSz)+1; P:= Random(PMax)+1 End;
      O1:= Random(HOsz)+1;
End;
    Csere(O,O1,P); Utkozesek;
If UtkOSz>A Then
Begin Csere(O,O1,P); Volt:= False; Utkozesek End Else Volt:= True;
If LSz Mod 1000=0 Then
Begin PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz); Repaint End;
End;
If (UtkOSz>0) And (UtkOSz>PUtkOSz) Then
Begin edPuf.Text:= IntToStr(PUtkOSz); POR:= PPOR; CSO:= PCSO; Utkozesek End
Else edPuf.Text:= IntToStr(UtkOSz);
PORKepre; UtkKepre; edLSz.Text:= IntToStr(LSz);
With lbKeszVege Do If UtkOSz=0 Then
Begin KetOra; OsztOSz; Caption:= 'Kész' End Else Caption:= 'Vége';
edStop.Text:= TimeToStr(GetTime);
end;

end.