在ggvis中的執行順序和被動滑塊輸入有光澤

Question

我創建了一個非常簡單的閃亮應用程序，帶有一個反應小工具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') 

}