Created
April 9, 2012 16:39
-
-
Save shintakezou/2344629 to your computer and use it in GitHub Desktop.
Modelling social relationships in Prolog
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
%{ knowledge starts from here | |
%% the database knows these people | |
person('Mary Brod'). | |
person('Carl Stuckart'). | |
person('Rudolf Fisher'). | |
person('Amanda Least'). | |
person('Minority Report'). | |
%% when they are born | |
born('Mary Brod', date(1988, 3, 11)). | |
born('Carl Stuckart', date(1978, 5, 10)). | |
born('Rudolf Fisher', date(1978, 5, 10)). | |
born('Amanda Least', date(1988, 11, 3)). | |
born('Minority Report', date(1997, 11, 3)). | |
%% their gender | |
gender('Mary Brod', female). | |
gender('Carl Stuckart', male). | |
gender('Rudolf Fisher', male). | |
gender('Amanda Least', female). | |
gender('Minority Report', male). | |
%% their sex orientation | |
likesGender('Mary Brod', [female, male]). | |
likesGender('Carl Stuckart', [female]). | |
likesGender('Rudolf Fisher', [female]). | |
likesGender('Amanda Least', [male]). | |
likesGender('Minority Report', [female]). | |
%% who knows who (reciprocal) | |
knows('Mary Brod', 'Amanda Least'). | |
knows('Mary Brod', 'Carl Stuckart'). | |
knows('Mary Brod', 'Minority Report'). | |
knows('Carl Stuckart', 'Mary Brod'). | |
knows('Carl Stuckart', 'Rudolf Fisher'). | |
knows('Carl Stuckart', 'Minority Report'). | |
knows('Rudolf Fisher', 'Carl Stuckart'). | |
knows('Rudolf Fisher', 'Amanda Least'). | |
knows('Rudolf Fisher', 'Minority Report'). | |
knows('Amanda Least', 'Mary Brod'). | |
knows('Amanda Least', 'Rudolf Fisher'). | |
knows('Amanda Least', 'Minority Report'). | |
knows('Minority Report', 'Mary Brod'). | |
knows('Minority Report', 'Carl Stuckart'). | |
knows('Minority Report', 'Rudolf Fisher'). | |
knows('Minority Report', 'Amanda Least'). | |
%% who knows who (unidirectional) | |
knows('Carl Stuckart', 'Amanda Least'). | |
knows('Rudolf Fisher', 'Mary Brod'). | |
%% people like people (or maybe not); a rather broad term | |
likes('Mary Brod', 'Carl Stuckart'). | |
likes('Carl Stuckart', 'Mary Brod'). | |
likes('Carl Stuckart', 'Rudolf Fisher'). | |
likes('Rudolf Fisher', 'Amanda Least'). | |
likes('Amanda Least', 'Mary Brod'). | |
likes('Amanda Least', 'Rudolf Fisher'). | |
likes('Mary Brod', 'Minority Report'). | |
likes('Carl Stuckart', 'Minority Report'). | |
likes('Rudolf Fisher', 'Minority Report'). | |
likes('Amanda Least', 'Minority Report'). | |
likes('Minority Report', 'Mary Brod'). | |
likes('Minority Report', 'Carl Stuckart'). | |
likes('Minority Report', 'Rudolf Fisher'). | |
likes('Minority Report', 'Amanda Least'). | |
%% people may be in love (unrequited or not), and even with | |
%% more than one person. | |
loves('Mary Brod', 'Amanda Least'). | |
loves('Carl Stuckart', 'Amanda Least'). | |
loves('Rudolf Fisher', 'Mary Brod'). | |
loves('Rudolf Fisher', 'Amanda Least'). | |
loves('Amanda Least', 'Rudolf Fisher'). | |
%} knowledge ends here | |
%% friendship is reciprocal knowledge | |
friends(P1, P2) :- knows(P1, P2), knows(P2, P1). | |
%% get year from gprolog dt struct given by date_time | |
get_year(Y, dt(Y, _, _, _, _, _)). | |
%% compute the current age of a person (simplified) | |
age(Person, AgeYear) :- | |
person(Person), | |
date_time(Dt), | |
get_year(Yc, Dt), | |
born(Person, date(Yb, _, _)), | |
AgeYear is Yc - Yb. | |
%% two persons could have sex if they like/love each other and their | |
%% sex orientations match the gender of the probable partner, | |
%% and if they are in age for each other or, if underaged, | |
%% the difference is not more than 5 | |
canHaveSex(P1, P2) :- | |
(likes(P1, P2) ; loves(P1, P2)), | |
(likes(P2, P1) ; loves(P2, P1)), | |
gender(P1, G1), gender(P2, G2), | |
likesGender(P1, L1), likesGender(P2, L2), | |
member(G1, L2), member(G2, L1), | |
age(P1, Age1), age(P2, Age2), | |
( (Age1 >= 18, Age2 >= 18) ; | |
( abs(Age1 - Age2) < 6, (Age1 > 13, Age2 > 13) ) | |
). |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment