R:“领带"两个图在一起 [英] R: "tie" two graphs together

问题描述

我正在使用R编程语言.使用以下代码，我能够创建两个交互式图形:

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)

我的问题:是否可以将这些图形配置为:对于其中一个图形，另一图形的滑块也会移动吗?

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)

但我正在寻找一种方法，以便在您移动图1"的滑块时在一定距离内，用于图2"的滑动器被拉紧.也被移动相同的距离-反之亦然.这可能吗?然后，在这里，我将使用 plotly :: subplot()语句或 htmltools:taglist()并将结果保存为html文件.

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.

(从长远来看，我想有4个图:graph1，graph2一起移动，graph3，graph4一起移动)

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

谢谢

推荐答案

基于@ Z.Lin提供的建议，这是我一直在寻找的答案:

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

感谢@ Z.Lin的所有帮助

Thank you @Z.Lin for all your help

这篇关于R:“领带"两个图在一起的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！