Question summary

I had recently asked this question where problems encoding a Bayesian Network were linked to the use of MultinomialDistribution. While that problem can be avoided using EmpiricalDistribution, there remains an issue with using ProbabilityDistribution for larger networks as it seems: While Probability can be used for inference with 4 nodes, it will not evaluate for the "full" example network of 5 nodes -- which still is far removed from real application demands. Why is this so? What can be done about it?

Bayesian Network Example

Again I would like to use the (simple) example that is given on 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?"

Encoding the Bayesian Network in Mathematica

Essentially the Bayesian Network is a sparse way to define the joint probability distribution function for the random variables using the chain rule of probability theory:

$ \begin{align} P(I,D,G,S,L) = P(I) \times P(D) \times P(G|I,D) \times P(S|I) \times P(L|G) \end{align} $

I am encoding this in Mathematica as follows:

(* nodes without parents *)
distI = BernoulliDistribution[ 0.3 ]; (* prior probability of high intelligence *)
distD = BernoulliDistribution[ 0.4 ]; (* prior probability of hard class *)

(* nodes with parents = conditional probability distributions *)
(* conditional distribution of the grade *)
cpdG = Function[ { i, d },
    With[
      {
        p = Piecewise[
                {
                  { {  0.3,  0.4,  0.3  }, i == 0 && d == 0 },
                  { {  0.05, 0.25, 0.7  }, i == 0 && d == 1 },
                  { {  0.9,  0.08, 0.02 }, i == 1 && d == 0 },
                  { {  0.5,  0.3,  0.2  }, i == 1 && d == 1 }
                }
            ]
      },
      EmpiricalDistribution[ p -> Range[3] ]
    ]
];

(* conditional distribution for the SAT score *)
cpdS = Function[ i,
   With[
    {
     θ = Piecewise[
           {
             { 0.05, i == 0 },
             { 0.8,  i == 1 }
           }
         ] (* probability of a high SAT score *)
     },
     BernoulliDistribution[θ]
   ]
];

(* conditional probability function for the Letter *)
cpdL = Function[ g,
   With[
     {
       θ = Piecewise[
             {
               { 0.9,  g == 1 },
               { 0.6,  g == 2 },
               { 0.01, g == 3 } 
             }
           ]
     },
     BernoulliDistribution[θ]
   ]
];

(* BayesNetwork = Joint Probability Distribution Function *)
(* B4 = P(I,D,G,L) *) 
distB4 = ProbabilityDistribution[
   PDF[ distI, i] PDF[ distD, d] PDF[ cpdG[i,d], g] PDF[ cpdL[g], l],
   {i, 0, 1, 1},
   {d, 0, 1, 1},
   {g, 1, 3, 1},
   {l, 0, 1, 1}
];

(* B5 = P(I,D,G,S,L) *)
distB5 = ProbabilityDistribution[
   PDF[ distI, i] PDF[ distD, d] PDF[ cpdG[i,d], g] PDF[ cpdS[i], s] PDF[ cpdL[g], l],
   {i, 0, 1, 1},
   {d, 0, 1, 1},
   {g, 1, 3, 1},
   {s, 0, 1, 1},
   {l, 0, 1, 1}
];

Doing Inference

Now we would like to ask the question as stated above:

Probability[ g == 1 \[Conditioned] i == 1, {i,d,g,l} \[Distributed] distB4 ]

0.74

Probability[ g == 1 \[Conditioned] i == 1, {i,d,g,s,l} \[Distributed] distB5 ]

Probability[ ] is returned unevaluted.

Why is this the case? What can be done about it - after all 5 nodes should not be too far a stretch?