我正在制作一个shiny的应用，用户可以点击选择图片上的点。我使用ggplot2显示选中的点，作为图像上的红点。
我的工作方式非常接近我想要的方式，除了每次用户点击一个新点时，整个图像都会重新加载*。理想情况下，我会在每次点击时重新绘制数据，但不会重新加载整个图像。
我的问题是，是否有可能让绘图点反复加载，但保留背景图像（因为它不会在点击之间发生变化）？
我的实际应用程序涉及的比这更多，但这是我最好的尝试，我想解决的问题的最小可重现性示例（请注意，您需要调整image.file到指向您机器上的jpg文件以运行此文件;我不知道如何使图像本身可重现，抱歉）：
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)
由于每次点击鼠标都会重新加载图像，因此我预计会出现UI，CPU负载和数据传输负载的反应性问题。有什么方法可以减轻这种情况吗？
*从代码本身可能很明显，但我已经通过观看CPU负载来证明这一点，同时在加载大图像的情况下反复点击。
注意我能找到的最接近我的问题的是这个问题。不幸的是，它没有解决重新加载图像的问题，只是加速了数据点的渲染，这不是我的问题。 Update large plots in Shiny without Re-Rendering
答案 0 :(得分：2)
我首先尝试建议一个较短版本的代码，以确保哪个部分是重型代码。
我从服务器中取出了基础＆lt; - ggplot（），因为它依赖于静态值，并且可以执行一次。
我创建了xy_coord（）捕获点击x-y坐标。
我使用shinySignals :: reducePast将值添加到数据帧xy_click（）。 注意： shinySignals仍处于开发阶段，因此如果您愿意，可以自行编写该功能。
现在，我假设你的问题是在renderPlot中有base，对吗？
output$plot <- renderPlot({
base +
geom_point(...)
})
在更新的解决方案：
中在用户界面中，我在div＆＃34; container＆＃34;，底部为jpeg图像创建了两个div，而第二个为div。 < / p>
我在底部output$plot
我使用点击选项click="image$click"第二个地块output$plot1，每次都会渲染，因为它位于顶部。
我使用了bg="transparent"选项让图片在后台显示。
<强> EXTRA
您甚至可以通过将图片移动到应用文件夹中的output$plot <- renderPlot(...)文件夹并使用www
div中来避免使用tags$img
| shinyApp/
| app.R
| www/
| survey.jpg
注意：这应该适用于图像和plot2完美对齐的情况，我没有进行过密集测试，但我尝试了几个例子。
更新了解决方案
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)
我原始代码的版本
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)