我编写了一个 Shiny 的应用程序,允许用户在图像顶部绘制矩形(下面的最小可重现示例)。
我目前的方法的问题是 每次添加一个矩形时,都会创建一个新图像,将其写入磁盘并渲染(发送到用户的浏览器)。 这需要相当长的时间,并且当 Internet 连接速度很慢时会变得非常烦人。
有什么方法可以在图像顶部显示矩形直接在浏览器中 ,不修改服务器端的图像?我唯一需要确保的是浏览器将绘图上的矩形坐标发送回服务器。
我正在寻找的一个很好的例子(在 JavaScript 中):https://kyamagu.github.io/bbox-annotator/demo.html
我知道 JavaScript 可以通过小部件嵌入到 Shiny 应用程序中,如果没有人提出更简单的解决方案,我会这样做。
library(shiny)
library(png)
library(RCurl)
myurl = 'https://raw.githubusercontent.com/Tixierae/deep_learning_NLP/master/CNN_IMDB/cnn_illustration.png'
my_img = readPNG(getURLContent(myurl))
img_height = dim(my_img)[1]
img_width = dim(my_img)[2]
server = function(input, output) {
observe({
outfile = tempfile(tmpdir='./', fileext='.png')
png(filename=outfile,width=img_width,height=img_height)
par(mar=c(0,0,0,0),xaxs='i', yaxs='i')
plot(NA,xlim=c(0,img_width),ylim=c(0,img_height))
rasterImage(my_img,0,0,img_width,img_height)
if (!is.null(input$image_brush)){
b_in = lapply(input$image_brush,as.numeric)
if (!is.null(b_in$xmin)){
rect(b_in$xmin,img_height-b_in$ymax,b_in$xmax,img_height-b_in$ymin,border='green',lwd=5)
}
}
dev.off()
output$my_image = renderImage({
list(
src = outfile,
contentType = 'image/png',
width = img_width,
height = img_height,
alt = ''
)
},deleteFile=TRUE)
output$image = renderUI({
imageOutput('my_image',
height = img_height,
width = img_width,
click = 'image_click',
dblclick = dblclickOpts(
id = 'image_dblclick'
),
hover = hoverOpts(
id = 'image_hover'
),
brush = brushOpts(
id = 'image_brush',resetOnNew=TRUE,delayType='debounce',delay=100000
)
)
})
})
}
ui = bootstrapPage(
uiOutput('image')
)
shinyApp(ui=ui, server=server)
最佳答案
这是一个完全基于 this answer 的 JS 选项.
# JS and CSS modified from: https://stackoverflow.com/a/17409472/8099834
css <- "
#canvas {
width:2000px;
height:2000px;
border: 10px solid transparent;
}
.rectangle {
border: 5px solid #FFFF00;
position: absolute;
}
"
js <-
"function initDraw(canvas) {
var mouse = {
x: 0,
y: 0,
startX: 0,
startY: 0
};
function setMousePosition(e) {
var ev = e || window.event; //Moz || IE
if (ev.pageX) { //Moz
mouse.x = ev.pageX + window.pageXOffset;
mouse.y = ev.pageY + window.pageYOffset;
} else if (ev.clientX) { //IE
mouse.x = ev.clientX + document.body.scrollLeft;
mouse.y = ev.clientY + document.body.scrollTop;
}
};
var element = null;
canvas.onmousemove = function (e) {
setMousePosition(e);
if (element !== null) {
element.style.width = Math.abs(mouse.x - mouse.startX) + 'px';
element.style.height = Math.abs(mouse.y - mouse.startY) + 'px';
element.style.left = (mouse.x - mouse.startX < 0) ? mouse.x + 'px' : mouse.startX + 'px';
element.style.top = (mouse.y - mouse.startY < 0) ? mouse.y + 'px' : mouse.startY + 'px';
}
}
canvas.onclick = function (e) {
if (element !== null) {
var coord = {
left: element.style.left,
top: element.style.top,
width: element.style.width,
height: element.style.height
};
Shiny.onInputChange('rectCoord', coord);
element = null;
canvas.style.cursor = \"default\";
} else {
mouse.startX = mouse.x;
mouse.startY = mouse.y;
element = document.createElement('div');
element.className = 'rectangle'
element.style.left = mouse.x + 'px';
element.style.top = mouse.y + 'px';
canvas.appendChild(element);
canvas.style.cursor = \"crosshair\";
}
}
};
$(document).on('shiny:sessioninitialized', function(event) {
initDraw(document.getElementById('canvas'));
});
"
library(shiny)
ui <- fluidPage(
tags$head(
tags$style(css),
tags$script(HTML(js))
),
fluidRow(
column(width = 6,
# inline is necessary
# ...otherwise we can draw rectangles over entire fluidRow
uiOutput("canvas", inline = TRUE)),
column(
width = 6,
verbatimTextOutput("rectCoordOutput")
)
)
)
server <- function(input, output, session) {
output$canvas <- renderUI({
tags$img(src = "https://www.r-project.org/logo/Rlogo.png")
})
output$rectCoordOutput <- renderPrint({
input$rectCoord
})
}
shinyApp(ui, server)
关于javascript - 在图像 R Shiny 上绘制矩形的浏览器友好方式,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/59718113/