R/get_samples_fact_inputfile.R

In visStatistics: Automated Selection and Visualisation of Statistical Hypothesis Tests

# Internal helper function in visstat----
#' Selects columns defined by characters varsample and varfactor from
#' a data.frame
#'
#' Selects columns defined by characters \code{varsample} and \code{varfactor}
#' from \code{dataframe}, returns selected columns with their names.
#' @param dataframe \code{data.frame} or \code{list} containing at least two
#' columns with column headings of data type \code{character}.Data must be
#' column wise ordered.
#' @param varsample column name of dependent variable in dataframe,
#' datatype \code{character}
#' @param varfactor column name of independent variable in dataframe, datatype
#' \code{character}
#' @return selected columns, \code{sample}, \code{factor}, \code{name_of_sample}
#' (character string equaling varsample), \code{name_of_factor}
#' (character string equaling varsample)
#'
#' @examples
#' get_samples_fact_inputfile(trees, "Girth", "Height")
#' @noRd

get_samples_fact_inputfile <- function(dataframe, varsample, varfactor) {
  # json input------
  if (is.null(dim(dataframe)))
  # FALSE for csv
    {
      fulldata <- dataframe
      data <- dataframe$data
      data <- as.data.frame(data)

      if ("matching" %in% names(dataframe) & varfactor == "match") {
        matched_selected_group0 <- which(data$group0 == 1 & data$match == 1)
        matched_selected_group1 <- which(data$group1 == 1 &
          data$match == 1)
        fact <- c(
          rep(fulldata$group0name, length(matched_selected_group0)),
          rep(fulldata$group1name, length(matched_selected_group1))
        )
        fact <- as.factor(fact)
        fullsample <- data[, varsample]

        samples <- fullsample[c(matched_selected_group0, matched_selected_group1)]
        name_of_factor <- paste(fulldata$group0name, "and", fulldata$group1name)
        # name_of_factor="groups"
        name_of_sample <- varsample
        # does not work on multiple matching criterias:
        # matchingCriteria=paste(tolower(paste(as.character(dataframe$matching),collapse =" ")),sep="")
        matchingCriteria <- tolower(paste(apply(dataframe$matching, 1, function(x) {
          paste(x, collapse = " ")
        }), collapse = ", "))
        name_of_sample <- paste(name_of_sample, "with match:", matchingCriteria)
        # json file with no matching criterion
      } else if ("matching" %in% names(dataframe) &
        varfactor != "match") {
        samples <- data[, varsample]
        fact <- data[, varfactor]
        name_of_sample <- varsample
        name_of_factor <- varfactor
        matchingCriteria <- ""
      } else {
        stop("code runs only on json files generated by Web server")
      }
      # csv input------
    } else {
    # Select samples and fact from data.frame dataframe-----
    samples <- dataframe[, varsample]
    fact <- dataframe[, varfactor]
    name_of_sample <- varsample
    name_of_factor <- varfactor
    matching_criteria <- ""
  }


  # samples are the two groups selected by the user in groups at the web surface
  mylist <- list(
    "samples" = samples,
    "fact" = fact,
    "name_of_sample" = name_of_sample,
    "name_of_factor" = name_of_factor,
    "matching_criteria" = matching_criteria
  )
  return(mylist)
}