繁体   English   中英

在闪亮的条件面板中隔离

[英]isolate conditionalPanel in shiny

我有一个shiny标签,用户可以在其中通过selectInput选择多个参数。 选择之后,用户单击一个actionButton ,服务器端将进行大量计算。 根据结果​​和选择,应该显示一个或几个conditionalPanels 问题在于,一旦用户更改了选择,显示的conditionalPanel就会立即更改。 但是,我希望仅在用户再次按下actionButton并更新服务器端的计算之后才能评估条件。 有没有办法将conditionalPanel的conditionalPanel绑定到actionButton

这是我能想到的最好的MWE,可以捕获所有细微差别(实际上,这里仍然缺少条件面板对某些服务器结果的依赖性):

library(shiny)
library(plyr)

ui <- fluidPage(
  selectInput("variable", "Variable:",
              c("SLength" = "Sepal.Length",
                "SWidth" = "Sepal.Width",
                "PLength" = "Petal.Length",
                "PWidth" = "Petal.Width",
                "Species" = "Species"),
              multiple = TRUE),
  br(),
  actionButton("goButton", "Go!"), 
  hr(),
  conditionalPanel(condition = "input['variable'].length == 1",
                   plotOutput("oneplot")),
  conditionalPanel(condition = "input['variable'].length == 2",
                   plotOutput("twoplot"))
)

server <- function(input, output){
  v <- reactiveValues(plot.type = NULL)

  observeEvent(input$goButton, {
    if (is.null(input$variable)) return(NULL)
    if ("Species" %in% input$variable & length(input$variable > 1)){
      sec.var <- input$variable[which(input$variable != "Species")]
      v$summary <- ldply(by(iris[,sec.var], iris$Species, mean))
      v$summary[,1] <- as.factor(v$summary[,1])
    } else if ("Species" %in% input$variable)
      v$summary <- table(iris$Species) else
        v$summary <- iris[,input$variable]
  })

  output$oneplot <- renderPlot({
    if (is.null(v$summary)) return(NULL)
    if (input$variable == "Species") return(NULL)
    hist(v$summary)
  })

  output$twoplot <- renderPlot({
    if (is.null(v$summary)) return(NULL)
    plot(v$summary)
  })
}

shinyApp(ui, server)

假设我启动了该应用程序,然后选择SLengthSWidth ,单击Go -Button并得到一个点图。 然后,我想显示SLength vs. PLength ,所以我从选择字段中删除了SWidth ,同时获得了两个直方图,每个先前的选择一个。 条件面板会立即对input$variable的更改作出反应,而服务器脚本中的观察者仍在等待我按下按钮。 显然,这不是用户期望的行为。 预期的行为是对条件面板条件的评估仅在按下“ Go按钮时进行。 有没有办法做到这一点?

在服务器端做条件怎么样?

    library(shiny)
    library(plyr)

    ui <- fluidPage(
      selectInput("variable", "Variable:",
                  c("SLength" = "Sepal.Length",
                    "SWidth" = "Sepal.Width",
                    "PLength" = "Petal.Length",
                    "PWidth" = "Petal.Width",
                    "Species" = "Species"),
                  multiple = TRUE),
      br(),
      actionButton("goButton", "Go!"), 
      hr(),
       plotOutput("oneplot")
     # conditionalPanel(condition = "input['variable'].length == 1",
     #                  plotOutput("oneplot")),
     # conditionalPanel(condition = "input['variable'].length == 2",
      #                 plotOutput("twoplot"))
    )

    server <- function(input, output){
      v <- reactiveValues(plot.type = NULL)

      observeEvent(input$goButton, {
        if (is.null(input$variable)) return(NULL)
        if ("Species" %in% input$variable & length(input$variable > 1)){
          sec.var <- input$variable[which(input$variable != "Species")]
          v$summary <- ldply(by(iris[,sec.var], iris$Species, mean))
          v$summary[,1] <- as.factor(v$summary[,1])
        } else if ("Species" %in% input$variable)
          v$summary <- table(iris$Species) else
            v$summary <- iris[,input$variable]
      })

      output$oneplot <- renderPlot({
        #Added actionButton dependency here
        input$goButton
        isolate({
        if(length(input$variable)== 1) {
            if (is.null(v$summary)) return(NULL)
            if (input$variable == "Species") return(NULL)
            hist(v$summary)
        }
        else {
             if (is.null(v$summary)) return(NULL)
            plot(v$summary)
        }
        })
      })

      #output$twoplot <- renderPlot({

        #if (is.null(v$summary)) return(NULL)
        #plot(v$summary)

      #})
    }

shinyApp(ui, server)         

编辑:通过使用submitButton添加了另一个选项

您还可以使用submitButton() ,并将observeEvent()附加到input$variable() “包含输入按钮的表单不会在输入发生更改时自动更新其输出,而是会等到用户显式单击提交按钮之后。” 提交按钮

library(shiny)
library(plyr)

ui <- fluidPage(
  selectInput("variable", "Variable:",
              c("SLength" = "Sepal.Length",
                "SWidth" = "Sepal.Width",
                "PLength" = "Petal.Length",
                "PWidth" = "Petal.Width",
                "Species" = "Species"),
              multiple = TRUE),
  br(),
  submitButton("Go!"), 
  hr(),
  conditionalPanel(condition = "input['variable'].length == 1",
                   plotOutput("oneplot")),
  conditionalPanel(condition = "input['variable'].length == 2",
                   plotOutput("twoplot"))
)

server <- function(input, output){
  v <- reactiveValues(plot.type = NULL)

  observeEvent(input$variable, {
    if (is.null(input$variable)) return(NULL)
    if ("Species" %in% input$variable & length(input$variable > 1)){
      sec.var <- input$variable[which(input$variable != "Species")]
      v$summary <- ldply(by(iris[,sec.var], iris$Species, mean))
      v$summary[,1] <- as.factor(v$summary[,1])
    } else if ("Species" %in% input$variable)
      v$summary <- table(iris$Species) else
        v$summary <- iris[,input$variable]
  })

  output$oneplot <- renderPlot({
    if (is.null(v$summary)) return(NULL)
    if (input$variable == "Species") return(NULL)
    hist(v$summary)
  })

  output$twoplot <- renderPlot({
    if (is.null(v$summary)) return(NULL)
    plot(v$summary)
  })
}

shinyApp(ui, server)

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM