根据输入列在 dashboardSidebar 中创建两个下拉菜单

Question

我想在侧边栏上制作两个下拉菜单，一个用于我的 df.t 数据框中 RNAType 列中的每个唯一字符串。一个下拉菜单应命名为 MicroRNA，另一个应命名为 snRNA，下拉菜单中的选项应取自 miRNA 列。我提供了一个示例，当我只有一组 MicroRNA 时如何完成此操作，但是，我不知道如何根据列输入

添加两个 dashboardSidebar

图书馆（生存）图书馆（幸存者）

   df.t <-  structure(list(miRNA = c("hsa-let-7f-3p", "hsa-let-7d-3p", "hsa-let-7c-3p", 
"hsa-let-7g-3p", "hsa-let-7g-3p", "hsa-let-7i-3p"), RNAType = c("MicroRNA", 
"MicroRNA", "MicroRNA", "snRNA", "snRNA", "snRNA"), Status = c("1", 
"0", "1", "1", "1", "1"), TimeDiff = c("213", "1313", "2442", 
"1313", "1212", "2213"), value = c("10.3", "4", "3", "2.4", "5.4", 
"4.3")), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))

ui.miRNA <- dashboardPage(
        # Application title
        dashboardHeader(title=h4(HTML("Plot"))),
        dashboardSidebar(
            selectInput("MicroRNA", "miRNA", choices = unique( df.t$miRNA))),
        dashboardBody(
            sliderInput("obs", "Quantiles",
                        min = 0, max = 1, value = c(0.4, 0.8)
            ),
            tabsetPanel(
                tabPanel("Plot", plotOutput("myplot", width = "400px", height = "300px"))
            )
        )
    )

我的服务器：

server <- function(input, output, session) {
            data_selected <- reactive({
        req(input$MicroRNA)
        filter(df.t, 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)
                              
        
        
    }    )
}

Answer 1

我过滤了 MicroRNA 和 snRNA 的 RNAType 列，并根据 miRNA 的独特值创建了下拉列表。然后，您可以使用两个输入值来创建 2 个带有过滤数据框的独立图。

我认为你的反应data_selected没有用

library(shiny)
library(shinydashboard)
library(dplyr)
library(survival)
library(survminer)

df.t <- structure(list(
  miRNA = c("hsa-let-7f-3p", "hsa-let-7d-3p", "hsa-let-7c-3p", "hsa-let-7g-3p", "hsa-let-7g-3p", "hsa-let-7i-3p"),
  RNAType = c("MicroRNA", "MicroRNA", "MicroRNA", "snRNA", "snRNA", "snRNA"),
  Status = c(TRUE, FALSE, TRUE, TRUE, TRUE, TRUE),
  TimeDiff = c(213, 1313, 2442, 1313, 1212, 2213),
  value = c(10.3, 4, 3, 2.4, 5.4, 4.3)
), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))


ui.miRNA <- dashboardPage(
  # Application title
  dashboardHeader(title=h4(HTML("Plot"))),
  dashboardSidebar(
    selectInput(
      "MicroRNA", "miRNA",
      choices = df.t %>% filter(RNAType == "MicroRNA") %>% distinct(miRNA) %>% pull(miRNA)
    ),
    selectInput(
      "snRNA", "snRNA",
      choices = df.t %>% filter(RNAType == "snRNA") %>% distinct(miRNA) %>% pull(miRNA)
    )
  ),
  dashboardBody(
    sliderInput("obs", "Quantiles",
                min = 0, max = 1, value = c(0.4, 0.8)
    ),
    tabsetPanel(
      tabPanel("Plot",
               plotOutput("myplot1", width = "400px", height = "300px"),
               plotOutput("myplot2", width = "400px", height = "300px"))
    )
  )
)

server <- function(input, output, session) {

  output$myplot1 <- renderPlot({
    req(input$MicroRNA)
    df.t.sub <- df.t %>% filter(RNAType == "MicroRNA" & miRNA %in% input$MicroRNA)
    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 = df.t.sub)

    new_env <- environment()
    new_env$value <- df.t.sub$value
    new_env$TimeDiff <- df.t.sub$TimeDiff
    new_env$Status <- df.t.sub$Status
    new_env$lower_value <- lower_value
    new_env$upper_value <- upper_value
    ggsurvplot(fitSurv, new_env)
  })

  output$myplot2 <- renderPlot({
    req(input$snRNA)
    df.t.sub <- df.t %>% filter(RNAType == "snRNA" & miRNA %in% input$snRNA)
    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 = df.t.sub)

    new_env <- environment()
    new_env$value <- df.t.sub$value
    new_env$TimeDiff <- df.t.sub$TimeDiff
    new_env$Status <- df.t.sub$Status
    new_env$lower_value <- lower_value
    new_env$upper_value <- upper_value
    ggsurvplot(fitSurv, new_env)
  })

}

shinyApp(ui.miRNA, server)

第一个图生成错误，因为它只包含一行，其中 lower_value 和 upper_value 相同。添加更多数据应该可以解决问题。要消除错误，您还可以向 req()

添加一些条件

根据输入列在 dashboardSidebar 中创建两个下拉菜单

Create two dropdowns in dashboardSidebar based on column of input

r

shiny

shinydashboard