R/f11.interface.code.r

In rbmn: Handling Linear Gaussian Bayesian Networks

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
bnfit2nbn <- function(bn.fit)
#TITLE transforms a /bn.fit/ of /bnlearn/ package to a /nbn/
#DESCRIPTION returns a \code{nbn} object
# from a Gaussian \code{bn.fit} object of /bnlearn/
# package.
#DETAILS
# If \code{bn.fit} is not pertinent, a fatal error
# is issued.
#KEYWORDS
#INPUTS
#{bn.fit}<< The object to be transformed.>>
#[INPUTS]
#VALUE
# A list following the \code{nbn} specification
#EXAMPLE
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 12_05_11
#REVISED 12_05_11
#--------------------------------------------
{
  # checking
  if (!inherits(bn.fit, "bn.fit")) {
    r.erreur(bn.fit,message="This object is not of class 'bn.fit'")
  }
  # initializing the resulting object
  res <- vector("list",length(bn.fit))
  names(res) <- names(bn.fit)
  # filling each node
  for (nn in r.bf(res)) {
    sigma <- bn.fit[[nn]]$sd
    bnc <- bn.fit[[nn]]$coefficients
    mui <- which(names(bnc)=="(Intercept)")
    if (length(mui)!=1) {
      r.erreur(list(nn,bn.fit[[nn]]),
             message="unexpected node of 'bn.fit'")
    }
    mu <- bnc[mui]
    parents <- names(bnc)[-mui]
    regcoef <- bnc[-mui]
    res[[nn]] <- list(mu=mu,sigma=sigma,parents=parents,regcoef=regcoef)
  }
  # providing the topological order
  tor <- order4nbn(res)
  res <- res[tor]
  # returning
  res
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
bn2nbn <- function(bn)
#TITLE transforms a /bn/ of /bnlearn/ package to a /nbn/
#DESCRIPTION returns a \code{nbn} object
# from a DAG (\code{bn} object) of /bnlearn/
# package. O and 1 coefficients are introduced...
#DETAILS
#KEYWORDS
#INPUTS
#{bn}<< The object to be transformed.>>
#[INPUTS]
#VALUE
# A list following the \code{nbn} specification
#EXAMPLE
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 13_05_02
#REVISED 13_05_02
#--------------------------------------------
{
  # checking
  if (!inherits(bn, "bn")) {
    r.erreur(bn,message="This object is not of class 'bn'")
  }
  nono <- bn$nodes
  # initializing the resulting object
  res <- vector("list",length(nono))
  names(res) <- names(nono)
  # filling each node
  for (nn in names(res)) {
    sigma <- 1
    mu <- 0
    parents <- nono[[nn]]$parents
    regcoef <- rep(1,length(parents))
    res[[nn]] <- list(mu=mu,sigma=sigma,parents=parents,regcoef=regcoef)
  }
  # providing a topological order
  tor <- order4nbn(res)
  res <- res[tor]
  # returning
  res
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
nbn2bnfit <- function(nbn,onlydag=FALSE)
#TITLE transforms a /nbn/ to a /bn.fit/ of /bnlearn/ package
#DESCRIPTION returns a \code{bn.fit} object
# from a Gaussian \code{nbn} object of /rbmn/
# package.
#DETAILS
#KEYWORDS
#INPUTS
#{nbn}<< The object to be transformed.>>
#[INPUTS]
#{onlydag} << Indicates if only the DAG must be computed. In that
# case a /bn/ object of /bnlearn/ is returned.
#VALUE
# The resulting \code{bn.fit} (or \code{bn}) object.
#EXAMPLE
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 12_11_29
#REVISED 13_04_24
#--------------------------------------------
{
  # checking
  if (!requireNamespace("bnlearn"))
    stop("this function requires the bnlearn package.")
  # creating the dag
  mod <- string7dag4nbn(nbn,":")
  dag <- bnlearn::model2network(mod)
  if (onlydag) { return(dag);}
  # incorporating the parameters
  prodis <- vector("list",0)
  for (nn in r.bf(nbn)) {
    para <- vector("list",0)
    para$coef <- c(nbn[[nn]]$mu)
    for (pp in r.bf(nbn[[nn]]$parents)) {
      para$coef <- c(para$coef,nbn[[nn]]$regcoef[pp])
    }
    names(para$coef) <- c("(Intercept)",nbn[[nn]]$parents)
    para$sd <- nbn[[nn]]$sigma
    prodis[[nn]] <- para
  }
  names(prodis) <- names(nbn)
  # creating the bnfit
  res <- bnlearn::custom.fit(dag,dist=prodis)
  # returning
  res
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>