R/summary.R

In neuroconductor/brainKCCA: Region-Level Connectivity Network Construction via Kernel Canonical Correlation Analysis

#' Print information of object generated by permkCCA_multipleRegion function
#'
#' This function can print information of kcca object for single object.
#' @author Xubo Yue, Chia-Wei Hsu (tester), Jian Kang (maintainer)
#' @param kcca_object the result generated by permkCCA_multipleRegion function.
#' This argument can also accept an adjacent matrix containing information of connectinity network.
#' This matrix must have row names or column names, which define the region index. For example,
#' column names with 1, 5, 10 means region 1, 5 and 10.
#' @param significance significance level of hypothesis testing
#' @param patientID if you have more than one patient in the kcca_object,
#' you need to specify which patient you would like to summarize.
#' If you have only one patient, then the default patientID is 1.
#' @param saveFormat a character string; possible values are excel,
#' latex, html, markdown, etc.; it can also be set in the global option
#' knitr.table.format; if format is a function, it must return a character
#' string. If you specify saveFormat="group", then this function can help you summarize
#' group level information for all patients.
#' @param threshold the threshold for significance of percentage of connection
#' (if percentage exceeds threhold, then the region pair is significant).
#' Typically, it can be 15-30\%.
#' @details After you obtained results from permkCCA_multipleRegion() function,
#' there are two ways to summarize and save information of
#' kcca objects at group level (i.e. construct region-level conenctivity network):\cr
#' (1) for each patient i, you can spcify patientID = i and saveFormat="excel",
#' and then store the output in csv files. The generated csv files have 7 columns:
#' row number, index1, index2, region1, region2, pvalue, indicator of significance,
#' and count flag (always 1). See example 1 for more information. \cr
#' (2) if you do not want save information in csv files, you can specify
#' saveFormat="group" abd then this function can help you summarize group
#' level information for all patients. The output variables have 7 columns: row number, index1,
#' index2, region1, region2, pvalue, indicator of significance, and count flag (always 1).\cr
#' If you want to save data as other format such as latex, you can directly copy
#' the generated latex code to your tex file. See example 3 for more information.\cr
#' Note that if returned object has length 0 (i.e. no connection), then warning message will be generated.
#' @importFrom rgl rgl.snapshot
#' @export
#' @examples
#' \donttest{
#' #It will take more than 10 s to run
#' #write data into temp file
#' filePath <- tempdir()
#' #the nii.gz fMRI imaging file is created (toy example)
#' oro.nifti::writeNIfTI(brainKCCA::input_img, paste(filePath, "/",  "temp", sep=""))
#' #read fMRI data
#' testcase1 <- nii2RData(niiFile1 = "temp", resolution = "3mm", imgPath = filePath)
#' result1<-permkCCA_multipleRegion(imageDat = testcase1, region = c(1,5,10))
#' summary_kcca(result1)
#' }

