使用输入响应式地调用响应式列表中的数据框？

Question

我有一个简单闪亮的应用程序，其中加载了列表。我正在尝试使用一些用户输入来调用所需的数据。虽然当我使用 paste0 创建列表和数据框的名称时，它没有被调用。

如下图所示：我有两个值框。第一个我只是调用完整的 list/dataframe 即 Store1_2021$Bakery %>% nrow().

第二个 1 我正在使用 paste0() 函数尝试复制，但它打印为文本而不是调用数据框。

我不确定这是否是最佳做法，但如果有人有任何解决方案，我将不胜感激。

## app.R ##
library(shiny)
library(shinydashboard)

Store1_2021 <- list(Bakery = structure(list(Sales = c(23, 33, 124, 133), Item = c("Bread", 
                                                                                  "Bread", "Bread", "Torillas"), Units = c(1, 3, 2, 4)), row.names = c(NA, 
                                                                                                                                                       -4L), class = "data.frame"), Electronics = structure(list(Sales = c(23, 
                                                                                                                                                                                                                           33, 124, 133), Item = c("Tv", "Tv", "Tv", "Speaker"), Units = c(1, 
                                                                                                                                                                                                                                                                                           3, 2, 4)), row.names = c(NA, -4L), class = "data.frame"))
Store2_2021 <- list(Bakery = structure(list(Sales = c(23, 133, 124, 23), Item = c("Bread", 
                                                                                  "Torillas", "Bread", "Bread"), Units = c(1, 3, 2, 4)), row.names = c(NA, 
                                                                                                                                                       -4L), class = "data.frame"), Electronics = structure(list(Sales = c(23, 
                                                                                                                                                                                                                           33, 124, 12), Item = c("Speaker", "Tv", "Tv", "Speaker"), Units = c(1, 
                                                                                                                                                                                                                                                                                               3, 2, 4)), row.names = c(NA, -4L), class = "data.frame"))

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("store","Select Store:", choices = c(1,2)),
    selectInput("department", "Select Department:", choices = c("Bakery","Electronics"))
  ),
  dashboardBody(
    fluidRow(
    valueBoxOutput("box1"),
    valueBoxOutput("box2")

    )
  )
)

server <- function(input, output) { 
  
  output$box1 <- renderValueBox({
    valueBox(
      Store1_2021$Bakery %>% nrow()
      
      ,
      
      "No of Transactions (rows)",
      icon = icon("users"),
      color = "blue"
    )
  })
  
  output$box2 <- renderValueBox({
    valueBox(
      
      paste0("Store",input$store,"_2021","$",input$department)
      
      ,
      
      "No of Transactions (rows)",
      icon = icon("users"),
      color = "blue"
    )
  })
  
}

shinyApp(ui, server)

Answer 1

试试这个

## app.R ##
library(shiny)
library(shinydashboard)

Store1_2021 <- list(Bakery = structure(list(Sales = c(23, 33, 124, 133), Item = c("Bread", 
                                                                                  "Bread", "Bread", "Torillas"), Units = c(1, 3, 2, 4)), row.names = c(NA, 
                                                                                                                                                       -4L), class = "data.frame"), Electronics = structure(list(Sales = c(23, 
                                                                                                                                                                                                                           33, 124, 133), Item = c("Tv", "Tv", "Tv", "Speaker"), Units = c(1, 
                                                                                                                                                                                                                                                                                           3, 2, 4)), row.names = c(NA, -4L), class = "data.frame"))
Store2_2021 <- list(Bakery = structure(list(Sales = c(23, 133, 124, 23), Item = c("Bread", 
                                                                                  "Torillas", "Bread", "Bread"), Units = c(1, 3, 2, 4)), row.names = c(NA, 
                                                                                                                                                       -4L), class = "data.frame"), Electronics = structure(list(Sales = c(23, 
                                                                                                                                                                                                                           33, 124, 12), Item = c("Speaker", "Tv", "Tv", "Speaker"), Units = c(1, 
                                                                                                                                                                                                                                                                                               3, 2, 4)), row.names = c(NA, -4L), class = "data.frame"))

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("store","Select Store:", choices = c(1,2)),
    selectInput("department", "Select Department:", choices = c("Bakery","Electronics"))
  ),
  dashboardBody(
    fluidRow(
      valueBoxOutput("box1"),
      valueBoxOutput("box2")
      
    )
  )
)

server <- function(input, output) { 
  
  output$box1 <- renderValueBox({
    valueBox(
      Store1_2021$Bakery %>% nrow()
      
      ,
      
      "No of Transactions (rows)",
      icon = icon("users"),
      color = "blue"
    )
  })
  
  mystore <- reactive({get(sprintf("Store%s_2021",input$store))})
  
  mydept <- eventReactive(c(mystore(),input$department), {
    mystore()[[input$department]]
  })
  
  output$box2 <- renderValueBox({
    valueBox(
      
      nrow(mydept())
      ,
      
      "No of Transactions (rows)",
      icon = icon("users"),
      color = "red"
    )
  })
  
}

shinyApp(ui, server)

Answer 2

另一种选择是

  output$box2 <- renderValueBox({
    valueBox(
      .GlobalEnv[[glue("Store{input$store}_2021")]][[input$department]] %>%
        nrow(),
      "No of Transactions (rows)",
      icon = icon("users"),
      color = "blue"
    )
  })