Обновить интерфейс несколько раз подряд в R Shiny - PullRequest
Новая
       8

Обновить интерфейс несколько раз подряд в R Shiny

0 голосов
/ 24 ноября 2018

Я пытаюсь заставить кнопку мигать (циклически переходить между цветами) несколько раз, прежде чем окончательно остановиться.Вроде имитировать лотерею.

Окончательный цвет в конце будет определяться вычислением, но сначала мне нужно выяснить, как заставить его мигать в начальный n раз, прежде чем он остановится.

Это то, что я пытался сделать, но он обновляет цвета только часть времени, например, 2 или 3 раза.

library(shiny)
ui  <- fluidPage(

  uiOutput('ColorButton'),
  actionButton(inputId = 'Generator', label = 'Show colors', style = "background-color: #fff; color: #FF0000; border-color: #FF0000; 
               border-width: 2px; font-size: 20px; font-weight: bolder; 
               border-radius: 6px; height: 60px; display: block; margin-top: 100px; margin-left: auto; margin-right: auto"
  )

)

server <- function(input, output, session) { 
  values <- reactiveValues(go = 0)
  values$color <- '#FF0000'
  observe({ values$style = paste("background-color:", values$color, ";height:300px; width: 300px; border-radius: 150px;
                       display: block; margin-top: 100px; margin-left: auto; margin-right: auto") })

  colors <- c("darkgray", "blue", "red", "green", "orange", "darkblue", "yellow", "gray20", "purple",  "black", "cyan", "violet", "beige", "magenta", "pink", "brown")

  observeEvent(input$Generator, { values$go <- 1 }) 

  observeEvent(values$go, { 
    if(values$go > 0 & values$go < 20) { 

      sampled <- sample(c(1:12), 1)
      values$color <- colors[sampled]
      values$go <- values$go +1
      Sys.sleep(0.1)


   }
  })
  output$ColorButton  <- renderUI({ actionButton(inputId = 'ColorButton', label = NULL, style = values$style)})
}

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 27 ноября 2018

Я немного изменил ваш пример и включил invalidateLater и isolate в наблюдателя, который меняет цвет, а в другом наблюдателе я обрабатываю случай, когда values$go равен 0, поэтому ColorButton имеет исходный цвет. 

library(shiny)

ui  <- {fluidPage(
  uiOutput('ColorButton'),
  actionButton(inputId = 'Generator', label = 'Show colors', style = "background-color: #fff; color: #FF0000; border-color: #FF0000; 
               border-width: 2px; font-size: 20px; font-weight: bolder; 
               border-radius: 6px; height: 60px; display: block; margin-top: 100px; margin-left: auto; margin-right: auto"
  )
)}

colors <- c("darkgray", "blue", "red", "green", "orange", "darkblue", "yellow", "gray20",
            "purple",  "black", "cyan", "violet", "beige", "magenta", "pink", "brown")

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

  values <- reactiveValues(go = 0)

  observe({
    if (values$go == 0) {
      values$color <- '#FF0000'
      values$go <- values$go +1
    }
  })

  observeEvent(input$Generator, {
    if (values$go == 20) {
      values$color <- '#FF0000'
      values$go <- 0
    }
  })

  observe({
    req(input$Generator)
    invalidateLater(500, session)
    isolate({
      if (values$go > 0 & values$go < 20) {
        sampled <- sample(c(1:12), 1)
        values$color <- colors[sampled]
        values$go <- values$go +1
      }      
    })
  }) 

  observe({ 
    values$style = paste("background-color:", values$color, ";height:300px; width: 300px; border-radius: 150px;
                         display: block; margin-top: 100px; margin-left: auto; margin-right: auto") 
  })

  output$ColorButton  <- renderUI({
    actionButton(inputId = 'ColorButton', label = NULL, style = values$style)
  })
}

shinyApp(ui = ui, server = server)
...