summary_kcca <- function(kcca_object,significance=0.05,patientID=1,saveFormat="markdown", threshold=0.2) {

  ###############################################
  #adjacent matrix
  if(is.matrix(kcca_object)){

    if(!is.null(colnames(kcca_object)))
      regionOfMatrix <- as.numeric(colnames(kcca_object))
    else if(!is.null(rownames(kcca_object)))
      regionOfMatrix <- as.numeric(rownames(kcca_object))
    else{
      warning("need row or column names.")
      return(0)
    }

    pairs <- which(kcca_object!=0,arr.ind = T)
    pairs <- unique(t(apply(pairs,1,sort))) #remove same value with reverse order
    pairs <- pairs[pairs[,1]!=pairs[,2],] #remove same value in two column

    pairs <- matrix(regionOfMatrix[matrix(pairs,ncol=2)[,]],ncol = 2)

    result_noP <- NULL
    result_noP[[1]] <- pairs

    final_noP <- NULL
    final_noP[[1]] <- result_noP

    if(length(final_noP[[1]][[1]])==0) warning("result has length 0 (no connection)!")

    return(final_noP)
  }
  ###############################################


  #group-level summary
  if(saveFormat=="group"){

    kcca_object <- kcca_object[lengths(kcca_object)!=6]
    if(length(kcca_object)==1) {warning("you only have one patient data, there is no group-level information.", call. = FALSE); return(0)}

    temp1 <- tempFunction(1, kcca_object, significance)
    for(i in 2:length(kcca_object)){
      temp2 <- tempFunction(i, kcca_object, significance)
      temp1 <- rbind(temp1, temp2)
      temp1[] <- lapply(temp1, function(x) type.convert(as.character(x)))
      temp1 <- aggregate(. ~ index1+index2+region1+region2, temp1, sum)
    }

    temp1$percent <- temp1$significant/temp1$count
    data_file2N <- temp1[temp1$percent>=threshold,]
    result_noP <- NULL
    result_noP[[1]] <- cbind(data_file2N$index1, data_file2N$index2)
    result_noP[[2]] <- result_noP[[3]] <- NULL
    result_noP[[4]] <- list(cbind(data_file2N$region1, data_file2N$region2))
    final_noP <- NULL
    final_noP[[1]] <- result_noP

    if(length(final_noP[[1]][[1]])==0) warning("result has length 0 (no connection)!")
    return(final_noP)

    # for(i in 1:length(kcca_object)){
    #   if(is.null(dim(kcca_object[[i]][[1]]))) rowNum<-1
    #   else rowNum<-dim(kcca_object[[i]][[1]])[1]
    #   temp <- NULL
    #   for(j in 1:length(kcca_object[[i]][[2]])) temp <- c(temp,kcca_object[[i]][[2]][[j]])
    #   tableTemp <- cbind(matrix(kcca_object[[i]][[1]],rowNum,2),matrix(kcca_object[[i]][[4]],rowNum,2),temp)
    #   tableTemp<-as.data.frame(tableTemp)
    #   colnames(tableTemp) <- c("index1","index2","region1","region2","pvalue")
    #   tableTemp$significant <- ifelse(as.numeric(as.vector(tableTemp$pvalue))<significance, 1, 0)
    #   tableTemp$count<- 1
    #   #assign(paste("kcca_subject",i,sep=""), tableTemp[,-5])
    #   if(i==1) summary_info<-tableTemp
    #   if(i!=1) {
    #     summary_info$significant <- summary_info$significant + tableTemp$significant
    #     summary_info$count <- summary_info$count + tableTemp$count
    #   }
    # }
    #
    # summary_info$percent<-summary_info$significant/summary_info$count
    # summary_info$connect<-ifelse(summary_info$percent>=0.5,1,0)
    # return(summary_info)
  }

  #individual-level summary
  input_length <- length(kcca_object)-1
  i <- index <- patientID
  if(index>input_length | index<0){warning("length of your input is out of bound.", call. = FALSE); return(0)}

  if(is.null(dim(kcca_object[[i]][[1]]))) rowNum<-1
  else rowNum<-dim(kcca_object[[i]][[1]])[1]
  cat("\n" ,"summary of kcca object ", i, " generated by 'permkCCA_multipleRegion' function: \n")
  temp <- NULL
  for(j in 1:length(kcca_object[[i]][[2]])) temp <- c(temp,kcca_object[[i]][[2]][[j]])
  tableTemp <- cbind(matrix(kcca_object[[i]][[1]],rowNum,2),matrix(kcca_object[[i]][[4]],rowNum,2),round(temp, 4))
  tableTemp<-as.data.frame(tableTemp)
  colnames(tableTemp) <- c("index1","index2","region1","region2","pvalue")

  if(saveFormat=="excel"){
    tableTemp$significant <- ifelse(as.numeric(as.vector(tableTemp$pvalue))<significance, 1, 0)
    tableTemp$count<- 1
    return(tableTemp)
  }

  else return(knitr::kable(tableTemp, format=saveFormat))
}


tempFunction <- function(i, kcca_object, significance){
  if(is.null(dim(kcca_object[[i]][[1]]))) rowNum<-1
  else rowNum<-dim(kcca_object[[i]][[1]])[1]
  temp <- NULL
  for(j in 1:length(kcca_object[[i]][[2]])) temp <- c(temp,kcca_object[[i]][[2]][[j]])
  tableTemp <- cbind(matrix(kcca_object[[i]][[1]],rowNum,2),matrix(kcca_object[[i]][[4]],rowNum,2),round(temp, 4))
  tableTemp<-as.data.frame(tableTemp)
  colnames(tableTemp) <- c("index1","index2","region1","region2","pvalue")
  tableTemp$significant <- ifelse(as.numeric(as.vector(tableTemp$pvalue))<significance, 1, 0)
  tableTemp$count<- 1
  return(tableTemp)
}