Shiny：如何更改点击点的形状和/或大小？

Question

我想更改下图中单击点的形状和大小。如何实现？对于这个玩具图，我将点数从原来的 100k 减少到 2k。因此，预期的解决方案应该是高度可扩展的，并且不偏离原始图，即点击点更新之前和之后的所有颜色应该相同。

library(shiny)
library(plotly)

df <- data.frame(X=runif(2000,0,2), Y=runif(2000,0,20), 
                 Type=c(rep(c('Type1','Type2'),600),
                        rep(c('Type3','Type4'),400)),
                 Val=sample(LETTERS,2000,replace=TRUE))

# table(df$Type, df$Val)

ui <- fluidPage(
  title = 'Select experiment',
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("SelType", "Select Types to plot:",
                  choices = unique(df$Type),
                  selected = NA)
    ),
    mainPanel(
      plotlyOutput("plot", width = "400px"),
      verbatimTextOutput("click")
    )
  )
)

---

server <- function(input, output, session) {

  output$plot <- renderPlotly({
    if(length(input$SelType) != 0){
      df <- subset(df, Type %in% input$SelType)
      p <- ggplot(df, aes(X, Y, col = as.factor(Val))) + 
        geom_point()
    }else{
      p <- ggplot(df, aes(X, Y, col = as.factor(Val))) +
        geom_point()
    }
    ggplotly(p)  %>% layout(height = 800, width = 800)

  })

  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" 
    else cat("Selected point associated with value: ", d$Val)
  })

}

shinyApp(ui, server)

这里已经提出了一个相关的问题，但是用颜色突出显示点的方法不起作用（当变量的级别数很高时，很难对可能已经存在于图中的颜色进行硬编码） 。

Answer 1

Plotly 的restyle函数在这里对我们没有帮助，但我们仍然可以将onclick 事件与一点 JavaScript 一起使用。该代码具有 10,000 分的可接受性能。

我们可以使用 JavaScript 获取被点击的点：

var point = document.getElementsByClassName('scatterlayer')[0].getElementsByClassName('scatter')[data.points[0].curveNumber].getElementsByClassName('point')[data.points[0].pointNumber];

（scatterlayer是所有散点图元素所在的层， scatter[n]是第n个散点图，point[p]是其中的第p个点）

现在我们只是让这一点变得更大（或者你想要的任何其他形状/变换）：

point.setAttribute('d', 'M10,0A10,10 0 1,1 0,-10A10,10 0 0,1 10,0Z');

为了能够恢复所有内容，我们将有关该点的未更改信息与其余 Plotly 信息一起存储：

var plotly_div = document.getElementsByClassName('plotly')[0];
plotly_div.backup = {curveNumber: data.points[0].curveNumber,
                     pointNumber: data.points[0].pointNumber,
                     d: point.attributes['d'].value
                    }

稍后我们可以还原这一点：

var old_point = document.getElementsByClassName('scatterlayer')[0].getElementsByClassName('scatter')[plotly_div.backup.curveNumber].getElementsByClassName('point')[plotly_div.backup.pointNumber]
old_point.setAttribute('d', plotly_div.backup.d);

现在我们可以将所有代码添加到plotly小部件中。

javascript <- "
function(el, x){
  el.on('plotly_click', function(data) {
    var point = document.getElementsByClassName('scatterlayer')[0].getElementsByClassName('scatter')[data.points[0].curveNumber].getElementsByClassName('point')[data.points[0].pointNumber];
    var plotly_div = document.getElementsByClassName('plotly')[0];
    if (plotly_div.backup !== undefined) {
      var old_point = document.getElementsByClassName('scatterlayer')[0].getElementsByClassName('scatter')[plotly_div.backup.curveNumber].getElementsByClassName('point')[plotly_div.backup.pointNumber]
      if (old_point !== undefined) {
        old_point.setAttribute('d', plotly_div.backup.d);
      }
    }
    plotly_div.backup = {curveNumber: data.points[0].curveNumber,
                         pointNumber: data.points[0].pointNumber,
                         d: point.attributes['d'].value,
                         style: point.attributes['style'].value
                        }

    point.setAttribute('d', 'M10,0A10,10 0 1,1 0,-10A10,10 0 0,1 10,0Z');
  });
}"

[...]

ggplotly(p) %>% onRender(javascript)

或者，您可以根据单击点的位置创建一个新的 SVG 元素，但使用您想要的颜色和形状。

您可以在此处尝试不使用 R/Shiny。

var point = document.getElementsByClassName('scatterlayer')[0].getElementsByClassName('scatter')[data.points[0].curveNumber].getElementsByClassName('point')[data.points[0].pointNumber];

point.setAttribute('d', 'M10,0A10,10 0 1,1 0,-10A10,10 0 0,1 10,0Z');