Dynamic scatter plot in Ploty - R

Question

I'm trying to create a scatter plot with Ploty that allow me to display the different species of the Iris dataset plus a square for each species representing the min and max values for Sepal length and width. To clarify, I want something like this for each species:

For that, I've created a list of scatter plots + squares for each species, and I want to call each item on the list (a chart + a square for the specie selected) with the dropdown menu. So far I've failed to do that. I've also tried to do the "standard" procedure of plotting the species in a scatter ggplot, create it to a ploty chart and add the dropdown menu. That workerd fine for interactively select each specie, but I can't managed to change the limits of the square when a new species is selected.

This is my code so far (the one that stores the ggplots + the squares in a list):

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

Do you have any ideas on how to tackle this issue? I think that it's better to create a ggplot, add the dropdowm menu with ploty and then select the species from the chart, but I can´t manage to "listen" to the event and change the limits on the geom_rect part of the code.

Thanks!

Ben Ben · Accepted Answer · 2020-11-01T18:11:45

I think this approach might work.

For rectangles, define your shapes in a list for each of the three groups you are interested in (in this case, Species).

Then, your plotly plot will have your three traces, one for each group. The first could have a default of visible = TRUE.

In your updatemenus buttons list, you can set everything, including visibility and the rectangle shapes.

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

Plot

Dynamic scatter plot in Ploty - R

1 Answers