Ggplotly error: Is it possible to combine facet_wrap and rangeslider?

Plotly R, MATLAB, Julia, Net Plotly R
1

I am trying to add a rangeslider to a ggplotly graph created with the facet_wrap() function. However, I get the following error: “Can only add a rangeslider to a plot with one x-axis”. This is happening because the facet_wrap produces six identical x-axes.

Is there any way to add a rangeslider to these types of graphs? I used the following code to create the graph, it works correctly until the rangeslider() function is added at the end.

library(tidyverse)
library(plotly)
dat <- read.csv("https://raw.githubusercontent.com/LucasTremlett/Proyecto-Visualizacion/master/owid-covid-data.csv")
p<-dat %>% select(new_cases_per_million, date, location) %>% 
  mutate(date = as.Date(date)) %>%
  filter(location=="Germany"| location=="Spain"| location=="Italy"| location=="United Kingdom"|
           location=="Netherlands" | location=="France")  %>% 
  ggplot(aes(x=date, y=new_cases_per_million)) + 
  geom_area(na.rm = TRUE) +
  facet_wrap( ~ location) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b")

ggplotly(p, tooltip = c("x", "y")) %>% 
  rangeslider()
2

I have managed to devise a sort of solution which creates three different range sliders using subplot() instead of facet wrap:

dat <- read.csv("https://raw.githubusercontent.com/LucasTremlett/Proyecto-Visualizacion/master/owid-covid-data.csv")
dat<-dat %>% select(new_cases_per_million, date, location) %>% 
  mutate(date = as.Date(date)) %>%
  filter(location=="Germany"| location=="Spain"| location=="Italy"| location=="United Kingdom"|
                                          location=="Netherlands" | location=="France") %>% 
  mutate(pais=case_when(location=="Germany"  ~ "Alemania",
                        location=="Italy"  ~ "Italia",
                        location=="Netherlands"  ~ "Paises Bajos",
                        location=="Spain"  ~ "España",
                        location=="United Kingdom"  ~ "Reino Unido",
                        location=="France"  ~ "Francia")) %>%  
  mutate(tex=paste0("El ", as.character(date), " hubo ",
                    as.character(new_cases_per_million), " casos nuevos en ",
                    as.character(pais)))



  p1<- dat %>%
  filter(location=="Germany")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  ylab("") + xlab("") +
  theme(panel.grid = element_blank())
  
   p2<- dat %>%
  filter(location=="Spain")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  ylab("") + xlab("") + 
  theme(panel.grid = element_blank())
   
    p3<- dat %>%
  filter(location=="Italy")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  ylab("") + xlab("") + 
  theme(panel.grid = element_blank())
    
     p4<- dat %>%
  filter(location=="United Kingdom")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  ylab("") + xlab("") + 
  theme(panel.grid = element_blank())
     
      p5<- dat %>%
  filter(location=="Netherlands")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  theme(panel.grid = element_blank())
      
       p6<- dat %>%
  filter(location=="France")  %>% 
    ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_area(aes(group=1)) +
  facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  theme(panel.grid = element_blank())

subplot(ggplotly(p1, tooltip="text", dynamicTicks = TRUE) %>% rangeslider(),
        (ggplotly(p2, tooltip="text", dynamicTicks = TRUE) %>% rangeslider()),
        (ggplotly(p3, tooltip="text", dynamicTicks = TRUE) %>% rangeslider()),
        (ggplotly(p4, tooltip="text", dynamicTicks = TRUE) %>% rangeslider()),
        (ggplotly(p5, tooltip="text", dynamicTicks = TRUE) %>% rangeslider()),
        (ggplotly(p6, tooltip="text", dynamicTicks = TRUE) %>% rangeslider()),
        nrows=2, shareX = TRUE, shareY = TRUE)

This creates the graph in the link: RPubs - HTML

However I would much prefer having a single rangeslider that controls all graphs. I can do this setting nrows=6, however this creates a pretty ugly graph as all the plots are stacked over each other. Also it would be great if I could change the layout of the range slider, in this same way this user requests, only in R Studio instead of JS. Any suggestions on how to achieve this would be greatly appreciated. I know this is a lot for one post so thank you for bearing with me!!

3

I believe I have come as close as I can get using crosstalk’s filterslider(). However, this is still not the perfect solution as the graph doesn’t zoom in when a range is selected . Here is the code, I hope someone will find it to be useful:

library(tidyverse)
library(plotly)
library(crosstalk)
dat <- read.csv("https://raw.githubusercontent.com/LucasTremlett/Proyecto-Visualizacion/master/owid-covid-data.csv")
dat<-dat %>% select(new_cases_per_million, date, location) %>% 
  mutate(date = as.Date(date)) %>%
  filter(location=="Germany"| location=="Spain"| location=="Italy"| location=="United Kingdom"|
           location=="Netherlands" | location=="France") %>% 
  mutate(pais=case_when(location=="Germany"  ~ "Alemania",
                        location=="Italy"  ~ "Italia",
                        location=="Netherlands"  ~ "Paises Bajos",
                        location=="Spain"  ~ "España",
                        location=="United Kingdom"  ~ "Reino Unido",
                        location=="France"  ~ "Francia")) %>%  
  mutate(tex=paste0("El ", as.character(date), " hubo ",
                    as.character(new_cases_per_million), " casos nuevos por millón de habitantes en ",
                    as.character(pais))) %>% 
  filter(date>=as.Date("2020-03-05") & date<=as.Date("2020-05-06"))



dat<- dat %>% highlight_key()
  
  
  p1<-dat %>% ggplot(aes(x=date, y=new_cases_per_million, text=tex)) + 
  geom_col(aes(group=1)) +
    facet_wrap( ~ pais) +
  theme_minimal() +
  scale_y_continuous(limits=c(0,200)) +
  scale_x_date(limits = c(as.Date("2020-03-05"),as.Date("2020-05-06")),
               date_breaks = "3 weeks", date_labels = "%d-%b") +
  geom_hline(yintercept = 0) +
  ylab("") + xlab("") +
  theme(panel.grid = element_blank())

  p1<-ggplotly(p1, tooltip = "text")
  
rs<-filter_slider("date", "Fecha", dat, ~date)

bscols(widths=c(0.05,10.5),rs, p1)