【问题标题】:Shiny Dashboard. Dynamic UI with more than one selectInput per wellPanel闪亮的仪表板。每个 wellPanel 具有多个 selectInput 的动态 UI
【发布时间】:2017-11-30 05:08:55
【问题描述】:

我有一个数据集,显示一组网站是否经常使用(每个网站是/否)以及上次使用的时间(昨天/上周/...每个网站)。 我想构建一个带有动态 UI 的闪亮仪表板,显示两个相邻的选定网站的社会人口统计网站配置文件,按网站使用情况或网站覆盖范围进行过滤。

动态 UI 的结构:

选择过滤器类型 (1) 网站使用率 vs (2) 网站覆盖率

如果是“网站使用”:

选择第一个网站 (web1-web5)

选择第二个网站 (web1-web5)

如果是网站覆盖率:

选择第一个网站 (web1-web5)

选择到达第一个网站(每天、每周、每月、每年)

选择第二个网站 (web1-web5)

选择到达第二个网站(每天、每周、每月、每年)

我尝试了 Rstudio 的以下解决方案: Dynamic UI Guide from Rstudio

我的问题是,使用“switch”的解决方案只允许每个 wellPanel 有一个 selectInput 字段。像这样我不能为第二个网站添加额外的过滤器。是否有不使用 switch 的解决方法或不同的解决方案?

示例数据框

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"))
web1Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
                  labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
web2Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
                  labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
web3Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
                  labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
web4Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
                  labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
