Doctor Planning resolved with #Prolog

2020-04-22

Below my #prolog solution for “Doctor Planning” proposed by dmcommunity.org challenge April 2020

There should be more constraints like a limit of shifts a week for each doctor… In any case after few seconds I get the first result [[2,3,4],[2,3,4],[2,3,4],[2,3,4],[1,2,3],[1,2,4],[1,2,4]]

It means: Monday sheets: doctor 2 (early), doctor 3 (late) and doctor 4 (night)…

:- use_module(library(clpfd)). /* using swi-prolog */
:- use_module(library(clpz)). /* using scryer-prolog */
/*
  solver for issue
  https://dmcommunity.org/challenge/challenge-apr-2020/
  tested with swi-prolog and scryer-prolog
*/

/*
  constraint 1:
  a doctor can work only a shift a day
*/
constraint1_one_shift_a_day(Doctors):-
	all_different(Doctors).

/*
  constraint 2:
  a doctor should always be available
  for his shift
*/
constraint2_doctor_day_shift(1, 5, _).
constraint2_doctor_day_shift(1, 6, _).
constraint2_doctor_day_shift(1, 7, _).
constraint2_doctor_day_shift(2, _, 1).
constraint2_doctor_day_shift(2, _, 2).
constraint2_doctor_day_shift(3, Day, _):- Day in 1..5.
constraint2_doctor_day_shift(3, Day, Shift):- Day in 6..7, Shift in 1..2.
constraint2_doctor_day_shift(4, _, _).
constraint2_doctor_day_shift(5, _, _).

constraint2_doctor5(Doctors):-
	findall(5, member([_,_,5], Doctors), Turns),
	length(Turns, Tot), Tot #<2.

/*
  constraint 3:
  if a doctor has a night shift,
  they either get the next day off or
  the night shift again
*/
constraint3_two_shifts_rest([[D11,D12,D13],
			     [D21,D22,D23],
			     [D31,D32,D33],
			     [D41,D42,D43],
			     [D51,D52,D53],
			     [D61,D62,D63],
			     [D71,D72,D73]
			    ]):-
	D13 #\= D21,
	D13 #\= D22,
	D23 #\= D31,
	D23 #\= D32,
	D33 #\= D41,
	D33 #\= D42,
	D43 #\= D51,
	D43 #\= D52,
	D53 #\= D61,
	D53 #\= D62,
	D63 #\= D71,
	D63 #\= D72,
	D73 #\= D11,
	D73 #\= D12.

/*
  constaint 4:
  both days in the weekend on none
*/
constraint4_both_saturday_sunday([_,
				  _,
				  _,
				  _,
				  _,
				  [D61,D62,D63],
				  [D61,D62,D63]
				 ]).
constraint4_both_saturday_sunday([_,
				  _,
				  _,
				  _,
				  _,
				  [D61,D62,D63],
				  [D62,D61,D63]
				 ]).

overall_constraints(Doctors):-
	constraint3_two_shifts_rest(Doctors),
	constraint4_both_saturday_sunday(Doctors),
	constraint2_doctor5(Doctors).

solve_one_day(Day, Doctors):-
	length(Doctors,3),
	Doctors ins 1..5,
	constraint1_one_shift_a_day(Doctors),
	Doctors = [Doctor1, Doctor2, Doctor3],
	/* constraint 2 */
	constraint2_doctor_day_shift(Doctor1, Day, 1),
	constraint2_doctor_day_shift(Doctor2, Day, 2),
	constraint2_doctor_day_shift(Doctor3, Day, 3).

solve_day_by_day([], _Doctors).
solve_day_by_day([Day|Days], [DayDoctors|Doctors]):-
	solve_one_day(Day, DayDoctors),
	solve_day_by_day(Days, Doctors).

solve(Doctors):-
	solve_day_by_day([1,2,3,4,5,6,7], Doctors),
	overall_constraints(Doctors).

Comments:

Gergö Barany - Apr 6, 2020

