我希望能够在图像上绘制一个矩形。我正在考虑使用Shiny制作应用程序,但我首先需要弄清楚如何在图像上绘制矩形?有没有人有任何想法或指示?
我的想法是我需要对图像进行分层,我的图像总是640x640像素,所以我的想法是在图像顶部的640x640矩阵,让我选择“像素”来创建矩形的边界?
编辑:我还有更多,我现在可以使用下面的代码在闪亮的图像上绘制。
感谢这些链接:
现在我需要绘制多个矩形并在绘制更多时将结果保存在绘图上。想法?
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)
答案 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)