web5Rch <- factor(sample(1:4, 5, replace = TRUE), levels = c(1,2,3,4,99), 
                  labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
popWeight <- sample(1000:1500, 5, replace = TRUE)

df <- data.frame(gender, age, web1, web2, web3, web4, web5, web1Rch, 
                 web2Rch, web3Rch, web4Rch, web5Rch, popWeight)
df

以下代码是我走了多远。但我无法创建一个动态 UI,允许我使用第二个网站的图形填充第二个仪表板列。 Switch 不允许我放置两个 selectInput 字段。

示例代码

library(shiny)
library (tidyr)
library (dplyr)
library(ggplot2)
library(scales)

# Create Two Versions of Data Frame for "Regular Usage" and "Reach"

dfRegular <- df[,c(1:7,13)] %>% 
  gather(web, value, -age, -gender, -popWeight)

dfReach <- df[,c(1:2,8:13)] %>% 
  gather(web, value, -age, -gender, -popWeight)

# Code for Shiny App    
ui <- fluidPage(      
  titlePanel ("Website Profile"),      
  br(),      
  fluidRow(                   
    column(2,
           wellPanel(
             selectInput(inputId = "evalType", label = "Choose Evaluation", 
                         choices = c("Regular", "Reach"))
           ),             
           wellPanel(uiOutput("ui"))
    ),               
    column(5, plotOutput("Gender")),                 
    column(5, plotOutput("Gender1"))
  )  
)

server <- function(input, output) {
  # Output UI
  output$ui <- renderUI({
    if(is.null(input$evalType))
      return()        
    switch(
      input$evalType,
      "Regular" = selectInput(
        inputId = "websiteName", label = "Choose first Website", 
        choices = unique(dfRegular$web)), 
      "Reach" = selectInput(
        inputId = "reachWeb", label = "Choose Reach (second Website)", 
        choices = c("web1Rch", "web2Rch", "web3Rch", "web4Rch", "web5Rch"))
    )       
  })

  output$evalTypeText <- renderText({
    input$evalType
  })    

  dfInput <- reactive({
    dfRegular %>% 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)
  })      

  dfInput <- reactive({
    dfRegular %>% filter(web == input$websiteName & value == "Yes")
  })

  output$Gender1 <- 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 shiny dashboard dynamic-ui


    【解决方案1】:

    有几种方法可以帮助您实现所需,例如,您可以使用 conditionalPanel 代替:

    [更新]

    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"))
    web1Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
    web2Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
    web3Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
    web4Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
    web5Rch <- factor(sample(1:4, 5, replace=TRUE), levels = c(1,2,3,4,99), labels = c("Daily", "Weekly", "Monthly", "Yearly", "Missing Value"))
    popWeight <- sample(1000:1500, 5, replace=TRUE)
    
    df <- data.frame(gender, age, web1, web2, web3, web4, web5, web1Rch, web2Rch, web3Rch, web4Rch, web5Rch, popWeight)
    df
    
    library(shiny)
    library (tidyr)
    library (dplyr)
    library(ggplot2)
    library(scales)
    
    # Create Two Versions of Data Frame for "Regular Usage" and "Reach"
    
    dfRegular <- df[,c(1:7,13)] %>% 
      gather(web, value, -age, -gender, -popWeight)
    
    dfReach <- df[,c(1:2,8:13)] %>% 
      gather(web, value, -age, -gender, -popWeight)
    
    
    # Code for Shiny App
    
    ui <- fluidPage(
    
      titlePanel ("Website Profile"),
    
      br(),
    
      fluidRow(
    
        column(2,
               wellPanel(
                 selectInput(inputId = "evalType", label = "Choose Evaluation", choices = c("Regular", "Reach"))
               ),
    
               wellPanel(
                 conditionalPanel(condition="input.evalType == 'Regular'",
                                  selectInput(inputId = "websiteName", label = "Choose first Website", choices = unique(dfRegular$web))),
                 conditionalPanel(condition="input.evalType == 'Regular'",
                                  selectInput(inputId = "websiteName2", label = "Choose second Website", choices = unique(dfRegular$web))),
                 conditionalPanel(condition="input.evalType == 'Reach'",
                                  selectInput(inputId = "websiteName3", label = "Choose first Website", choices = unique(dfRegular$web))),
                 conditionalPanel(condition="input.evalType == 'Reach'",
                                  selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly"))),
                 conditionalPanel(condition="input.evalType == 'Reach'",
                                  selectInput(inputId = "websiteName4", label = "Choose first Website", choices = unique(dfRegular$web))),
                 conditionalPanel(condition="input.evalType == 'Reach'",
                                  selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly"))))
        )
      ,
    
      column(5,
             plotOutput("Gender")
      ),
    
      column(5,
             plotOutput("Gender1")
      ))
    )  
    
    
    
    
    server <- function(input, output) {
    
      dfInput <- reactive({
        dfRegular %>% 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)
      })
    
    
      dfInput1 <- reactive({
        dfRegular %>% filter(web == input$websiteName2 & value == "Yes")
      })
    
      output$Gender1 <- renderPlot({
        df1 <- dfInput1()
        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)
    

    if...else statement

    您正在使用的switch 函数当时仅适用于一个小部件,因此您需要创建多个output$ui(基于switch)。

    【讨论】:

    • 感谢这完美的作品。但由于某种原因,它弄乱了我的列布局。 ui 显示在图形上方而不是旁边。
    【解决方案2】:

    你可以在renderUI 中返回任何你想要的东西,只要它属于shiny.tag 类。例如

    # context server
    output$ui <- renderUI({
      if (input$evalType == "regular")
        return(actionButton("some_id", "you clicked option regular"))
      else
        return(icon("bolt"))
    })
    

    【讨论】:

    • 您好 Gregor,感谢您的回答。使用此解决方案,我会收到与“switch”代码示例相同的错误消息。 “不允许多参数返回”。是否有可能将两个 selctInputs 返回到一个 wellPanel 中?
    • 当您输入类似return(a,b) 的内容时,通常会发生此错误。您确定您没有将多个值传递给 return 函数吗?
    • 你是对的。将 selectInput() 按钮作为列表返回后,现在一切正常。我会把完整的答案写成下面的代码。
    【解决方案3】:

    我使用了来自@Gregor de Cillia 的输入。以下代码最终对我来说效果最好。

    library(shiny)
    library (tidyr)
    library (dplyr)
    library(ggplot2)
    library(scales)
    
    # Create Two Versions of Data Frame for "Regular Usage" and "Reach"
    
    dfRegular <- df[,c(1:7,13)] %>% 
      gather(web, value, -age, -gender, -popWeight)
    
    dfReach <- df[,c(1:2,8:13)] %>% 
      gather(web, value, -age, -gender, -popWeight)
    
    
    # Code for Shiny App    
    ui <- fluidPage(      
      titlePanel ("Website Profile"),      
      br(),      
      fluidRow(                   
        column(2,
               wellPanel(
                 selectInput(inputId = "evalType", label = "Choose Evaluation", 
                             choices = c("Regular", "Reach"))
               ),             
               wellPanel(uiOutput("ui"))
        ),               
        column(5, plotOutput("Gender")),                 
        column(5, plotOutput("Gender1"))
      )  
    )
    
    server <- function(input, output) {
    
    # Output UI
      output$ui <- renderUI({
        if (input$evalType == "Regular")
          return(
            list(uiWeb1 = selectInput(inputId = "websiteName1", label = "Choose first Website", choices = unique(dfRegular$web)),
                 uiWeb2 = selectInput(inputId = "websiteName2", label = "Choose second Website", choices = unique(dfRegular$web)))
          )
    
        else if(input$evalType == "Reach")
          return(
            list(uiRch1 = selectInput(inputId = "websiteName3", label = "Choose first Website", choices = unique(dfReach$web)),
                 uiRch2 = selectInput(inputId = "reach1", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly")),
                 uiRch3 = selectInput(inputId = "websiteName4", label = "Choose second Website", choices = unique(dfReach$web)),
                 uiRch4 = selectInput(inputId = "reach2", label = "Choose Reach", choices = c("daily","weekly","monthly","yearly"))
                 )
          )
    
        else 
          return(icon("bolt"))
      })
    
      dfInput1 <- reactive({
        dfRegular %>% filter(web == input$websiteName1 & value == "Yes")
      })
    
      output$Gender <- renderPlot({
        df1 <- dfInput1()
        ggplot(df1) +
          aes(x = gender, y = popWeight / sum(popWeight)) +
          stat_summary(fun.y = sum, geom = "bar") +
          scale_y_continuous("Population (%)", labels = scales::percent)
      })      
    
      dfInput2 <- reactive({
        dfRegular %>% filter(web == input$websiteName2 & value == "Yes")
      })
    
      output$Gender1 <- renderPlot({
        df1 <- dfInput2()
        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)
    

    【讨论】:

      猜你喜欢
      • 2019-05-25
      • 2018-05-30
      • 2019-07-26
      • 2019-07-26
      • 2016-08-12
      • 2016-01-11
      • 2018-07-07
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多