मैं साइडबार पर दो ड्रॉपडाउन बनाना चाहता हूं, एक मेरे df.t डेटा फ्रेम में RNAType कॉलम में प्रत्येक अद्वितीय स्ट्रिंग के लिए। एक ड्रॉपडाउन को MicroRNA और दूसरे को snRNA नाम दिया जाना चाहिए और ड्रॉपडाउन के विकल्पों को कॉलम miRNA से लिया जाना चाहिए। मैंने एक उदाहरण प्रदान किया है कि यह कैसे किया जाता है जब मेरे पास केवल एक समूह होता है, माइक्रोआरएनए, हालांकि, मुझे नहीं पता कि कॉलम इनपुट के आधार पर दो 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)
                              
        
        
    }    )
}
1
user2300940 9 पद 2020, 13:38

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() में कुछ शर्तें भी जोड़ सकते हैं

1
Thomas 9 पद 2020, 14:55