闪亮更新点击的点以突出显示它

时间:2017-08-30 19:39:52

标签: r shiny plotly ropensci ggplotly

以下是提取点击事件的工作示例。我想问你是否有办法用增加大小来更新点击的点或突出显示它等等?,

library(shiny)
library(plotly)

ui <- fluidPage(
    plotlyOutput("plot"),
    verbatimTextOutput("click")
)

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

    nms <- row.names(mtcars)

    output$plot <- renderPlotly({
        p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl), key = nms)) + 
           geom_point()
        ggplotly(p)

    })

    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 Car: ", d$key)
    })

}

shinyApp(ui, server)

enter image description here

我搜索了SO和其他适当的来源,找到了以下问题的解决方案,但找不到。

更新

  • This解决方案适用于此玩具情节。但是,我的原始用例包含50个级别的感兴趣的变量,并且很可能已经存在洋红色或任何其他颜色。此外,更改颜色需要相当长的时间。
  • 有没有办法增加点击点的大小,以区别于附近的100点?

我们要求here更改点击点形状的相关问题。

1 个答案:

答案 0 :(得分:3)

您可以使用Plotly htmlwidget功能将onrender&#39; events添加到您的Shiny应用中。

ggplotly(p) %>% onRender(javascript)

colors数组传递给restyle函数。选定的点(pointNumber)颜色为洋红色,而其他点从图例中获取颜色。你可以用marker大小做同样的事情,标记符号有点棘手,因为Plotly在这里不接受数组。

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] = '#FF00FF';
    Plotly.restyle(el, 
                   {'marker':{color: colors}}, 
                   [data.points[0].curveNumber]
                  );

  });
}
library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("plot")
)

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] = '#FF00FF';
    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) {

  nms <- row.names(mtcars)

  output$plot <- renderPlotly({
    p <- ggplot(mtcars, aes(x = mpg, y = wt, col = as.factor(cyl), key = nms)) + 
      geom_point()
    ggplotly(p) %>% onRender(javascript)

  })
}

shinyApp(ui, server)

一些解释:

  • Plotly的事件,例如plotly_click在事件函数
  • 中传递了一些信息(本例中为data
  • data.points包含触发事件的点数
  • 在这种情况下,我们只有一个点data.points[0],其中pointNumber是原始数组的索引,curveNumber是跟踪号。
  • 将所有输入数据存储在绘制绘图的div
  • 我们可以通过document.getElementsByClassName('plotly')[0].data
  • 访问它
  • 可以通过document.getElementsByClassName('legendpoints')[i]访问图例,其中i是图例的索引
  • ggplotly或plot_ly返回htmlwidgets
  • 可以使用任何htmlwidget functions添加Javascript或HTML代码,例如在这种情况下onrender