MultipleRoomsScheduling.pl

:- consult('AssignOperations.pl').

:- dynamic agenda_operation_room/3.

assign :- 
    write('Please Insert a date for the operation rooms schedulling (format: AAAAMMDD): '), 
    read(Date), 
    assign_operations(Date, Result), 
    write('Surgeries distribution: '), nl, 
    write(Result), nl, 
    store_surgeries(Date, Result).

store_surgeries(_, []).
store_surgeries(Date, [(Surgery, Room)|Rest]) :-
    (retract(agenda_operation_room(Room, Date, Surgeries)) ; Surgeries = []),
    assert(agenda_operation_room(Room, Date, [Surgery|Surgeries])),
    store_surgeries(Date, Rest).

% Definir o predicado surgeries/1
surgeries(NumSurgeries) :-
    get_all_surgeries(Surgeries),
    length(Surgeries, NumSurgeries).

% Show rooms and apply genetic algorithm
show_rooms_and_apply_genetic_algorithm(Date) :-
    get_all_operation_rooms(Date, Rooms),
    write('Available rooms: '), write(Rooms), nl,
    write('Select the room numbers to apply the genetic algorithm (e.g., [sR1, sR2]): '), 
    read(SelectedRooms),
    % Convert single room to list if necessary
    (is_list(SelectedRooms) -> RoomsList = SelectedRooms ; RoomsList = [SelectedRooms]),
    apply_genetic_algorithm_to_rooms(Date, RoomsList).

apply_genetic_algorithm_to_rooms(_, []).
apply_genetic_algorithm_to_rooms(Date, [Room|Rest]) :-
    % Fetch surgeries for the room
    agenda_operation_room(Room, Date, Surgeries),
    % Only apply genetic algorithm if there are surgeries
    (Surgeries \= [] -> 
        (write('Applying genetic algorithm to room '), write(Room), 
         write(' with surgeries: '), write(Surgeries), nl,
         apply_genetic_algorithm(Surgeries))
        ;
        (write('No surgeries found for room '), write(Room), nl)
    ),
    % Continue with remaining rooms if any
    (Rest \= [] -> apply_genetic_algorithm_to_rooms(Date, Rest) ; true).

% Genetic algorithm

% Parameters initialization
initialize :- 
    write('Number of new generations: '), read(NG), 
    (retract(generations(_)); true), 
    asserta(generations(NG)), 
    write('Population size: '), read(PS), 
    (retract(population(_)); true), 
    asserta(population(PS)), 
    write('Probability of crossover (%):'), 
    read(P1), 
    PC is P1 / 100, 
    (retract(prob_crossover(_)); true), 
    asserta(prob_crossover(PC)), 
    write('Probability of mutation (%):'), 
    read(P2), 
    PM is P2 / 100, 
    (retract(prob_mutation(_)); true), 
    asserta(prob_mutation(PM)), 
    write('Time limit (seconds):'), read(TL), 
    (retract(time_limit(_)); true), 
    asserta(time_limit(TL)), 
    write('Target evaluation value:'), read(TV), 
    (retract(target_value(_)); true), 
    asserta(target_value(TV)).

% Population generation
apply_genetic_algorithm(Surgeries) :-
    initialize,
    current_time(StartTime),
    generate_population(Surgeries, Pop),
    write('Pop='), write(Pop), nl,
    evaluate_population(Pop, PopValue),
    write('PopValue='), write(PopValue), nl,
    order_population(PopValue, PopOrd),
    generations(NG),
    write('Generation 0:'), nl,
    write(PopOrd), nl,
    generate_generation(1, NG, PopOrd, StartTime).

generate_population(Surgeries, Pop) :- 
    population(PopSize), 
    length(Surgeries, NumSurgeries), 
    generate_population(PopSize, Surgeries, NumSurgeries, Pop).

generate_population(0, _, _, []) :- !.
generate_population(PopSize, Surgeries, NumSurgeries, [Ind|Rest]) :- 
    PopSize1 is PopSize - 1, 
    generate_population(PopSize1, Surgeries, NumSurgeries, Rest), 
    generate_individual(Surgeries, NumSurgeries, Ind), 
    \+ member(Ind, Rest).
generate_population(PopSize, Surgeries, NumSurgeries, Pop) :- 
    generate_population(PopSize, Surgeries, NumSurgeries, Pop).

