在保留悬停信息的同时将多边形添加到散点图

Question

我正在使用R 的plotly 绘制5 个x,y 数据集群。

以下是数据：

set.seed(1)
df <- do.call(rbind,lapply(seq(1,20,4),function(i) data.frame(x=rnorm(50,mean=i,sd=1),y=rnorm(50,mean=i,sd=1),cluster=i)))

这是他们的plotly 散点图：

library(plotly)
clusters.plot <- plot_ly(marker=list(size=10),type='scatter',mode="markers",x=~df$x,y=~df$y,color=~df$cluster,data=df) %>% hide_colorbar() %>% layout(xaxis=list(title="X",zeroline=F),yaxis=list(title="Y",zeroline=F))

这给出了：

然后，按照@Marco Sandri 的answer，我使用以下代码添加包围这些集群的多边形：

多边形代码：

library(data.table)
library(grDevices)

splinesPolygon <- function(xy,vertices,k=3, ...)
{
  # Assert: xy is an n by 2 matrix with n >= k.
  # Wrap k vertices around each end.
  n <- dim(xy)[1]
  if (k >= 1) {
    data <- rbind(xy[(n-k+1):n,], xy, xy[1:k, ])
  } else {
    data <- xy
  }
  # Spline the x and y coordinates.
  data.spline <- spline(1:(n+2*k), data[,1], n=vertices, ...)
  x <- data.spline$x
  x1 <- data.spline$y
  x2 <- spline(1:(n+2*k), data[,2], n=vertices, ...)$y
  # Retain only the middle part.
  cbind(x1, x2)[k < x & x <= n+k, ]
}

clustersPolygon <- function(df)
{
  dt <- data.table::data.table(df)
  hull <- dt[,.SD[chull(x,y)]]
  spline.hull <- splinesPolygon(cbind(hull$x,hull$y),100)
  return(data.frame(x=spline.hull[,1],y=spline.hull[,2],stringsAsFactors=F))
}

library(dplyr)
polygons.df <- do.call(rbind,lapply(unique(df$cluster),function(l)
  clustersPolygon(df=dplyr::filter(df,cluster == l)) %>%
    dplyr::rename(polygon.x=x,polygon.y=y) %>%
    dplyr::mutate(cluster=l)))

现在添加多边形：

clusters <- unique(df$cluster)

for(l in clusters) clusters.plot <- clusters.plot %>% 
 add_polygons(x=dplyr::filter(polygons.df,cluster == l)$polygon.x,
              y=dplyr::filter(polygons.df,cluster == l)$polygon.y,
              line=list(width=2,color="black"),
              fillcolor='transparent', inherit = FALSE)

这给出了：

虽然这很好用，但不幸的是它消除了添加多边形之前存在的hoverinfo，现在只是每个多边形的痕迹。

将inherit 从FALSE 更改为TRUE 会导致我写的关于in that post 的错误。所以我的问题是如何在不改变原始图的hoverinfo 的情况下添加多边形。

Answer 1

我认为这里的部分问题是，当您开始混合和匹配跟踪类型时，plotly 中的 colorbar 会出现一些奇怪的行为和副作用。

解决这个问题的最简单方法（这似乎是合适的，因为您是按集群着色，而不是连续变量）是将集群列的类更改为有序因子表达式df$cluster <- ordered(as.factor(df$cluster))。 （我相信这也可能出现在 dplyr mutate 语句中。）

包和数据生成函数

---

library(data.table)
library(grDevices)
library(dplyr)
library(plotly)

## Function Definitions 
splinesPolygon <- function(xy,vertices,k=3, ...) {
  # Assert: xy is an n by 2 matrix with n >= k.
  # Wrap k vertices around each end.
  n <- dim(xy)[1]
  if (k >= 1) {
    data <- rbind(xy[(n-k+1):n,], xy, xy[1:k, ])
  } else {
    data <- xy
  }
  # Spline the x and y coordinates.
  data.spline <- spline(1:(n+2*k), data[,1], n=vertices, ...)
  x <- data.spline$x
  x1 <- data.spline$y
  x2 <- spline(1:(n+2*k), data[,2], n=vertices, ...)$y
  # Retain only the middle part.
  cbind(x1, x2)[k < x & x <= n+k, ]
}

