unikaj podwójnego odświeżania wykresu w błyszczącym

Question

W błyszczącym wątku próbuję zaznaczyć punkty pasujące do klikniętego punktu (na podstawie nearPoints() i kliknij).

To rodzaj prac. Jednak reaktywne części błyszczącej aplikacji są odświeżane dwukrotnie, a druga iteracja wydaje się usuwać kliknięte informacje.

Jak mogę uniknąć drugiego odświeżenia aplikacji?

Oto MWE: (!)

library("Cairo") 
library("ggplot2") 
library("shiny") 

ui <- fluidPage(
    fluidRow(
    titlePanel('Phenotype Plots') 
), 

    fluidRow(
    uiOutput("plotui") 
), 

    hr(), 

    fluidRow(

    wellPanel(
     h4("Selected"), 
     tableOutput("info_clicked") 
     ##dataTableOutput("info_clicked") ## overkill here 
    ) 
) 
) 


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

    selected_line <- reactive({ 
    nearPoints(mtcars, input$plot_click, 
       maxpoints = 1, 
       addDist = TRUE) 
    }) 

    output$plotui <- renderUI({ 
     plotOutput("plot", height=600, 
     click = "plot_click" 
    ) 
    }) 

    output$plot <- renderPlot({ 

    p <- ggplot(mtcars) + 
     facet_grid(am ~ cyl) + 
     theme_bw() + 
     geom_point(aes(x=wt, y=mpg)) 

    sline <- selected_line() 
    if (nrow(sline) > 0) { 
     p <- p + 
     geom_point(aes(x=wt, y=mpg), 
        data=mtcars[mtcars$gear == sline$gear,], 
        colour="darkred", 
        size=1) 
    } 

    p 

    }) 

    ##output$info_clicked <- renderDataTable({ 
    output$info_clicked <- renderTable({ 
    res <- selected_line() 
    ## datatable(res) 
    res 
    }) 

} 

shinyApp(ui, server) 

Answer 1

Wreszcie znalazłem obejście dla unikania podwójnego kliknięcia na odświeżenie w błyszczące: przechwytywania kliknij na reactiveValue(), używając observeEvent(). Wygląda na to, że pracuję nad moim projektem i dla twojego MWE. Zobacz zaktualizowaną sekcję kodu poniżej.

library("Cairo") 
library("ggplot2") 
library("shiny") 

ui <- fluidPage(
    fluidRow(
    titlePanel('Phenotype Plots') 
), 

    fluidRow(
    uiOutput("plotui") 
), 

    hr(), 

    fluidRow(

    wellPanel(
     h4("Selected"), 
     tableOutput("info_clicked") 
     ##dataTableOutput("info_clicked") ## overkill here 
    ) 
) 
) 


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

    ## CHANGE HERE 
    ## Set up buffert, to keep the click. 
    click_saved <- reactiveValues(singleclick = NULL) 

    ## CHANGE HERE 
    ## Save the click, once it occurs. 
    observeEvent(eventExpr = input$plot_click, handlerExpr = { click_saved$singleclick <- input$plot_click }) 


    ## CHANGE HERE 
    selected_line <- reactive({ 
    nearPoints(mtcars, click_saved$singleclick, ## changed from "input$plot_click" to saved click. 
       maxpoints = 1, 
       addDist = TRUE) 
    }) 

    output$plotui <- renderUI({ 
    plotOutput("plot", height=600, 
       click = "plot_click" 
    ) 
    }) 

    output$plot <- renderPlot({ 

    p <- ggplot(mtcars) + 
     facet_grid(am ~ cyl) + 
     theme_bw() + 
     geom_point(aes(x=wt, y=mpg)) 

    sline <- selected_line() 
    if (nrow(sline) > 0) { 
     p <- p + 
     geom_point(aes(x=wt, y=mpg), 
        data=mtcars[mtcars$gear == sline$gear,], 
        colour="darkred", 
        size=1) 
    } 

    p 

    }) 

    ##output$info_clicked <- renderDataTable({ 
    output$info_clicked <- renderTable({ 
    res <- selected_line() 
    ## datatable(res) 
    res 
    }) 

} 

shinyApp(ui, server)