Search code examples
rggplot2plotlyvisualization

Generating a dropdown menu for unique categorical values in R Plotly


I have a dataframe of tree diameter measurements that I'd like to visualize with an interactive scatter plot. There are a large number (>50) species in my actual dataset, and I'd like to be able to filter them to only show one species at a time. I've seen solutions where each menu option is hard-coded in the updatemenus argument, but this is less than ideal, as the number of species in my dataset is large and may change in the future.

I'd like to produce a plot similar to the static scatterplot generated by ggplot. Based on this question I have a semi-working example: it plots the data points and shows the species names in the dropdown menu, but when I select any of the species the chart does not update.

I'm not sure what I'm doing wrong, but it seems like the dropdown menu is not linked to the dataframe?

Thanks in advance!

Sample code:

library(tidyr)
library(plotly)
library(rstatix)
####Generate random plot data####
set.seed(1)

df<-as.data.frame(c(1000:1999))
Names<-c('Spruce','Pine','Oak','Birch','Willow','Cherry','Fir','Larch')
df$Species<-sample(Names,size = 1000, replace = T)
df$Diam1<-(rexp(1000,1/40))
df$Diam2<-df$Diam1*1.02
df$Diam3<-df$Diam2*1.03
names(df)[1]<-'Tag'
head(df)

#Pivot data longer
LongDF<-df%>%
  group_by(Species)%>% #group by species
  pivot_longer( #arrange long rather than wide.
    cols = Diam1:Diam3,
    names_to = 'Year',
    values_to = 'DBH')


#Format year field as date
LongDF[LongDF=='Diam1']<-'2020'
LongDF[LongDF=='Diam2']<-'2022'
LongDF[LongDF=='Diam3']<-'2024'

LongDF$Year<-lubridate::ymd(LongDF$Year,truncated=2L)

head(LongDF)

#Static plotting with ggplot
LongDF%>%
  ggplot(aes(x=Year, y=DBH))+
  geom_line(aes(group=Tag),colour='lightblue')+
  geom_jitter(width = 0.05)+
  facet_wrap(~Species,scales='free')

#Dynamic plotting with plotly
genDropdown <- function(NameList) {
  outlist <- list(list(
    method = "restyle", 
    args=list("transforms[0].value", NameList[1]),
    label = 'Species'
  ))
  
  for(i in 1:length(NameList)) {
    item <- list(list(
      method = "restyle", 
      args=list("transforms[0].value", NameList[i]),
      label = NameList[i]
    ))
    outlist <- c(outlist,item)
  }
  
  return(outlist)
}

UniqueNames<-unique(LongDF$Species)

plt<-plot_ly(data=LongDF, type='scatter', mode='lines+markers')%>%
  add_trace( x=~Year,
             y=~DBH,
             marker=list(
               color='lightblue',
               size=12,
               line=list(
                 color='darkblue',
                 width=2
               )
             ),
             showlegend=F
  )%>%
  layout(
    title= "DBH over time",
    xaxis = list(title = 'Year'),
    yaxis = list(title = 'DBH (cm)'),
    updatemenus = list(
      list(type='dropdown',
           active=0,
           buttons = genDropdown(UniqueNames))
    ))

plt

I've tried to implement a function which dynamically generates inputs for the 'updatemenus' argument. Ideally this would filter the plot to only display one species at a time, but selecting options from the dropdown doesn't change the chart.


Solution

  • Here is how I would do but I'm not a master in plotly widgets.

    UniqueNames <- unique(LongDF$Species)
    nspecies <- length(UniqueNames)
    
    buttons <- lapply(1:nspecies, function(i) {
      visible <- rep(FALSE, nspecies)
      visible[i] <- TRUE
      list(method = "restyle",
           args = list("visible", visible),
           label = UniqueNames[i]
      )
    })
    
    plot_ly(data=LongDF, type='scatter', mode='lines+markers')%>%
      add_trace( x = ~Year,
                 y = ~DBH,
                 color = ~Species,
                 marker=list(
                   size=12,
                   line=list(
                     width=2
                   )
                 ),
                 showlegend = FALSE
      ) %>%
      layout(
        title= "DBH over time",
        xaxis = list(title = 'Year'),
        yaxis = list(title = 'DBH (cm)'),
        updatemenus = list(
          list(
            type = 'dropdown',
            y = 1,
            buttons = buttons
          )
        )
      )
    

    This works but at the initialisation all species are shown, I don't know how to prevent that?