在 R Shiny 中更改一个 plotly scatter3d 中的一个点

Question

我有一个应用程序，我试图在其中更改点的大小、颜色或符号。 点是用户单击的对象。 单击一个点会在我的程序中创建一个弹出窗口，其中显示另一个数据集链接到属于单击点的行号的列中的 ID 值。我在演示应用程序（没有弹出窗口）中包含了点击事件的事件流。

我正在尝试根据答案here 更改点以绘制二维散点图。但是，将代码应用于我的 3d 绘图似乎不起作用。

一些额外的背景信息：我正在构建一个程序来分析 3D 散点数据，我的应用程序包含其中几个 3D 图

有人知道怎么做吗？

下面的应用程序包含 2d（注释）和 3d 绘图对象的代码，以显示工作和非工作情况，是对 @Maximilian Peters 给出的代码的直接修改

感谢您的帮助！

额外问题： 假设我们可以使它适用于 3dplot，我还想弄清楚如何更改 JavaScript 代码以根据存储在反应变量（即 values$activepoint）而不是来自点击事件，因为我将允许用户使用 按钮循环访问点，该按钮更改我们从中检索附加信息的点 ID。

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot"),
  textOutput('messageNr')
)

javascript <- "
function(el, x){
el.on('plotly_click', function(data) {
colors = [];
var base_color = document.getElementsByClassName('legendpoints')[data.points[0].curveNumber].getElementsByTagName('path')[0].style['stroke']
for (var i = 0; i < data.points[0].data.x.length; i += 1) {
colors.push(base_color)
};
colors[data.points[0].pointNumber] = '#000000';
Plotly.restyle(el, 
{'marker':{color: colors}}, 
[data.points[0].curveNumber]
);
//make sure all the other traces get back their original color
for (i = 0; i < document.getElementsByClassName('plotly')[0].data.length; i += 1) {
if (i != data.points[0].curveNumber) {
colors = [];
base_color = document.getElementsByClassName('legendpoints')[i].getElementsByTagName('path')[0].style['stroke'];
for (var p = 0; p < document.getElementsByClassName('plotly')[0].data[i].x.length; p += 1) {
colors.push(base_color);
}
Plotly.restyle(el, 
{'marker':{color: colors}}, 
[i]);
}
};
});
}"


server <- function(input, output, session) {
  row.names(mtcars) <- 1:nrow(mtcars)
  colorscale <- c("blue", "red", "yellow")

  values <- reactiveValues()

  output$plot <- renderPlotly({
    values$point <- event_data("plotly_click", source = "select")

  plot_ly(mtcars,
          x = ~mpg,
          y = ~cyl,
          z = ~wt,
          type = "scatter3d",
          color = as.factor(mtcars$gear),
          colors = colorscale,
          mode = "markers",
          source = "select",
          showlegend = F)%>%
    add_markers() %>% onRender(javascript)
  } )



observeEvent(values$point, {
  values$row <- as.numeric(values$point$pointNumber) +1
   values$ID <- rownames(mtcars)[values$row]
   ### the values$ID is what I use to look up the corresponding dataset in other dataframes containing the detailed info of a datapoint in the 
   ### summary data set that is used to create the real scatter3d plots in which the user clicks. 
  output$messageNr <- renderText(values$ID)
  })
 }

# server <- function(input, output, session) {
# 
#   nms <- row.names(mtcars)
# 
#   output$plot <- renderPlotly({
#     p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl))) +
#       geom_point()
#     ggplotly(p) %>% onRender(javascript)
# 
#   })
# }

shinyApp(ui, server)

Answer 1

您可以添加仅用于突出显示点的跟踪，更改单个点的位置以响应 Javascript eventListener。

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot"),
  textOutput('messageNr')
)

