Я разрабатываю приложение R Shiny, которое позволяет пользователю выбирать точки на изображении, а затем извлекать соответствующие данные из того места, где они выбрали точки.
Я создал минимальный воспроизводимый пример приложения (ниже). Пользователи загружают изображение (.png или .jpg) с помощью файла ввода, и оно загружается в два ggplots как annotation_raster. Кисть на левом графике меняет вид на правом графике. Щелчок по правому графику записывает нажатое местоположение в реактивном столбце - в этом случае он выводит координаты на консоль.
Проблема, с которой я сталкиваюсь, заключается в том, что изображения должны быть достаточно маленькими (<< 1 МБ), что влияет на разрешение изображения, которое можно ввести. Кроме того, чем больше изображение, тем медленнее графикиреагировать на изменение вида кисти или точки записи. Мне интересно, если кто-нибудь знает способ ускорить рендеринг изображения. Кроме того, я не знаю, правильно ли я сохраняю изображение как реактивную переменную. </p>
UI
ui <- fluidPage (
sidebarLayout(
sidebarPanel( width = 2,
fileInput(inputId = 'files',
label = 'Select an Image',
accept=c('image/png', 'image/jpeg')
)
), # end of sidebarPanel
mainPanel(
fluidRow(
column(width = 12, height = 500,
h4("Drag window to zoom on LEFT plot. Digitize points on the RIGHT plot."),
fluidRow(
column(width = 5,
plotOutput("plot2", height = 500,
brush = brushOpts(
id = "plot2_brush",
resetOnNew = TRUE
)
)
), # end of column
column(width = 5, height = 500,
plotOutput("plot3", height = 500, click="plotclick")
) # end of column
) # end of fluidRow
) #end column
)
) #end mainPanel
) #end sidebarLayout
) # end of UI
SERVER
#Required packages
library(shiny)
library(imager)
library(ggplot2)
library(dplyr)
library(DT)
server <- function(input, output) {
#Reactive variables related to the image
LoadedImage <- reactive({load.image(gsub("\\\\", "/", input$files$datapath))})
ImageWidth <- reactive(width(LoadedImage()))
ImageHeight <- reactive(height(LoadedImage()))
null <- reactiveValues(df=tibble("nullx"=c(0,0),"nully"=c(0,0)))
# Linked plots (middle and right)
ranges2 <- reactiveValues(x = NULL, y = NULL)
output$plot2 <- renderPlot({
if(is.null(input$files)){} # if there's no file input don't plot anything
else{ # if there is a file input then plot the interactive ggplot
ggplot(null$df,aes(x=nullx,y=nully)) +
annotation_raster(LoadedImage(),ymin=2,ymax = height(LoadedImage()), xmin=0, xmax=width(LoadedImage())) +
geom_point() +
coord_fixed()+
xlim(0, width(LoadedImage()))+
ylim(0, height(LoadedImage()))
}
})
output$plot3 <- renderPlot({
if(is.null(input$files)){} # if there's no file input don't plot anything
else{ # if there is a file input then plot the interactive ggplot
ggplot(data=null$df, aes(x=nullx,y=nully,color="NA"))+geom_point() +
annotation_raster(LoadedImage(),ymin=0,ymax=height(LoadedImage()), xmin=0, xmax=width(LoadedImage())) +
coord_cartesian(xlim=ranges2$x,ylim=ranges2$y)
}
})
# If the there is a brush on plot2 then change the range used on plot3
observe({
brush <- input$plot2_brush
if (!is.null(brush)) {
ranges2$x <- c(brush$xmin, brush$xmax)
ranges2$y <- c(brush$ymax, brush$ymin)
} else {
ranges2$x <- null$df$nullx
ranges2$y <- null$df$nully
}
})
#observe clicks on the right plot to get xy coordinates
observeEvent(input$plotclick,{
print(c(x=input$plotclick$x, y=input$plotclick$y))
})
}