R/buildPartyNode.R

Defines functions buildPartyNode

############################################################################
# .buildPartyNode
buildPartyNode <- function(model,function.name)
{
  numnode <- partykit:::nodeids(model)
  counts <- c()
  for (i in 1:length(numnode)) {
    # treedepth[i] <- partykit:::depth.party(model[i])
    # depths[i] <- abs(treedepth[i] - max(treedepth))
    counts[i] <- as.numeric(partykit:::.nobs_party(model,id=i))
  }
  depths<-table(unlist(sapply(numnode, function(x) intersect(numnode, nodeids(model, from = x))))) - 1

  label <- labels(model, minlength=0, digits=7)
  fieldLabels <- "root"
  ops <- ""
  values<-list()
  values[[1]]<- "" #list("")

  # Added by Zementis: Information to create nodes.
  ids <- nodeids(model)
  rows <- nodeids(model)
  parent_ii <- 1

  # Check the function.name.
  scores <-c()
  for (i in 1:length(numnode)) {
    scores[i] <- as.character(predict_party(model,id=i, newdata=data_party(model)))
  }

  # Get the information for the primary predicates

  if (length(numnode) > 1) {
    for (i in 2:length(numnode)) {
      noderule <- partykit:::.list.rules.party(model,i)
      noderule <- gsub(" ", "", noderule)

      noderule <- unlist(strsplit(noderule, '&'))
      n <- length(noderule)
      noderule <- noderule[n]

      var <-  strsplit(noderule, '%in%')[[1]][1]
      fieldLabels <- c(fieldLabels, var)

      ops <- c(ops, "isIn")

      noderule <- strsplit(noderule, '%in%')[[1]][2]

      noderule <- substring(noderule,4,nchar(noderule)-2)
      noderule <- unlist(strsplit(noderule,"[,]|[^[:print:]]",fixed=F))

      tt <- gsub("\"","",noderule)
      values[[i]] <- tt
    }
    nodes <- genPartyNodes(function.name, depths, ids, counts, scores, fieldLabels, ops, values,
                           model, data, parent_ii, rows,"right")
  } else {
    nodes <- genPartyNodes(function.name, depths, ids, counts, scores, fieldLabels, ops, values,
                           model, data, parent_ii, rows,"right")
  }
  ## return(node)
}
tpgjs66/pmmlParty documentation built on Nov. 1, 2021, 5:40 a.m.