R/chmi.stat_tools.R

In mvazquezs/chmitools: Package to manage & obtain results of the CHMI Study

#-----------------------------------------
# Useful functions to manage 'CHMI' study
#-----------------------------------------


### `traits` function---------------------------------------------------------------------------

#' @export
chmi.stat.select_traits <- function(phen, l_vars, group_tr, traits)
{
# 'laply()' function to select 'l_vars' into 'data'
  id_vars <- laply(l_vars, function(x) which(names(phen) == x))

  # initial 'double_check_01' variables
		stopifnot(all(l_vars %in% names(phen)))
	  stopifnot(length(l_vars) == length(id_vars))

# select individual variables
  t_vars <- c()
  if(!missing(traits)) {
    stopifnot(all(traits %in% names(phen)))

    t_vars <- c(t_vars, traits)
  }


 if(group_tr != 'none') {
    traits <- switch(group_tr,
     	ab_full = chmi.l_traits.ab()[['complete_tr']],
	    ab_select = chmi.l_traits.ab()[['select_tr']],
	    pbmc_full = chmi.l_traits.pbmc()[['complete_tr']],

    stop())
    stopifnot(all(traits %in% names(phen)))

    t_vars <- c(t_vars, traits)
    t_vars <- unique(t_vars)
    }

    ### compile 'phen'
	if(length(t_vars) == 0) {
    phen <- phen[, c(id_vars)]
  } else {
    idt_vars <- laply(t_vars, function(x) which(names(phen) == x))
    stopifnot(length(t_vars) == length(idt_vars))

    phen <- phen[, c(id_vars, idt_vars)]

		# avoid duplicated cols
		phen <- phen[ , !duplicated(colnames(phen))]
		}

# return
	return(phen)
}



### rmarkdown loop to plot graphs-------------------------------------------------------------------

#' @export
chmi.stat.rmarkdown_plot <- function(l_plots)
{
# loop
  for(i in seq_along(l_plots)) {
  # titles
    cat('##', paste0('l_plots_', i), '\n')
    # plots
      print(l_plots[[i]])
  }
}



### read 'xls' & 'xlsx' format----------------------------------------------------------------------

# '@export
chmi.stat.read_excels <- function(file, stat = c('readxl', 'openxlsx'))
{
# arg
  stat <- match.arg(stat, c('readxl', 'openxlsx'))

# function
    l_sheet <- excel_sheets(file)
    dat_sheet <- lapply(l_sheet, function(x)
      read_excel(file, sheet = x))

# return
  return(dat_sheet)
}