我认为你不能用标准做到这一点plotly
API.
我认为对于这样的情况最好使用shiny
并创建一个网络应用程序。您可以根据需要添加任意数量的滑块,然后根据需要过滤数据以更新绘图。
这样做的缺点是您只是用新数据重新绘制绘图,而不是像以前那样制作动画。所以你最终会失去之前的平滑过渡。
实际上有一种我不知道的保持动画方面的方法,但你需要更深入地研究shiny
/plotly
。看一眼这个链接。我不知道这一点,所以我没有尝试这样做。不过我稍后会看一下!
这是我的闪亮解决方案:
library(shiny)
library(plotly)
library(dplyr)
gendata <- function(){
#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 %>%
dplyr::mutate(date = as.Date(date)) %>%
dplyr::group_by(month = format(date, "%Y-%m")) %>%
dplyr::summarise(mean = mean(new_var_i), .groups='drop')
#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)
######
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 %>%
dplyr::mutate(date = as.Date(date)) %>%
dplyr::group_by(month = format(date, "%Y-%m")) %>%
dplyr::summarise(mean = mean(new_var_i), .groups='drop')
#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)
# combine all files
# note: sliderInput needs numeric data, so I converted values of "var" to numeric
final <- rbind(result_1, result_2)
final$var <- as.integer(as.character(final$var))
return(final)
}
final <- gendata()
ui <- fluidPage(
fluidRow(column=12,
plotlyOutput("lineplot")),
fluidRow(column=12,
# create slider for group a
sliderInput("groupa", "Group A:",
min = min(final$var), max = max(final$var),
value = min(final$var), step = 1,
animate =
animationOptions(interval = 300, loop = FALSE),
width='95%')),
fluidRow(column=12,
# create slider for group b
sliderInput("groupb", "Group B:",
min = min(final$var), max = max(final$var),
value = min(final$var), step = 1,
animate =
animationOptions(interval = 300, loop = FALSE),
width='95%')))
server <- function(input, output, session){
# create a reactive dataframe with filtered data for group a at current value of var
df.a <- reactive({
final %>% dplyr::filter(group == 'group_a') %>%
dplyr::filter(var == input$groupa)
})
# create a reactive dataframe with filtered data for group b at current value of var
df.b <- reactive({
final %>% dplyr::filter(group == 'group_b') %>%
dplyr::filter(var == input$groupb)
})
# Create plotly with filtered data
output$lineplot <- renderPlotly({
plot_ly() %>%
add_trace(data=df.a(), x=~month, y=~mean, color=~group, type = 'scatter', mode = 'lines', colors = 'Set1') %>%
add_trace(data=df.b(), x=~month, y=~mean, color=~group, type = 'scatter', mode = 'lines', colors = 'Set1')
})
}
shinyApp(ui, server)