/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Simsttab -- Simplistic school time tabler Copyright (C) 2005 Markus Triska triska@gmx.at This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- use_module(library(clpfd)). :- use_module(library(sgml)). :- dynamic req/4, coupling/4, teacher_freeday/2, slots_per_day/1, num_slots/1, free_slot/2, room_alloc/4. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Posting constraints Initially, a requirement is represented as a term req(C,S,T,N), meaning that N times a week (on different days), class C is to be taught subject S by teacher T. A requirement R is then transformed to a term R-Ls, where Ls is a list of length N. The elements of this list are variables and act as placeholders for the time slots of the scheduled lessons of requirement R. To break symmetry, the elements of Ls are constrained to be strictly ascending (it follows that they are all_different). The time slots of each teacher are constrained to be all_different/1. The time slots divided by slots_per_day are constrained to be strictly ascending (= enforce distinct days), except for coupled lessons. The time slots of each class, and of lessons occupying the same room, are constrained to be all_different/1. Labeling is performed on all slot variables. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ all_reqs(Rs) :- setof(req(Class,Sub,Teacher,Num), req(Class,Sub,Teacher,Num), Rs0), maplist(req_with_joblist, Rs0, Rs). all_classes(Classes) :- setof(C, S^N^T^req(C,S,T,N), Classes). all_teachers(Teachers) :- setof(T, C^S^N^req(C,S,T,N), Teachers). all_rooms(Rooms) :- findall(Room, room_alloc(Room,_C,_S,_Slot), Rooms0), sort(Rooms0, Rooms). timetab_(Rs, Vars) :- all_reqs(Rs), reqs_varlist(Rs, Vars), num_slots(Numslots), Numslots1 is Numslots - 1, Vars ins 0..Numslots1, maplist(constrain_subject, Rs), all_classes(Classes), all_teachers(Teachers), all_rooms(Rooms), maplist(constrain_teacher(Rs), Teachers), maplist(constrain_class(Rs), Classes), maplist(constrain_room(Rs), Rooms). slot_quotient(S, Q) :- slots_per_day(SPD), Q #= S / SPD. dlist([]) --> []. dlist([E|Es]) --> [E], dlist(Es). ignore([], _, Ls, Ls). ignore([I|Is], Pos, [E|Es0], Es) :- ( I =:= Pos -> Es = Rest, Is1 = Is ; Es = [E|Rest], Is1 = [I|Is] ), Pos1 is Pos + 1, ignore(Is1, Pos1, Es0, Rest). %:- ignore([3], 0, [a,b,c,d], [a,b,c]). %:- ignore([1,2], 0, [a,b,c,d], [a,d]). slots_couplings(Slots, F-S) :- nth0(F, Slots, S1), nth0(S, Slots, S2), S2 #= S1 + 1. constrain_subject(req(Class,Subj,_Teacher,_Num)-Slots) :- strictly_ascending(Slots), % break symmetry maplist(slot_quotient, Slots, Qs0), findall(F-S, coupling(Class,Subj,F,S), Cs), maplist(slots_couplings(Slots), Cs), findall(Second, coupling(Class,Subj,_First,Second), Couplings0), sort(Couplings0, Couplings1), ignore(Couplings1, 0, Qs0, Qs1), strictly_ascending(Qs1). all_diff_from(Vs, F) :- maplist(#\=(F), Vs). constrain_class(Rs, Class) :- sublist(class_req(Class), Rs, Sub), reqs_varlist(Sub, Vs), all_different(Vs), findall(S, free_slot(Class,S), Frees), maplist(all_diff_from(Vs), Frees). constrain_teacher(Rs, Teacher) :- sublist(teacher_req(Teacher), Rs, Sub), reqs_varlist(Sub, Vs), all_different(Vs), ( teacher_freeday(Teacher,F) -> maplist(slot_quotient, Vs, Qs), all_diff_from(Qs, F) ; true ). sameroomvars([], _Reqs, []). sameroomvars([r(Class,Subject,Lesson)|Rs], Reqs, [Var|Vars]) :- memberchk(req(Class,Subject,_Teachar,_Num)-Slots, Reqs), nth0(Lesson, Slots, Var), sameroomvars(Rs, Reqs, Vars). constrain_room(Reqs, Room) :- findall(r(Class,Subj,Less), room_alloc(Room,Class,Subj,Less), RReqs), sameroomvars(RReqs, Reqs, Roomvars), all_different(Roomvars). strictly_ascending([]). strictly_ascending([A|As]) :- ascending_lag(As, A). ascending_lag([], _). ascending_lag([A|As], Prev) :- A #> Prev, ascending_lag(As, A). %room(r1,'1a',sjk,[1,2,3,4]). %room(r1,'1b',sjk,[1,2,3,4]). %room(r1,'1c',sjk,[1,2,3,4]). %room(r1,'1d',sjk,[1,2,3,4]). %coupling('1a',sjk,1,2). %teacher_freeday(2,2). %teacher_freeday(1,4). %teacher_freeday(3,0). req_with_joblist(R, R-Slots) :- arg(4, R, N), length(Slots, N). class_req(C, req(C,_S,_T,_N)-_List). teacher_req(T, req(_C,_S,T,_N)-_List). reqs_varlist([]) --> []. reqs_varlist([req(_C,_S,_N,_T)-Vars|Rs]) --> dlist(Vars), reqs_varlist(Rs). reqs_varlist(Rs, Vs) :- phrase(reqs_varlist(Rs), Vs). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Printing - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ % teachers print_teachers(Rs) :- all_teachers(Ts), maplist(print_teacher(Rs), Ts). print_teacher(Rs, Teacher) :- format("\n\n\n\nTeacher: ~w\n", [Teacher]), sublist(teacher_req(Teacher), Rs, Sub), num_slots(NumSlots), slots_per_day(SPD), print_teacher_(0, NumSlots, SPD, Sub). teacher_nth(Rs, N, C/Subj) :- member(req(C,Subj,_,_)-Times, Rs), member(N, Times). print_teacher_(N, N, _, _) :- !. print_teacher_(N0, N, SPD, Rs) :- ( 0 =:= N0 mod SPD -> nl, nl ; true ), ( teacher_nth(Rs, N0, Subj) -> S = Subj ; S = free ), format("~w ",[S]), N1 is N0 + 1, print_teacher_(N1, N, SPD, Rs). % classes print_classes(Rs) :- all_classes(Cs), maplist(print_class(Rs), Cs). print_class(Rs, Class) :- format("\n\n\n\nClass: ~w\n", Class), sublist(class_req(Class), Rs, Sub), num_slots(NumSlots), slots_per_day(SPD), print_class_(0, NumSlots, SPD, Sub). class_nth(Rs, N, Subj) :- member(req(_,Subj,_,_)-Times, Rs), member(N, Times). print_class_(N, N, _, _) :- !. print_class_(N0, N, SPD, Rs) :- ( 0 =:= N0 mod SPD -> nl, nl ; true ), ( class_nth(Rs, N0, Subj) -> S = Subj ; S = free ), format("~w ",[S]), N1 is N0 + 1, print_class_(N1, N, SPD, Rs). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Parse XML file. This part of the program contains side-effects: It asserts facts read from the XML file to make them more conveniently accessible in the remainder of the program. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ xml_element(E, element(E,_,_)). process_req(ClassId, element(req,Attr,_)) :- memberchk(subject=Subject, Attr), memberchk(teacher=Teacher, Attr), memberchk(amount=Amount, Attr), atom_number(Amount, NAmount), %format("registering: ~w ~w ~w ~w\n",[ClassId,Subject,Teacher,Amount]), assert(req(ClassId,Subject,Teacher,NAmount)). process_coupling(ClassId, element(coupling,Attr,_)) :- memberchk(subject=Subject, Attr), memberchk(lesson1=Slot1, Attr), memberchk(lesson2=Slot2, Attr), atom_number(Slot1, NSlot1), atom_number(Slot2, NSlot2), assert(coupling(ClassId,Subject,NSlot1,NSlot2)). process_free(ClassId, element(free,Attr,_)) :- memberchk(slot=Slot, Attr), atom_number(Slot, NSlot), assert(free_slot(ClassId,NSlot)). process_class(element(class,Attr,Content)) :- memberchk(id=Id, Attr), sublist(xml_element(req), Content, Reqs), %format("id: ~w, reqs: ~w\n",[Id,Reqs]), maplist(process_req(Id), Reqs), sublist(xml_element(coupling), Content, Couplings), maplist(process_coupling(Id), Couplings), sublist(xml_element(free), Content, Freeslots), maplist(process_free(Id), Freeslots). process_globals(Content) :- memberchk(element(global,GlobAttr,_), Content), memberchk(numslots=Numslots, GlobAttr), memberchk(slotsperday=Slotsperday, GlobAttr), atom_number(Slotsperday, NSlotsperday), atom_number(Numslots, NNumslots), assert(slots_per_day(NSlotsperday)), assert(num_slots(NNumslots)). process_allocation(RoomId, element(allocate,Attr,_)) :- memberchk(class=Class, Attr), memberchk(subject=Subject, Attr), memberchk(lesson=Lesson, Attr), atom_number(Lesson, NLesson), assert(room_alloc(RoomId,Class,Subject,NLesson)). process_room(element(room,Attr,Content)) :- memberchk(id=Id, Attr), sublist(xml_element(allocate), Content, Allocations), maplist(process_allocation(Id), Allocations). process_freeday(element(freeday,Attr,_)) :- memberchk(teacher=Teacher, Attr), memberchk(day=Day, Attr), atom_number(Day, NDay), assert(teacher_freeday(Teacher,NDay)). process_input :- load_xml_file('reqs.xml', AST), memberchk(element(requirements,_,Content), AST), process_globals(Content), sublist(xml_element(class), Content, Classes), maplist(process_class, Classes), sublist(xml_element(room), Content, Rooms), maplist(process_room, Rooms), sublist(xml_element(freeday), Content, Freedays), maplist(process_freeday, Freedays). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% doit :- process_input, timetab_(Rs, Vs), label(Vs), print_classes(Rs), nl, nl, print_teachers(Rs), nl. %?- doit. :- doit, halt.