R/getScoreEnsemble.R

getScoreEnsemble <- function (list.chf, mat.status, cl, score, n.obs, n.death, n.groups)
{
  if (any(colSums(mat.status) == 0)){
    id_only_inbagg <- which(colSums(mat.status) == 0)
    mat.status <- mat.status[, -id_only_inbagg, drop = FALSE]
    cl <- cl[-id_only_inbagg]
  }
  vec.n.oob <- 1 / colSums(mat.status != 0)
  mat.oob.eche <- matrix(0, nrow = n.obs, ncol = n.death)
  for (j in 1:n.groups){
    mat.tmp <- (mat.status == j) * 1
    mat.nxN <- t(mat.tmp) %*% list.chf[[j]]
    mat.oob.eche <- mat.oob.eche + mat.nxN
  }
  mat.oob.eche <- mat.oob.eche * vec.n.oob
  if (score == "Conc"){
    oob.eche <- rowSums(mat.oob.eche)
    imp <- getConc(oob.eche, cl)
  } else if (score == "DPO"){
    oob.eche <- rowSums(mat.oob.eche)
    imp <- getDPO(oob.eche, cl)
  } else {
    imp <- getBrierScoreEnsemble(mat.oob.eche, cl)
  }
  imp
}
holgerschw/logicFS documentation built on April 15, 2020, 10:42 p.m.