CODEWITHSUNDEEP
rshinyspatialreactiveggplotly
Hixon
Hixon

Reputation: 89

R Shiny interactive/reactive polygon selection and manipulation

I am working on a shiny app, in which I would like to enable the user to classify polygon triangles based on selected colors and save it along with the color as grouping variable to a new data frame with "Add selection", then choose another color and "Add selection" until all triangles are classified.

Here is the code with the data.frame:

library(shiny)
library(tidyverse)
library(DT)
library(colourpicker)

ui = fluidPage(
  colourInput("col", "Select colour", "purple"),
  actionButton("addToDT", "Add selection", icon = icon("plus")),
  actionButton("plotSelectedButton", "Plot selection", icon = icon("chart-simple"), class = "btn btn-success"), hr(),
  plotOutput("plot", brush = "plot_brush", click = "plot_click", dblclick = "plot_reset"),
  DT::dataTableOutput('plot_DT'), hr(),
  textOutput("clickcoord")
)

server = function(input, output, session) {
  
  df = data.frame(x_axis = c(27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 27.0, 27.0, 26.5, 26.5, 26.5, 26.0, 27.5, 27.5, 27.0, 27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 26.5, 27.0, 27.0, 26.0, 26.5, 26.5, 27.0, 27.5, 27.5, 27.5, 27.5, 27.0, 27.0, 27.0, 26.5, 28.0, 28.0, 27.5, 26.5, 27.0, 26.5, 26.0, 26.5, 26.0, 27.0, 27.5, 27.0),
                  y_axis = c(-2.309401, -1.732051, -2.020726, -3.175426, -2.598076, -2.886751, -3.175426, -2.598076, -2.886751, -1.732051, -2.309401, -2.020726, -2.598076, -3.175426, -2.886751, -2.598076, -3.175426, -2.886751, -1.732051, -1.154701, -1.443376, -2.598076, -2.020726, -2.309401, -2.598076, -2.020726, -2.309401, -1.443376, -1.154701, -1.732051, -2.309401, -2.020726, -2.598076, -2.309401, -2.020726, -2.598076, -1.443376, -2.020726, -1.732051, -2.309401, -2.886751, -2.598076, -2.309401, -2.886751, -2.598076, -1.443376, -1.732051, -2.020726, -2.309401, -2.598076, -2.886751, -2.309401, -2.598076, -2.886751),
                  poly_fill = c(1.483173, 1.483173, 1.483173, 1.471993, 1.471993, 1.471993, 1.172595, 1.172595, 1.172595, 1.323123, 1.323123, 1.323123, 2.072898, 2.072898, 2.072898, 1.524850, 1.524850, 1.524850, 2.299198, 2.299198, 2.299198, 1.712300, 1.712300, 1.712300, 1.249020, 1.249020, 1.249020, 1.175852, 1.175852, 1.175852, 1.161548, 1.161548, 1.161548, 2.253344, 2.253344, 2.253344, 1.669739, 1.669739, 1.669739, 1.260699, 1.260699, 1.260699, 1.463628, 1.463628, 1.463628, 1.212740, 1.212740, 1.212740, 1.791753, 1.791753, 1.791753, 1.483173, 1.483173, 1.483173),
                  poly_id = paste0(paste0("poly_", rep(1:3, each = 3)), ".", rep(c(1,2,3,4,5,6), each = 9)))
  
  selectedPoly = reactiveVal(rep(FALSE, nrow(df)))
  
  output$plot = renderPlot({
    df$sel = selectedPoly()
    
    ggplot(df, 
           aes(x = x_axis, 
               y= y_axis, 
               group = poly_id, 
               fill = poly_fill,
               colour = sel)) + 
      geom_polygon() +
      scale_color_manual(values = c("white", input$col)) + 
      theme_bw()
  })
  
  output$clickcoord <- renderPrint({
    print(input$plot_click)
  })
  
  observeEvent(input$plot_brush, {
    brushed = brushedPoints(df, input$plot_brush, allRows = TRUE)$selected_
    selectedPoly(brushed | selectedPoly())
  })
  
  observeEvent(input$plot_click, {
    clicked = nearPoints(df, input$plot_click, allRows = TRUE)$selected_
    selectedPoly(clicked | selectedPoly())
  })
  
  observeEvent(input$plot_reset, {
    selectedPoly(rep(FALSE, nrow(df)))
  })
  
  output$plot_DT = DT::renderDataTable({
    df$sel = selectedPoly()
    df = filter(df, sel == T)
  })
}

shinyApp(ui, server)

My problem is that click and brush select not working properly due to points are overlapping? I would like to select a triangle by clicking within the area (color the three border of a triangle if selected). What would be the best way to select a triangle by single clicking into the area of the triangle?

I tried shiny and ggplot. Clicking does not select properly the triangles, brush selects but misses edges.

Upvotes: 1

Views: 123

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84649

