r - 用户可以在 R 中以交互方式在图像上绘制矩形吗(通过 Shiny 应用程序)

Question

我希望能够在图像上绘制一个矩形。我想使用 Shiny 来制作应用程序，但我首先需要弄清楚如何在图像上绘制矩形？有没有人有任何想法或指示？

我的想法是我需要对我的图像进行分层，我的图像总是 640x640 像素，所以我的想法是图像顶部的 640x640 矩阵，让我选择“像素”来创建矩形的边界？



编辑:我还有更进一步的，我现在可以使用下面的代码在 Shiny 的图像上绘制。

感谢这些链接:

https://shiny.rstudio.com/articles/plot-interaction.html

https://stackoverflow.com/a/32706324/5163910

现在我需要绘制多个矩形并在绘制更多矩形时将结果保留在绘图上。想法？

library(shiny)

ui <- basicPage(
    plotOutput("plot1",
               click = "plot_click",
               dblclick = "plot_dblclick",
               hover = "plot_hover",
               brush = "plot_brush"
    ),
    verbatimTextOutput("info")
)

server <- function(input, output) {
    library(jpeg)
    output$plot1 <- renderPlot({
        img <- readJPEG("street_1.jpg", native = TRUE)
        # plot(anImage)
        plot(1:640, type='n')
        rasterImage(img,1,1,640,640)
    }, height = 640, width = 640)

    output$info <- renderText({
        xy_str <- function(e) {
            if(is.null(e)) return("NULL\n")
            paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
        }
        xy_range_str <- function(e) {
            if(is.null(e)) return("NULL\n")
            paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1), 
                   " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
        }

        paste0(
            "click: ", xy_str(input$plot_click),
            "dblclick: ", xy_str(input$plot_dblclick),
            "hover: ", xy_str(input$plot_hover),
            "brush: ", xy_range_str(input$plot_brush)
        )
    })
}

shinyApp(ui, server)

Answer 1

得到它的工作。如果有人想做类似的事情，这是我用来让它工作的代码。

library(shiny)

ui <- basicPage(
    plotOutput("plot1",
               click = "plot_click",
               dblclick = "plot_dblclick",
               hover = "plot_hover",
               brush = "plot_brush"
    ),
    verbatimTextOutput("info")
)

server <- function(input, output) {
    library(jpeg)
    prev_vals <- NULL
    structures <- reactiveValues(data = data.frame(box_id = numeric(), xmin = numeric(), ymin = numeric(), xmax = numeric(), xmax = numeric()))

    output$plot1 <- renderPlot({
        img <- readJPEG("street_1.jpg", native = TRUE)
        plot(1:640, type='n')
        rasterImage(img,1,1,640,640)
        if (nrow(structures$data) > 0) {
            r <- structures$data
            rect(r$xmin, r$ymin, r$xmax, r$ymax, border = "red")
        }
    }, height = 640, width = 640)

    observe({
        e <- input$plot_brush
        if (!is.null(e)) {
            vals <- data.frame(xmin = round(e$xmin, 1), ymin = round(e$ymin, 1), xmax = round(e$xmax, 1), ymax = round(e$ymax, 1))
            if (identical(vals,prev_vals)) return() #We dont want to change anything if the values havent changed.
            structures$data <- rbind(structures$data,cbind(data.frame(box_id = nrow(structures$data)+1),vals))
            prev_vals <<- vals
        }
    })

    output$info <- renderText({

        xy_str <- function(e) {
            if(is.null(e)) return("NULL\n")
            paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
        }


        xy_range_str <- function(e) {
            if(is.null(e)) return("NULL\n")
            paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1), 
                   " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
        }

        paste0(
            "click: ", xy_str(input$plot_click),
            "dblclick: ", xy_str(input$plot_dblclick),
            "hover: ", xy_str(input$plot_hover),
            "brush: ", xy_range_str(input$plot_brush)
        )

    })
}

shinyApp(ui, server)