r machine-learning bayesian-networks bnlearn

bnlearn Error: Wrong number of conditional probability distributions

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

Solution

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)