R snippet to set “Auto” grouping cutoff mode in the tcga_surv_get function for TCGA-Survival analysis

[quiquemedina]

Dear UCSCXenaShiby developers,
I wonder if you would kindly share the R snippet under the grouping “Auto” cutoff mode in the tcga_surv_get function for TCGA-Survival analysis.

Grouping samples by optimal cutoff (“Auto”) mode

data <- tcga_surv_get(
"RUNX1",
TCGA_cohort = "LUAD",
profile = "mRNA",
TCGA_cli_data = dplyr::full_join(load_data("tcga_clinical"), load_data("tcga_surv"), by
= "sample"),
opt_pancan = .opt_pancan
)

tcga_surv_plot(
data,
time = "OS.time",
status = "OS",
cutoff_mode = "Auto", # "Custom"
#cutpoint = c(50, 50),
profile = "mRNA",
palette = "aaas"
)

Best regards,
Enrique

[ShixiangWang]

Hi @quiquemedina

It should be quite easy to obtain the source code by just running function name in R console:

> library(UCSCXenaShiny)
> tcga_surv_get
function (item, TCGA_cohort = "LUAD", profile = c("mRNA", "miRNA", 
    "methylation", "transcript", "protein", "mutation", "cnv"), 
    TCGA_cli_data = dplyr::full_join(load_data("tcga_clinical"), 
        load_data("tcga_surv"), by = "sample"), opt_pancan = .opt_pancan) 
{
    stopifnot(length(item) == 1)
    profile <- match.arg(profile)
    if (!requireNamespace("stringr")) {
        install.packages("stringr")
    }
    if (TCGA_cohort == "PANCAN") {
        cliMat <- TCGA_cli_data
    }
    else {
        .type <- switch(TCGA_cohort, COADREAD = c("COAD", "READ"), 
            GBMLGG = c("GBM", "LGG"), LUNG = c("LUAD", "LUSC"), 
            TCGA_cohort)
        cliMat <- TCGA_cli_data %>% dplyr::filter(.data$type %in% 
            .type)
    }
    message("Querying data of molecule(s) ", item, " for survival analysis in TCGA cohort ", 
        TCGA_cohort, ".")
    gd <- query_pancan_value(item, data_type = profile, opt_pancan = opt_pancan)
    if (is.list(gd)) 
        gd <- gd[[1]]
    if (all(is.na(gd))) {
        return(NULL)
    }
    gd <- gd[nchar(names(gd)) == 15]
    merged_data <- dplyr::tibble(sampleID = names(gd), value = as.numeric(gd)) %>% 
        dplyr::filter(as.numeric(substr(.data$sampleID, 14, 15)) < 
            10) %>% dplyr::inner_join(cliMat, by = c(sampleID = "sample")) %>% 
        dplyr::select(c("sampleID", "value", "OS", "OS.time", 
            "DSS", "DSS.time", "DFI", "DFI.time", "PFI", "PFI.time", 
            "gender", "age_at_initial_pathologic_diagnosis", 
            "ajcc_pathologic_tumor_stage")) %>% dplyr::rename(age = .data$age_at_initial_pathologic_diagnosis, 
        stage = .data$ajcc_pathologic_tumor_stage) %>% dplyr::mutate(stage = stringr::str_match(.data$stage, 
        "Stage\\s+(.*?)[ABC]?$")[, 2]) %>% dplyr::mutate(stage = ifelse(is.na(.data$stage), 
        "Unknown", .data$stage), gender = ifelse(is.na(.data$gender), 
        "Unknown", .data$gender))
    return(merged_data)
}
<bytecode: 0x127aef270>
<environment: namespace:UCSCXenaShiny>
> tcga_surv_plot
function (data, time = "time", status = "status", cutoff_mode = c("Auto", 
    "Custom"), cutpoint = c(50, 50), cnv_type = c("Duplicated", 
    "Normal", "Deleted"), profile = c("mRNA", "miRNA", "methylation", 
    "transcript", "protein", "mutation", "cnv"), palette = "aaas", 
    ...) 
{
    cutoff_mode <- match.arg(cutoff_mode)
    profile <- match.arg(profile)
    kept_cols <- c("value", time, status)
    data <- dplyr::select(data, dplyr::all_of(kept_cols))
    if (time != "time") 
        colnames(data)[2] <- "time"
    if (status != "status") 
        colnames(data)[3] <- "status"
    if (!requireNamespace("survminer")) {
        install.packages("survminer")
    }
    if (profile %in% c("mRNA", "miRNA", "methylation", "transcript", 
        "protein")) {
        sur_plot(data, cutoff_mode, cutpoint, palette = palette, 
            ...)
    }
    else if (profile == "mutation") {
        sur_plot_mut(data, palette = palette, ...)
    }
    else {
        sur_plot_cnv(data, cnv_type, palette = palette, ...)
    }
}
<bytecode: 0x125cd8ff0>
<environment: namespace:UCSCXenaShiny>
> UCSCXenaShiny:::sur_plot
function (data, cutoff_mode, cutpoint, palette = "aaas", ...) 
{
    if (cutoff_mode == "Auto") {
        data2 <- data %>% survminer::surv_cutpoint(time = "time", 
            event = "status", variables = c("value"), minprop = 0.25, 
            progressbar = TRUE) %>% survminer::surv_categorize(labels = c("Low", 
            "High")) %>% data.frame()
        data$group <- data2$value
    }
    else {
        if (length(cutpoint) == 1) {
            cutpoint <- c(cutpoint, cutpoint)
        }
        data <- data %>% dplyr::arrange(.data$value) %>% dplyr::mutate(per_rank = 100/nrow(.) * 
            (1:nrow(.)))
        data <- data %>% dplyr::mutate(group = dplyr::case_when(.data$per_rank > 
            !!cutpoint[2] ~ "High", .data$per_rank <= !!cutpoint[1] ~ 
            "Low", TRUE ~ NA_character_))
    }
    p_survplot(data %>% dplyr::mutate(group = factor(group, c("Low", 
        "High"))), palette = palette, ...)
}
<bytecode: 0x14f5e47b8>
<environment: namespace:UCSCXenaShiny>

[quiquemedina]

Great! Thank you so much for the hint!