Vermeiden Sie doppelte Aktualisierung des Plots in glänzendem

Question

In einem glänzenden Plot versuche ich, Punkte zu markieren, die einem angeklickten Punkt entsprechen (basierend auf nearPoints() und click).

Es funktioniert irgendwie. Die reaktiven Teile der glänzenden App werden jedoch zweimal aktualisiert und die zweite Iteration scheint die angeklickte Information zu löschen.

Wie kann ich die zweite Aktualisierung der App vermeiden? Hier

ist die 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

Schließlich fand eine Lösung für die Vermeidung doppelter refresh auf Klick in Shiny: Fänger-Klick auf ein reactiveValue(), mit der observeEvent(). Scheinbar funktioniert mein Projekt und auch dein MWE. Siehe aktualisierten Codeabschnitt unten.

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)