Сделать выбор квантилей ползунком

Question

Интересно, можно ли сделать эту часть quantile(value, probs = c(0, .4, .8)) в моей функции survfit ниже в ползунок, который идет от 0 до 1. Ползунок должен управлять первой и последней частью квантиля (в моем примере части 0,4 и 0,8), поэтому может потребоваться два отдельных ползунка.

Я пробовал это, но получил ошибку input not found

  dashboardBody(
    sliderInput("obs1", "LowQuantile",
                min = 0, max = 1, value = 0.1
    ),
    sliderInput("obs2", "HighQuantile",
                min = 0, max = 1, value = 0.1
    )


fitSurv <-   survfit(Surv(TimeDiff, Status) ~ cut(value,
                                                      quantile(value, probs = c(0, input$obs1,input$obs2)),
                                                      include.lowest=TRUE),
                         data = data_selected())

Вот мое приложение:

library(dplyr) 
require(survminer)
library(tidyverse)
require(reshape2)
library(shiny)
library(tidyr)
require(survival)

пример данных:

 df.miRNA.cpm <-     structure(list(`86` = c(5.57979757386892, 17.0240095264258, 4.28380151026145, 
13.0457611762755, 12.5531123449841), `175` = c(5.21619202802748, 
15.2849097474841, 2.46719979911461, 10.879496005461, 9.66416497290915
), `217` = c(5.42796072966512, 17.1413407297933, 5.15230233060323, 
12.2646127361351, 12.1031024927547), `394` = c(-1.1390337316217, 
15.1021660424984, 4.63168157763046, 11.1299079134792, 9.55572588729967
), `444` = c(5.06134249676025, 14.5442494311861, -0.399445049232868, 
7.45775961504073, 9.92629675808998)), row.names = c("hsa_let_7a_3p", 
"hsa_let_7a_5p", "hsa_let_7b_3p", "hsa_let_7b_5p", "hsa_let_7c_5p"
), class = "data.frame")

df.miRNA.cpm$miRNA <- rownames(df.miRNA.cpm)


  ss.survival.shiny.miRNA.miRNA <-   structure(list(ID = c("86", "175", "217", "394", "444"), TimeDiff = c(71.0416666666667, 
601.958333333333, 1130, 1393, 117.041666666667), Status = c(1L, 
1L, 0L, 0L, 1L)), row.names = c(NA, 5L), class = "data.frame")

Объедините два примера фреймов данных:

 data_prep.miRNA <- df.miRNA.cpm %>% 
tidyr::pivot_longer(-miRNA, names_to = "ID") %>% 
left_join(ss.survival.shiny.miRNA.miRNA)

Блестящий:

ui.miRNA <- fluidPage(
  selectInput("MicroRNA", "miRNA", choices = unique(data_prep.miRNA$miRNA)),

  plotOutput("myplot"))

server <- function(input, output, session) {
  
  data_selected <- reactive({
    filter(data_prep.miRNA, miRNA %in% input$MicroRNA)
  })
  
  output$myplot <- renderPlot({
      fitSurv <-   survfit(Surv(TimeDiff, Status) ~ cut(value, quantile(value, probs = c(0, .4, .8)), include.lowest=TRUE),data = data_selected())

    ggsurvplot(fitSurv,data_selected ())
    
    
  })
}

shinyApp(ui.miRNA, server)

Answer 1

Основная проблема здесь - проблема области видимости одной из функций, вызываемых ggsurvfit. Вызывается stats::get_all_vars, глубоко вложенный в вызов функции. Эта функция каким-то образом приводит к проблеме определения объема, и она не находит переменные, используемые для нижнего / верхнего квантиля, потому что они не содержатся в кадре данных, который предоставляется в качестве входных данных для аргумента data. Однако stats::get_all_vars принимает среду вместо фрейма данных. Следовательно, мой прием заключается в том, чтобы передавать не фрейм данных, а среду в аргументе data из ggsurvfit. Затем среда содержит все необходимые переменные из фрейма данных, используемого для построения модели, а также переменные для квантилей. Я считаю, что это не оптимальное решение, и рад возможности получить лучшие.

Кроме того, я использую только один ползунок для выбора значений для квантилей:

library(dplyr) 
require(survminer)
library(tidyverse)
require(reshape2)
library(shiny)
library(tidyr)
require(survival)

df.miRNA.cpm <-     structure(list(`86` = c(5.57979757386892, 17.0240095264258, 4.28380151026145, 
                                            13.0457611762755, 12.5531123449841), `175` = c(5.21619202802748, 
                                                                                           15.2849097474841, 2.46719979911461, 10.879496005461, 9.66416497290915
                                            ), `217` = c(5.42796072966512, 17.1413407297933, 5.15230233060323, 
                                                         12.2646127361351, 12.1031024927547), `394` = c(-1.1390337316217, 
                                                                                                        15.1021660424984, 4.63168157763046, 11.1299079134792, 9.55572588729967
                                                         ), `444` = c(5.06134249676025, 14.5442494311861, -0.399445049232868, 
                                                                      7.45775961504073, 9.92629675808998)), row.names = c("hsa_let_7a_3p", 
                                                                                                                          "hsa_let_7a_5p", "hsa_let_7b_3p", "hsa_let_7b_5p", "hsa_let_7c_5p"
                                                                      ), class = "data.frame")

df.miRNA.cpm$miRNA <- rownames(df.miRNA.cpm)


ss.survival.shiny.miRNA.miRNA <-   structure(list(ID = c("86", "175", "217", "394", "444"), TimeDiff = c(71.0416666666667, 
                                                                                                         601.958333333333, 1130, 1393, 117.041666666667), Status = c(1L, 
                                                                                                                                                                     1L, 0L, 0L, 1L)), row.names = c(NA, 5L), class = "data.frame")
data_prep.miRNA <- df.miRNA.cpm %>% 
  tidyr::pivot_longer(-miRNA, names_to = "ID") %>% 
  left_join(ss.survival.shiny.miRNA.miRNA)

ui.miRNA <- fluidPage(
  selectInput("MicroRNA", "miRNA", choices = unique(data_prep.miRNA$miRNA)),
  sliderInput("obs", "Quantiles",
              min = 0, max = 1, value = c(0.4, 0.8)
  ),
  
  plotOutput("myplot"))

server <- function(input, output, session) {
  
  data_selected <- reactive({
    filter(data_prep.miRNA, miRNA %in% input$MicroRNA)
  })
  
  output$myplot <- renderPlot({
    lower_value <- input$obs[1]
    upper_value <- input$obs[2]
    fitSurv <-   survfit(Surv(TimeDiff, Status) ~ cut(value, quantile(value, probs = c(0, lower_value, upper_value)), include.lowest=TRUE),data = data_selected())
    
    new_env <- environment()
    new_env$value <- data_selected()$value
    new_env$TimeDiff <- data_selected()$TimeDiff
    new_env$Status <- data_selected()$Status
    new_env$lower_value <- lower_value
    new_env$upper_value <- upper_value
    ggsurvplot(fitSurv, new_env)
    
    
  })
}

shinyApp(ui.miRNA, server)