R/stratify_by_phenotype.R

In frhl/our: genetic data analysis

#' @title stratify_by_phenotype
#' @description Combined two different list of data.frames/data.tables
#' so that they can later be plotted
#' @param ind a named list individual IDs. Each list will
#' be merged with the reference data.table.
#' @param ref a named list of data.tables/data.frames with two columns,
#' in which first column being the individual id, and the 2nd one being
#' the phenotype value of interest.
#' @examples
#' \dontrun{
#' ind = list(healthy = letters[3:12], unhealthy = letters[13:26])
#' ref = list(disease1 = data.table(sid = letters[1:23], value = runif(23)))
#' result = stratify_by_phenotype(ind, ref)
#' head(result)
#' }
#' @export

stratify_by_phenotype <- function(ind, ref){

  # check the input
  stopifnot(is.list(ind))
  stopifnot(is.list(ref))
  stopifnot(!is.null(names(ind)))
  stopifnot(!is.null(names(ref)))

  # setup groups
  groups = names(ind)
  traits = names(ref)

  # convert ref to data.frame
  ref = lapply(ref, setDT)

  # combine data,into groups of data.tables
  # that can then be re-joined
  result = lapply(groups, function(group){
    do.call(rbind, lapply(traits, function(trait){
      current_trait = ref[[trait]]
      current_ids = ind[[group]]
      current = current_trait[current_trait$sid %in% current_ids,]
      current$group = group
      current$trait = trait
      return(current)
    }))
  })

  # combine all data.frames
  df = setDT(do.call(rbind, result))
  return(df)
}