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

时间:2018-01-04 22:49:42

标签: r hover plotly

我正在使用x,y的{​​{1}}绘制5个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

给出了: enter image description here

然后,在@Marco Sandri的answer之后,我使用以下代码添加限制这些群集的多边形:

多边形代码:

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))

现在添加多边形:

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)))

给出了:

enter image description here

虽然这很有用,但不幸的是它消除了添加多边形之前存在的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) ,现在只是每个多边形的轨迹。

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

3 个答案:

答案 0 :(得分:6)

我认为这里的部分问题是colorbar 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对象

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

## 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

提供以下输出

polygons

答案 1 :(得分:1)

这似乎可以满足您的需求:

Thread thread = new Thread() {
    @Override
    public void run() {
        startService(new Intent(getApplicationContext(), YourService.class));
    }
};
thread.start();

我添加了

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)

不确定     填色 需要了.. 它适合您的需要吗?

答案 2 :(得分:1)

有点解决方法。您可以使用data.frame替换poly.df文件。 可以简单地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)

enter image description here