R [Shiny]：实现对 dateRangeInput 有反应的值框的问题

Question

我刚刚开始探索 R 中的 shiny 和 shinydashboard 包。我正在尝试将一个基本的仪表板放在一起以查看 gapminder 数据集。我正在尝试在页面顶部放置一些类似 KPI 的图块，以显示前 5 个国家/地区的预期寿命，对应于 dateRangeInput 中选择的年份的结束日期。当我尝试过滤数据子集以将年份限制为日期范围内的结束年份时，我遇到了问题（请参阅下面的代码）。在运行时，我返回了以下错误：

# Warning: Error in : Problem with `filter()` input `..1`.
# comparison (1) is possible only for atomic and list types
# Input `..1` is `year == var_maxDate`.

如有任何帮助，我们将不胜感激。

提前致谢:)

library(shiny)
library(tidyverse)
library(shinydashboard)
library(gapminder)

# LOAD DATA ----
data <- gapminder %>% as_tibble() %>% arrange(country, year)

# UI ----
ui <- dashboardPage(skin = "yellow",
    dashboardHeader(title = "Shiny Dashboard"),
    dashboardSidebar(
        sidebarMenu(id = "tabs",
                    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
                             menuSubItem("Life Expectancy", tabName = "life"),
                             menuSubItem("GDP Per Capita", tabName = "gdp")),
                    menuItem("Linear Modelling", icon = icon("th"), tabName = "lm", badgeLabel = "new", badgeColor = "green"),
                    dateRangeInput("dateRange", "Date range:", start = paste(min(data$year),"01-01",sep="-"),
                                   end = paste(max(data$year),"01-01",sep="-"), format = "yyyy"))),
    dashboardBody(
        tabItems(
            
            # Life Expectancy Page Content
            tabItem(tabName = "life",
                    splitLayout(
                            valueBoxOutput("kpi.top5.life1", width = NULL),
                            valueBoxOutput("kpi.top5.life2", width = NULL),
                            valueBoxOutput("kpi.top5.life3", width = NULL),
                            valueBoxOutput("kpi.top5.life4", width = NULL),
                            valueBoxOutput("kpi.top5.life5", width = NULL)
                    )),
            
            # GDP Page Content
            tabItem(tabName = "gdp"),
            
            # LM Page Content
            tabItem(tabName = "lm",
                    h2("Simple Linear Regression"))
            
        )
    )
)

# SERVER ----
server <- function(input, output) {
  
    var_maxDate <- reactive({as.integer(format(input$dateRange[2], "%Y"))})
    
    kpi.top5.life <- data %>% filter(year == var_maxDate) %>% slice_max(n = 5, order_by = lifeExp)
    # kpi.btm5.life <- data %>% filter(year == max(year)) %>% slice_min(n = 5, order_by = lifeExp)
    # kpi.top5.gdp <- data %>% filter(year == max(year)) %>% slice_max(n = 5, order_by = gdpPercap)
    # kpi.btm5.gdp <- data %>% filter(year == max(year)) %>% slice_min(n = 5, order_by = gdpPercap)
     
    # Value Boxes - Top 5 KPIs | Life Expectancy
    output$kpi.top5.life1 <- renderValueBox({
        valueBox(paste(round(kpi.top5.life$lifeExp[1],1), "years"),
                 kpi.top5.life$country[1], icon = icon("heart"), color = "green")
    })
    
    output$kpi.top5.life2 <- renderValueBox({
        valueBox(paste(round(kpi.top5.life$lifeExp[2],1), "years"),
                 kpi.top5.life$country[2], icon = icon("heart"), color = "green")
    })
    
    output$kpi.top5.life3 <- renderValueBox({
        valueBox(paste(round(kpi.top5.life$lifeExp[3],1), "years"),
                 kpi.top5.life$country[3], icon = icon("heart"), color = "green")
    })
    
    output$kpi.top5.life4 <- renderValueBox({
        valueBox(paste(round(kpi.top5.life$lifeExp[4],1), "years"),
                 kpi.top5.life$country[4], icon = icon("heart"), color = "green")
    })
    
    output$kpi.top5.life5 <- renderValueBox({
        valueBox(paste(round(kpi.top5.life$lifeExp[5],1), "years"),
                 kpi.top5.life$country[5], icon = icon("heart"), color = "green")
    })
    
}

