在保留悬停信息的同时将多边形添加到散点图 [英] Adding a polygon to a scatter plotly while retaining the hover info
问题描述
我正在使用 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,平均值=i,sd=1),簇=i)))
这是他们的 plotly
散点图:
图书馆(情节)clusters.plot <- plot_ly(marker=list(size=10),type='scatter',mode="markers",x=~df$x,y=~df$y,color=~df$cluster,数据=df) %>% hide_colorbar() %>% 布局(xaxis=list(title="X",zeroline=F),yaxis=list(title="Y",zeroline=F))
这给出了:
然后,按照@Marco Sandri 的
虽然这很好用,但不幸的是它消除了添加多边形之前存在的 hoverinfo
,现在只是每个多边形的轨迹.
将 inherit
从 FALSE
更改为 TRUE
导致我写的关于
I have 5 clusters of x,y
data I'm plotting using R
's plotly
.
Here are the data:
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)))
Here's their plotly
scatter plot:
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))
Which gives:
Then, following @Marco Sandri's answer, I add polygons circumscribing these clusters using this code:
Polygons code:
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)))
And now adding the polygons:
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)
Which gives:
Although this works great, unfortunately it eliminates the hoverinfo
that existed prior to adding the polygons, and now is just the trace of each polygon.
Changing inherit
from FALSE
to TRUE
results with the error I write about in that post. So my question is how to add the polygons without changing the hoverinfo
of the original plot.
I think part of the issue here is that the colorbar
in plotly
has some somewhat weird behavior and side effects when you start to mix and match trace types.
The simplest way to work around this (and it seems appropriate since you are coloring by clusters, not a continuous variable) is to change the class of your clustered column to be an ordered factor with the expression df$cluster <- ordered(as.factor(df$cluster))
. (I believe this could be in a dplyr mutate statement as well.)
Packages and data generation functions
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))
}
Generate Data
The one critical difference here is to define your cluster as an ordered factor to keep it from being treated as a continuous variable that will invoke the colorbar
weirdness.
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)))
Build a plotly
object
Mostly the same here, but starting by initializing an empty plotly object and then adding the hull polygons before the raw data points.
## 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
Gives the following output
这篇关于在保留悬停信息的同时将多边形添加到散点图的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!