% Simsttab -- Simplistic school time tabler % Copyright (C) 2005 Markus Triska % % 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 % % Contact me via triska@gmx.at. % http://stud4.tuwien.ac.at/~e0225855/simsttab/simsttab.html :- use_module(library(bounds)). :- dynamic req/4, coupling/4, teacher_freeday/2, slots_per_day/1, num_slots/1, free_slot/2, room_alloc/4. 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 in 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) :- ordered(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), ordered(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). ordered([]). ordered([O|Os]) :- ordered_lag(Os, O). ordered_lag([], _). ordered_lag([O|Os], Prev) :- Prev #< O, ordered_lag(Os, O). reqcmp(Delta, req(_,_,N1,_)-_,req(_,_,N2,_)-_) :- (N1 =:= N2 -> Delta = '<' ; compare(Delta, N1, N2) ). %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(req(C,S,T,N), req(C,S,T,N)-List) :- length(List,N). :- req_with_joblist(req(2,ph,phteacher,2), req(2,ph,phteacher,2)-[_,_]). 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). print_plan(C, Rs) :- sublist(class_req(C), Rs, Sub), print_plan(C, Sub, 0). print_classes(Rs) :- all_classes(Cs), maplist(print_class(Rs), Cs). print_class(Rs, Class) :- format("\n\n\n\nClass: ~w\n", Class), print_plan(Class, Rs). class_nth(Rs, C, N, Subj) :- member(req(C,Subj,_Num,_Teacher)-Times, Rs), member(N, Times). print_plan(C, Rs, N) :- num_slots(NSlots), slots_per_day(SPD), ( N < NSlots -> (0 =:= N mod SPD -> nl, nl ; true ), ( class_nth(Rs, C, N, Subj) -> S = Subj ; S = free ), format("~w ",[S]), N1 is N + 1, print_plan(C, Rs, N1) ; true ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Parse XML file. This part of the program contains side-effects: It asserts % the facts that are read in 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,_)) :- member(subject=Subject, Attr), member(teacher=Teacher, Attr), member(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,_)) :- member(subject=Subject, Attr), member(lesson1=Slot1, Attr), member(lesson2=Slot2, Attr), atom_number(Slot1, NSlot1), atom_number(Slot2, NSlot2), assert(coupling(ClassId,Subject,NSlot1,NSlot2)). process_free(ClassId, element(free,Attr,_)) :- member(slot=Slot, Attr), atom_number(Slot, NSlot), assert(free_slot(ClassId,NSlot)). process_class(element(class,Attr,Content)) :- member(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) :- member(element(global,GlobAttr,_), Content), member(numslots=Numslots, GlobAttr), member(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,_)) :- member(class=Class, Attr), member(subject=Subject, Attr), member(lesson=Lesson, Attr), atom_number(Lesson, NLesson), assert(room_alloc(RoomId,Class,Subject,NLesson)). process_room(element(room,Attr,Content)) :- member(id=Id, Attr), sublist(xml_element(allocate), Content, Allocations), maplist(process_allocation(Id), Allocations). process_freeday(element(freeday,Attr,_)) :- member(teacher=Teacher, Attr), member(day=Day, Attr), atom_number(Day, NDay), assert(teacher_freeday(Teacher,NDay)). process_input :- load_xml_file('reqs.xml', AST), member(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, halt. :- doit.