R/getInferenceWeightedRatio.R

In mortenarendt/MBtransfeR:

#' A function to cut out inference statistics from the random permutation generated repo of sampling data generated by randpermutationTransferStats().
#'
#'
#'@param res the output from the randpermutationTransferStats
#'@param include logical vector indicating which of the variables to include. 
#'@return data.frame with model statistics and random permutation based inference statistics.
#'@export
getInferenceWeightedRatio <- function(res, trc=100, include = !logical(dim(res[[1]])[1])){
  modelratio <- getWeightedRatio(truncateZerosInf(res[[1]]$Fisher_estimate[include],trc),res[[1]]$Fisher_p.value[include])
  # output: df <- data.frame(pv, SElgratio, permmedian = median(tb$ratio), modelratio)
  permSTAT <- res[[3]]
  
  niter <- dim(permSTAT)[3]
  tb <- c()
  for (i in 1:niter){
    xx <- permSTAT[include,,i] %>%
      data.frame() %>%
      mutate(Fisher_estimatetr = truncateZerosInf(Fisher_estimate,trc)) 
    xx <- getWeightedRatio(xx$Fisher_estimatetr,xx$Fisher_p.value)
    tb <- rbind(tb,xx)
  }
  
  pv <- sum(tb$ratio>modelratio$ratio) / niter
  
  # estimate null distribution for ratio
  lgratio <- log(tb$ratio)
  SElgratio <- sqrt(sum(lgratio^2)/length(lgratio))
  
  #print(c(i,median(tb$ratio),modelratio))
  df <- data.frame(modelratio = modelratio$ratio,ntest = sum(include), pv, SElgratio, permmedian = median(tb$ratio))
  return(df)
}