【问题标题】:Shiny: Create reactive filter using different variables.Shiny:使用不同的变量创建反应式过滤器。
【发布时间】:2017-08-14 22:15:12
【问题描述】:

我有一个数据框,它将社会人口统计数据与多个网站的意识测量相结合。每个网站都有一个单独的列,说明此人是否知道该网站(“是”/“否”)。此外,每个受访者都应该根据他出席的人数来加权(变量 popWeight)。

我想创建一个闪亮的应用程序,为知道所选网站的人显示图表。该网站应该可以通过 selectInput () 按钮进行选择。

我发现了几篇关于 stackoverflow 的文章,其中涵盖了使用 dplyr+shiny 的数据集过滤器。但是它们都改变了变量值而不是变量本身。

我尝试使用以下方法,但没有成功(编码示例见下文)。

[Use shiny text input and dplyr to filter rows in a dataframe

示例数据框:

gender <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Male", "Female", "Missing Value"))
age <- sample(18:55, 5, replace=TRUE)
web1 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value"))
web2 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value"))
web3 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value"))
web4 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value"))
web5 <- factor(sample(1:2, 5, replace=TRUE), levels = c(1,2,99), labels = c("Yes", "No", "Missing Value"))
popWeight <- sample(1000:1500, 5, replace=TRUE)

df <- data.frame(gender, age, web1, web2, web3, web4, web5, popWeight)
df

我想以交互方式做的事情:

library(ggplot2)
library(dplyr)

df1 <- filter (df, web1 == "Yes")

ggplot(df1)+
  aes(x=gender, y=popWeight/sum(popWeight))+
  stat_summary(fun.y = sum, geom = "bar")+
  scale_y_continuous("Population (%)", labels = scales::percent)

我尝试了什么

library(shiny)
library(ggplot2)
library(dplyr)

ui <- fluidPage(
  selectInput(inputId = "WebsiteName", label = "Choose a Website", choices = names(df) [c(3:7)]),
  plotOutput("Gender")
)


server <- function(input, output) {

  dfInput <- reactive({
    df %>% filter (input$WebsiteName == "Yes")
  })

  output$Gender <- renderPlot({
    df1 <- dfInput()
    ggplot(df1)+
      aes(x=gender, y=popWeight/sum(popWeight))+
      stat_summary(fun.y = sum, geom = "bar")+
      scale_y_continuous("Population (%)", labels = scales::percent)
  })
}


shinyApp(ui = ui, server = server)

有没有办法改变过滤器变量而不是值?我也愿意接受其他解决方案。

【问题讨论】:

    标签: r filter shiny dplyr


    【解决方案1】:

    您可以tidy您的数据集,以更有用的方式对其进行转换,并为您省去一些麻烦:

    整洁的数据集

    df<- df %>% 
        gather(web, value, -age, -gender, -popWeight)
    

    用户界面

    更改了 selectInput 选项

    ui <- fluidPage(
      selectInput(inputId = "websiteName", 
                  label = "Choose a Website", 
                  choices = unique(df$web)),
      plotOutput("Gender")
    )
    

    服务器

    更新了反应式表达

    server <- function(input, output) {
    
      dfInput <- reactive({
        df %>% filter(web == input$websiteName & value == "Yes")
      })
    
      output$Gender <- renderPlot({
        df1 <- dfInput()
        ggplot(df1) +
          aes(x = gender, y = popWeight / sum(popWeight)) +
          stat_summary(fun.y = sum, geom = "bar") +
          scale_y_continuous("Population (%)", labels = scales::percent)
      })
    }
    

    【讨论】:

      【解决方案2】:

      我认为您需要添加第二个 UI,该 UI 取决于第一个选择的变量。在这里,我使用 renderUI() 在服务器中创建了它。然后,我使用所选的列对数据进行子集化,该列等于所选变量。希望这会有所帮助。

      library(shiny)
      library(ggplot2)
      library(dplyr)
      
      ui <- fluidPage(
        selectInput(inputId = "WebsiteName", label = "Choose a Website", choices = names(df) [c(3:7)]),
        htmlOutput("variableUI"),
        plotOutput("Gender")
      )
      
      
      server <- function(input, output) {
      
        output$variableUI <- renderUI({
          selectInput(inputId = "variable", label = "Choices", choices = df[,input$WebsiteName])
        })
      
        dfInput <- reactive({
         ##subsetting is a bit tricky here to id the column on which to subset        
          df[ df[ , input$WebsiteName ] == input$variable, ]
        })
      
        output$Gender <- renderPlot({
          df1 <- dfInput()
          ggplot(df1)+
            aes(x=gender, y=popWeight/sum(popWeight))+
            stat_summary(fun.y = sum, geom = "bar")+
            scale_y_continuous("Population (%)", labels = scales::percent)
        })
      }
      
      
      shinyApp(ui = ui, server = server)
      

      【讨论】:

        猜你喜欢
        • 2018-10-11
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2015-07-08
        • 2018-01-30
        • 2018-12-29
        相关资源
        最近更新 更多