/* Intelligence test in Picat. From https://mathematica.stackexchange.com/questions/128945/problems-encoding-a-bayesian-network-with-just-five-nodes-using-probabilitydistr Example is from "page 53 in Probabilistic Graphical Models (2009), by Daphne Koller and Neir Friedman:" """ The network has five nodes (random variables): Difficulty of a class taken by a student (0 = easy, 1 = hard) Intelligence of the student (0 = low, 1 = high) Grade achieved by the student (1 = A, 2 = B, 3 = C) SAT score of the student (0 = low, 1 = high) Letter of recommendation by the teacher (0 = False, 1 = True) We would like to use this network to do probabilistic inference (causal or evidential) like: "What is the probability of the student achieving an A, given that he is intelligent?" """ The answer is (see below): about 0.75 This is a port of my Gamble model gamble_intelligence_test.rkt This program was created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import ppl_distributions, ppl_utils. main => go. /* * observe(Sat == "sat_high"), var : difficulty Probabilities: difficulty_easy: 0.6007207207207207 difficulty_hard: 0.3992792792792793 mean = [difficulty_easy = 0.600721,difficulty_hard = 0.399279] var : grade Probabilities: grade_a: 0.6792792792792792 grade_b: 0.1899099099099099 grade_c: 0.1308108108108108 mean = [grade_a = 0.679279,grade_b = 0.18991,grade_c = 0.130811] var : intelligence Probabilities: intelligence_high: 0.8745945945945945 intelligence_low: 0.1254054054054054 mean = [intelligence_high = 0.874595,intelligence_low = 0.125405] var : letter Probabilities: true: 0.7218018018018018 false: 0.2781981981981982 mean = [true = 0.721802,false = 0.278198] var : sat Probabilities: sat_high: 1.0000000000000000 mean = [sat_high = 1.0] * observe(not Letter), var : difficulty Probabilities: difficulty_hard: 0.5336603063692555 difficulty_easy: 0.4663396936307444 mean = [difficulty_hard = 0.53366,difficulty_easy = 0.46634] var : grade Probabilities: grade_c: 0.6955791453910239 grade_b: 0.2283660306369256 grade_a: 0.0760548239720505 mean = [grade_c = 0.695579,grade_b = 0.228366,grade_a = 0.0760548] var : intelligence Probabilities: intelligence_low: 0.8576995431335662 intelligence_high: 0.1423004568664337 mean = [intelligence_low = 0.8577,intelligence_high = 0.1423] var : letter Probabilities: false: 1.0000000000000000 mean = [false = 1.0] var : sat Probabilities: sat_low: 0.8447325987637732 sat_high: 0.1552674012362268 mean = [sat_low = 0.844733,sat_high = 0.155267] * observe(Letter), var : difficulty Probabilities: difficulty_easy: 0.7348169995978013 difficulty_hard: 0.2651830004021987 mean = [difficulty_easy = 0.734817,difficulty_hard = 0.265183] var : grade Probabilities: grade_a: 0.6493497787907226 grade_b: 0.3439469097734281 grade_c: 0.0067033114358493 mean = [grade_a = 0.64935,grade_b = 0.343947,grade_c = 0.00670331] var : intelligence Probabilities: intelligence_low: 0.5425660276176432 intelligence_high: 0.4574339723823569 mean = [intelligence_low = 0.542566,intelligence_high = 0.457434] var : letter Probabilities: true: 1.0000000000000000 mean = [true = 1.0] var : sat Probabilities: sat_low: 0.6120123340930420 sat_high: 0.3879876659069580 mean = [sat_low = 0.612012,sat_high = 0.387988] * observe(Grade == "grade_a"), var : difficulty Probabilities: difficulty_easy: 0.7981576067128785 difficulty_hard: 0.2018423932871215 mean = [difficulty_easy = 0.798158,difficulty_hard = 0.201842] var : grade Probabilities: grade_a: 1.0000000000000000 mean = [grade_a = 1.0] var : intelligence Probabilities: intelligence_high: 0.6072601240423203 intelligence_low: 0.3927398759576797 mean = [intelligence_high = 0.60726,intelligence_low = 0.39274] var : letter Probabilities: true: 0.8953848960233491 false: 0.1046151039766509 mean = [true = 0.895385,false = 0.104615] var : sat Probabilities: sat_high: 0.5047427946005107 sat_low: 0.4952572053994893 mean = [sat_high = 0.504743,sat_low = 0.495257] * observe(Intelligence=="intelligence_high"), var : difficulty Probabilities: difficulty_easy: 0.6086520236369718 difficulty_hard: 0.3913479763630282 mean = [difficulty_easy = 0.608652,difficulty_hard = 0.391348] var : grade Probabilities: grade_a: 0.7459025532389341 grade_b: 0.1672427249414651 grade_c: 0.0868547218196008 mean = [grade_a = 0.745903,grade_b = 0.167243,grade_c = 0.0868547] var : intelligence Probabilities: intelligence_high: 1.0000000000000000 mean = [intelligence_high = 1.0] var : letter Probabilities: true: 0.7766752146281637 false: 0.2233247853718363 mean = [true = 0.776675,false = 0.223325] var : sat Probabilities: sat_high: 0.7921730404727394 sat_low: 0.2078269595272606 mean = [sat_high = 0.792173,sat_low = 0.207827] */ go ?=> reset_store, run_model(10_000,$model,[show_probs_trunc,mean]), nl, % fail, nl. go => true. model() => Difficulty = categorical([0.6,0.4],["difficulty_easy","difficulty_hard"]), Intelligence = categorical([0.7,0.3],["intelligence_low","intelligence_high"]), Grades = ["grade_a","grade_b","grade_c"], Grade = cases([ [(Intelligence=="intelligence_low",Difficulty=="difficulty_easy"), categorical([0.3,0.4,0.3],Grades)], [(Intelligence=="intelligence_low",Difficulty=="difficulty_hard"), categorical([0.05,0.25,0.7],Grades)], [(Intelligence=="intelligence_high",Difficulty=="difficulty_easy"), categorical([0.9,0.08,0.02],Grades)], [(Intelligence=="intelligence_high",Difficulty=="difficulty_hard"), categorical([0.5,0.3,0.2],Grades)], [true,"grade unknown"] ]), % Receives a letter of recommendation Letter = case(Grade, [["grade_a",flip(0.9)], ["grade_b",flip(0.6)], ["grade_c",flip(0.01)]]), SatOpts = ["sat_high","sat_low"], Sat = cond(Intelligence == "intelligence_high", categorical([0.8,0.2],SatOpts), categorical([0.05,0.95],SatOpts)), % observe(Sat == "sat_high"), % observe(not Letter), % observe(Letter), % observe(Grade == "grade_a"), observe(Intelligence=="intelligence_high"), if observed_ok then add_all([ ["grade",Grade], ["intelligence",Intelligence], ["difficulty",Difficulty], ["sat",Sat], ["letter",Letter] ]) end.