时间戳

首页 > 解决方案 > 创建一个带有闪亮的条形图，每次选择一个区域时都会显示一个新图

r - 创建一个带有闪亮的条形图，每次选择一个区域时都会显示一个新图

问题描述

我正在尝试创建一个交互式条形图，但是我的闪亮技能并不是最好的。我试图让一些东西工作，但我很挣扎——服务器部分开始让我有点困惑。

以下是我试图在交互式图中包含的用户输入集：

  1. 一个选择输入，允许您选择一个区域，当进行此选择时，会出现一个全新的图（仅显示该特定区域的人口统计数据）。

  2. 一个滑块输入，可让您在一系列年龄组中滑动。例如 - 您可能只想选择从“0 到 10”和“40 到 44”的年龄范围。

下面我创建了一个可复制的示例，您可以复制和粘贴。请注意，我的主数据集中的年龄范围不等间隔，也没有足够的数据使每个位置都有完整的年龄范围。我所做的只是尝试创建我拥有的较大数据集的小版本。


library(dplyr)
library(ggplot2)
library(shiny)
library(shinyWidgets)

# creating example data

exampledata <- data.frame(City=c("London","Liverpool","Manchester",
                                        "Porstmouth","Liverpool","Leeds",
                                        "London","Manchester","Nottingham"),
                         Ageband = c("35 to 39","80+","40 to 44",
                                        "0 to 10","80+","35 to 39",
                                        "40 to 44","0 to 10", "80+"),
                         count = c(1200,800,520,
                                      300,105,630,
                                      410,150,700))


# Static Plot to show what I intend to make interactive

ggplot(exampledata, aes(fill=Ageband, y=count, x=Ageband)) + 
  geom_bar(position="dodge", stat="identity", show.legend = FALSE) +
  facet_wrap(~City)+
  labs(y="Participant count", x=" ",caption=(paste0("Participants sampled = ", sum(exampledata$count))))+
  scale_fill_manual(name="Age",values=c("#CEE0F1", "#C3DAEE" ,"#B3D3E8" ,"#A2CBE2", "#8FC1DD" ,"#79B6D9" ,"#66AAD4" ,"#559FCD" ,"#4493C6", "#3686C0", "#2878B9","#1C69AF" ,"#1257A1" ,"#084594", "#05337d"))+
  theme(plot.title = element_text(hjust = 0.5))+
  theme(axis.text.x = element_text(angle = 90))

# shiny attempt

ui <- fluidPage(
  titlePanel("Age Distribution of Research"),
  selectInput("location", "Select Location", choices = exampledata$City),
  sliderTextInput("age", "Select Age", choices = exampledata$Ageband)
  plotOutput("bar")
)

server <- function(input, output, session) {

# At this point would you need to create a reactive expression or not?
  
  data <- reactive({
    exampledata %>%
      filter(City == input$City)
  })

# At which point of the plots do the inputs need specifying? 
  
  output$plot <- renderPlot({
    
    ggplot(data, aes(aes(fill=Ageband, y=count, x=input$age)) + 
             geom_bar(position="dodge", stat="identity", show.legend = FALSE)
   })
}

}

shinyApp(ui = ui, server = server)

标签： rggplot2shiny

解决方案

这是否接近您想要的？

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyWidgets)

exampledata <- data.frame(City=c("London","Liverpool","Manchester",
                                 "Porstmouth","Liverpool","Leeds",
                                 "London","Manchester","Nottingham"),
                          Ageband = c("35 to 39","80+","40 to 44",
                                      "0 to 10","80+","35 to 39",
                                      "40 to 44","0 to 10", "80+"),
                          count = c(1200,800,520,
                                    300,105,630,
                                    410,150,700))

ui <- fluidPage(
  titlePanel("Age Distribution of Research"),
  selectInput("location", "Select Location", choices = exampledata$City, selected="London", multiple=TRUE),
  # Slider inputs work with numeric data, not categorical data
  selectInput("age", "Select Age", choices = exampledata$Ageband, selected="35 to 39", multiple=TRUE),
  plotOutput("plot")
)

server <- function(input, output, session) {
  data <- reactive({
    exampledata %>%
      filter(
        City %in% input$location,
        Ageband %in% input$age
      )
  })
  
  output$plot <- renderPlot({
    req(input$age, input$location)
    
    data() %>% 
      ggplot(aes(fill=City, y=count, x=Ageband)) + 
             geom_bar(position="dodge", stat="identity")
  })
}

shinyApp(ui = ui, server = server)

推荐阅读