javascript <- "
function(el, x) {
  el.on('plotly_click', function(data) {

    var highlight_trace = el.data.length - 1;
    //the coordinates of the point which was clicked on
    //is found in data
    var newPoint = {x: data.points[0].x,
                    y: data.points[0].y,
                    z: data.points[0].z};

    //update the plot data and redraw it
    if (el.data[highlight_trace].x[0] != newPoint.x ||
        el.data[highlight_trace].y[0] != newPoint.y ||
        el.data[highlight_trace].z[0] != newPoint.z) {
      el.data[highlight_trace].x[0] = newPoint.x;
      el.data[highlight_trace].y[0] = newPoint.y      
      el.data[highlight_trace].z[0] = newPoint.z
      Plotly.redraw(el);
      }
  })
}
"


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

  output$plot <- renderPlotly(
    {
      p <- plot_ly()
      p <- add_trace(p,
              data = mtcars,
              x = ~mpg,
              y = ~cyl,
              z = ~wt,
              color = as.factor(mtcars$gear),
              type = 'scatter3d',
              mode = "markers")
      p <- add_trace(p, 
                     x = c(20), 
                     y = c(5), 
                     z = c(4), 
                     name = 'highlight',
                     type = 'scatter3d',
                     mode = 'markers',
                     marker = list(size = 15,
                                   opacity = 0.5)) %>% onRender(javascript)
      p
    } 
  )
}

shinyApp(ui, server)

• el 是存储绘图的 JavaScript 元素
• 'el.data' 是 Plotly 存储绘图数据的位置
• if 块确保仅在单击新点时才重绘图表
• 如果单击某个点，则会覆盖高亮轨迹的数据，并且绘图为redrawn

---

注意事项

• 请确保您使用的是最新版本的 Plotly，否则点击事件可能不起作用或有问题
• 在您的原始代码中，跟踪被多次绘制（删除showlegend 以查看它），可能是因为add_markers()

---

交互式 JavaScript 示例

Plotly.d3.csv('https://raw.githubusercontent.com/plotly/datasets/master/3d-scatter.csv', function(err, rows) {
      function unpack(rows, key) {
        return rows.map(function(row) {
          return row[key];
        });
      }
      var trace1 = {
        x: unpack(rows, 'x1').slice(0, 30),
        y: unpack(rows, 'y1').slice(0, 30),
        z: unpack(rows, 'z1').slice(0, 30),
        mode: 'markers',
        marker: {
          size: 12,
          line: {
            color: 'rgba(217, 217, 217, 0.14)',
            width: 0.5
          },
          opacity: 0.8
        },
        type: 'scatter3d'
      };

      var trace3 = {
        x: [0],
        y: [0],
        z: [0],
        name: 'highlight',
        mode: 'markers',
        type: 'scatter3d',
        marker: {
          size: 24,
          opacity: 0.5
        }
      };
      var data = [trace1, trace3];
      var layout = {
        margin: {
          l: 0,
          r: 0,
          b: 0,
          t: 0
        }
      };
      
      myDiv = document.getElementById('myDiv');
      Plotly.newPlot(myDiv, data);

      myDiv.on('plotly_click', function(data) {
        var highlight_trace = myDiv.data.length - 1;
        //the coordinates of the point which was clicked on
        //is found in data
        var newPoint = {
          x: data.points[0].x,
          y: data.points[0].y,
          z: data.points[0].z
        };

        //update the plot data and redraw it
        if (myDiv.data[highlight_trace].x[0] != newPoint.x ||
          myDiv.data[highlight_trace].y[0] != newPoint.y ||
          myDiv.data[highlight_trace].z[0] != newPoint.z) {
          myDiv.data[highlight_trace].x[0] = newPoint.x;
          myDiv.data[highlight_trace].y[0] = newPoint.y
          myDiv.data[highlight_trace].z[0] = newPoint.z
          Plotly.redraw(myDiv);
        }
      });


    })

<script src="https://cdn.plot.ly/plotly-latest.min.js"></script>
<div id='myDiv'></div>