ggvisプロットより前のUIを更新R Shiny

Question

背景：私は、MySQLデータベースとインターフェースするダッシュボードを構築しています。ユーザは、データベースからデータを引き出して「送信」をクリックし、データをggvisとプロットする粗いフィルタを指定すると、ユーザは細かいフィルタで再生し、プロットされるデータのサブセットに影響を及ぼすことができる。これらのファインフィルタは、データベースから取得したデータに依存するため、uiOutput/renderUIを使用してデータから生成します。

問題：私の挑戦は、私はUIは、プロットが更新され前のデータに基づいて更新することにしたいということです。そうしないと、古いデータセットの細かいフィルタが新しいデータに適用され、プロット時にエラーが発生します。

例：次の例では、mtcarsを使用して問題を再現しています。エラーを表示するには、4シリンダーを選択して[Submit]をクリックし、6シリンダーを選択して[Submit]をもう一度クリックします。この場合、4シリンダファインフィルタを6シリンダデータセットに適用すると、1点のみが返され、ggvisにスムーザを適用しようとするとエラーが発生します。私と同じエラーではありませんが、十分に近いです。

library(shiny) 
library(dplyr) 
library(ggvis) 

ui <- fluidPage(
    headerPanel("Example"), 
    sidebarPanel(
    h2("Course Filter:"), 
    selectInput("cyl_input", "Cylinders", c(4, 6)), 
    actionButton("submit", "Submit"), 
    conditionalPanel(condition = "input.submit > 0", 
     h2("Fine Filter: "), 
     uiOutput("mpg_input") 
    ) 
), 
    mainPanel(
    ggvisOutput("mtcars_plot") 
) 
) 

server <- function(input, output) { 
    mycars <- eventReactive(input$submit, { 
    filter(mtcars, cyl == input$cyl_input) 
    }) 
    output$mpg_input <- renderUI({ 
    mpg_range <- range(mycars()$mpg) 
    sliderInput("mpg_input", "MPG: ", 
       min = mpg_range[1], max = mpg_range[2], 
       value = mpg_range, 
       step = 0.1) 
    }) 
    observe({ 
    if (!is.null(input$mpg_input)) { 
     mycars() %>% 
     filter(mpg >= input$mpg_input[1], 
       mpg <= input$mpg_input[2]) %>% 
     ggvis(~mpg, ~wt) %>% 
     layer_points() %>% 
     layer_smooths() %>% 
     bind_shiny("mtcars_plot") 
    } 
    }) 
} 

shinyApp(ui = ui, server = server) 

Answer 1

何時間も騒がれた後、私は非常に面白い回避策を見つけました。私はそれに非常に満足していないので、誰かが改善を提供することを望んでいる。まとめると、renderUIコールは、プロットが生成される前、すなわちプロットが生成される前に実行されていたことを要約すると、ただし、renderUIは、UIのスライダを直接変更するのではなく、スライダを更新するようにブラウザに通知するメッセージをブラウザに送信します。このようなメッセージは、すべてのオブザーバが実行された後にのみ実行されます。特に、これは、オブザーバがggvisへの呼び出しをラッピングした後に発生します。したがって、シーケンスは

1. と思われます。スライダを更新するためにブラウザに送信されたメッセージ。
2. スライダー内の値に基づいてプロットが生成されますが、これも以前の値です。
3. ブラウザの更新スライダー。悲しいことに、遅すぎる:(

これを回避するために、私はMPG値の範囲を格納する新しい反応変数を作成することにしました。粗いフィルターが適用された直後、そしてスライダーがブラウザーで更新される前その後、この変数は新しいデータフレームを直接参照します。その後、スライダを直接再生するとき、この反応変数はスライダを参照します。これは、データフレームまたはスライダを参照するかどうかを指定するフラグを設定するだけで、 。場所は

ここでは、コードです：

library(shiny) 
library(dplyr) 
library(ggvis) 

ui <- fluidPage(
    headerPanel("Example"), 
    sidebarPanel(
    h2("Course Filter:"), 
    selectInput("cyl_input", "Cylinders", c(4, 6)), 
    actionButton("submit", "Submit"), 
    conditionalPanel(condition = "input.submit > 0", 
        h2("Fine Filter: "), 
        uiOutput("mpg_input") 
    ) 
), 
    mainPanel(
    ggvisOutput("mtcars_plot") 
) 
) 
server <- function(input, output) { 
    # create variable to keep track of whether data was just updated 
    fresh_data <- TRUE 
    mycars <- eventReactive(input$submit, { 
    # data have just been refreshed 
    fresh_data <<- TRUE 
    filter(mtcars, cyl == input$cyl_input) 
    }) 
    output$mpg_input <- renderUI({ 
    mpgs <- range(mycars()$mpg) 
    sliderInput("mpg_input", "MPG: ", 
       min = mpgs[1], max = mpgs[2], 
       value = mpgs, 
       step = 0.1) 
    }) 
    # make filtering criterion a reactive expression 
    # required because web page inputs not updated until after everything else 
    mpg_range <- reactive({ 
    # these next two lines are required though them seem to do nothing 
    # from what I can tell they ensure that mpg_range depends reactively on 
    # these variables. Apparently, the reference to these variables in the 
    # if statement is not enough. 
    input$mpg_input 
    mycars() 
    # if new data have just been pulled reference data frame directly 
    if (fresh_data) { 
     mpgs <- range(mycars()$mpg) 
    # otherwise reference web inputs 
    } else if (!is.null(input$mpg_input)) { 
     mpgs <- input$mpg_input 
    } else { 
     mpgs <- NULL 
    } 
    return(mpgs) 
    }) 
    observe({ 
    if (!is.null(mpg_range())) { 
     mycars() %>% 
     filter(mpg >= mpg_range()[1], 
       mpg <= mpg_range()[2]) %>% 
     ggvis(~mpg, ~wt) %>% 
     layer_points() %>% 
     layer_smooths() %>% 
     bind_shiny("mtcars_plot") 
    } 
    # ui now updated, data no longer fresh 
    fresh_data <<- FALSE 
    }) 
} 

shinyApp(ui = ui, server = server)