R/combine_groups.R

Defines functions combine.groups

Documented in combine.groups

#' Sums up numerical and logical data groupwise
#'
#' @param data numerical or logical data
#' @param groups group vector
#' @param method method to be used
#' @param save save data
#' @param name name to save data as
#' @param name2 should name be generated automatically
#' @param destination where to save data
#' @param return return data frame
#'
#' @return
#' @export
#'
#'
combine.groups <- function(data, groups, method, save = T, name, name2 = F, destination = "dat", return = F) {

  if(!hasArg(data)) {
    message("Set data: ")
    data <- getData()
  }

  if(!hasArg(groups)) {
    message("Set groups: ")
    groups <- getData()
  }


  groups <- groups[rownames(data)]


  data.count <- matrix(0, nrow = length(unique(groups)), ncol = ncol(data))
  rownames(data.count) <- unique(groups)
  colnames(data.count) <- colnames(data)


  if(!hasArg(method)) {
    method <- whatToDo("How should groups be combined?", c("mean", "median", "sum", "max", "min", "and", "or"))
  }


  if(method == "mean") {

    for(i in 1:nrow(data.count)) {
      for(j in 1:ncol(data.count)) {
        data.count[i, j] <- mean(data[groups == rownames(data.count)[i], j], na.rm = T)
      }
    }

  }

  else if(method == "median") {

    for(i in 1:nrow(data.count)) {
      for(j in 1:ncol(data.count)) {
        data.count[i, j] <- median(data[groups == rownames(data.count)[i], j], na.rm = T)
      }
    }

  }

  else if(method == "sum") {

    for(i in 1:nrow(data.count)) {
      for(j in 1:ncol(data.count)) {
        data.count[i, j] <- sum(data[groups == rownames(data.count)[i], j], na.rm = T)
      }
    }

  }

  else if(method == "max") {

    for(i in 1:nrow(data.count)) {
      for(j in 1:ncol(data.count)) {
        data.count[i, j] <- max(data[groups == rownames(data.count)[i], j], na.rm = T)
      }
    }

  }

  else if(method == "min") {

    for(i in 1:nrow(data.count)) {
      for(j in 1:ncol(data.count)) {
        data.count[i, j] <- min(data[groups == rownames(data.count)[i], j], na.rm = T)
      }
    }

  }

  else if(method == "and") {

    for(i in 1:nrow(data.count)) {

      for(j in 1:ncol(data.count)) {

        data.count[i, j] <- data[groups == rownames(data.count)[i], j][1]

        for(k in 1:sum(groups == rownames(data.count)[i])) {

          data.count[i, j] <- combineAND(data.count[i, j], data[groups == rownames(data.count)[i], j][k])

        }

      }

    }

  }

  else if(method == "or") {

    for(i in 1:nrow(data.count)) {

      for(j in 1:ncol(data.count)) {

        data.count[i, j] <- data[groups == rownames(data.count)[i], j][1]

        for(k in 1:sum(groups == rownames(data.count)[i])) {

          data.count[i, j] <- combineOR(data.count[i, j], data[groups == rownames(data.count)[i], j][k])

        }

      }

    }

  }

  if(name2) {
    name = rownames(data.count)[1]
  }

  if(save) {
    saveThis(data.count, name = name, destination = destination)
  }

  if(return) {
    data.count
  }

}
nicohuttmann/htmnanalysis documentation built on Dec. 6, 2020, 3:02 a.m.