Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- likes(tom,book).
- likes(pam,fish).
- likes(ann, apple).
- likes(ann, cat).
- likes(ann, flower).
- likes(bob, apple).
- likes(bob, cat).
- likes(bob, flower).
- likes(pem, apple).
- likes(pem, cat).
- likes(pem, phone).
- :-dynamic likesInfo/2.
- changeDB(X,Y) :-
- (retract(likesInfo(X, C)); C = 0),
- C1 is C + 1,
- assertz(likesInfo(X, C1)).
- existBetter(X):-
- likesInfo(X,C), likesInfo(X1,C1), C1 > C.
- mostResembling(L):-
- forall(likes(X, Y), changeDB(X,Y)),
- findall(X, (likesInfo(X, _), not(existBetter(X))), L),
- retractall(likesInfo(_,_)).
- % Поиск пары персон с наибольшим числом общих предпочтений
- most_resembling( Person1, Person2 ) :-
- pair_prefs( ['$pair_prefs'( Common_Things, Person1, Person2 ) | L ] ),
- print( L ).
- :- dynamic seen/2.
- %
- likes( tom, book ).
- likes( pam, fish ).
- likes( ann, apple ).
- likes( ann, cat ).
- likes( ann, flower ).
- likes( bob, apple ).
- likes( bob, cat ).
- likes( bob, flower ).
- likes( pem, apple ).
- likes( pem, cat ).
- likes( pem, phone ).
- % Поиск всех пар персон с любым количеством общих предпочтений
- pair_prefs( Prefs1 ) :-
- persons( Persons ),
- things( Persons, PThings_List ),
- bagof( '$pair_prefs'( Common_Things, Person1, Person2 ) ),
- Things1^Things2^Person1^Person2^(
- person_things( Persons, PThings_List, Person1, Things1 ),
- person_things( Persons, PThings_List, Person2, Things2 ),
- is_valid_pair( Person1, Person2 ),
- record_seen( Person1, Person2 ),
- intersection( Things1, Things2, Common_Things )
- ),
- Prefs
- ),
- isort( Prefs, Prefs1 ).
- pair_prefs( [] ).
- %
- person_things( Persons, Pref_List, Person, Things ) :-
- member( Person, Persons ),
- member( Things, Pref_List ),
- likes_things( Person, Things ).
- % Все персоны, представленные в likes/2
- persons( Persons ) :-
- setof( Person, Person^Thing^likes( Person, Thing ), Persons ).
- % Все предпочтения, представленнын в likes/2
- % и структурированные в соответствии c likes_things/2
- things( Persons, PThings_List ) :-
- bagof( PThings,
- PThings^Person^(
- member(Person, Persons ),
- likes_things( Person, PThings )
- ),
- PThings_List
- ).
- % То же, что и likes/2, за исключением того, что указан список предпочтений
- likes_things( Person, Things ) :-
- setof( Thing, Thing^Person^likes( Person, Thing ), Things ).
- % Пара персон применима если они не одна и та же персона
- is_valid_pair( Person1, Person2 ) :-
- dif( Person1, Person2 ),
- + is_seen( Person1, Person2 ).
- % Запись факта истории поиска: пара P1 и P2 проверены
- record_seen( P1, P2 ) :- assertz( seen( P1, P2 ) ).
- % Проверка факта истории поиска: проверены ли пара P1 и P2
- % при любом порядке переменных
- is_seen( P1, P2 ) :- seen( P1, P2 ); seen( P2, P1 ).
- %
- isort([], []).
- isort([H|T], R):- isort(T, W), insert(H, W, R).
- %
- insert(X, [], [X]).
- insert(X, [H|T], [X|L]):- X @> H, insert(H, T, L).
- insert(X, [H|T], [H|L]):- X @=< H, insert(X, T, L).
- :- initialization( goal ).
- %
- goal :-
- most_resembling( Person1, Person2 ),
- abolish_seen(),
- writef( 'nPersons: %q, %qn', [ Person1, Person2 ] ).
- % Результат работы pair_prefs/1
- % [
- % '$pair_prefs'([apple,cat,flower],ann,bob),
- % '$pair_prefs'([apple,cat],bob,pem),
- % '$pair_prefs'([apple,cat],ann,pem),
- % '$pair_prefs'([],pem,tom),
- % '$pair_prefs'([],pam,tom),
- % '$pair_prefs'([],pam,pem),
- % '$pair_prefs'([],bob,tom),
- % '$pair_prefs'([],bob,pam),
- % '$pair_prefs'([],ann,tom),
- % '$pair_prefs'([],ann,pam)
- % ]
- % Persons: ann, bob
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement