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

时间:2017-09-27 14:30:10

标签: r shiny

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

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

red rectangle over image

编辑:我还有更多,我现在可以使用下面的代码在闪亮的图像上绘制。

感谢这些链接:

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

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)

1 个答案:

答案 0 :(得分:5)

搞定了。如果有人想做类似的事情,这就是我用它来实现它的代码。

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)