添加多个“滑块"，然后单击“确定".到同一张图 [英] Adding Multiple "sliders" to the same Graph

问题描述

我正在使用R编程语言.使用"plotly"模式库中，我可以制作以下交互式图形:

 库(dplyr)库(ggplot2)图书馆(闪亮)图书馆(密谋)库(htmltools)图书馆(dplyr)#生成数据set.seed(123)var = rnorm(731，100,25)date = seq(as.Date("2014/1/1")，as.Date("2016/1/1")，by ="day")数据= data.frame(var，date)值<-90:100结合<-vector('list'，length(vals))计数<-0为(以val为单位){数据$ var_i =我data $ new_var_i = ifelse(数据$ var> i，1,0)#大于i的观察值的百分比(每个月)aggregate_i =数据％>％mutate(date = as.Date(date))％&％group_by(month = format(date，％Y-％m"))％&％摘要(均值=均值(new_var_i))#将文件合并在一起gregate_i $ var =我aggregate_i $ var = as.factor(aggregate_i $ var)计数<-计数+ 1组合[[count]]< -gregate_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.frame(var，date)值<-90:100结合<-vector('list'，length(vals))计数<-0为(以val为单位){数据$ var_i =我data $ new_var_i = ifelse(数据$ var> i，1,0)#大于i的观察值的百分比(每个月)aggregate_i =数据％>％mutate(date = as.Date(date))％&％group_by(month = format(date，％Y-％m"))％&％摘要(均值=均值(new_var_i))#将文件合并在一起gregate_i $ var =我aggregate_i $ var = as.factor(aggregate_i $ var)计数<-计数+ 1组合[[count]]< -gregate_i}result_2<-bind_rows(combine)result_2 $ group ="group_b";result_2 $ group = as.factor(result_2 $ group)#合并所有文件最终= rbind(结果_1，结果_2)gg< -ggplot(final，aes(frame = var，color = group))+ geom_line(aes(x = month，y = mean，group = 1))+主题(axis.text.x = element_text(angle =90))+ ggtitle("title")gg = ggplotly(gg) 

现在，我正在尝试制作两个单独的滑块":一个滑块"对于"group_a"另一个滑块"代表"group_b".看起来像这样:

我的逻辑是，框架""ggplot()"中的自变量语句应具有两个级别:

  gg< -ggplot(final，aes(frame = c(var，group)，color = group))+ geom_line(aes(x = month，y = mean，group = 1))+主题(axis.text.x = element_text(angle = 90))+ ggtitle("title")gg错误:美学的长度必须为1或与数据(550)相同:帧 

有人可以告诉我如何解决此问题吗?

谢谢

解决方案

我认为您无法使用标准的 plotly API来做到这一点.

我认为在这种情况下，最好使用 shiny 并创建一个Web应用程序.您可以根据需要添加任意数量的滑块，然后根据需要过滤数据以更新绘图.

这样做的缺点是您只是用新数据重画了情节，而不是像以前那样制作动画.因此，您最终失去了以前的平稳过渡.

实际上，有一种方法可以保持我不知道的动画效果，但是您需要更深入地研究 shiny / plotly .看看

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

解决方案

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)

这篇关于添加多个“滑块"，然后单击“确定".到同一张图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！