ggplot2 in glänzend, dann ändert Bild/Plot neu zu laden, ohne sie komplett neu zu erstellen

Question

ich eine App mit shiny machte, die Benutzer erlaubt, klicken Punkte auf einem Bild auszuwählen. Ich verwende ggplot2, um die ausgewählten Punkte als rote Punkte auf dem Bild anzuzeigen.

Ich habe dies funktioniert ziemlich nah an der Art, die ich will, nur dass jedes Mal, wenn der Benutzer einen neuen Punkt klickt, das gesamte Bild neu geladen wird *. Idealerweise würde ich die Daten bei jedem Klick neu plotten, aber nicht das gesamte Bild neu laden.

Meine Frage ist, ist es möglich, die Plotpunkte reaktiv neu geladen zu haben, aber allein das Hintergrundbild verlassen (da es nicht zwischen Klicks ändern wird)?

Meine eigentliche App ist komplizierter als diese, aber hier ist mein bestes Beispiel für ein minimales reproduzierbares Beispiel des Problems, das ich ansprechen möchte (beachten Sie, dass Sie image.file einstellen müssen, um auf eine jpg - Datei zu zeigen Maschine, um diese zu laufen, ich weiß nicht, wie das Bild machen selbst reproduzierbar, sorry):

library(ggplot2) 
library(jpeg) 
library(grid) 
library(shiny) 

#### pre-run setup #### 

# set up a function for loading an image file as a grob 
grob_image <- function(file) { 
    grid::rasterGrob(jpeg::readJPEG(file), interpolate = TRUE) 
} 

# initiate a ggplot theme for use in plotting 
# (just getting rid of everything so we only see the image itself) 
theme_empty <- theme_bw() 
theme_empty$line <- element_blank() 
theme_empty$rect <- element_blank() 
theme_empty$strip.text <- element_blank() 
theme_empty$axis.text <- element_blank() 
theme_empty$plot.title <- element_blank() 
theme_empty$axis.title <- element_blank() 

# set the image input file 
image.file <- "session2_ebbTriggerCountMap.jpg" 

#### UI #### 
ui <- fluidPage(

    # display the image, with any click-points 
    fluidRow(
     plotOutput("plot", 
        click = "image_click" 
     ) 
    ) 

) 


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

    # initialise a data.frame for collecting click points 
    data.thisimage <- data.frame(x = rep(NA_real_, 100L), y = rep(NA_real_, 100L)) 

    # initalise the plot (this is the image on which to put any points we get) 
    # the `geom_blank` here is to set up the x and y axes as per the width and height of the image 
    img <- grob_image(image.file) 
    base <- ggplot() + 
     geom_blank(data = data.frame(x = c(0, dim(img$raster)[2]), y = c(0, dim(img$raster)[1])), 
        mapping = aes(x = x, y = y) 
     ) + 
     theme_empty + 
     annotation_custom(grob = img) 

    # plot the image 
    output$plot <- renderPlot({ 
     base 
    }) 

    #### click action #### 
    # watch for a mouse click (point selected on the plot) 
    observeEvent(input$image_click, { 

     # add a row of data to the data frame 
     data.thisimage[ which(is.na(data.thisimage$x))[1L], ] <<- c(
      input$image_click$x, input$image_click$y 
     ) 

     # re-render the plot with the new data 
     output$plot <<- renderPlot({ 
      base + 
       geom_point(data = data.thisimage[ !is.na(data.thisimage$x), ], 
          mapping = aes(x = as.numeric(x), y = as.numeric(y)), 
          colour = "red") 
     }) 

    }) 
} 
shinyApp(ui, server) 

Da das Bild mit jedem Mausklick neu geladen wird, ich habe Probleme mit Reaktivität der UI Antizipation , CPU-Last und Datenübertragungslast. Gibt es eine Möglichkeit, das zu lindern?

* es ist wohl offensichtlich aus dem Code selbst, aber ich habe es mir selbst bewiesen, indem die CPU-Auslastung zu beobachten beim Klicken immer und immer wieder mit einem großen ish Bild geladen.

HINWEIS das nächste, was ich zu meinem Problem finden konnte, war diese SO Frage. Leider löst es nicht das Problem des Neuladens des Bildes, sondern beschleunigt nur das Rendern von Datenpunkten, was hier nicht mein Problem ist. Update large plots in Shiny without Re-Rendering

