rNIX/R/stats.R

#' Construct a string to report mean and SD

#' @param v a vector of values
#' @param nD number of decimals to print
#'
#' @return a combined string
#'
#' @export

get.mean<-function(v,nD=0){
   x=base::sprintf('%.0f (%.0f)',base::mean(v,na.rm=TRUE),stats::sd(v,na.rm=TRUE))
   if (nD==1){
      x=base::sprintf('%.1f (%.1f)',base::mean(v,na.rm=TRUE),stats::sd(v,na.rm=TRUE))
   }
   if (nD==2){
      x=base::sprintf('%.2f (%.2f)',base::mean(v,na.rm=TRUE),stats::sd(v,na.rm=TRUE))
   }
   x
}

#' Construct a string to report median and range
#'
#' @param v a vector of values
#' @param nD number of decimals to print
#'
#' @return a combined string
#'
#' @export

get.median<-function(v,nD=0){
   base::sprintf('%.0f (%.0f-%.0f)',stats::median(v,na.rm=TRUE),base::min(v,na.rm=TRUE),base::max(v,na.rm=TRUE))
   if (nD==1){
      base::sprintf('%.1f (%.1f-%.1f)',stats::median(v,na.rm=TRUE),base::min(v,na.rm=TRUE),base::max(v,na.rm=TRUE))
   }
   if (nD==2){
      base::sprintf('%.2f (%.2f-%.2f)',stats::median(v,na.rm=TRUE),base::min(v,na.rm=TRUE),base::max(v,na.rm=TRUE))
   }
 
}

#' Construct a string to report median and quartiles
#'
#' @param v a vector of values
#'
#' @return a combined string
#'
#' @export


get.medianQ<-function(v){
   q=base::c(0.25,0.75)
   qv=stats::quantile(v,probs=q,na.rm=TRUE)
   base::print(qv[1])
   base::sprintf('%.0f (%.0f-%.0f)',stats::median(v,na.rm=TRUE),qv[1],qv[2])
}

#' Construct a string to report count and portion that match comma separated string list
#'
#' @param v a vector of values
#' @param val comma separated list of values 
#'
#' @return a combined string
#'
#' @export

get.portion<-function(v,val){
   vals<-base::as.integer(base::strsplit(base::as.character(val),',')[[1]])
   n1=base::length(v[base::is.element(v,vals)])
   base::sprintf('%.0f (%.0f %%)',n1,100*n1/base::length(v))
}

#' Report count of elements in v that match comma separated string list
#'
#' @param v a vector of values
#' @param val comma separated list of values 
#'
#' @return a combined string
#'
#' @export

get.events<-function(v,val){
   vals<-base::as.integer(base::strsplit(base::as.character(val),',')[[1]])
   base::length(v[base::is.element(v,vals)])
}

#' Repeat function and merge output in a vector
#'
#' @param func function to perform, with elements v and a key k
#' @param v parameter of the func
#' @param keys a set of k values for the func
#'
#' @return a combined output
#'
#' @export

get.series<-function(func,v,keys=c()){
   out=base::c()
   for (k in keys){
      out=base::c(out,func(v,k))
   }
   out
}

#' Construct a contingency table
#'
#' @param df data frame with entries selected by an outcome variable
#' @param df1 complementary data frame to df
#' @param var variable to test dependency for
#' @param keys possible values of var
#'
#' @return contingency table as a data frame, rows are keys, and columns are v for df and v1 for df1
#'
#' @export


get.contingency<-function(df,df1,var,keys){
   v<-base::c()
   v1<-base::c()
   #for (k in names(z)){
       #keys=z[[k]][,'Key']
   v<-base::c(v,get.series(get.events,df[,var],keys))
   v1<-base::c(v1,get.series(get.events,df1[,var],keys))
   if (base::length(keys)==1){
       v<-base::c(v,base::nrow(df)-v[1])
       v1<-base::c(v1,base::nrow(df1)-v1[1])
   }   
   base::data.frame(v=v,v1=v1)
}

#' Determine statistical significance of df/df1 splitting for variable using chi-square test
#'
#' @param df data frame with entries selected by an outcome variable
#' @param df1 complementary data frame to df
#' @param var variable to test dependency for
#' @param keys possible values of var
#'
#' @return chisq.test output
#'
#' @export

get.chisq<-function(df,df1,var,keys){
   cf<-get.contingency(df,df1,var,keys)
   stats::chisq.test(cf,simulate.p.value=TRUE)$p.value
}

#' Determine statistical significance of df/df1 splitting for variable using FIsher's exact test
#'
#' @param df data frame with entries selected by an outcome variable
#' @param df1 complementary data frame to df
#' @param var variable to test dependency for
#' @param keys possible values of var
#'
#' @return fisher.test output
#'
#' @export

get.fisher<-function(df,df1,var,keys){
   cf<-get.contingency(df,df1,var,keys)
   stats::fisher.test(cf,simulate.p.value=TRUE)$p.value
}

#' Determine statistical significance of df/df1 splitting for a continous variable (MWU/Wilcox)
#'
#' @param df data frame with entries selected by an outcome variable
#' @param df1 complementary data frame to df
#' @param var variable to test dependency for
#'
#' @return wilcox.test output
#'
#' @export

get.u<-function(df,df1,var){
   stats::wilcox.test(df[,var],df1[,var])$p.value
}

#' Determine statistical significance of df/df1 splitting for a continous variable (T-test) 
#'
#' @param df data frame with entries selected by an outcome variable
#' @param df1 complementary data frame to df
#' @param var variable to test dependency for
#'
#' @return wilcox.test output
#'
#' @export

get.t<-function(df,df1,var){
   stats::t.test(df[,var],df1[,var])$p.value
}