renderPlot：从数据框中的多列中选择输入

Question

我正在创建一个闪亮的应用程序，它将显示多年来在特定地点进行的所有项目的直方图。但是，我使用的数据有多列用于位置（location_1，location_2，...等）和其他类别，如author_1，author_2等（也就是说，我无法重新创建数据框以拥有一列位置而不创建指数级更大的 df）。我的实际数据有几百行，这只是一个简化版本。 目前我的代码如下所示：

数据：

df  <- data.frame(
  title = c("Project 1", "Project 2", "Project 3"),
  year = c(2021, 2020, 2023),
  author_1 = c("Bob", "Jane", "Taylor"),
  author_2 = c("Alex", "Ann", NA),
  author_3 = c("Charlie", NA, NA),
  location_1 = c("London", "Berlin", "Paris"),
  location_2 = c("Beijing", "Delhi", NA),
  location_3 = c("New York City", NA, NA)
)

ui

library(shiny)
library(tidyverse)

ui <- fluidPage(sliderInput(inputId = "year", 
                            label = "Project Funding Year:",
                            min = min(df$year),
                            max = max(df$year),
                            value = c(min(df$year), max(df$year)),
                            sep = "",
                            step = 1),
                selectInput(inputId = "location",
                            label = "Location",
                            choices = list("London", "Berlin", "Paris", "Beijing", "Delhi", "New York City")),
                plotOutput(outputId = "histogram")
                
)

服务器

server <- function(input, output, session) {
  output$histogram <- renderPlot(
    df %>% filter(year == input$year,
                  location_1 == input$location) %>% 
      ggplot(aes(x = location_1))+
      geom_histogram(stat = "count")
    
  )
}

shinyApp(ui, server)

例如，在 renderPlot 的输入中是否可以从数据框中的多个列（例如 location_1、location_2，...等）中选择输入？感谢您的任何建议！

Answer 1

将我的建议付诸行动...

首先，一个实用函数来整理一组列（例如

location_1

、

location_2

和

location_3

）...

pivot_column_set <- function(colName, d) {
  d %>% 
    pivot_longer(
      starts_with(colName),
      names_to = "index",
      values_to = "value",
      names_prefix = paste0(colName, "_") 
    ) %>% 
    mutate(source = colName) %>% 
    select(title, year, index, source, value)
}

[请注意，这不是我通常编写这样的函数的方式。 由于多种原因，它不符合 tidyverse 的精神。它又快又脏，但它有效......]

例如给予

pivot_column_set("location", df)
# A tibble: 9 × 5
  title      year index source   value        
  <chr>     <dbl> <chr> <chr>    <chr>        
1 Project 1  2021 1     location London       
2 Project 1  2021 2     location Beijing      
3 Project 1  2021 3     location New York City
4 Project 2  2020 1     location Berlin       
5 Project 2  2020 2     location Delhi        
6 Project 2  2020 3     location NA           
7 Project 3  2023 1     location Paris        
8 Project 3  2023 2     location NA           
9 Project 3  2023 3     location NA   

这意味着你可以写

tidyData <- lapply(
  c("author", "location"), 
  pivot_column_set, 
  d = df
) %>%
bind_rows() %>% 
pivot_wider(
  names_from = source,
  values_from = value
)
tidyData
# A tibble: 9 × 5
  title      year index author  location     
  <chr>     <dbl> <chr> <chr>   <chr>        
1 Project 1  2021 1     Bob     London       
2 Project 1  2021 2     Alex    Beijing      
3 Project 1  2021 3     Charlie New York City
4 Project 2  2020 1     Jane    Berlin       
5 Project 2  2020 2     Ann     Delhi        
6 Project 2  2020 3     NA      NA           
7 Project 3  2023 1     Taylor  Paris        
8 Project 3  2023 2     NA      NA           
9 Project 3  2023 3     NA      NA 

因此，现在整理输入数据是一件容易的事情，无论列集的数量以及它们各自包含的条目数量如何。 [尽管我在这里做了一些——希望是合理的——假设。]

这使您的应用程序非常简单。 请注意，我已经

• 更正了对

  input$year

  的使用，以正确处理返回范围的

  sliderInput

• 在

  multiple = TRUE

  中添加了

  input$year

  ，以便轻松查看数据选择是否正常工作
• 将数据过滤与绘图渲染分开，只是因为这是一个很好的做法

ui <- fluidPage(
  sliderInput(
    inputId = "year",
    label = "Project Funding Year:",
    min = min(df$year),
    max = max(df$year),
    value = c(min(df$year), max(df$year)),
    sep = "",
    step = 1
  ),
  selectInput(
    inputId = "location",
    label = "Location",
    choices = list("London", "Berlin", "Paris", "Beijing", "Delhi", "New York City"),
    # Allow multiple selections to demonstrate correct function with limited test data
    multiple = TRUE
  ),
  plotOutput(outputId = "histogram")
)

server <- function(input, output, session) {
  filteredData <- reactive({
    tidyData %>% filter(
      # Noite correct use of a sliderInput with a range
      year >= input$year[1] & year <= input$year[2],
      # To cater for multiple selections
      location %in% input$location
    )
  })

  output$histogram <- renderPlot(
    filteredData() %>%
    ggplot(aes(x = location)) +
      geom_histogram(stat="count")

  )
}

shinyApp(ui, server)