R [Блестящий]: Проблемы с реализацией ящиков значений, реагирующих на ввод dateRangeInput

#r #shiny #shinydashboard #shinyapps

Вопрос:

Я только начал изучать пакеты shiny amp; shinydashboard в R. Я пытаюсь собрать базовую панель мониторинга, которая просматривает набор данных 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)
 

Ответ №1:

Создайте фрейм данных, который вы хотите использовать в приложении ( kpi.top5.life ) reactive .

 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)
 

введите описание изображения здесь