Search code examples
performanceprologcombinatorics

How can prolog take minutes to check for answers within a bunch of possible combinations only?


The following sample program generates a schedule while matching certain conditions.

Conditions:

  1. assigns one employee per shift
  2. no employee should work consecutive shifts
  3. do not assign employee for personal holidays

The program provides valid solutions, but takes about 4 minutes although there should be only 128 possible combinations (combine 2 employees on 7 shifts). The program was executed using gprolog implementation within a single core virtual machine.

How is this possible? What is happening?

% which shifts have to be assigned to employees
shift(1, monday).   
shift(2, tuesday).
shift(3, wednesday).
shift(4, thursday).
shift(5, friday).
shift(6, saturday).
shift(7, sunday).

% available employees
employee(xerxes).
employee(yasmin).

% holidays specified in advance
unavailable(xerxes, shift(1, monday)).


get_all_employees(Employees) :-
    findall(employee(E), employee(E), Employees).

get_all_shifts(Shifts) :-
    findall(shift(D, N), shift(D, N), Shifts).

get_random_assignment(A) :-
    get_all_employees(Es), member(E, Es), 
    get_all_shifts(Ss), member(S, Ss),
    findall(assign(E,S), (E,S), A).

init_schedule(Schedule) :-
    length(Ss, N),
    get_all_shifts(Ss),
    length(Schedule, N),
    get_init_schedule_(Schedule).

get_init_schedule_([]).
get_init_schedule_([H|Schedule]) :-
    get_random_assignment(A),
    member(H, A),
    get_init_schedule_(Schedule).

get_schedule(Schedule) :-
    init_schedule(Schedule),
    one_employee_per_shift(Schedule),
    no_consecutive_shifts(Schedule),
    no_shift_on_personal_holiday(Schedule).

dif_assignment(assign(employee(_), shift(D, N)), assign(employee(_), shift(D2, N2))) :-
    D \== D2,
    N \== N2.

alldiff([]).
alldiff([E|Es]) :-
    maplist(dif_assignment(E), Es),
    alldiff(Es).

%
% 1. condition
%
one_employee_per_shift(Schedule) :-
    alldiff(Schedule).
%
% 2. Condition
%
no_consecutive_shift_(assign(employee(E), shift(D, _)), assign(employee(E2), shift(D2, _))) :-
    D_TMP is D + 1, 
    (D2 =:= D_TMP -> E \== E2 ; true).

no_consecutive_shifts([]).
no_consecutive_shifts([A|As]) :- 
    maplist(no_consecutive_shift_(A), As),
    no_consecutive_shifts(As).

%
% 3. Condition
%
no_shift_on_personal_holiday([]).
no_shift_on_personal_holiday([assign(employee(E), shift(D, N))|Schedule]) :-
    (unavailable(E2, shift(D, N)) -> E \== E2 ; true),
    no_shift_on_personal_holiday(Schedule).



Solution

  • takes about 4 minutes although there should be only 128 possible combinations (combine 2 employees on 7 shifts)

    It's true that this should be the search space, but you explore a lot more. Consider the first two answers from your predicate:

    ?- get_schedule(S).
    S = [assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(xerxes), shift(6, saturday)), assign(employee(yasmin), shift(1, monday)), assign(employee(yasmin), shift(3, wednesday)), assign(employee(yasmin), shift(5, friday)), assign(employee(yasmin), shift(7, sunday))] ;
    S = [assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(xerxes), shift(6, saturday)), assign(employee(yasmin), shift(1, monday)), assign(employee(yasmin), shift(3, wednesday)), assign(employee(yasmin), shift(7, sunday)), assign(employee(yasmin), shift(5, friday))] .
    

    These are the same schedule (i.e., the same assignment of persons to shifts), the elements are just arranged in different ways. Instead of exploring a solution space of 128 schedules, you are exploring something like the set of all permutations of 128 seven-element lists. That is too much.

    And even if this were fast, it is not great to give all of these redundant answers that are sorted unintuitively. So the solution is to break this symmetry by only trying schedules that are "properly sorted" the way humans would expect.

    Your get_all_shifts/1 already gives us the shifts as we would expect:

    ?- get_all_shifts(Shifts).
    Shifts = [shift(1, monday), shift(2, tuesday), shift(3, wednesday), shift(4, thursday), shift(5, friday), shift(6, saturday), shift(7, sunday)].
    

    We just need to change init_schedule/1 to something that only produces schedules in which the shifts are ordered this way. In other words, we just need to pair up employees with these shifts as they are given:

    init_schedule(Schedule) :-
        get_all_shifts(Shifts),
        shifts_schedule(Shifts, Schedule).
    
    shifts_schedule([], []).
    shifts_schedule([Shift | Shifts], [Assignment | Assignments]) :-
        employee(Employee),
        Assignment = assign(employee(Employee), Shift),
        shifts_schedule(Shifts, Assignments).
    

    This now really only has 128 solutions:

    ?- time(findall(S, init_schedule(S), AllSchedules)), length(AllSchedules, N).
    % 544 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 3239908 Lips)
    AllSchedules = [[assign(employee(xerxes), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(3, wednesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(xerxes), shift(5, friday)), assign(employee(xerxes), shift(6, saturday)), assign(employee(...), shift(..., ...))], [assign(employee(xerxes), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(3, wednesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(xerxes), shift(5, friday)), assign(employee(...), shift(..., ...)), assign(..., ...)], [assign(employee(xerxes), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(3, wednesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(...), shift(..., ...)), assign(..., ...)|...], [assign(employee(xerxes), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(xerxes), shift(3, wednesday)), assign(employee(...), shift(..., ...)), assign(..., ...)|...], [assign(employee(xerxes), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(...), shift(..., ...)), assign(..., ...)|...], [assign(employee(xerxes), shift(1, monday)), assign(employee(...), shift(..., ...)), assign(..., ...)|...], [assign(employee(...), shift(..., ...)), assign(..., ...)|...], [assign(..., ...)|...], [...|...]|...],
    N = 128.
    

    And the rest works as expected, producing a single solution very quickly:

    ?- time(get_schedule(S)).
    % 8,664 inferences, 0.003 CPU in 0.002 seconds (108% CPU, 3426483 Lips)
    S = [assign(employee(yasmin), shift(1, monday)), assign(employee(xerxes), shift(2, tuesday)), assign(employee(yasmin), shift(3, wednesday)), assign(employee(xerxes), shift(4, thursday)), assign(employee(yasmin), shift(5, friday)), assign(employee(xerxes), shift(6, saturday)), assign(employee(yasmin), shift(7, sunday))] ;
    % 3,610 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 4158272 Lips)
    false.