Nice solution! I was wondering how to approach this with CLP(FD), it did not seem “natural” to me. Here is my solution using a more “symbolic” approach, not using numerical constraints but with DCGs and aggressive use of dif/2: % A day is a list of three Doctor-Day-Shift terms. Only one shift per day % for each doctor. day(Day, EarlyDoc, LateDoc, NightDoc) –> [EarlyDoc-Day-early, LateDoc-Day-late, NightDoc-Day-night], { dif(EarlyDoc, LateDoc), dif(EarlyDoc, NightDoc), dif(LateDoc, NightDoc) }. % A week is a list of Doctor-Day-Shift terms. week –> day(sun, EarlySun, LateSun, NightSun), % Whoever works this night shift does not work the early or late shift % the next day. { dif(NightSun, EarlyMon), dif(NightSun, LateMon) }, day(mon, EarlyMon, LateMon, NightMon), { dif(NightMon, EarlyTue), dif(NightMon, LateTue) }, day(tue, EarlyTue, LateTue, NightTue), { dif(NightTue, EarlyWed), dif(NightTue, LateWed) }, day(wed, EarlyWed, LateWed, NightWed), { dif(NightWed, EarlyThu), dif(NightWed, LateThu) }, day(thu, EarlyThu, LateThu, NightThu), { dif(NightThu, EarlyFri), dif(NightThu, LateFri) }, day(fri, EarlyFri, LateFri, NightFri), { dif(NightFri, EarlySat), dif(NightFri, LateSat) }, day(sat, EarlySat, LateSat, NightSat), { dif(NightSat, EarlySun), dif(NightSat, LateSun) }, % The week starts and ends with a Sunday to ensure all constraints wrap % around correctly. In this formulation, both Sundays have the same % schedule, but this could be relaxed. day(sun, EarlySun, LateSun, NightSun). % Just the general constraints, no doctor-specific ones yet. schedule_(Schedule) :- phrase(week, Schedule). day(mon). day(tue). day(wed). day(thu). day(fri). day(sat). day(sun). weekend(sat). weekend(sun). shift(early). shift(late). shift(night). % Doctor-specific availability rules. doctor_available(fleming-Day-Shift) :- shift(Shift), member(Day, [fri, sat, sun]). doctor_available(freud-Day-Shift) :- member(Shift, [early, late]), day(Day). doctor_available(heimlich-Day-Shift) :- day(Day), shift(Shift), \+ ( weekend(Day), Shift = night ). doctor_available(eustachi-Day-Shift) :- day(Day), shift(Shift). doctor_available(golgi-Day-Shift) :- day(Day), shift(Shift). % but at max 2 night shifts, see golgi_rule/1 % A day with actual doctors assigned. scheduled_day(Day) –> [EarlyDoc-Day-early, LateDoc-Day-late, NightDoc-Day-night], { doctor_available(EarlyDoc-Day-early), doctor_available(LateDoc-Day-late), doctor_available(NightDoc-Day-night) }. % A week with doctors assigned. scheduled_week –> scheduled_day(sun), scheduled_day(mon), scheduled_day(tue), scheduled_day(wed), scheduled_day(thu), scheduled_day(fri), scheduled_day(sat), scheduled_day(sun). weekend_rule(Schedule) :- Weekend = [SatEarlyDoc-sat-early, SatLateDoc-sat-late, SatNightDoc-sat-night, SunEarlyDoc-sun-early, SunLateDoc-sun-late, SunNightDoc-sun-night], append(_Prefix, Weekend, Schedule), % The doctors working the Saturday shifts must have Sunday shifts as % well. SunDocs = [SunEarlyDoc, SunLateDoc, SunNightDoc], member(SatEarlyDoc, SunDocs), member(SatLateDoc, SunDocs), member(SatNightDoc, SunDocs), % There is no doctor working a Saturday and not Sunday, or vice versa. % This is redundant, it is implied by the other constraints. \+ ( member(Doctor-sat-_, Schedule), \+ member(Doctor-sun-_, Schedule) ), \+ ( member(Doctor-sun-_, Schedule), \+ member(Doctor-sat-_, Schedule) ). golgi_rule(Schedule) :- bagof(Day, Shift^member(golgi-Day-Shift, Schedule), GolgiNights), length(GolgiNights, N), N =< 2. % Main predicate: A fully scheduled week with all constraints applied. schedule(Schedule) :- schedule_(Schedule), phrase(scheduled_week, Schedule), golgi_rule(Schedule), weekend_rule(Schedule). Tested with SWI-Prolog 7.2.3. Example solution: ?- time(schedule(S)), maplist(writeln, S). % 26,781 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 7957758 Lips) fleming-sun-early freud-sun-late eustachi-sun-night freud-mon-early heimlich-mon-late eustachi-mon-night freud-tue-early heimlich-tue-late eustachi-tue-night freud-wed-early heimlich-wed-late eustachi-wed-night freud-thu-early heimlich-thu-late eustachi-thu-night fleming-fri-early freud-fri-late golgi-fri-night fleming-sat-early freud-sat-late eustachi-sat-night fleming-sun-early freud-sun-late eustachi-sun-night S = [fleming-sun-early, freud-sun-late, eustachi-sun-night, freud-mon-early, heimlich-mon-late, eustachi-mon-night, freud-tue-early, … - … - late, … - …|…] . If I’m not mistaken, this is equivalent to your sample solution except for having Golgi on Friday night instead of Heimlich.


Enter your instance's address


More posts like this