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.
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)