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

问题描述

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

I have an app where I am trying to change a point's size or color or symbol. The point being the object that the user has clicked. Clicking a point creates a popup in my program that shows another dataset linked to the ID value in a column belonging to the rownumber belonging to the point clicked. I included the flow of events in the demo app (without popups) for the click event.

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

I'm trying to change the point based on the answer here for a plotly 2d scatter plot. However, applying the code to my 3d plot doesn't seem to work.

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

A little extra background info: i'm building a program to analyse 3d scatter data and my app contains several of these 3D plots

有人知道怎么做吗?

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

The app below contains the code for both a 2d (commented) and 3d plot object to show the working and non working situation and is a direct modification of the code given by @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)

推荐答案

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

You could add a trace just for highlighting the point, change the location of the single point in response to a 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
• el is the JavaScript element where your plot is stored
• 'el.data' is where Plotly stores the data for your plot
• the if block makes sure that the graph is only redrawn if a new point is clicked on
• if a point is clicked on, the data for the highlight trace is overwritten and the plot is redrawn

注意事项

• 请确保您使用的是最新版本的 Plotly，否则点击事件可能无法正常工作或有错误
• 在您的原始代码中，跟踪被多次绘制(删除 showlegend 以查看它)，可能是因为 add_markers()
• Please make sure that you are using the latest version of Plotly, otherwise the click event might not work or is buggy
• In your original code the trace is drawn multiple times (remove showlegend to see it), probably because of add_markers()

交互式 JavaScript 示例

Interactive JavaScript example

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>

这篇关于在 R Shiny 中更改一个 plotly scatter3d 中的一个点的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持跟版网！

The End

---