1

I am using the R programming language. With the following code, I was able to create two interactive graphs:

library(dplyr)
library(ggplot2)
library(shiny)
library(plotly)
library(htmltools)

library(dplyr)
#generate data
set.seed(123)

var = rnorm(731, 100,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_1 <- bind_rows(combine)
result_1$group = "group_a"
result_1$group = as.factor(result_1$group)


gg <-ggplot(result_1, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("graph1")

gg = ggplotly(gg)

######

var = rnorm(731, 85,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_2 <- bind_rows(combine)
result_2$group = "group_b"
result_2$group = as.factor(result_2$group)


gg1 <-ggplot(result_2, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("graph2")

gg1 = ggplotly(gg1)

enter image description here

My question: is it possible to configure these graphs such that: if you "move the slider" for one of these graphs, the slider for the other graph also moves?

I figured out how to make the slider move both of the lines provided they are on the same graph:

final = rbind(result_1, result_2)

graph <-ggplot(final, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("title")

graph = ggplotly(graph)

enter image description here

But I am looking for a way so that if you move the slider for "graph 1" by a certain distance, the slider for "graph 2" is also moved the same distance - and vice versa. Is this possible? From here, I would then use the plotly::subplot() statement or htmltools:taglist() and save the results as an html file.

(In the long term, I want to have 4 graphs : graph1, graph2 move together and graph3,graph4 move together)

Thank you

Z.Lin
  • 28,055
  • 6
  • 54
  • 94
stats_noob
  • 5,401
  • 4
  • 27
  • 83
  • 1
    Have you considered having the two graphs in separate facets within one ggplot2 object? E.g. by adding `+ facet_grid(~group)` to `graph` before converting it to a plotly object. You can control both facet panels with the same slider then. – Z.Lin Feb 10 '21 at 08:29
  • Thank you for the suggestions! I will try this! – stats_noob Feb 10 '21 at 13:59
  • I just tried it. It worked! Thank you! – stats_noob Feb 10 '21 at 14:18
  • I posted your answer in case other people wanted to a see a full solution. Let me know if you want to post it instead, I can delete it. Thank you for all your help – stats_noob Feb 10 '21 at 15:57

2 Answers2

1

Based on the suggestions provided by @Z.Lin, here is the answer I was looking for :

library(ggplot2)
library(shiny)
library(plotly)
library(htmltools)

library(dplyr)
#generate data
set.seed(123)

var = rnorm(731, 100,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_1 <- bind_rows(combine)
result_1$group = "group_a"
result_1$group = as.factor(result_1$group)


gg <-ggplot(result_1, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("graph1")

gg = ggplotly(gg)

######

var = rnorm(731, 85,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_2 <- bind_rows(combine)
result_2$group = "group_b"
result_2$group = as.factor(result_2$group)


final = rbind(result_1, result_2)


graph <-ggplot(final, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("title") + facet_wrap(. ~ group)

graph = ggplotly(graph)

#view graph
graph

enter image description here

Thank you @Z.Lin for all your help

stats_noob
  • 5,401
  • 4
  • 27
  • 83
1

If you want two sets of graphs with two different sliders, and then save the results as an html file:

library(dplyr)
library(ggplot2)
library(shiny)
library(plotly)
library(htmltools)

library(dplyr)
#generate data
set.seed(123)

######

var = rnorm(731, 85,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_2 <- bind_rows(combine)
result_2$group = "group_b"
result_2$group = as.factor(result_2$group)


final = rbind(result_1, result_2)


graph <-ggplot(final, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("title") + facet_wrap(. ~ group)

graph = ggplotly(graph)


#########

var = rnorm(731, 95,25)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
data = data.frame(var,date)

vals <- 90:100
combine <- vector('list', length(vals))
count <- 0
for (i in vals) {
    
    data$var_i = i
    data$new_var_i = ifelse(data$var >i,1,0)
    
    #percent of observations greater than i (each month)
    aggregate_i = data %>%
        mutate(date = as.Date(date)) %>%
        group_by(month = format(date, "%Y-%m")) %>%
        summarise( mean = mean(new_var_i))
    
    #combine files together
    
    aggregate_i$var = i
    aggregate_i$var = as.factor(aggregate_i$var)
    
    count <- count + 1
    combine[[count]] <- aggregate_i
    
}

result_2 <- bind_rows(combine)
result_2$group = "group_b"
result_2$group = as.factor(result_2$group)


final = rbind(result_1, result_2)


graph1 <-ggplot(final, aes(frame = var, color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("title") + facet_wrap(. ~ group)

graph1 = ggplotly(graph1)



#####

library(htmltools)

doc <- htmltools::tagList(
    div(graph, style = "float:left;width:50%;"),
    div(graph1,style = "float:left;width:50%;")
    
)

htmltools::save_html(html = doc, file = "twin.html")

enter image description here

stats_noob
  • 5,401
  • 4
  • 27
  • 83