Question

我创建了一个非常简单的闪亮app，其中包含一个被动小部件sliderInput。该解决方案允许我操纵y轴的比例。但是当我将滑块设置在0到0.3之间然后我更改产品时，例如P1-> P3 sliderInput窗口小部件自动返回到原始范围（即0和1）。应用程序工作正常，但我注意到当我更改具有操纵范围的产品时，第一步是绘制带有操纵y轴的绘图，之后该绘图包含y轴的原始范围。它看起来很丑，特别是在更复杂的应用程序中。如何更改执行顺序，即第一个是改变y轴的范围然后生成一个图？

global.R

library(dplyr)

prod <- c('P1','P2','P3')
level <- c('L1','L2','L3')
part <- c('p1','p2','p3','p4','p5')

set.seed(123)
module1_df <- data.frame(prod = sample(prod,300, replace = T), 
                         value = runif(300,0,0.3))

module1_df <- as.data.frame(module1_df %>% 
                                    group_by(prod) %>% 
                                    mutate(id = 1:n()) %>% 
                                    arrange(prod, id))

app.R

library(shiny)
library(ggvis)

ui <- navbarPage(
                title = '',
                tabPanel("Module 1",
                         selectInput('prod', '', prod),
                         uiOutput('in_value'),
                         ggvisOutput('plot_show')
                )
        )
)

server <- (function(input, output) {

        data_0 <- reactive({
                df <- module1_df %>% 
                        filter(prod == input$prod)
        })

        output$in_value <- renderUI({
                df2 <- data_0()
                var <- 'value'
                min_value <- min(df2[,var])
                sliderInput('value','',min = round(min_value,0), 
                            max = 1, value = c(0,1), step = 0.1)
        })

        data <- reactive({
                df3 <- data_0()
                if (!is.null(input$value)) {
                        df3 <- df3 %>% 
                                filter(df3[['value']] >= input$value[1] & 
                                       df3[['value']] <= input$value[2])
                }
                return(df3)

        })
        plot <- reactive({

                withProgress('', value = 0, {
                        y_min <- input$value[1]
                        y_max <- input$value[2]

                        plot <- data() %>% 
                                ggvis(~id, ~value) %>% 
                                layer_points() %>% 
                                scale_numeric('y',domain = c(y_min, y_max))

                        Sys.sleep(0.5)
                })
                return(plot)
        })

        plot %>% bind_shiny('plot_show')

})


shinyApp(ui = ui, server = server)

Answer 1

在您的反应式绘图命令中放置invalidateLater 1秒将使渲染器等待滑块重新初始化。我还将Sys.sleep更改为更短的时间，因此重新绘制延迟几乎难以察觉

# note the added 'session' argument
server <- function(input, output, session) {

  data_0 <- reactive({
    df <- module1_df %>% 
      filter(prod == input$prod)
  })

  output$in_value <- renderUI({
    df2 <- data_0()
    var <- 'value'
    min_value <- min(df2[,var])
    sliderInput('value','', min = round(min_value ,0), 
                max = 1, value = c(0, 1), step = 0.1)
  })


  data <- reactive({
    df3 <- data_0()
    if (!is.null(input$value)) {
      df3 <- df3 %>% 
        filter(df3[['value']] >= input$value[1] & 
                 df3[['value']] <= input$value[2])
    }
    return(df3)

  })



  plot <- reactive({

   invalidateLater(1000, session)

    withProgress('', value = 0, {
      y_min <- input$value[1]
      y_max <- input$value[2]

      plot <- isolate(data()) %>% 
        ggvis(~id, ~value) %>% 
        layer_points() %>% 
        scale_numeric('y', domain = c(y_min, y_max))

        Sys.sleep(0.01)
    })
    return(plot)
  })

  plot %>% bind_shiny('plot_show')

}

ggvis中的执行顺序和反应滑块输入闪亮

1 个答案: