R Shiny - загрузка изображения в ggplot annotation_raster - PullRequest
0 голосов
/ 10 октября 2019

Я разрабатываю приложение 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))
  })
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...