在交互和非交互模式之间切换

Question

我正在尝试创建一个 checkBoxInput 以在交互和非交互模式之间切换。使用 actionButton 我可以控制输出以等待输入。但我想创建一个切换来更改 actionButton 的此操作。

例如，当交互模式开启时，使用 checkBoxInput，我希望 Shiny 在不需要 actionButton 的情况下创建输出，当交互模式关闭时，我希望 Shiny 等待actionButton。

示例 1

我尝试在这里创建一个示例，但我不确定如何继续。

library (shiny) 

vars <- setdiff(names(iris), "Species")

ui <- pageWithSidebar(
  headerPanel('Interactive and non-interactive mode'),
  sidebarPanel(
    checkboxInput('check', "Interactive Mode", value = FALSE),
    selectInput('xcol', 'X Variable', vars),
    selectInput('ycol', 'Y Variable', vars, selected = vars[[2]]),
    numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
    actionButton('run', "Run")
  ),
  mainPanel(
    plotOutput('plot1')
  )
)

server <- function(input, output, session) {
  
  # Combine the selected variables into a new data frame
  selectedData <- eventReactive(input$run, {
    iris[, c(input$xcol, input$ycol)]
  })
  
  
  clusters <- reactive({
    req(input$run)
    kmeans(selectedData(), input$clusters)
  })
  
  output$plot1 <- renderPlot({
  
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
    
    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
  
}


shinyApp(ui, server)

示例 2（此示例有效？但不确定 - 需要进一步测试）

我想知道我是否听起来很混乱，所以我做了一个更简单的例子并将交互模式重命名为“即时模式”。我很想知道如何使用 isolate 概念使更大的应用程序工作。

library(shiny)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    checkboxInput("instant", label = "Instant Mode", value = TRUE),
    selectInput("input1", label = NULL, choices = names(iris)),
    actionButton("run", "Run")
  ),
  mainPanel(
    verbatimTextOutput("values_print"),
    plotOutput("plot1")
  )
))

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

  output$plot1 <- renderPlot({

    if(input$instant) {
      boxplot(iris[[input$input1]], horizontal = TRUE)
    } else {
      req(input$run)
      isolate(boxplot(iris[[input$input1]], horizontal = TRUE))
    }

  })

}
shinyApp(ui, server)

Answer 1

只是要注意这个答案并不完美，但我有几分钟的时间，这就是我想出的：

library (shiny) 

vars <- setdiff(names(iris), "Species")

ui <- pageWithSidebar(
  headerPanel('Interactive and non-interactive mode'),
  sidebarPanel(
    checkboxInput('check', "Interactive Mode", value = FALSE),
    selectInput('xcol', 'X Variable', vars),
    selectInput('ycol', 'Y Variable', vars, selected = vars[[2]]),
    numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
    actionButton('run', "Run")
  ),
  mainPanel(
    plotOutput('plot1')
  )
)

server <- function(input, output, session) {
  
  values <- reactiveValues()
  
  observeEvent(input$run, {
    values$selectedData=iris[, c(input$xcol, input$ycol)]
    values$clusters=kmeans(values$selectedData, input$clusters)
  })
  
  observe({
    req(input$check)
    values$selectedData=iris[, c(input$xcol, input$ycol)]
    values$clusters=kmeans(values$selectedData, input$clusters)
  })
  
  output$plot1 <- renderPlot({
    
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
    
    par(mar = c(5.1, 4.1, 0, 1))
    plot(req(values$selectedData),
         col = values$clusters$cluster,
         pch = 20, cex = 3)
    points(values$clusters$centers, pch = 4, cex = 4, lwd = 4)
  })
  
}


shinyApp(ui, server)

我也使集群计数依赖于 actionButton，但在您的示例中并非如此。唯一的问题是，最初选择 checkBoxInput 时，情节会“做出反应”。让我知道你的想法。正如开头提到的，我怀疑有更好的解决方案。

更新

请参阅下面关于使用 shinyjs 的评论。此示例使用 toggleState，它等效于带有 if 语句的 enable/disable。要隐藏使用 show/hide。

library (shiny)
library(shinyjs)

vars <- setdiff(names(iris), "Species")

ui <- pageWithSidebar(
    headerPanel('Interactive and non-interactive mode'),
    sidebarPanel(
        useShinyjs(),
        checkboxInput('check', "Interactive Mode", value = FALSE),
        selectInput('xcol', 'X Variable', vars),
        selectInput('ycol', 'Y Variable', vars, selected = vars[[2]]),
        numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
        actionButton('run', "Run")
    ),
    mainPanel(
        plotOutput('plot1')
    )
)

server <- function(input, output, session) {
    
    values <- reactiveValues()
    
    observeEvent(input$check, {
        toggleState('run')
    }, ignoreInit = TRUE)
    
    observeEvent(input$run, {
        values$selectedData=iris[, c(input$xcol, input$ycol)]
        values$clusters=kmeans(values$selectedData, input$clusters)
    })
    
    observe({
        req(input$check)
        values$selectedData=iris[, c(input$xcol, input$ycol)]
        values$clusters=kmeans(values$selectedData, input$clusters)
    })
    
    output$plot1 <- renderPlot({
        
        palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
                  "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
        
        par(mar = c(5.1, 4.1, 0, 1))
        plot(req(values$selectedData),
             col = values$clusters$cluster,
             pch = 20, cex = 3)
        points(values$clusters$centers, pch = 4, cex = 4, lwd = 4)
    })
    
}


shinyApp(ui, server)

Answer 2

也许这就是您要找的。

library(shiny)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    #checkboxInput("instant", label = "Instant Mode", value = TRUE),
    radioButtons(inputId = "instant", label = "Mode", choices = c("Instant","Not Instant"), selected = character(0)),
    selectInput("input1", label = NULL, choices = names(iris)),
    actionButton("run", "Run")
  ),
  mainPanel(
    plotOutput("plot1")
  )
))

server <- function(input, output, session) {
  rv <- reactiveValues(cntr=0)

  observeEvent(input$run,{
    if (input$instant=="Instant") { rv$cntr <- 0
    }else {
      rv$cntr <- 1
    }
  })
  
  output$plot1 <- renderPlot({
    req(input$instant)
    if (input$instant=="Instant") {
      rv$cntr <- 0
      p <- boxplot(iris[[input$input1]], horizontal = TRUE)
    }else {
      input$run
      print(rv$cntr)
      if (rv$cntr==1){
        p <- boxplot(iris[[input$input1]], horizontal = TRUE)
      } else p <- NULL
    }
    p
  })
  
}
shinyApp(ui, server)