Plotly 中的动态散点图 - R

Question

我正在尝试使用 Ploty 创建一个散点图，它允许我显示 Iris 数据集的不同物种以及每个物种的正方形，代表 Sepal 长度和宽度的最小值和最大值。澄清一下，我希望每个物种都有这样的东西：

为此，我为每个物种创建了一个散点图 + 正方形列表，我想用下拉菜单。到目前为止，我没有做到这一点。我还尝试执行在散点图 ggplot 中绘制物种的“标准”程序，将其创建到绘图图表并添加下拉菜单。这个 workerd 很好地交互 select 每个物种，但是当一个新物种被 selected 时，我无法设法改变正方形的限制。

到目前为止，这是我的代码（将 ggplots + 方块存储在列表中的代码）：

data("iris")
flw <-data.frame(iris)
flw_squares <- data.frame(spc = c("setosa","virginica","versicolor"),
                            sep_lg_min = c(4.5,6.5,5),
                            sep_lg_max = c(5.8,8,7),
                            sep_wd_min = c(3.2,2.5,2.5),
                            sep_wd_max = c(4.25,3.5,3.5))

flw_lst <- data.frame()
for (i in 1:length(flw_squares$spc)){
  spc_selected= flw_squares$spc[i]
  flw_lst[i,1] <- flw_squares$spc[i]
  flw_lst[i,2] <- as.numeric((flw%>%filter(Species== spc_selected)%>%
                                filter(Sepal.Length==min(as.numeric(Sepal.Length),na.rm = TRUE)))$Sepal.Length)[1]
  flw_lst[i,3] <- as.numeric((flw%>%filter(Species== spc_selected)%>%
                                filter(Sepal.Length==max(as.numeric(Sepal.Length),na.rm = TRUE)))$Sepal.Length)[1]
  flw_lst[i,4] <- as.numeric((flw%>%filter(Species== spc_selected)%>%
                                filter(Sepal.Width==min(as.numeric(Sepal.Width),na.rm = TRUE)))$Sepal.Width)[1]
  flw_lst[i,5] <- as.numeric((flw%>%filter(Species== spc_selected)%>%
                                filter(Sepal.Width==max(as.numeric(Sepal.Width),na.rm = TRUE)))$Sepal.Width)[1]
  }

colnames(flw_lst)<-c("Species","min Sepal.Length","max Sepal.Length","min Sepal.Width","max Sepal.Width")

# ggplot(flw,aes(x=Sepal.Length,y=Sepal.Width))+
#          geom_point(aes(color=Species))

spc_lst<-list()

for (i in 1:length(flw_squares$spc)){
  
  spc_selected=flw_lst[i,1]
  #INTERACTIVE SCATTER PLOT
  spc_p<-flw%>%filter(Species== spc_selected) %>%ggplot(aes(y=Sepal.Width ,x=Sepal.Length ))+
    theme_bw()+ ggtitle(paste("Scatter plot "),spc_selected) +
    geom_point(shape=21, size=3, stroke=.2)+
    scale_color_manual(values = "black")+
    scale_fill_manual(name="Species")+
    labs(color = "Species") +  theme(legend.position = "bottom", legend.box = "horizontal")+
    geom_rect(aes(  

      xmin= as.numeric((flw%>%filter(Species== spc_selected)%>%
                                    filter(Sepal.Length==min(as.numeric(Sepal.Length),na.rm = TRUE)))$Sepal.Length)[1],
      xmax= as.numeric((flw%>%filter(Species== spc_selected)%>%
                                    filter(Sepal.Length==max(as.numeric(Sepal.Length),na.rm = TRUE)))$Sepal.Length)[1],
      ymin= as.numeric((flw%>%filter(Species== spc_selected)%>%
                                    filter(Sepal.Width==min(as.numeric(Sepal.Width),na.rm = TRUE)))$Sepal.Width)[1],
      ymax= as.numeric((flw%>%filter(Species== spc_selected)%>%
                                    filter(Sepal.Width==max(as.numeric(Sepal.Width),na.rm = TRUE)))$Sepal.Width)[1],
      ),
      fill = "transparent",color = "red", size = .4)
  
  spc_p=ggplotly(spc_p)
  
  spc_lst[[i]]<- plotly_build(spc_p)
  
}

spc_lst[[1]] %>%
  layout(
    yaxis = list(title = "y"),
    updatemenus = list(
      list(
        y = 0.7,
        buttons = list(
          list(method = "restyle",
               args = list("visible", list(TRUE, FALSE, FALSE)),
               label = "setosa"),
          list(method = "restyle",
               args = list("visible", list(FALSE, TRUE, FALSE)),
               label = "virginica"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, TRUE)),
               label = "versicolor")))
    )
  )

您对如何解决这个问题有什么想法吗？我认为最好创建一个 ggplot，添加带有 ploty 的下拉菜单，然后 select 图表中的物种，但我无法设法“收听”事件并更改 geom_rect部分代码。

谢谢！

Answer 1

我认为这种方法可能有效。

对于矩形，在列表中为您感兴趣的三个组中的每个组定义形状（在本例中，Species）。

然后，您的 plotly 图将包含三个轨迹，每组一个。第一个可以有默认值 visible = TRUE.

在您的 updatemenus buttons 列表中，您可以设置所有内容，包括可见性和矩形形状。

library(plotly)

df <- iris

species_names <- unique(df$Species)

shapes <- lapply(species_names, function(x) {
  list(
    type = "rect",
    x0 = min(df[df$Species == x, "Sepal.Length"]), 
    x1 = max(df[df$Species == x, "Sepal.Length"]), 
    xref = "x",
    y0 = min(df[df$Species == x, "Sepal.Width"]),
    y1 = max(df[df$Species == x, "Sepal.Width"]), 
    yref = "y",
    line = list(color = "red"),
    layer = "below",
    opacity = .5
  )
}) 

plot_ly() %>%
  add_trace(data = df[df$Species == species_names[1],], 
            x = ~Sepal.Length, 
            y = ~Sepal.Width, 
            type = 'scatter', 
            mode = 'markers', 
            visible = T) %>%
  add_trace(data = df[df$Species == species_names[2],], 
            x = ~Sepal.Length, 
            y = ~Sepal.Width, 
            type = 'scatter', 
            mode = 'markers', 
            visible = F) %>%
  add_trace(data = df[df$Species == species_names[3],], 
            x = ~Sepal.Length, 
            y = ~Sepal.Width, 
            type = 'scatter', 
            mode = 'markers', 
            visible = F) %>%
  layout(
    shapes = list(shapes[[1]]),
    updatemenus = list(
    list(y = .7,     
         buttons = list(
           list(method = "update",
                args = list(list(visible = c(T, F, F)),
                            list(title = species_names[1], 
                                 shapes = list(shapes[[1]]))),
                label = species_names[1]),
           list(method = "update",
                args = list(list(visible = c(F, T, F)),
                            list(title = species_names[2], 
                                 shapes = list(shapes[[2]]))),
                label = species_names[2]),
           list(method = "update",
                args = list(list(visible = c(F, F, T)),
                            list(title = species_names[3], 
                                 shapes = list(shapes[[3]]))),
                label = species_names[3])
         )))
  )

情节

Plotly 中的动态散点图 - R

Dynamic scatter plot in Ploty - R

r

scatter-plot

ggplot2

ggplotly