/* * Filename: mc8.pro (marriage counsellor 8) * * Programmer: Br. David Carlson * * Date of creation: September 4, 1993 * * Revised: December 11, 1999 to run under yap. * * Description: * * This program is used to predict the likelihood that 2 people have * (or will have) marriage problems. This version is interactive. Start * with the goal: report. */ report :- write('Marriage Counsellor Expert System Report'), nl, nl, problems(marriage, Prob), write('Likelihood of overall marriage problems is '), write(Prob), nl. problems(marriage, Prob) :- problems(financial, FinProb), write('Likelihood of financial problems is '), write(FinProb), nl, problems(sexual, SexProb), write('Likelihood of sexual problems is '), write(SexProb), nl, problems(communications, CommProb), write('Likelihood of communications problems is '), write(CommProb), nl, problems(psychological, PsychProb), write('Likelihood of psychological problems is '), write(PsychProb), nl, problems(parental_divorce, ParDivProb), write('Degree of problems due to parental divorce is '), write(ParDivProb), nl, average5(FinProb, SexProb, CommProb, PsychProb, ParDivProb, Prob). problems(financial, Prob) :- ask(low_earnings(husband), HusbProb), ask(low_earnings(wife), WifeProb), average2(HusbProb, WifeProb, Prob). /* The 3 problems in the next section are seen as so important that the * resultant probability is the largest of the 3 probabilities, instead * of the average. */ problems(sexual, Prob) :- ask(unfaithful(husband), HusbProb), ask(unfaithful(wife), WifeProb), ask(impotent(husband), ImProb), maximum3(HusbProb, WifeProb, ImProb, Prob). /* In the next section as well, the resultant probability is taken to be * the largest of the component probabilities. */ problems(communications, Prob) :- dominance(DomProb), abuse(AbuseProb), reticence(RetProb), maximum3(DomProb, AbuseProb, RetProb, Prob). problems(psychological, Prob) :- depression(DepressProb), psychosis(PsychProb), maximum2(DepressProb, PsychProb, Prob). problems(parental_divorce, Prob) :- ask(parents_divorced(husband), HusbProb), ask(parents_divorced(wife), WifeProb), average2(HusbProb, WifeProb, Prob). dominance(Prob) :- ask(domineering(wife), WifeProb), ask(domineering(husband), HusbProb), maximum2(WifeProb, HusbProb, Prob). abuse(Prob) :- ask(abusive(husband), HusbProb), ask(abusive(wife), WifeProb), maximum2(HusbProb, WifeProb, Prob). reticence(Prob) :- ask(reticent(husband), HusbProb), ask(reticent(wife), WifeProb), average2(HusbProb, WifeProb, Prob). depression(Prob) :- ask(depressed(husband), HusbProb), ask(depressed(wife), WifeProb), average2(HusbProb, WifeProb, Prob). psychosis(Prob) :- ask(psychotic(husband), HusbProb), ask(psychotic(wife), WifeProb), average2(HusbProb, WifeProb, Prob). ask(Problem, Prob) :- write('Enter likelihood that: '), write(Problem), write(' '), read(Prob). /* could add input checking on Prob */ average5(N1, N2, N3, N4, N5, Avg) :- Avg is (N1 + N2 + N3 + N4 + N5) / 5. average2(N1, N2, Avg) :- Avg is (N1 + N2) / 2. maximum2(N1, N2, N1) :- N1 > N2, !. maximum2(_, N2, N2). maximum3(N1, N2, N3, Max) :- N1 > N2, !, maximum2(N1, N3, Max). maximum3(_, N2, N3, Max) :- maximum2(N2, N3, Max).