Action Button 和 Isolate 在 Shiny 中似乎无法正常工作

Question

我有一个闪亮的应用程序，可以根据用户 selection 制作情节。因为我只想要在操作按钮被 selected 后绘制新图，所以我将绘图代码放在 "isolate" 中。结果是按下操作按钮后立即出现一个新图，但有时它也会在不按下按钮的情况下出现。特别是当我 select 对通过条件面板出现的参数进行子分类时（"Alpha"、"Beta"、"Gamma"、...）。在原始版本中，更改日期可能会导致重新执行情节。这是我的代码：我错过了什么？

callingColorPlot <- function(var) {
  listaMia<- list("alpha" = 2, "beta" = 3, "gamma" = 4, "delta" = 5, "epsilon" = 6, "zeta" = 7, "eta" = 8)
  valori <- (c(1:8))*10
  require(shiny)
  shinyApp(
    ui = fluidPage(
      titlePanel("Title"),
      sidebarLayout(
        sidebarPanel (position = "left", 
                      helpText(h4("Specificy:")), br(),       
                      selectInput("selectedColor", label = (strong("Select your color")), 
                                  choices = list( "Yellow selection", "Orange selection", "Blue selection", "Gray selection"), selected = ""),
                      conditionalPanel (
                        condition = "input.selectedColor == 'Yellow selection'",
                        selectInput("subCategory", label = (strong("Select sub categories")), choices = listaMia, selected="")
                      ),  
                      conditionalPanel (
                        condition = "input.selectedColor == 'Blue selection'",
                        checkboxGroupInput("letterCheckbox", label = strong("Select your letter"), 
                                           choices = listaMia, selected = "")
                      ), 
                      br(),
                      dateRangeInput("dates", label = (strong("Time Interval")), start='2012-01-02', end='2012-10-31', min='2012-01-02', max='2012-10-31'), 
                      sliderInput("sliderBegin", label = strong("Starting hour"), min = 0, max = 23, value = 0),
                      uiOutput("sliderInput"),
                      br(), actionButton("okButton", "Go")
        ),
        mainPanel(plotOutput("plotResult")))  
    ), 
    server = function(input, output, session) 
      {
      output$sliderInput <- renderUI ({
        sliderInput("sliderFinal", label = strong("Final hour"), min = 0, max = 24, value = 24);           
      })     
      output$plotResult <- renderPlot ( {
        input$okButton
        if (input$okButton == 0)
        return()              
         isolate ({ 
           plotWidth=c(430, 430, 430, 430, 430, 430, 430, 430)
           plotNames=c("1", "2", "3", "4", "5", "6", "7", "Tot")
          if (input$selectedColor == 'Yellow selection') { 
            color='yellow'
            xlabel="Yellow selection"
            mainTitle="Yellow selection"
          }else if (input$selectedColor == 'Orange selection') {
            color='orange'
            xlabel="Orange selection"
            mainTitle="Orange selection"  
          }else if (input$selectedColor == 'Blue selection') {              
            if (length(input$letterCheckbox)==0)
              return()
            color='darkblue'
            xlabel="Blue selection"
            mainTitle="Blue selection"
          }else if (input$selectedColor == 'Gray selection') {      
            color='darkgray'
            xlabel="Gray selection"
            mainTitle="Gray selection"
          } 
          mychart <- barplot (valori, col = color, border='white'
                              , width=plotWidth, space=0.2
                              , xlab=xlabel, ylab="values", names.arg=plotNames
                              , ylim=c(0, 100), xlim=c(150, 3750), main=mainTitle)  
        }) 
      })
    })
}

Answer 1

所以回到你的问题：

1) 您需要将 Shiny 更新到最新版本，这样才能解决按钮的问题

2) 滑块输入现在同步，时间将设置为 24 小时

3) 我添加了 observe 语句来控制 DateRangeInput 来控制负日期范围

callingColorPlot <- function(var) {
  listaMia<- list("alpha" = 2, "beta" = 3, "gamma" = 4, "delta" = 5, "epsilon" = 6, "zeta" = 7, "eta" = 8)
  valori <- (c(1:8))*10
  require(shiny)
  shinyApp(
    ui = fluidPage(
      titlePanel("Title"),
      sidebarLayout(
        sidebarPanel (position = "left", 
                      helpText(h4("Specificy:")), br(),       
                      selectInput("selectedColor", label = (strong("Select your color")), 
                                  choices = list( "Yellow selection", "Orange selection", "Blue selection", "Gray selection"), selected = ""),
                      conditionalPanel (
                        condition = "input.selectedColor == 'Yellow selection'",
                        selectInput("subCategory", label = (strong("Select sub categories")), choices = listaMia, selected="")
                      ),  
                      conditionalPanel (
                        condition = "input.selectedColor == 'Blue selection'",
                        checkboxGroupInput("letterCheckbox", label = strong("Select your letter"), 
                                           choices = listaMia, selected = "")
                      ), 
                      br(),
                      dateRangeInput("dates", label = (strong("Time Interval")), start='2012-01-02', end='2012-10-31', min='2012-01-02', max='2012-10-31'), 
                      sliderInput("sliderBegin", label = strong("Starting hour"), min = 0, max = 23, value = 0),
                      uiOutput("sliderInput"),
                      br(), actionButton("okButton", "Go")
        ),
        mainPanel(plotOutput("plotResult")))  
    ), 
    server = function(input, output, session) 
    {

      observe({
        if(input$dates[1] > input$dates[2])
        {
          date1 <- input$dates[1]
          updateDateRangeInput(session, "dates", label = (paste("Time Interval")), start=date1, end=date1, min='2012-01-02', max='2012-10-31') 
        }
      })

      output$sliderInput <- renderUI ({
        sliderInput("sliderFinal", label = strong("Final hour"), min = input$sliderBegin, max = 24, value = 24);           
      })    
      output$plotResult <- renderPlot ( {
        input$okButton
        if (input$okButton == 0)
          return()              
        isolate ({ 
          plotWidth=c(430, 430, 430, 430, 430, 430, 430, 430)
          plotNames=c("1", "2", "3", "4", "5", "6", "7", "Tot")
          if (input$selectedColor == 'Yellow selection') { 
            color='yellow'
            xlabel="Yellow selection"
            mainTitle="Yellow selection"
          }else if (input$selectedColor == 'Orange selection') {
            color='orange'
            xlabel="Orange selection"
            mainTitle="Orange selection"  
          }else if (input$selectedColor == 'Blue selection') {              
            if (length(input$letterCheckbox)==0)
              return()
            color='darkblue'
            xlabel="Blue selection"
            mainTitle="Blue selection"
          }else if (input$selectedColor == 'Gray selection') {      
            color='darkgray'
            xlabel="Gray selection"
            mainTitle="Gray selection"
          } 
          mychart <- barplot (valori, col = color, border='white'
                              , width=plotWidth, space=0.2
                              , xlab=xlabel, ylab="values", names.arg=plotNames
                              , ylim=c(0, 100), xlim=c(150, 3750), main=mainTitle)  
        }) 
      })
    })
} 

callingColorPlot()

Action Button 和 Isolate 在 Shiny 中似乎无法正常工作

Action Button and Isolate seem to not work as expected in Shiny

r

button

plot

shiny