% Individual generation
generate_individual([G], 1, [G]) :- !.
generate_individual(Surgeries, NumSurgeries, [G|Rest]) :- 
    NumTemp is NumSurgeries + 1, 
    random(1, NumTemp, N), 
    remove(N, Surgeries, G, NewList), 
    NumSurgeries1 is NumSurgeries - 1, 
    generate_individual(NewList, NumSurgeries1, Rest).

remove(1, [G|Rest], G, Rest).
remove(N, [G1|Rest], G, [G1|Rest1]) :- 
    N1 is N - 1, 
    remove(N1, Rest, G, Rest1).

% Population evaluation
evaluate_population([], []).
evaluate_population([Ind|Rest], [Ind*V|Rest1]) :- 
    evaluate(Ind, V), 
    evaluate_population(Rest, Rest1).

evaluate(Seq, V) :- 
    evaluate_priority(Seq, 0, 0, V).

% Evaluate priority
evaluate_priority([], _, V, V).
evaluate_priority([Surgery|Rest], LastPriority, Acc, V) :- 
    surgery_id(Surgery, Type), 
    operation_priority(Type, Priority), 
    (Priority >= LastPriority -> 
        NewAcc is Acc + Priority ; 
        NewAcc is Acc + Priority + 20),
    evaluate_priority(Rest, Priority, NewAcc, V).

% Population sorting
order_population(PopValue, PopValueOrd) :- 
    bsort(PopValue, PopValueOrd).

bsort([X], [X]) :- !.
bsort([X|Xs], Ys) :- 
    bsort(Xs, Zs), 
    bchange([X|Zs], Ys).

bchange([X], [X]) :- !.
bchange([X*VX, Y*VY|L1], [Y*VY|L2]) :- 
    VX > VY, !, 
    bchange([X*VX|L1], L2).
bchange([X|L1], [X|L2]) :- 
    bchange(L1, L2).

% Generation evolution
generate_generation(G, G, Pop, _) :- !,
    write('Generation '), write(G), write(':'), nl,
    write(Pop), nl,
    Pop = [BestInd|_],
    write('Best individual in final generation: '),
    write(BestInd), nl.

generate_generation(N, G, Pop, StartTime) :- 
    N < G, 
    current_time(CurrentTime), 
    time_limit(TL), 
    MaxTime is StartTime + TL, 
    (CurrentTime > MaxTime -> 
        (write('Time limit reached.'), nl, Pop = [BestInd|_], write('Best individual: '), write(BestInd), nl) ; 
        (write('Generation '), write(N), write(':'), nl, 
        write(Pop), nl, 
        select_population_varied(Pop, SelectedPop), 
        crossover_population(SelectedPop, NPop1), 
        mutation(NPop1, NPop), 
        evaluate_population(NPop, NPopValue), 
        order_population(NPopValue, NPopOrd), 
        elitism(Pop, NPopOrd, BestInd), 
        target_value(TV), 
        (BestInd = _*BestVal, BestVal =< TV -> 
            (write('Target evaluation reached.'), nl, write('Best individual: '), write(BestInd), nl) ; 
            (N1 is N + 1, generate_generation(N1, G, NPopOrd, StartTime))))).

% Crossover surgeries
generate_crossover_points(P1, P2) :- 
    generate_crossover_points1(P1, P2).

generate_crossover_points1(P1, P2) :- 
    surgeries(N), 
    NTemp is N + 1, 
    random(1, NTemp, P11), 
    random(1, NTemp, P21), 
    P11 \== P21, !, 
    ((P11 < P21, !, P1 = P11, P2 = P21); P1 = P21, P2 = P11).
generate_crossover_points1(P1, P2) :- 
    generate_crossover_points1(P1, P2).

% random permutation of elements
crossover_population(Pop, NewPop) :-
    random_permutation(Pop, PermutedPop),
    crossover(PermutedPop, NewPop).

crossover([], []).
crossover([Ind*_], [Ind]).
crossover([Ind1*_, Ind2*_|Rest], [NInd1, NInd2|Rest1]) :- 
    generate_crossover_points(P1, P2), 
    prob_crossover(Pcruz), 
    random(0.0, 1.0, Pc), 
    ((Pc =< Pcruz, !, 
      cross(Ind1, Ind2, P1, P2, NInd1), 
      cross(Ind2, Ind1, P1, P2, NInd2)) ; 
    (NInd1 = Ind1, NInd2 = Ind2)), 
    crossover(Rest, Rest1).

fillh([], []).
fillh([_|R1], [h|R2]) :- 
    fillh(R1, R2).

sublist(L1, I1, I2, L) :- 
    I1 < I2, !, 
    sublist1(L1, I1, I2, L).
