Блестящая приборная панель. Динамический пользовательский интерфейс с более чем одним selectInput на лунку панели

У меня есть набор данных, который показывает для набора веб-сайтов, используется ли каждый из них регулярно (да / нет на веб-сайте) и когда он использовался в последний раз (вчера / на прошлой неделе / ​​... на веб-сайт). Я хочу создать Shiny Dashboard с динамическим пользовательским интерфейсом, который показывает социально-демографические профили веб-сайтов для двух выбранных веб-сайтов рядом друг с другом, отфильтрованные либо по использованию веб-сайта, либо по его охвату.

Структура динамического интерфейса:

Выберите тип фильтра (1) Использование веб-сайта против (2) Доступ к веб-сайту

В случае использования сайта:

Выберите 1-й веб-сайт (web1-web5)

Выберите 2-й веб-сайт (web1-web5)

В случае использования сайта:

Выберите 1-й веб-сайт (web1-web5)

Выберите Reach 1st Website (ежедневно, еженедельно, ежемесячно, ежегодно)

Выберите 2-й веб-сайт (web1-web5)

Выберите Reach 2nd Website (ежедневно, еженедельно, ежемесячно, ежегодно)

Я попробовал следующее решение от Rstudio: Руководство по динамическому интерфейсу от Rstudio

Моя проблема заключается в том, что решение с использованием "switch" позволяет только одно поле selectInput для каждой скважины. Таким образом, я не могу установить дополнительные фильтры для второго сайта. Есть ли обходной путь или другое решение, не использующее переключатель?

Примерный фрейм данных

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

Следующий код, как далеко я получил. Но я не могу создать динамический интерфейс, который позволяет мне заполнять второй столбец панели инструментов графикой для второго веб-сайта. 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)
Источник

3 ответа

Решение

Есть несколько способов, которые могут помочь вам достичь того, что вам нужно, например, вы можете использовать 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).

Источник

Вы можете вернуть все, что вы хотите в 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 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)
Источник
Другие вопросы по тегам