在图像 R Shiny 上绘制矩形的浏览器友好方式

Question

我编写了一个闪亮的应用程序，允许用户在图像顶部绘制矩形（下面的最小可重现示例）。

我当前方法的问题是每次添加一个矩形时，都会创建一个新图像，将其写入磁盘并渲染（发送到用户的浏览器）。这需要相当长的时间，并且在互联网连接缓慢时变得非常烦人。

有什么方法可以在图像顶部显示矩形直接在浏览器中，而不需要在服务器端修改图像？我唯一需要确保的是浏览器将绘图上的矩形坐标发送回服务器。

我正在寻找的一个很好的例子（在 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)

Answer 1

这是一个完全基于 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)