You have to check for each triangle whether it contains the clicked point. I do it below with the help of pcds::in.triangle. I also had to set a transparent color for the non-selected triangles, otherwise the white color could overwrite the selected color.

library(shiny)
library(ggplot2)
library(DT)
library(colourpicker)

ui = fluidPage(
  colourInput("col", "Select colour", "purple"),
  actionButton("addToDT", "Add selection", icon = icon("plus")),
  actionButton("plotSelectedButton", "Plot selection", icon = icon("chart-simple"), class = "btn btn-success"), hr(),
  plotOutput("plot", click = "plot_click", dblclick = "plot_reset"),
  DT::dataTableOutput('plot_DT'), hr(),
  textOutput("clickcoord")
)

x <- c(27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 27.0, 27.0, 26.5, 26.5, 26.5, 26.0, 27.5, 27.5, 27.0, 27.0, 27.0, 27.5, 26.5, 26.5, 27.0, 27.5, 27.5, 28.0, 26.5, 27.0, 27.0, 26.0, 26.5, 26.5, 27.0, 27.5, 27.5, 27.5, 27.5, 27.0, 27.0, 27.0, 26.5, 28.0, 28.0, 27.5, 26.5, 27.0, 26.5, 26.0, 26.5, 26.0, 27.0, 27.5, 27.0)
y <- c(-2.309401, -1.732051, -2.020726, -3.175426, -2.598076, -2.886751, -3.175426, -2.598076, -2.886751, -1.732051, -2.309401, -2.020726, -2.598076, -3.175426, -2.886751, -2.598076, -3.175426, -2.886751, -1.732051, -1.154701, -1.443376, -2.598076, -2.020726, -2.309401, -2.598076, -2.020726, -2.309401, -1.443376, -1.154701, -1.732051, -2.309401, -2.020726, -2.598076, -2.309401, -2.020726, -2.598076, -1.443376, -2.020726, -1.732051, -2.309401, -2.886751, -2.598076, -2.309401, -2.886751, -2.598076, -1.443376, -1.732051, -2.020726, -2.309401, -2.598076, -2.886751, -2.309401, -2.598076, -2.886751)
indices <- seq(1, 54, by = 3)
Triangles <- lapply(indices, function(i) {
  A <- c(x[i], y[i])
  B <- c(x[i+1], y[i+1])
  C <- c(x[i+2], y[i+2])
  rbind(A, B, C)
})
selectedTriangle <- function(pt) {
  inTriangle <- 3 * (which(sapply(Triangles, function(tr) {
    pcds::in.triangle(pt, tr)$in.tri
  })) - 1) + 1
  selected <- rep(FALSE, 54)
  selected[c(inTriangle, inTriangle+1, inTriangle+2)] <- TRUE
  selected
}

server = function(input, output, session) {
  
  df = data.frame(x_axis = x,
                  y_axis = y,
                  poly_fill = c(1.483173, 1.483173, 1.483173, 1.471993, 1.471993, 1.471993, 1.172595, 1.172595, 1.172595, 1.323123, 1.323123, 1.323123, 2.072898, 2.072898, 2.072898, 1.524850, 1.524850, 1.524850, 2.299198, 2.299198, 2.299198, 1.712300, 1.712300, 1.712300, 1.249020, 1.249020, 1.249020, 1.175852, 1.175852, 1.175852, 1.161548, 1.161548, 1.161548, 2.253344, 2.253344, 2.253344, 1.669739, 1.669739, 1.669739, 1.260699, 1.260699, 1.260699, 1.463628, 1.463628, 1.463628, 1.212740, 1.212740, 1.212740, 1.791753, 1.791753, 1.791753, 1.483173, 1.483173, 1.483173),
                  poly_id = paste0(paste0("poly_", rep(1:3, each = 3)), ".", rep(c(1,2,3,4,5,6), each = 9)))
  
  selectedPoly = reactiveVal(rep(FALSE, nrow(df)))
  
  output$plot = renderPlot({
    df$sel = selectedPoly()

    ggplot(df, 
           aes(x = x_axis, 
               y= y_axis, 
               group = poly_id, 
               fill = poly_fill,
               colour = sel)) + 
      geom_polygon() +
      scale_color_manual(values = c("#ffffff00", input$col)) + 
      theme_bw()
  })
  
  output$clickcoord <- renderPrint({
    print(input$plot_click)
  })
  
  observeEvent(input$plot_click, {
    clicked <- input$plot_click
    pt <- c(clicked$x, clicked$y)
    selected <- selectedTriangle(pt)
    selectedPoly(selected | selectedPoly())
  })
  
  observeEvent(input$plot_reset, {
    selectedPoly(rep(FALSE, nrow(df)))
  })
  
  output$plot_DT = DT::renderDataTable({
    df$sel = selectedPoly()
    df = dplyr::filter(df, sel == TRUE)
  })
}

shinyApp(ui, server)

Upvotes: 1

Related Questions