Answer 1

Ich werde versuchen, zunächst eine kürzere Version des Codes vorzuschlagen, um sicherzustellen, welcher Teil der schweren ist.

• Ich nahm Basis < - ggplot() aus dem Server, wie es auf statischen Werten abhängt, und einmal ausgeführt werden kann.

• Ich erstellte xy_coord() erfassen Sie die Klick-X-Y-Koordinaten.

• I shinySignals verwendet :: reducePast die Werte in einem Datenrahmen xy_click() hinzuzufügen. Hinweis: shinySignals ist noch in der Entwicklung, so dass Sie die Funktion selbst schreiben können, wenn Sie möchten.

• Jetzt nehme ich an, Ihr Problem ist mit base in renderPlot, richtig?

  output$plot <- renderPlot({ base + geom_point(...) })

Im Aktualisiert Lösung:

• In der Benutzeroberfläche, habe ich zwei divs auf der jeweils anderen innerhalb div "Container", den Boden für die JPEG Bild und 2. für die Punkte.

• aufgetragen ich das JPEG-Bild einmal am Boden output$plot

• ich die Klick-Option verwendet click="image$click" das zweite Grundstück output$plot1, die jedes Mal wiedergegeben werden, weil es auf der Spitze.

• Ich verwendete bg="transparent" Option, um das Bild im Hintergrund sichtbar zu haben.

EXTRA

könnten Sie auch durch Bewegen des Bildes zu www Ordner im App-Ordner und die Einbettung des Bildes in der ersten div mit tags$img

| shinyApp/ 
    | app.R 
| www/ 
    | survey.jpg 

HINWEIS mit output$plot <- renderPlot(...) vermeiden : Dies sollte bei perfekter Ausrichtung von Bild und Plot2 funktionieren, habe ich nicht intensiv getestet, aber ich habe ein paar Beispiele ausprobiert .

---

Aktualisiert Lösung

library(ggplot2) 
library(jpeg) 
library(grid) 
library(shiny) 

#### pre-run setup #### 

# initiate a ggplot theme for use in plotting 
# (just getting rid of everything so we only see the image itself) 
theme_empty <- theme_bw() 
theme_empty$line <- element_blank() 
theme_empty$rect <- element_blank() 
theme_empty$strip.text <- element_blank() 
theme_empty$axis.text <- element_blank() 
theme_empty$plot.title <- element_blank() 
theme_empty$axis.title <- element_blank() 

# set the image input file 
image.file <- "www/survey.jpg" 

img <- jpeg::readJPEG(image.file) 

## set up a function for loading an image file as a grob --------------------- 
# grob_image <- function(file) { 
# grid::rasterGrob(jpeg::readJPEG(file), interpolate = TRUE) 
# } 

## load the image as a a grob --------------------- 
# img <- grob_image(image.file) 

