时间戳

首页 > 解决方案 > UpdateSelectInput 不更新选项

r - UpdateSelectInput 不更新选项

问题描述

我无法更新 selectinputs 的输入选项。我以为我有我需要的一切 -observe和updateSelectInput必要的反应，但它不起作用。

library(shiny)
library(ggplot2)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("dataset", label = "Choose dataset", choices = c(" ", "diamonds", "mtcars", "mpg")),
                 selectInput("x", "X", choices = NULL),
                 selectInput("y", "Y", choices = NULL),
                 selectInput("group", "Group", choices = NULL),
    actionButton("update", "Update")),
    mainPanel(plotOutput("plot"), verbatimTextOutput("codetext"))
  ))

server <- function(input, output, session) {
  
  
  data <- reactive({
    input$dataset
  })
  
  observe({
    updateSelectInput(session, "x", choices = c(" ", names(data())))
    updateSelectInput(session, "y", choices = c(" ", names(data())))
    updateSelectInput(session, "group", choices = c(" ", names(data())))
  })
  
  code <- reactive({
    req(data())
    req(input$x)
    req(input$y)
    paste("ggplot(", data(),",aes(x = ", input$x, ",y = ", input$y, ")) + geom_boxplot()")
  })
  output$plot <- renderPlot({
    req(input$update)
    req(code())
    req(input$x)
    req(input$y)
    eval(parse(text = code())) 
  })
  
  output$codetext <- renderText({
    code()
  })
  
  
}

shinyApp(ui, server)

标签： rshiny

解决方案

由于您的数据集名称是字符串，因此您需要使用get(). 尝试这个

library(shiny)
library(ggplot2)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("dataset", label = "Choose dataset", choices = c("diamonds", "mtcars", "mpg")),
                 selectInput("x", "X", choices = NULL),
                 selectInput("y", "Y", choices = NULL),
                 selectInput("group", "Group", choices = NULL),
                 actionButton("update", "Update")),
    mainPanel(plotOutput("plot") #, verbatimTextOutput("codetext")
              )
  ))

server <- function(input, output, session) {
  
  
  data <- reactive({
    req(input$dataset)
    get(input$dataset)
  })
  
  observe({
    req(data())
    updateSelectInput(session, "x", choices = c(" ", names(data())))
    updateSelectInput(session, "y", choices = c(" ", names(data())))
    updateSelectInput(session, "group", choices = c(" ", names(data())))
  })
  
  # code <- reactive({
  #   req(data())
  #   req(input$x)
  #   req(input$y)
  #   paste("ggplot(", data(),",aes(x = ", input$x, ",y = ", input$y, ")) + geom_boxplot()")
  # })
  output$plot <- renderPlot({
    # req(input$update)
    # req(code())
    # req(input$x)
    # req(input$y)
    # eval(parse(text = code())) 
    req(data(),input$x,input$y)
    if (input$x==" " | input$y==" ") return(NULL)
    ggplot(data(), aes(x = .data[[input$x]],y = .data[[input$y]])) + geom_boxplot()
  })
  
  # output$codetext <- renderText({
  #   code()
  # })
  
}

shinyApp(ui, server)

推荐阅读