Using plotly in R to show "facets! interactively in dropdown list

Question

I'd like to create an animated graph using plotly in R in a way in which my facets are displayed by selectiong on a dropdown list. I'm not sure if this can be done, I have seen something similar here but I've got around 30 different categories so doing the code one by one manually would take quite a lot of time...

Basically, my plots are line graphs showing timing (T0 to T8) of sightings of different species within different regions. I'd like to generate a graph in which I could select an Ecoregion and visualise lines showing the mean timing for each time point of a species in that region, that is one line per species present (no mater if there were 1 or 20 records) I've got the following graph

set.seed(123)
species <- rep(c("Species A", "Species B", "Species C"), each = 7)
ecoregions <- rep(letters[1:30], each = 2)  
times <- rep(0:7, times = 3)
values <- matrix(rpois(21, 10), ncol = 3)
colnames(values) <- paste0("DaSS", 1:3)

Df2 <- data.frame(Tpoint = rep(values, each = length(ecoregions)),
                  Time = rep(times, times = length(ecoregions)),
                  Species = rep(species, times = length(ecoregions)),
                  Ecoregion = rep(ecoregions, each = length(times)))

This is my ggplot code for creating what I want with facets, but since there are many ecoregions these are tiny, so I'd like to create an interactive plot with plotly instead of facets

p<-Df2%>%
  ggplot(aes(x = Times, y = values, group =Species, color=Species)) +

  stat_summary(fun = "mean", geom = "line")+
  #geom_smooth(method = "loess", se = TRUE) +
  
   labs(title = "Amount of time by species and ecoregion",
       x = "Time point",
       y = "hours")+
theme_bw()+
  theme(legend.position="bottom",
        strip.text = element_text(size = 14),  # Adjust strip text size
        strip.background = element_blank(),    # Remove strip background
        panel.spacing = unit(1, "lines")
) +facet_wrap("Ecoregion")

I've used something like the below code but haven't had much luck...the data won't change when I use any of the buttons.

p <- Df2 %>%
  group_by(Species, Ecoregion) %>%
  #summarize(mean_Time = mean(Time)) %>%
  plot_ly(x = ~Species, y = ~Time, color = ~Species, type = "scatter", mode = "lines") %>%
  layout(
    xaxis = list(title = "Species"),
    yaxis = list(title = "Time"),
    updatemenus = list(
      list(type = "buttons",
           showactive = FALSE,
           buttons = button_list)
    )
  )

# Show the interactive plot
p

Any help would be appreciated!

Answer 1

As your data looks odd (too many values are the same), I will use gapminder data. I will only select 3 countries to demonstrate. You need to adjust your dataframe this way to make it work for your use case. The key is to use method = "update" and make it visible in updatemenus. Try this

mycolors <- c("orange","dodgerblue","green")
mycountries <- c("France", "Italy", "Spain")
varnames <- c("lifeExp","pop","gdpPercap")

n <- length(mycountries)
m <- length(varnames)

cols <- c()
for (i in 1:m){
  for (j in 1:n){ cols[j + 3*(i-1)] <- paste0(varnames[i],"_",mycountries[j]) }
}

df <- gapminder %>%  dplyr::filter(country %in% mycountries) %>%
  dplyr::mutate(rowid = row_number()) %>% 
  pivot_wider(
    names_from = country,
    values_from = varnames
  )  %>%  select(all_of(cols),year)

## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
             type = "scatter",
             mode = "lines",
             x = ~year, 
             y= ~df[[cols[[1]]]], 
             line = list(color = mycolors[1]), 
             name = mycountries[1]) 
p <- p %>% add_lines(x = ~year, y = df[[2]], name =  mycountries[2], line=list(color = mycolors[2]), visible = T)
p <- p %>% add_lines(x = ~year, y = df[[3]], name =  mycountries[3], line=list(color = mycolors[3]), visible = T)

p
## Add arbitrary number of traces
## Ignore first 3 columns as it has already been added

coln <- 3
for (col in cols[4:9]) {
  print(col)
  coln <- coln + 1
  k <- coln %% 3
  j <- ifelse(k==0,3,k)
  #name = sub("\\_.*", "", col)  ##  varname
  name = sub(".*_", "", col)    ##  country name
  p <- p %>% add_lines(x = ~year, y = df[[col]], name = name, line=list(color = mycolors[j]), visible = F)
}

mytitle <- "Dropdown line plot"
data_var <- c("Life Expectancy","Population","GDP per Capita")

pp <- p %>%
  layout(
    title = paste(mytitle,"-",data_var[1]),
    xaxis = list(title = "Year"),
    yaxis = list(title = data_var[1]),
    updatemenus = list(
      list(
        y = 0.7,
        # type="buttons",  ### prints all buttons; comment this line to get a dropdown
        ## Add all buttons at once
        buttons = lapply(0:(m-1), function(col) {
          list(method="update", 
               args = list(list(visible = c(cols == c(cols[col*3+1],cols[col*3+2],cols[col*3+3]))), # this defines visibility on click
                           list(yaxis = list(title = paste(data_var[1+col])), title = paste(mytitle,"-",data_var[1+col]) ) 
                      ),
               label = paste0(varnames[1+col])
               )
        })
      )
    )
  )

pp

Answer 2

Consider building a restyle button list that contains the subset values by Ecoregion with all plot aesthetics (x, y, color, type, mode):

button_list <- lapply(
  unique(Df2$Ecoregion),
  \(er) list(
    method = "restyle", 
    args = list(
      "y", list(subset(Df2, Ecoregion == er)$Tpoint),
      "x", list(subset(Df2, Ecoregion == er)$Time),
      "color", list(subset(Df2, Ecoregion == er)$Species),
      "type", "scatter",
      "mode", "lines"
    ), 
    label = subset(Df2, Ecoregion == er)$Ecoregion[1]
  )
)

p <- subset(Df2, Ecoregion == unique(Df2$Ecoregion)[1]) %>%
  plot_ly( 
    x = ~Time, y = ~Tpoint, color = ~Species, type = "scatter", mode = "lines"
  ) %>%
  layout(
    title = "Ecoregion Line Plots",
    xaxis = list(title = "Time"),
    yaxis = list(title = "Tpoint"),
    updatemenus = list(
      list(
        buttons = button_list
      )
    )
  )

p