Anonymous user
Stable marriage problem: Difference between revisions
→{{header|Prolog}}
(Modified for standard library updates) |
|||
Line 1,170:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% rules
stable_mariage :-
new(LstMan, chain),
Line 1,188 ⟶ 1,189:
new(LstCouple, chain),
% creation of the couple.
send(LstWoman, for_all, and(message(@prolog,
message(@pce, write_ln, @arg1?name, with, @arg1?elu?name))),
nl,
% test of the stability of couples
stability(LstCouple),
Line 1,211 ⟶ 1,213:
send(@pce, write_ln, NC2?second, with, NC2?first),
nl,
stability(LstCouple).
transform(PceCouple, couple(First, Second)):-▼
get(PceCouple?first, value, First),▼
get(PceCouple?second, value, Second).▼
get_two_random_couples(Len, C1, C2) :-
Line 1,226 ⟶ 1,222:
C1 \= C2.
send(LstCouple, append, new(_, tuple(Woman?elu?name, Woman?name))).▼
% iterations of the algorithm
▲cree_couple(Woman, LstCouple ) :-
▲ send(LstCouple, append, new(_, tuple(Woman?elu, Woman?name))).
round(LstMan, LstWoman) :-
send(LstMan, for_some, message(@arg1, propose)),
Line 1,241 ⟶ 1,235:
true
).
:-pce_begin_class(person, object, "description of a person").
variable(name, object, both, "name of the person").
variable(preference, chain, both, "list of priority").
variable(status, object, both, "statut of engagement : maybe / free").
Line 1,252 ⟶ 1,245:
send(P, slot, name, Name),
send(P, slot, preference, Pref),
send(P, slot, liste, new(_, chain)),▼
send(P, slot, status, free).
% reception of the list of partners
init_liste(P, Lst) :->
% we replace the list of name of partners
send(P, slot, liste, Lst).▼
% with the list of persons partners.
new(NLP, chain),
send(LP, for_all, message(@prolog, find_person,@arg1, Lst, NLP)),
:- pce_end_class(person).
find_person(Name, LstPerson, LstPref) :-
send(LstPref, append, Elem).
:-pce_begin_class(man, person, "description of a man").
Line 1,270 ⟶ 1,272:
propose(P) :->
get(P, slot, status, free),
get(P, slot, name, Name),▼
get(P, slot, preference, XPref),
get(XPref, delete_head, Pref),
send(P, slot, preference, XPref),
▲ get(Lst, find, @arg1?name == Pref, Elem),
▲ send(Elem, proposition, Name).
refuse(P) :->
Line 1,286 ⟶ 1,285:
:- pce_end_class(man).
:-pce_begin_class(woman, person, "description of a woman").
variable(elu, object, both, "name of the elu").
Line 1,312 ⟶ 1,309:
send(R, sort, ?(@arg1?first, compare, @arg2?first)),
get(R, delete_head, Tete),
▲ send(Elem, accept),
send(P, slot, status, maybe),
send(P, slot, elu, Tete?second),
send(R, for_some, message(
send(P, slot, contact, new(_, chain)) .
% looking for the person of the given name Contact
Line 1,324 ⟶ 1,320:
fetch(P, Contact, Chain) :->
get(P, slot, preference, Lst),
% a woman receive a proposition from a man
Line 1,331 ⟶ 1,329:
send(C, append, Name),
send(P, slot, contact, C).
:- pce_end_class(woman).
▲ send(Chain, append, new(_, tuple(Index, Nom))).
% computation of the stability od couple
stability(LstCouple) :-
chain_list(LstCouple, LstPceCouple),
maplist(transform, LstPceCouple, PrologLstCouple),
study_couples(PrologLstCouple, [],
(
->
writeln('Couples are stable')
;
sort(
writeln('Unstable couples are'),
maplist(print_unstable_couple,
nl
).
print_unstable_couple((C1, C2)) :-
format('~w and ~w~n', [C1, C2]).
▲transform(PceCouple, couple(First, Second)):-
▲ get(PceCouple?first, value, First),
▲ get(PceCouple?second, value, Second).
study_couples([], UnstableCouple, UnstableCouple).
Line 1,371 ⟶ 1,364:
append(CurrentUnstableCouple, Lst1,CurrentUnstableCouple1)
;
CurrentUnstableCouple1 = CurrentUnstableCouple
),
study_couples(T, CurrentUnstableCouple1, UnstableCouple).
build_one_couple(C1, C2, (C1, C2)).
Line 1,400 ⟶ 1,394:
( (IY12 < IY11 , IX21 < IX22);
(IY21 < IY22 , IX12 < IX11)).
</lang>
The output :
| |||