shinyApp(ui, server)

Answer 1

通过 reactive 中的应用程序 (kpi.top5.life) 创建要使用的数据框。

var_maxDate <- reactive({
    val <- as.integer(format(input$dateRange[2], "%Y"))
    data %>% filter(year == val) %>% slice_max(n = 5, order_by = lifeExp)
    })

您可以在应用程序中将此数据引用为var_maxDate()。

完整代码-

library(shiny)
library(tidyverse)
library(shinydashboard)
library(gapminder)

# LOAD DATA ----
data <- gapminder %>% as_tibble() %>% arrange(country, year)

# UI ----
ui <- dashboardPage(skin = "yellow",
                    dashboardHeader(title = "Shiny Dashboard"),
                    dashboardSidebar(
                      sidebarMenu(id = "tabs",
                                  menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
                                           menuSubItem("Life Expectancy", tabName = "life"),
                                           menuSubItem("GDP Per Capita", tabName = "gdp")),
                                  menuItem("Linear Modelling", icon = icon("th"), tabName = "lm", badgeLabel = "new", badgeColor = "green"),
                                  dateRangeInput("dateRange", "Date range:", start = paste(min(data$year),"01-01",sep="-"),
                                                 end = paste(max(data$year),"01-01",sep="-"), format = "yyyy"))),
                    dashboardBody(
                      tabItems(
                        
                        # Life Expectancy Page Content
                        tabItem(tabName = "life",
                                splitLayout(
                                  valueBoxOutput("kpi.top5.life1", width = NULL),
                                  valueBoxOutput("kpi.top5.life2", width = NULL),
                                  valueBoxOutput("kpi.top5.life3", width = NULL),
                                  valueBoxOutput("kpi.top5.life4", width = NULL),
                                  valueBoxOutput("kpi.top5.life5", width = NULL)
                                )),
                        
                        # GDP Page Content
                        tabItem(tabName = "gdp"),
                        
                        # LM Page Content
                        tabItem(tabName = "lm",
                                h2("Simple Linear Regression"))
                        
                      )
                    )
)

# SERVER ----
server <- function(input, output) {
  
  var_maxDate <- reactive({
    val <- as.integer(format(input$dateRange[2], "%Y"))
    data %>% filter(year == val) %>% slice_max(n = 5, order_by = lifeExp)
    })
  
    
  # kpi.btm5.life <- data %>% filter(year == max(year)) %>% slice_min(n = 5, order_by = lifeExp)
  # kpi.top5.gdp <- data %>% filter(year == max(year)) %>% slice_max(n = 5, order_by = gdpPercap)
  # kpi.btm5.gdp <- data %>% filter(year == max(year)) %>% slice_min(n = 5, order_by = gdpPercap)
  
  # Value Boxes - Top 5 KPIs | Life Expectancy
  output$kpi.top5.life1 <- renderValueBox({
    valueBox(paste(round(var_maxDate()$lifeExp[1],1), "years"),
             var_maxDate()$country[1], icon = icon("heart"), color = "green")
  })
  
  output$kpi.top5.life2 <- renderValueBox({
    valueBox(paste(round(var_maxDate()$lifeExp[2],1), "years"),
             var_maxDate()$country[2], icon = icon("heart"), color = "green")
  })

  output$kpi.top5.life3 <- renderValueBox({
    valueBox(paste(round(var_maxDate()$lifeExp[3],1), "years"),
             var_maxDate()$country[3], icon = icon("heart"), color = "green")
  })

  output$kpi.top5.life4 <- renderValueBox({
    valueBox(paste(round(var_maxDate()$lifeExp[4],1), "years"),
             var_maxDate()$country[4], icon = icon("heart"), color = "green")
  })

  output$kpi.top5.life5 <- renderValueBox({
    valueBox(paste(round(var_maxDate()$lifeExp[5],1), "years"),
             var_maxDate()$country[5], icon = icon("heart"), color = "green")
  })

}

shinyApp(ui, server)

R [Shiny]：实现对 dateRangeInput 有反应的值框的问题

R [Shiny]: Issues implementing valueboxes that are reactive to a dateRangeInput

r

shiny

shinydashboard

shinyapps