चमकदार

Question

में साजिश के दोहरा ताज़ा से बचें एक चमकदार साजिश में मैं एक क्लिक किए गए बिंदु से मिलान करने वाले बिंदुओं को हाइलाइट करने की कोशिश कर रहा हूं (निकट बिंदुओं() पर क्लिक करें और क्लिक करें)।

यह काम करता है। हालांकि, चमकदार ऐप के प्रतिक्रियाशील हिस्सों को दो बार ताज़ा किया जाता है और दूसरा पुनरावृत्ति क्लिक की गई जानकारी को साफ़ करने लगता है।

मैं ऐप के दूसरे रीफ्रेश से कैसे बच सकता हूं? (!): एक reactiveValue() को कब्जा क्लिक observeEvent() का उपयोग कर

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

अंत में एक समाधान के चमकदार में क्लिक पर डबल ताज़ा से बचने के लिए मिला:

यहाँ मेगावाट है। मेरी परियोजना पर और आपके 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) { 

    ## 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)