Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 205343

Overlay points on magick image

$
0
0

I have a shiny app where you can upload an image. When you click on the image it adds the x and y coordinates to a reactive dataframe.

What I'd like to do is use this dataframe to lay points onto the image so you can see where you have clicked. I did accomplish this by converting the magick object to a ggplot and using geom_point, but I'd rather keep it as a magick object so I can use the processing features like negate and charcoal.

Any way I can do this, maybe with points or symbols?

This is the app currently

library(shiny)
library(magick)

# Define UI
ui <- fluidPage(

  # Application title
  titlePanel(""),

  sidebarLayout(
    sidebarPanel(
      fileInput("current_image", "Choose image file"),
      actionButton("delete_point", "Delete Last Point"),
      checkboxGroupInput("effects", "Effects",
                         choices = list("negate", "charcoal"))
    ),

    mainPanel(
      imageOutput("current_image_plot", click = "image_click"),
      tableOutput("value_table")
    )
  )
)

# Define server logic
server <- function(input, output) {

  image <- image_read("https://images-na.ssl-images-amazon.com/images/I/81fXghaAb3L.jpg")
  observeEvent(input$upload, {
    if (length(input$upload$datapath))
      image <<- image_read(input$upload$datapath)
  })

  output$current_image_plot <- renderImage({

    if("negate" %in% input$effects)
      image <- image_negate(image)

    if("charcoal" %in% input$effects)
      image <- image_charcoal(image)

    tmpfile <- image %>%
      image_write(tempfile(fileext='jpg'), format = 'jpg')

    list(src = tmpfile, contentType = "image/jpeg")
  })

  # Create reactive dataframe to store clicks in
  values <- reactiveValues()
  values$dat <- data.frame(x_values = numeric(),
                           y_values = numeric())

  # Observe the plot clicks
  observeEvent(input$image_click, {
    add_row <- data.frame(x_values = input$image_click$x,
                          y_values = input$image_click$y)

    values$dat <- rbind(values$dat, add_row)
  })

  # Observe remove button
  observeEvent(input$delete_point, {
    remove_row <- values$dat[-nrow(values$dat), ]
    values$dat <- remove_row
  })

  # Create a table
  output$value_table <- renderTable({
    values$dat
  })

}

# Run the application
shinyApp(ui = ui, server = server)

Viewing all articles
Browse latest Browse all 205343

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>