R/postprob.multlcmm.R

Defines functions postprob.multlcmm

Documented in postprob.multlcmm

#' @export
#'
postprob.multlcmm <- function(x,threshold=c(0.7,0.8,0.9),...)
{
 if (!inherits(x, "multlcmm")) stop("use only with \"multlcmm\" objects")
 if(x$ng==1)
 {
  cat("Postprob function can only be used when ng > 1 \n")
  res <- list()
 }
 else
 {
  classif<-NULL
  cl.table<-NULL
  thr.table <- NULL 
  for (g in 1:x$ng)
  {
   temp<- subset(x$pprob,x$pprob[,2]==g)
   temp1<-apply(temp[,3:(x$ng+2)],2,mean)
   cl.table<-rbind(cl.table,temp1)
   classif<-cbind(classif,c(as.integer(length(temp[,2])),as.double((length(temp[,2])/x$ns*100))))
   if(!is.null(threshold)) thr.table <- cbind(thr.table,sapply(threshold,function(x) length(which(temp[,2+g]>x)))/length(temp[,1]))  
  }

  rownames(cl.table)<-paste("class",1:x$ng,sep="")
  colnames(cl.table)<-paste("prob",1:x$ng,sep="")
  colnames(classif)<-paste("class",1:x$ng,sep="")
  rownames(classif)<-c("N","%")
  
  res <- list(round(classif,2),round(cl.table,4))
   
  if(!is.null(thr.table))
  {
   thr.table <- 100*thr.table  
    
   rownames(thr.table) <- paste("prob>",threshold,sep="") 
   colnames(thr.table) <- paste("class",1:x$ng,sep="") 
    
   res <- list(round(classif,2),round(cl.table,4),round(thr.table,2))  
  }     
 
  cat(" \n")
  cat("Posterior classification:", "\n")
  print(round(classif,2))
  cat(" \n")
 
  cat("Posterior classification table:", "\n")
  cat("     --> mean of posterior probabilities in each class", "\n")
  print(round(cl.table,4))
  cat(" \n")
   
  if(!is.null(thr.table))
  {
   cat("Posterior probaBIlities above a threshold (%):", "\n")
   print(round(thr.table,2))
   cat(" \n")    
  }   
 }
  
 return(invisible(res)) 
}
CecileProust-Lima/lcmm documentation built on March 3, 2024, 5:23 p.m.