clustersPolygon <- function(df) {
  dt <- data.table::data.table(df)
  hull <- dt[,.SD[chull(x,y)]]
  spline.hull <- splinesPolygon(cbind(hull$x,hull$y),100)
  return(data.frame(x=spline.hull[,1],y=spline.hull[,2],stringsAsFactors=F))
}

生成数据

---

这里的一个关键区别是将您的集群定义为一个有序因子，以防止它被视为一个会调用colorbar 怪异的连续变量。

set.seed(1)
df <- do.call(rbind,lapply(seq(1,20,4),function(i) data.frame(x=rnorm(50,mean=i,sd=1),y=rnorm(50,mean=i,sd=1),cluster=i)))

## Critical Step here: Make cluster an ordered factor so it will
## be plotted with the sequential viridis scale, but will not 
## be treated as a continuous spectrum that gets the colorbar involved
df$cluster <- ordered(as.factor(df$cluster))

## Make hull polygons
polygons.df <- do.call(rbind,lapply(unique(df$cluster),function(l) clustersPolygon(df=dplyr::filter(df,cluster == l)) %>% dplyr::rename(polygon.x=x,polygon.y=y) %>% dplyr::mutate(cluster=l)))
clusters <- unique(df$cluster)
clustersPolygon(df=dplyr::filter(df,cluster == l)) %>% dplyr::rename(polygon.x=x,polygon.y=y) %>% dplyr::mutate(cluster=l)))

构建一个plotly 对象

---

这里大体相同，但首先初始化一个空的 plotly 对象，然后在原始数据点之前添加船体多边形。

## Initialize an empty plotly object so that the hulls can be added first
clusters.plot <- plot_ly()

## Add hull polygons sequentially
for(l in clusters) clusters.plot <- clusters.plot %>% 
  add_polygons(x=dplyr::filter(polygons.df,cluster == l)$polygon.x,
               y=dplyr::filter(polygons.df,cluster == l)$polygon.y,
               name = paste0("Cluster ",l),
               line=list(width=2,color="black"),
               fillcolor='transparent', 
               hoverinfo = "none",
               showlegend = FALSE,
               inherit = FALSE)  

## Add the raw data trace
clusters.plot <- clusters.plot %>% 
  add_trace(data=df, x= ~x,y= ~y,color= ~cluster,
            type='scatter',mode="markers",
            marker=list(size=10)) %>% 
  layout(xaxis=list(title="X",
                    zeroline=F),
         yaxis=list(title="Y",
                    zeroline=F))
## Print the output
clusters.plot

给出以下输出

---

Answer 2

这似乎给了你正在寻找的东西：

for(l in clusters) clusters.plot <- clusters.plot %>% 
  add_polygons(x=dplyr::filter(polygons.df,cluster == l)$polygon.x,
           y=dplyr::filter(polygons.df,cluster == l)$polygon.y,
           line=list(width=2,color="black"),type = "contour",
           fillcolor='transparent', inherit = FALSE)

我添加了

type = "contour" 

不确定 填色 不再需要.. 它符合您的需要吗？

Answer 3

有点解决方法。 poly.df 文件可以替换为您的 data.frame。 可以简单 ggplot 进行可视化，然后通过 ggplotly 进行转换。

library(tidyverse)
library(plotly)

set.seed(1)
df <- do.call(rbind,lapply(seq(1,20,4), 
                           function(i) data.frame(x=rnorm(50,mean=i,sd=1),y=rnorm(50,mean=i,sd=1),cluster=i)))
poly.df <- df %>% 
  group_by(cluster) %>%
  do(.[chull(.$x, .$y),]) 

ggplot(df, aes(x, y, colour = as.factor(cluster))) +
  geom_polygon(data = poly.df, fill = NA)+
  geom_point() ->
  p

ggplotly(p)