#### UI #### 
ui <- fluidPage(

    # Overlapping images in 2 divs inside a "container" 
    fluidRow(
    div(id="container", 
     height = dim(img)[1], 
     width = dim(img)[2], 
     style="position:relative;", 
     div(tags$img(src='survey.jpg', 
        style=paste0("width:",dim(img)[2],";height:",dim(img)[2],";")), 
      # plotOutput("plot", 
      #    height = dim(img)[1], 
      #    width = dim(img)[2], 
      #    click = "image_cl1"), 
      style="position:absolute; top:0; left:0;"), 
     div(plotOutput("plot1", 
         height = dim(img)[1], 
         width = dim(img)[2], 
         click = "image_click"), 
      style="position:absolute; top:0; left:0;") 
    ) 
) 
) 

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

    ## get clicked point coordinates ----------------------- 
    xy_coord <- reactive(c(input$image_click$x,input$image_click$y)) 

    ## add the new points to the dataframe ----------------- 
    xy_clicks <- shinySignals::reducePast(xy_coord, 
             function(x,y){ 
              df <- x 
              nn <- nrow(df) 

              # add values in case of click 
              if(length(y)>0){ 
              df[nn+1,1 ] <- y[1] 
              df[nn+1,2 ] <- y[2] 
              } 
              return(df) 
             }, 
             init=data.frame(x_coord=numeric(0), 
                 y_coord=numeric(0))) 

    ## render plot of the jpeg image -------------------------------------- 
    # output$plot <- renderPlot({ 
    # ggplot()+ 
    #  geom_blank(data = data.frame(x = c(0, dim(img$raster)[2]) 
    #         , y = c(0, dim(img$raster)[1])), 
    #    mapping = aes(x = x, y = y))+ 
    #  theme_empty + 
    #  annotation_custom(grob = img) 
    # }) 

    # alternative for plot of the jpeg image 
    # output$plot <- renderPlot({ 
    # # plot_jpeg("survey.jpg") 
    # }) 


    ## re-render the plot with the new data ------------------------- 
    output$plot1 <- renderPlot({ 
    ggplot() + 
     geom_blank(data = data.frame(x = c(0,dim(img)[2]) 
            ,y = c(0,dim(img)[1])), 
       mapping = aes(x = x, 
           y = y))+ 
     theme_empty+ 
     geom_point(data = xy_clicks(), 
       mapping = aes(x = x_coord, 
           y = y_coord), 
       colour = "red")+ 
     coord_cartesian(xlim = c(0,dim(img)[2]), 
         ylim= c(0,dim(img)[1])) 

    }, 
    bg="transparent") 

} 


## uncomment and add verbatimTextOutput("txt") in UI to see the xy_clicks() dataframe 
# output$txt <- renderPrint(xy_clicks()) 

# Run the application 
shinyApp(ui = ui, server = server) 

---

Meine Version des ursprünglichen Codes

library(ggplot2) 
library(jpeg) 
library(grid) 
library(shiny) 

#### pre-run setup #### 

# set up a function for loading an image file as a grob 
grob_image <- function(file) { 
    grid::rasterGrob(jpeg::readJPEG(file), interpolate = TRUE) 
} 

# initiate a ggplot theme for use in plotting 
# (just getting rid of everything so we only see the image itself) 
theme_empty <- theme_bw() 
theme_empty$line <- element_blank() 
theme_empty$rect <- element_blank() 
theme_empty$strip.text <- element_blank() 
theme_empty$axis.text <- element_blank() 
theme_empty$plot.title <- element_blank() 
theme_empty$axis.title <- element_blank() 

# set the image input file 
image.file <- "survey.jpg" 


## initalise the plot (this is the image on which to put any points we get) 
# the `geom_blank` here is to set up the x and y axes as per the width and height of the image 
img <- grob_image(image.file) 

## create base plot ----------------------- 
base <- ggplot() + 
    geom_blank(data = data.frame(x = c(0, dim(img$raster)[2]) 
           , y = c(0, dim(img$raster)[1])), 
       mapping = aes(x = x, y = y) 
) + 
    theme_empty +annotation_custom(grob = img) 


#### UI #### 
ui <- fluidPage(

    # display the image, with any click-points 
    fluidRow(
    plotOutput("plot", 
       height = dim(img$raster)[1], 
       width = dim(img$raster)[2], 
       click = "image_click" 
    ) 
) 
) 

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


    ## get clicked point coordinates ----------------------- 
    xy_coord <- reactive(c(input$image_click$x,input$image_click$y)) 

    ## add the new points to the dataframe ----------------- 
    xy_clicks <- shinySignals::reducePast(xy_coord, 
             function(x,y){ 
              df <- x 
              nn <- nrow(df) 

              # add values in case of click 
              if(length(y)>0){ 
              df[nn+1,1 ] <- y[1] 
              df[nn+1,2 ] <- y[2] 
              } 

              return(df) 
             }, 
             init=data.frame(x_coord=numeric(0), 
                 y_coord=numeric(0))) 


    ## re-render the plot with the new data ------------------------- 
    output$plot <- renderPlot({ 
    base + 
     geom_point(data = xy_clicks(), 
       mapping = aes(x = x_coord, y = y_coord), 
       colour = "red") 
    }) 

    ## uncomment and add verbatimTextOutput("txt") in UI to see the xy_clicks() dataframe 
    # output$txt <- renderPrint(xy_clicks()) 
} 

# Run the application 
shinyApp(ui = ui, server = server)