Ó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, MessagesSysUtilsVariantsClasses

  GraphicsControlsFormsDialogsStdCtrlsGrids;

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

type

  St3=String[3];

  TfmORend = class(TForm)
    lbORendTLabel;
    sgPORTStringGrid;
    btKilepesTButton;
    btKeveresTButton;
    btUjTFTButton;
    btRendezTButton;
    edLSzTEdit;
    edLMaxTEdit;
    lbKeszVegeTLabel;
    lbMaxMenetTLabel;
    edPufTEdit;
    edStartTEdit;
    edStopTEdit;
    lbStartTLabel;
    lbStopTLabel;
    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(SenderTObject);
    procedure FormCreate(SenderTObject);
    procedure sgPORDrawCell(SenderTObject; Col, Row: Integer;
      RectTRectStateTGridDrawState);
    procedure sgPORClick(SenderTObject);
    procedure btKeveresClick(SenderTObject);
    procedure btUjTFClick(SenderTObject);
    procedure btRendezClick(SenderTObject);
    procedure edLMaxChange(SenderTObject);
  private
    Private declarations }
  public
    { Public declarations }
  end;

var
  fmORendTfmORend;
  ONevArray[0..OMax] Of St3;
  AColARow: Integer;
  POR, Utk, CSO, PPOR, PCSO: Array[1..HOSz+1,0..PMax+1] Of Word;
  PTF: Array[1..PMax,1..OMax] Of Word;
  LancArray[1..PMax] Of Word;
  Ind, ZeroArray[1..HOSz*PMax,1..2] Of Word;
  UtkOszOldUtkOSzPUtkOSz: Word;
  LSzLMaxLongInt;

implementation

{$R *.dfm}

procedure TfmORend.btKilepesClick(SenderTObject);
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:= NevSt[3]:= UpCase(St[3]); UpONev:= St;
End;

Function TfmORend.Volt(O, P: Word): Boolean;
Var I: Word;
Begin
  Volt:= FalseFor I:= 1 To HOsz Do If POR[I,P]=O Then
  Begin Volt:= TrueBreak 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(SenderTObject);
begin
  PUtkOSz:= 65000; edPuf.Text:= '0';
  Napok; TFGenUtkozesekPORKepreUtkKepre;
  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<PMaxDo
    Begin
      Lanc[Puf]:= 1; If Odd(I) Then Puf:= CSO[O2,PufElse Puf:= CSO[O1,Puf];
      Inc(I);
    End;
    Puf:= CSO[O2,P]; I:= 1;
    While (Puf<>0) And (I<PMaxDo
    Begin
      Lanc[Puf]:= 1; If Odd(I) Then Puf:= CSO[O1,PufElse 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(SenderTObject);
begin
  Napok; KeveresUtkozesekPORKepreUtkKepre;
  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]:= StIf 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(SenderTObject; Col, Row: Integer;
  RectTRectStateTGridDrawState);
begin
  With sgPOR.Canvas.Brush Do
  Begin
    If (gdFixed In StateAnd ((Col=AcolOr (Row=ARow)) Then
    Color:= clYellow Else Color:= clBtnFace;
    If gdSelected In State Then Color:= clLime;
    If Not((gdSelected In StateOr (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(SenderTObject);
begin
  With sgPOR Do
  Begin
    ACol:= Col; ARow:= RowRePaint;
    Csere(1,Col,Row);
  End;
end;

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

procedure TfmORend.FormCreate(SenderTObject);
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;
  RandomizeONevekACol:= 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;
  TFGenUtkozesekPORKepreUtkKepre;
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(SenderTObject);
Var O, O1, K, L, P, A, IndexRIndexIsmet: Word;
    Volt: Boolean;
begin
  edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
  edStop.Text:= ''; edStop.Repaint;
  LSz:= 0; Volt:= FalseOldUtkOSz:= 0; Ismet:= 0;
  Napok; lbKeszVege.Caption:= '';
  While (UtkOSz>0) And (LSz<LMaxDo
  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;
        KeveresUtkozesekPORKepreUtkKepreRePaint;
      End;
    End Else Ismet:= 0;
    Inc(LSz); Utkozesek; A:= UtkOSzOldUtkOSz:= A;
    O:= Random(HOSz)+1; P:= Random(PMax)+1;
    If Volt Then
    Begin
      Ind:= ZeroIndex:= 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:= FalseUtkozesek End Else Volt:= True;
    If LSz Mod 1000=0 Then
    Begin PORKepreUtkKepreedLSz.Text:= IntToStr(LSz); Repaint End;
  End;
  If (UtkOSz>0) And (UtkOSz>PUtkOSzThen
  Begin edPuf.Text:= IntToStr(PUtkOSz); POR:= PPOR; CSO:= PCSO; Utkozesek End
  Else edPuf.Text:= IntToStr(UtkOSz);
  PORKepreUtkKepreedLSz.Text:= IntToStr(LSz);
  With lbKeszVege Do If UtkOSz=0 Then
  Begin KetOraOsztOSzCaption:= 'Kész' End Else Caption:= 'Vége';
  edStop.Text:= TimeToStr(GetTime);
end;

end.