bnlearn Error: Wrong number of conditional probability distributions

Question

I am learning to work with bnlearn and I keep running into the following error in the last line of my code below:

Error in custom.fit(dag, cpt) : wrong number of conditional probability distributions

What am I doing wrong?

    modelstring(dag)= "[s][r][nblw|r][nblg|nblw][mlw|s:r][f|s:r:mlw][mlg|mlw:f] 
    [mlgr|mlg:nblg]"
    ###View DAG Specifics  
    dag
    arcs(dag)
    nodes(dag)
  # Create Levels
  State <- c("State0", "State1")
 ##Create probability distributions given; these are all 2d b/c they have 1 or 2 nodes
  cptS <- matrix(c(0.6, 0.4), ncol=2, dimnames=list(NULL, State))
  cptR <- matrix(c(0.7, 0.3), ncol=2, dimnames=list(NULL, State))
  cptNBLW <- matrix(c(0.95, 0.05, 0.05, 0.95), ncol=2, dimnames=list(NULL, "r"= State))
  cptNBLG <- matrix(c(0.9, 0.099999999999999998, 0.2, 0.8), ncol=2, dimnames=list(NULL, 
  "nblw"=State))
  cptMLG <- matrix(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),ncol=2,nrow = 2,
         dimnames=list("mlw"= State, "f"=State))

 cptMLGR <- matrix(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45),ncol=2,nrow = 2,
              dimnames=list("mlg"= State, "nblg"=State))

 cptMLW <-matrix(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), ncol=2,nrow = 2,byrow = TRUE,
           dimnames=list("r"= State, "s"=State))

    # Build  3-d matrices( becuase you have 3 nodes, you can't use the matrix function; you 
 have to build it from scratch)
 cptF <- c(0.05, 0.95, 0.4, 0.6, 0.9, 0.1, 0.99, 0.01, 0.9, 0.1, 0.95, 0.05, 0.95, 0.05, 0.99, 
  0.01)
   dim(cptF) <- c(2, 2, 2, 2)
  dimnames(cptF) <- list("s"=State, "r"=State, "mlw"=State)


             ###Create CPT Table
     cpt <- list(s = cptS, r = cptR, mlw = cptMLW,nblw= cptNBLW,
         mlg= cptMLG, nblg= cptNBLG, mlgr= cptMLGR)
   # Construct BN network with Conditional Probability Table
    S.net <- custom.fit(dag,cpt)

Reference: https://rpubs.com/sarataheri/bnlearnCGM

Answer 1

You have several errors in your CPT definitions. Primarily, you need to make sure that:

• the number of probabilities supplied are equal to the product of the number of states in the child and parent nodes,
• that the number of dimensions of the matrix/array is equal to the number of parent nodes plus one, for the child node,
• the child node should be given in the first dimension when the node dimension is greater than one.
• the names given in the dimnames arguments (e.g. the names in dimnames=list(ThisName = ...)) should match the names that were defined in the DAG, in your case with modelstring and in my answer with model2network. (So my earlier suggestion of using dimnames=list(cptNBLW = ...) should be dimnames=list(nblw = ...) to match how node nblw was declared in the model string)

You also did not add node f into your cpt list.

Below is your code with comments where things have been changed. (I have commented out the offending lines and added ones straight after)

library(bnlearn)

dag <- model2network("[s][r][nblw|r][nblg|nblw][mlw|s:r][mlg|mlw:f][mlgr|mlg:nblg][f|s:r:mlw]")

State <- c("State0", "State1")
cptS <- matrix(c(0.6, 0.4), ncol=2, dimnames=list(NULL, State))
cptR <- matrix(c(0.7, 0.3), ncol=2, dimnames=list(NULL, State))
 
# add child node into first slot of dimnames
cptNBLW <- matrix(c(0.95, 0.05, 0.05, 0.95), ncol=2, dimnames=list(nblw=State, "r"= State))
cptNBLG <- matrix(c(0.9, 0.099999999999999998, 0.2, 0.8), ncol=2, dimnames=list(nblg=State,"nblw"=State))
 
# Use a 3d array and not matrix, and add child node into dimnames
# cptMLG <- matrix(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),ncol=2,nrow = 2, dimnames=list("mlw"= State, "f"=State))
cptMLG <- array(c(0.95, 0.05, 0.4, 0.6, 0.2, 0.8, 0.05, 0.95),dim=c(2,2,2), dimnames=list(mlg = State, "mlw"= State, "f"=State))

# cptMLGR <- matrix(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45),ncol=2,nrow = 2, dimnames=list("mlg"= State, "nblg"=State))
cptMLGR <- array(c(0.6,0.4,0.95,0.05,0.2,0.8,0.55,0.45), dim=c(2,2,2), dimnames=list(mlgr=State, "mlg"= State, "nblg"=State))

# cptMLW <-matrix(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), ncol=2,nrow = 2,byrow = TRUE,  dimnames=list("r"= State, "s"=State))
cptMLW <-array(c(0.95, 0.05, 0.1, 0.9, 0.2, 0.8, 0.01, 0.99), dim=c(2,2,2),  dimnames=list(mlw=State, "r"= State, "s"=State))

# add child into first slot of dimnames
cptF <- c(0.05, 0.95, 0.4, 0.6, 0.9, 0.1, 0.99, 0.01, 0.9, 0.1, 0.95, 0.05, 0.95, 0.05, 0.99, 0.01)
dim(cptF) <- c(2, 2, 2, 2)
dimnames(cptF) <- list("f" = State, "s"=State, "r"=State, "mlw"=State)

# add missing node f into list
cpt <- list(s = cptS, r = cptR, mlw = cptMLW,nblw= cptNBLW, mlg= cptMLG, nblg= cptNBLG, mlgr= cptMLGR, f=cptF)
  
# Construct BN network with Conditional Probability Table
S.net <- custom.fit(dag, dist=cpt)