问题
I am using the R programming language. Using the "plotly" library, I was able to make the following interactive graph:
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)
######
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)
#combine all files
final = rbind(result_1, result_2)
gg <-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")
gg = ggplotly(gg)
Now, I am trying to make two separate "sliders" : one "slider" for "group_a" and another "slider" for "group_b". Something that looks like this:
My logic is, the "frame" argument within the "ggplot()" statement should have two levels:
gg <-ggplot(final, aes(frame = c(var,group), color = group)) + geom_line(aes(x=month, y=mean, group=1))+ theme(axis.text.x = element_text(angle=90)) + ggtitle("title")
gg
Error: Aesthetics must be either length 1 or the same as the data (550): frame
Can someone please show me how to fix this?
Thanks
回答1:
I don't think you can do this with the standard plotly API.
I think for cases like this it is better to use shiny and create a web application. You can add as many sliders as you need and then filter the data as needed to update the plots.
The downside to this is that you are just redrawing the plots with new data, as opposed to doing animations like before. So you end up loosing the smooth transitions that you had before.
There is actually a way of keeping the animation aspect that I didn't know, but you need to go deeper into shiny/plotly. Take a look at this link. I didn't know about this, so I didn't try to do it. But i will take a look at it later!
Here is my solution with shiny:
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)
来源：https://stackoverflow.com/questions/66109378/adding-multiple-sliders-to-the-same-graph