sublist(L1, I1, I2, L) :- 
    sublist1(L1, I2, I1, L).

sublist1([X|R1], 1, 1, [X|H]) :- !, 
    fillh(R1, H).
sublist1([X|R1], 1, N2, [X|R2]) :- !, 
    N3 is N2 - 1, 
    sublist1(R1, 1, N3, R2).
sublist1([_|R1], N1, N2, [h|R2]) :- 
    N3 is N1 - 1, 
    N4 is N2 - 1, 
    sublist1(R1, N3, N4, R2).

rotate_right(L, K, L1) :- 
    surgeries(N), 
    T is N - K, 
    rr(T, L, L1).

rr(0, L, L) :- !.
rr(N, [X|R], R2) :- 
    N1 is N - 1, 
    append(R, [X], R1), 
    rr(N1, R1, R2).

remove([], _, []) :- !.
remove([X|R1], L, [X|R2]) :- 
    \+ member(X, L), !, 
    remove(R1, L, R2).
remove([_|R1], L, R2) :- 
    remove(R1, L, R2).

insert([], L, _, L) :- !.
insert([X|R], L, N, L2) :- 
    surgeries(T), 
    ((N > T, !, N1 is N mod T); N1 = N), 
    insert1(X, N1, L, L1), 
    N2 is N + 1, 
    insert(R, L1, N2, L2).

insert1(X, 1, L, [X|L]) :- !.
insert1(X, N, [Y|L], [Y|L1]) :- 
    N1 is N - 1, 
    insert1(X, N1, L, L1).

cross(Ind1, Ind2, P1, P2, NInd11) :- 
    sublist(Ind1, P1, P2, Sub1), 
    surgeries(NumSurgeries), 
    R is NumSurgeries - P2, 
    rotate_right(Ind2, R, Ind21), 
    remove(Ind21, Sub1, Sub2), 
    P3 is P2 + 1, 
    insert(Sub2, Sub1, P3, NInd1), 
    removeh(NInd1, NInd11).

removeh([], []).
removeh([h|R1], R2) :- !, 
    removeh(R1, R2).
removeh([X|R1], [X|R2]) :- 
    removeh(R1, R2).

% Mutation surgeries
mutation([], []).
mutation([Ind|Rest], [NInd|Rest1]) :- 
    prob_mutation(Pmut), 
    random(0.0, 1.0, Pm), 
    ((Pm < Pmut, !, mutacao1(Ind, NInd)); NInd = Ind), 
    mutation(Rest, Rest1).

mutacao1(Ind, NInd) :- 
    generate_crossover_points(P1, P2), 
    mutacao22(Ind, P1, P2, NInd).

mutacao22([G1|Ind], 1, P2, [G2|NInd]) :- !, 
    P21 is P2 - 1, 
    mutacao23(G1, P21, Ind, G2, NInd).
mutacao22([G|Ind], P1, P2, [G|NInd]) :- 
    P11 is P1 - 1, 
    P21 is P2 - 1, 
    mutacao22(Ind, P11, P21, NInd).

mutacao23(G1, 1, [G2|Ind], G2, [G1|Ind]) :- !.
mutacao23(G1, P, [G|Ind], G2, [G|NInd]) :- 
    P1 is P - 1, 
    mutacao23(G1, P1, Ind, G2, NInd).

% Elitism
elitism(Pop, NPop, BestInd) :- 
    Pop = [BestInd|_], 
    (member(BestInd, NPop) -> NPop1 = NPop ; NPop1 = [BestInd|NPop]), 
    length(NPop1, Len), 
    population(PopSize), 
    (Len > PopSize -> remove_last(NPop1, NPop) ; NPop = NPop1), 
    write('Best individual carried over: '), 
    write(BestInd), nl.

remove_last([_], []) :- !.
remove_last([H|T], [H|T1]) :- 
    remove_last(T, T1).

% Population selection
tournament_selection(Pop, Selected) :- 
    length(Pop, Len), 
    random(1, Len, Index1), 
    random(1, Len, Index2), 
    nth1(Index1, Pop, Ind1*Val1), 
    nth1(Index2, Pop, Ind2*Val2), 
    (Val1 =< Val2 -> Selected = Ind1*Val1 ; Selected = Ind2*Val2).

select_population_varied(Pop, SelectedPop) :- 
    population(PopSize), 
    findall(Selected, 
            (between(1, PopSize, _), 
             tournament_selection(Pop, Selected)), 
            SelectedPop).

% Current time
current_time(T) :- 
    get_time(T).