R/Manifest.R

In ralmond/Peanut: Parameterized Bayesian Networks, Abstract Classes

### Create table of Model meta-information
BuildNetManifest <- function (Pnetlist) {
  ## Node Level fields
  Name <- character()
  Hub <- character()
  Title <- character()
  Pathname <- character()
  Description <- character()
  Errs <- list()

  ## Main Loop
  for (net in Pnetlist) {
    if (!is.Pnet(net)) {
      flog.error("Expected a list of Pnets, got ",net)
      Errs <- c(Errs,simpleError(paste("Expected a list of Pnets, got ",net)))
      next
    }
    netnm <-PnetName(net)
    flog.debug("Processing network %s.",netnm)
    Name <-c(Name,PnetName(net))
    out <- flog.try({
      Title <- c(Title,PnetTitle(net))
      Hub <- c(Hub,PnetHub(net))
      Pathname <-c(Pathname,ifelse(is.null(PnetPathname(net)),
                                   "",PnetPathname(net)))
      Description <- c(Description,PnetDescription(net))
    }, context=sprintf("Net: %s.",netnm))
    if (is(out,'try-error')) {
      Errs <- c(Errs,out)
    }
  }
  if (length(Errs) >0L)
    stop("Errors encountered while building manifest.")
  result <- data.frame(Name,Title,Hub,Pathname,Description,
                       stringsAsFactors=FALSE)
  rownames(result) <- Name
  ## Seems there is a bug in the class checking mechanism,
  ## Easiest to just leave it as a data.frame
  ##class(result) <- c("NetManifest",class(result))
  result
}

##############################################################
## Pnode Functions

BuildNodeManifest <- function (Pnodelist) {
  ## Node Level fields
  Model <- character()
  ModelHub <- character()
  NodeName <- character()
  NodeTitle <- character()
  Nstates <- integer()
  NodeDescription <- character()
  NodeLabels <- character()
  Continuous <- logical()
  LowerBound <- numeric()
  UpperBound <- numeric()

  ## State Level Fields
  StateName <- character()
  StateTitle <- character()
  StateDescription <- character()
  StateValue <- numeric()
  Errs <- list()

  ## Main Loop
  for (nd in Pnodelist) {
    if (!is.Pnode(nd)) {
      flog.error("Expected a list of Pnodes, got ",nd)
      Errs <- c(Errs,simpleError(paste("Expected a list of Pnodes, got ",nd)))
      next
    }
    ndnm <- PnodeName(nd)
    netnm <- PnetName(PnodeNet(nd))
    flog.debug("Processing node %s in network %s.",ndnm,netnm)
    out <- flog.try({
      k <- PnodeNumStates(nd)
      ## Key elements, these must be repeated for the states.
      Model <- c(Model,rep(PnetName(PnodeNet(nd)),k))
      NodeName <-c(NodeName,rep(PnodeName(nd),k))
      ## Non-key elements -- these can be blank.
      ModelHub <- c(ModelHub,PnetHub(PnodeNet(nd)))
      NodeTitle <- c(NodeTitle,PnodeTitle(nd))
      Nstates <- c(Nstates,k)
      NodeDescription <- c(NodeDescription,PnodeDescription(nd))
      NodeLabels <- c(NodeLabels,paste(PnodeLabels(nd),collapse=","))
      Continuous <- c(Continuous,isPnodeContinuous(nd))
      ## Pad the node level fields with blank lines
      if (k>1) {
        ModelHub <- c(ModelHub,rep("",k-1))
        NodeTitle <- c(NodeTitle,rep("",k-1))
        Nstates <- c(Nstates,rep(NA_integer_,k-1))
        NodeDescription <- c(NodeDescription,rep("",k-1))
        NodeLabels <- c(NodeLabels,rep("",k-1))
        Continuous <- c(Continuous,rep(as.logical(NA),k-1))
      }
      StateName <- c(StateName,PnodeStates(nd))
      StateTitle <- c(StateTitle,PnodeStateTitles(nd))
      StateDescription <- c(StateDescription,PnodeStateDescriptions(nd))
      if (isPnodeContinuous(nd)) {
        StateValue <- c(StateValue,rep(NA_real_,k))
        bnds <- PnodeStateBounds(nd)
        LowerBound <- c(LowerBound,bnds[,1L])
        UpperBound <- c(UpperBound,bnds[,2L])
      } else {
        if (!is.null(PnodeStateValues(nd))) {
          StateValue <- c(StateValue,PnodeStateValues(nd))
        } else {
          StateValue <- c(StateValue,rep(NA,k))
        }
        LowerBound <- c(LowerBound,rep(NA_real_,k))
        UpperBound <- c(UpperBound,rep(NA_real_,k))
      }
    }, context=sprintf("Net: %s, Node: %s.",netnm,ndnm))
    if (is(out,'try-error')) {
      Errs <- c(Errs,out)
    }
  }
  if (length(Errs) >0L)
    stop("Errors encountered while building manifest.")
  result <- data.frame(Model,NodeName,ModelHub,NodeTitle,NodeDescription,
                       NodeLabels,Continuous,Nstates,StateName,StateTitle,
                       StateDescription, StateValue,LowerBound,UpperBound,
                       stringsAsFactors=FALSE)
  ## Seems there is a bug in the class checking mechanism,
  ## Easiest to just leave it as a data.frame
  ##class(result) <- c("NodeManifest",class(result))
  result

}