R/query_tcga_group.R

In UCSCXenaShiny: Interactive Analysis of UCSC Xena Data

#' Group TPC samples by build-in or custom phenotype and support filtering or merging operations
#'
#' @param cancer select cancer cohort(s)
#' @param custom upload custom phenotype data
#' @param group target group names 
#' @param filter_by filter samples by one or multiple criterion
#' @param merge_by merge the target group for main categories
#' @param return_all return the all phenotype data
#' @param filter_id directly filter samples by provided sample ids
#' @param merge_quantile  whether to merge numerical variable by percentiles 
#' @param database one of c("toil","pcawg","ccle")
#'
#' @return a list object with grouping samples and statistics
#' @export
#'
#' @examples
#' \dontrun{
#' query_tcga_group(group = "Age")
#' 
#' query_tcga_group(cancer="BRCA", 
#'               group = "Stage_ajcc"
#'               )
#' 
#' query_tcga_group(cancer="BRCA", 
#'               group = "Stage_ajcc",
#'               filter_by = list(
#'                 c("Code",c("TP"),"+"),
#'                 c("Stage_ajcc",c(NA),"-"))
#'               )
#'               
#' query_tcga_group(cancer="BRCA", 
#'                  group = "Stage_ajcc",
#'                  filter_by = list(
#'                    c("Age",c(0.5),"%>"))
#' )
#' 
#' query_tcga_group(cancer="BRCA", 
#'                  group = "Stage_ajcc",
#'                  filter_by = list(
#'                    c("Age",c(60),">"))
#' )
#' 
#' query_tcga_group(cancer="BRCA", 
#'               group = "Stage_ajcc",
#'               merge_by = list(
#'                 "Early"=c("Stage I"), 
#'                 "Late" = c("Stage II","Stage III","Stage IV"))
#'               )
#' 
#' query_tcga_group(cancer="BRCA", 
#'                  group = "Age",
#'                  merge_by = list(
#'                    "Young"= c(20, 60), 
#'                    "Old"= c(60, NA)
#'                 )
#' )
#' 
#' query_tcga_group(cancer="BRCA", 
#'                  group = "Age",
#'                  merge_quantile = TRUE,
#'                  merge_by = list(
#'                    "Young"= c(0, 0.5), 
#'                    "Old"= c(0.5, 1)
#'                  )
#' )
#' }
query_tcga_group = function(database = c("toil","pcawg","ccle"),
                         cancer=NULL, 
                         custom = NULL,
                         group = "Gender",
                         filter_by = NULL,
                         filter_id = NULL,
                         merge_by = NULL,
                         merge_quantile = FALSE,   
                         return_all = FALSE
                         ){
  # step1: load build-in data
  database <- match.arg(database)
  # data("tcga_clinical_fine")
  # data("pcawg_info_fine")
  # data("ccle_info_fine")
  meta_data = switch(database,
                     "toil" = UCSCXenaShiny::tcga_clinical_fine,
                     "pcawg"= UCSCXenaShiny::pcawg_info_fine,
                     "ccle" = UCSCXenaShiny::ccle_info_fine)
  colnames(meta_data)[1:2] = c("Sample","Cancer") # CCLE:c("CCLE_name","Primary_Site)

  
  
  # Step2: add user-customized data
  if(!is.null(custom)){
    dup_names = intersect(colnames(meta_data)[-1:-2], colnames(custom)[-1])
    if(length(dup_names)>0){
      meta_data = meta_data %>%
        dplyr::select(!all_of(dup_names))
    } # 如果有重复列名，则去除原始metadata的重复列
    colnames(custom)[1] = "Sample"
    meta_data = dplyr::inner_join(meta_data, custom) # Note: Only consider the intersection
  }

  # step3: filter cancer(s)
  if(is.null(cancer)){cancer = unique(meta_data$Cancer)}
  meta_data_sub = meta_data %>% dplyr::filter(.data$Cancer %in% cancer)
  
  # 检查选择的分组参数是否在现有的列名中
  if(!any(colnames(meta_data_sub)==group)){
    stop(paste0("Please input the right group names:\n",
      paste(colnames(meta_data_sub)[-1:-2], collapse = " ")))
  }

  # step5: filter by specialized conditions
  if(!is.null(filter_by)){
    ## 按list内条件顺序级联筛选
    for (i in seq(filter_by)){
      # i = 1
      filter_by_L1 = trimws(filter_by[[i]][1])
      filter_by_L3 = trimws(filter_by[[i]][3])
      filter_by_L2 = sapply(strsplit(filter_by[[i]][2],"|",fixed = T)[[1]],
                            trimws,USE.NAMES = FALSE)
      filter_by_L2[filter_by_L2 %in% "NA"] <- NA

      # 6种过滤方式
      if (filter_by_L3=="+"){         #保留
        meta_data_sub <- meta_data_sub %>% 
          dplyr::filter(.data[[filter_by_L1]] %in% filter_by_L2)
      } else if (filter_by_L3=="-"){  #剔除
        meta_data_sub <- meta_data_sub %>% 
          dplyr::filter(!.data[[filter_by_L1]] %in% filter_by_L2)
      } else if (filter_by_L3==">"){  #大于 绝对值
        filter_by_L2 = as.numeric(filter_by_L2)
        meta_data_sub <- meta_data_sub %>% 
          dplyr::filter(.data[[filter_by_L1]] > filter_by_L2)
      } else if (filter_by_L3=="%>"){ #大于 分位数
        filter_by_L2 = as.numeric(filter_by_L2)
        meta_data_sub <- meta_data_sub %>% 
          dplyr::group_by("Cancer") %>% 
          dplyr::filter(.data[[filter_by_L1]] > 
                          quantile(.data[[filter_by_L1]],filter_by_L2,na.rm=T))
      } else if (filter_by_L3=="<"){ #小于 绝对值
        filter_by_L2 = as.numeric(filter_by_L2)
        meta_data_sub <- meta_data_sub %>% 
          dplyr::filter(.data[[filter_by_L1]] < filter_by_L2)
      } else if (filter_by_L3=="%<"){#小于 分位数
        filter_by_L2 = as.numeric(filter_by_L2)
        meta_data_sub <- meta_data_sub %>% 
          dplyr::group_by("Cancer") %>% 
          dplyr::filter(.data[[filter_by_L1]] < 
                          quantile(.data[[filter_by_L1]],filter_by_L2,na.rm=T))
      }
    }
  }



  # step3-2: filter by sample id
  if(!is.null(filter_id)){
    meta_data_sub = meta_data_sub %>% 
      dplyr::filter(.data$Sample %in% filter_id)
  }
  
  
  dim(meta_data_sub)


  # step3: merge group
  
  if(!is.null(merge_by)){
    # if(class(meta_data_sub[,group,drop=T])=="numeric"){
    if(inherits(meta_data_sub[, group, drop = T], "numeric")){
      # 分位数:每种肿瘤单独的分位数
      if(merge_quantile){
        for (i in seq(merge_by)){
          if(is.na(merge_by[[i]][1])){
            merge_by[[i]][1] = 0
          }
          if(is.na(merge_by [[i]][2])){
            merge_by[[i]][2] = 1
          }
        }
        meta_data_sub_split = split(meta_data_sub, meta_data_sub$Cancer)
        meta_data_sub = lapply(meta_data_sub_split, function(meta_data_one){
          # meta_data_one = meta_data_sub_split[["CESC"]]
          dat_num = meta_data_one[,group,drop=T]
          meta_data_one[,group,drop=T] = NA
          merge_by_one = merge_by
          for (i in seq(merge_by_one)){
            merge_by_one[[i]] = quantile(dat_num, merge_by_one[[i]], na.rm = T)
          }
          # 对于较大值组，左右均闭，这样可能导致大组的数目偏多（中位数）
          meta_data_one[,group,drop=T][which(findInterval(dat_num, merge_by_one[[1]])==1)] = names(merge_by_one)[1]
          meta_data_one[,group,drop=T][which(findInterval(dat_num, merge_by_one[[2]], rightmost.closed = TRUE)==1)] = names(merge_by_one)[2]
          meta_data_one
        }) %>% do.call(rbind, .)
      } else {
        dat_num = meta_data_sub[,group,drop=T]
        meta_data_sub[,group,drop=T] = NA
        for (i in seq(merge_by )){
          if(is.na(merge_by[[i]][1])){
            merge_by[[i]][1] = min(dat_num,na.rm = T)
          }
          if(is.na(merge_by [[i]][2])){
            merge_by[[i]][2] = max(dat_num,na.rm = T)
          }
        }
        if(merge_by[[1]][1] < merge_by[[2]][2] && merge_by[[1]][2] > merge_by[[2]][1]){
          stop("Please provide two independent grouping range")
        }
        meta_data_sub[,group,drop=T][which(findInterval(dat_num, merge_by[[1]])==1)] = names(merge_by)[1]
        meta_data_sub[,group,drop=T][which(findInterval(dat_num, merge_by[[2]], rightmost.closed = TRUE)==1)] = names(merge_by)[2]
      }
    # } else if (class(meta_data_sub[,group,drop=T])=="character"){
    } else if (inherits(meta_data_sub[, group, drop = T], "character")){
      dat_chr = meta_data_sub[,group,drop=T]
      meta_data_sub[,group,drop=T] = NA
      if(length(intersect(merge_by[[1]], merge_by[[2]]))){
        stop("Please provide two independent grouping range")
      }
      
      meta_data_sub[,group,drop=T][dat_chr %in% merge_by[[1]]] = names(merge_by)[1]
      meta_data_sub[,group,drop=T][dat_chr %in% merge_by[[2]]] = names(merge_by)[2]
    }  
    meta_data_sub = meta_data_sub[!is.na(meta_data_sub[,group,drop=T]),]
  }

  # 对否返回全部值
  if(return_all){
    return(meta_data_sub)
  }

  meta_data_sub2 = meta_data_sub[,c("Sample","Cancer",group)]
  meta_data_sub2 = meta_data_sub2[, !duplicated(colnames(meta_data_sub2))]
 
  sub2_group_stat = meta_data_sub2 %>%
    dplyr::select(last_col()) %>%
    dplyr::mutate(across(where(is.character), as.factor)) %>%
    summary()
  
  list(data = meta_data_sub2, stat = sub2_group_stat)
}