Добавление многоугольника к разбросу по графику при сохранении информации о зависании

У меня есть 5 кластеров данных x,y, которые я рисую с помощью R 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)))

Здесь их график рассеяния 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 приводит к ошибке, которую я пишу о в этом сообщении. Поэтому мой вопрос заключается в том, как добавить полигоны, не меняя hoverinfo исходного графика.

Ответ 1

Я думаю, что часть проблемы здесь состоит в том, что colorbar in plotly имеет несколько странное поведение и побочные эффекты, когда вы начинаете смешивать и сопоставлять типы трассировки.

Самый простой способ обойти это (и кажется уместным, так как вы раскрашиваете кластеры, а не непрерывную переменную) состоит в том, чтобы изменить класс кластерного столбца как упорядоченный множитель с выражением 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

Выдает следующий вывод

Ответ 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"

Не уверен, что Цвет заливки необходимо больше.. Соответствует ли вам ваша потребность?

Ответ 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)