Créer des groupes de passages de N personnes sur la base des disponibilités de P personnes sur M créneaux

selection.pl

% Pour l'utiliser : create_groups(Matrice_de_disponibilites, P, M, N, Resultat).
% Par exemple : create_groups([[1, 0, 0], [1, 1, 0], [0, 1, 0], [1, 1, 1]], 4, 3, 2, A).
% qui peut s'unifier avec A = [[1, 0, 0], [0, 1, 0], [0, 1, 0], [1, 0, 0]] (on voit bien que chaque personne est affectée à un seul créneau, et que chaque créneau affectée comporte exactement deux personnes)

% Code sous licence MIT. (c) 2018 Guillaume Jorandon

% Permet d'utiliser le predicat transpose/2 pour transposer une matrice.
:- use_module(library(clpfd)).

% gen_numeric(Result, Begin, End) : génère un entier entre deux bornes.
gen_numeric(Result, Result, _).
gen_numeric(Result, Min, Max):- Min2 is Min+1, Min2 =< Max, gen_numeric(Result, Min2, Max).

% length_list(Result, List) : retourne la taille d'une liste.
length_list(0, []).
length_list(N, [_|Y]):- length_list(M, Y), N is M+1.

% nth(Index, List, Elem) : retourne l'indice d'un élément donné ou l'élément donné pour un indice.
nth(1, [X|_], X).
nth(N, [X|Y], E):-
	length_list(Max, [X|Y]),
	gen_numeric(N, 1, Max),
	N > 1, 
	M is N-1,
	nth(M, Y, E).

% is_matrix(Matrix, N, M) : retourne vrai si on a une matrice de taille N lignes par M colonnes.
is_matrix([Curr], 1, M):- length_list(M, Curr).
is_matrix([Curr|Remaining], N, M):- length_list(M, Curr), N2 is N-1, is_matrix(Remaining, N2, M).

% is_binary_matrix(Matrix, N, M) : retourne vrai si on a une matrice binaire de taille NxM.
is_binary_matrix(Matrix, N, M):- is_matrix(Matrix, N, M), flatten(Matrix, List), is_binary_list(List).

% is_binary_list(List) : retourne vrai si on a une liste binaire (composée uniquement de 0 et de 1).
is_binary_list([]).
is_binary_list([Curr|Remaining]):- gen_numeric(Curr, 0, 1), is_binary_list(Remaining).

% substract_lists(X, Y, Res) : soustrait deux à deux les éléments d'une liste.
substract_lists([X], [Y], [Res]):- Res is X-Y.
substract_lists([X|X_R], [Y|Y_R], [Res|Res_R]):- Res is X-Y, substract_lists(X_R, Y_R, Res_R).

% matrix_at(Matrix, I, J, Elem) : retourne l'élément sur la ligne I, colonne J, ou la ligne I, colonne J d'un élément donné.
matrix_at(List, I, J, X):- nth(I, List, Curr), nth(J, Curr, X).

% matrix_sum_lines(Matrix, I, Sum) : retourne la somme des éléments de la ligne I.
matrix_sum_lines(Matrix, I, Sum):- nth(I, Matrix, Line), sum_list(Line, Sum).

% matrix_sum_columns(Matrix, J, Sum) : retourne la somme des éléments de la colonne J.
matrix_sum_columns(Matrix, J, Sum):- transpose(Matrix, TMatrix), matrix_sum_lines(TMatrix, J, Sum).

% matrix_remove_first_column(Matrix, Res) : retire la première colonne d'une matrice.
matrix_remove_first_column(Matrix, Res):- transpose(Matrix, [_|Remaining]), transpose(Remaining, Res).

% create_groups(D, P, M, N, A) : à partir d'une matrice de départ D de taille PxM, constitue la matrice d'arrivée A constituant des groupes de N personnes.
create_groups(D, P, M, N, A):-
	is_binary_matrix(D, P, M),
	is_binary_matrix(A, P, M),
	groups_constraint_A(A),
	groups_constraint_B(A, N),
	groups_constraint_C(D, A).

% groups_constraint_A(A) : valide la contrainte A, qui dit que la somme de chaque ligne est 1 sur la matrice d'arrivée. Autrement dit chaque personne est affectée à un seul créneau.
groups_constraint_A([]).
groups_constraint_A([Curr|Remaining]):- matrix_sum_lines([Curr], 1, X), X is 1, groups_constraint_A(Remaining).

% groups_constraint_B(A, N) : valide la contrainte B, qui dit que la somme de chaque colonne est de N ou 0 sur la matrice d'arrivée. Autrement dit chaque créneau est soit vide, soit occupé par exactement N personnes.
groups_constraint_B([], _).
groups_constraint_B(Matrix, N):- matrix_sum_columns(Matrix, 1, X), nth(_, [0, N], X), matrix_remove_first_column(Matrix, Remaining), groups_constraint_B(Remaining, N).

% groups_constraint_C(D, A) : valide la contrainte C, qui dit que si un élément de la matrice d'arrivée vaut 1, alors il vaut 1 aussi dans la matrice de départ. Autrement dit on n'affecte pas une personne à un créneau si elle ne s'est pas marquée disponible.
groups_constraint_C(D, A):-
		flatten(D, F_D),
		flatten(A, F_A),
		substract_lists(F_D, F_A, Res),
		is_binary_list(Res).