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

Smart investment Problem with Prolog

2024-07-14 | #programming #prolog

Below my #prolog solution for Smart investment problem. It is a sample of Linear Programming using Prolog. A client of an investment firm has $10000 available for investment. He has instructed that his money be invested in particular stocks, so that no more than $5000 is invested in any one stock but at least $1000 be invested in each stock.

Continue reading 


Stable Marriage Problem with Prolog

2024-06-07 | #programming #prolog

My #prolog solution for Stable Marriage Problem proposed by dmcommunity.org challenge Jun 2024. Given n men and n women, where each person has ranked all members of the opposite sex in order of preference, marry the men and women together such that there are no two people of opposite sex who would both rather have each other than their current partners.

Continue reading 