R闪亮的交互式/反应式多边形选择和操作

Question

我正在研究一个闪亮的应用程序，在其中我想让用户根据所选颜色对多边形三角形进行分类，并将其与颜色一起保存为分组变量到一个新的数据框架，带有"添加选择"然后选择另一种颜色和"添加选择"直到所有三角形都被分类。

下面是代码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)

我的问题是，点击和刷选择不正常工作，由于点重叠?我想通过点击区域内的选择一个三角形(颜色的三个边界的三角形，如果选择)。选择一个三角形的最佳方法是什么?

我试了shiny和ggplot。点击不能正确选择三角形，笔刷选择但遗漏边缘。

Answer 1

您必须检查每个三角形是否包含被单击的点。我在pcds::in.triangle的帮助下在下面做。我还必须为未选中的三角形设置一个透明的颜色，否则白色会覆盖选中的颜色。

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)