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.)
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))
}
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)))
plotly
objectMostly 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
This seems to give what you are looking for :
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)
I add the
type = "contour"
Not sure the fillcolor is needed anymore .. Does it fit your need ?
A bit work around. The poly.df
file can be replaced by your data.frame.
One can simply ggplot for visualisation and then transform by 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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With