Can users interactively draw rectangles on an image in R (via Shiny app)

Question

I want to be able to draw a rectangle on an image. I was thinking of using Shiny to make the app, but I first need to work out how to draw a rectangle on an image? Does anyone have any ideas or pointers?

My thinking was that I need to layer my image, my image is always 640x640 pixels, so my thinking was a matrix of 640x640 over the top of the image that lets me select the "pixels" to create the boundary of the rectangle?

Edit: I've got further, I can now draw on an image in shiny using the below code.

Thanks to these links:

• https://shiny.rstudio.com/articles/plot-interaction.html
• https://stackoverflow.com/a/32706324/5163910

Now I need to draw multiple rectangles and keep the results on the plot while I draw more. Thoughts?

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

Got it working. If anyone wants to do something similar, this is the code that I used to get it working.

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)