简体   繁体   中英

Subset a data frame in R/Shiny to generate a ggplot2 sf object

A complete ggplot2/Shiny beginner here. I have been searching on Stack and Google for days and could not come up with a decent solution.

Task: to create an interactive leaflet map showing a user-selected column in a long data format (Covid vaccine doses - first, second, and third dose; need shiny to feed this into ggplot2's "data"), which are pre-filtered based on additional user choices (month of the year, age group, type of vaccine administered; these cannot be fed into ggplot2 directly so I need to filter out the data). I am therefore interested in subsetting selected columns (time, age_group, vaccine) based on the values the users select in the input.

I am importing a data frame in.csv which needs to be merged with a sf object later on to match the data with the sf coordinates (supplied by RCzechia).

# Load packages
library(shiny)
library(here)
library(tidyverse)
library(ggplot2)
library(RCzechia)
library(sf)

# Load data
df <- read.csv("data", encoding = "UTF-8")

# load geo-spatial sf data for ggplot
czrep <- republika()
regions <- kraje(resolution = "low")

# Defining UI for the ggplot application
ui <- fluidPage(
    titlePanel(),
  
    # Sidebar
    sidebarLayout(
        sidebarPanel(width = 3,
          selectInput("box_time", label = "Month & Year",
                      choices = sort(unique(df$time)), selected = "",
                      width = "100%", selectize=FALSE),
          selectInput("box_age", label = "Age group",
                          choices = sort(unique(df$age_group)), selected = "",
                          width = "100%", selectize=FALSE),
          selectInput("box_vax", label = "Type of vaccine",
                          choices = sort(unique(df$vaccine)), selected = "",
                          width = "100%", selectize=FALSE),
          radioButtons("button_dose", label = "Vaccine dose",
                       choices = c("First dose" = "first_dose",
                                   "Second dose" = "second_dose",
                                   "Booster" = "booster"))
          ),
        # Displaying the user-defined ggplot
        mainPanel(
          plotOutput("map")
        )))

# Server
server <- function(input, output) {

# select column for ggplot
r_button_dose <- reactive({input$button_dose})

  ### Subset based on user choices - this is where I tried to create a new data frame (new_df) as a result of subsetting by - see below. ###
    
    # merge the df with the sf object
    new_df <- merge(regions, new_df, by.x = "region_id", by.y="region_id")
    
    # transform data set into an sf object (readable by ggplot)
    new_df <- st_as_sf(new_df)
  })
  
  # Generating the plot based on user choices
  output$map <- renderPlot({
    ggplot(data = new_df) +
      geom_sf(aes_string(fill = r_button_dose(), colour = NA, lwd = 2)) +
      geom_sf(data = czrep, color = "grey27", fill = NA) +
      scale_fill_viridis_c(trans = "log", labels = scales::comma) +
      labs(fill = "log scale") +
      theme_bw() +
      theme(legend.text.align = 1,
            legend.title.align = 0.5)
  })
    }

# Starting the Shiny application
shinyApp(ui = ui, server = server)

I cannot figure out how to subset the data - I have tried many different things that I found here and on the RStudio community forms.

Here are a couple of things I have already tried:


# used both filter() and subset(); also tried both '==' and '%in%'    
new_df %>% 
      filter(time %in% box_time() &
               age_group %in% input$box_age() & 
               vaccine %in% input$box_vax())
})

#OR#
  new_df <- reactive({
    df <- df %>% 
      filter(time %in% box_time() &
             age_group %in% input$box_age() & 
             vaccine %in% input$box_vax())
})

#OR#
new_df <- df
new_df$time <- df[df$time==box_time(),]
new_df$age_group <- df[df$age_group==input$box_age(),]
new_df$vaccine <- df[df$vaccine ==input$box_vax(),]

# I also tried passing them the same way as this example: 
r_button_dose <- reactive({input$button_dose})

#OR EVEN#
new_df <- reactive({
    new_df <- df
    new_df$time <- df[df$X.U.FEFF.year_mo==box_time(),]
    new_df$age_group <- df[df$age_group==input$box_age(),]
    new_df$vaccine <- df[df$vaccine ==input$box_vax(),]
  })

With the latest option, I get the following error - even though they are similar:

Listening on http://127.0.0.1:4092
Warning: Error in $: object of type 'closure' is not subsettable
  1: runApp
Warning: Error in $: object of type 'closure' is not subsettable
  1: runApp
Warning: Error in as.data.frame.default: cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame
  176: stop
  175: as.data.frame.default
  172: merge.data.frame
  168: renderPlot [C:/Users/xyz/Documents/R/example/gg_app.R#78]
  166: func
  126: drawPlot
  112: <reactive:plotObj>
   96: drawReactive
   83: renderFunc
   82: output$map
    1: runApp

I don't know what to do - looking for more examples online has not worked. I know that I cannot pass a reactive value directly (even though I am not sure if it is because it returns a logical value). I would be extremely grateful for any tips regarding how to resolve this - thank you!

You can define your reactive dataframe as a reactiveVal :

df_filtered <- reactiveVal(df) ## df being your initial static dataframe

The tricky bit is to treat your reactive dataframe as a function, not an static object:

## works:
df_filtered(df %>% filter(age_group == input$box_age))
renderDataTable(df_filtered()) ## note the parentheses

instead of:

## won't work:
df_filtered <- df %>% filter(age_group %in% input$box_age)
renderDataTable(df_filtered)

finally, wrap it into a reactive expression:

observe({df_filtered(df %>% filter(age_group == input$box_age))
         ## note: function argument, not assignment operator
         output$map <- renderPlot({
         df_filtered() %>% ## again: note function (parentheses)
             ggplot() # etc.
         })
    }) %>%  bindEvent(input$box_age, input$some_other_picker)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM