Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Adding a polygon to a scatter plotly while retaining the hover info

Tags:

r

hover

plotly

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: enter image description here

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:

enter image description here

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.

like image 685
dan Avatar asked Jan 04 '18 22:01

dan


3 Answers

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


polygons

like image 130
Matt Summersgill Avatar answered Nov 19 '22 04:11

Matt Summersgill


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 ?

like image 24
MrSmithGoesToWashington Avatar answered Nov 19 '22 05:11

MrSmithGoesToWashington


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)

enter image description here

like image 38
Volodymyr Avatar answered Nov 19 '22 05:11

Volodymyr