rdplyrshinyr-sfchoropleth

Shiny for choropleth map with two selection lists


I have df, and I wanted to create a shiny application that gets updated based on the value of two selection lists, one for picking an indicator, and the other for choosing the subgroup. I also create a function for produce the choropleth based on the values if its input. The function works fine when it is not run inside the shiny but return error within shiny (object of type ‘closure’).

library(dplyr)
library(readxl)
library(ggplot2)
library(sf)
library(rnaturalearth)

# Creating a test data frame
df <- tribble(
  ~Country, ~ISO3, ~Subgroup, ~Indicator, ~Value,
  "Jordan", "JOR", "Group1", "Ind1", 25.6,
  "Turkey", "TUR", "Group1", "Ind1", 56.4,
  "Jordan", "JOR", "Group1", "Ind2", 63.4,
  "Turkey", "TUR", "Group1", "Ind2", 87.5,
  "Jordan", "JOR", "Group2", "Ind1", 13.2,
  "Turkey", "TUR", "Group2", "Ind1", 22.6,
  "Jordan", "JOR", "Group2", "Ind2", 44.9,
  "Turkey", "TUR", "Group2", "Ind2", 78.5,
  
)

# Function to use for mapping an indicator
MapValue <- function(data, var, group){
  
  df <-  df %>%
    filter(Indicator == var & Subgroup == group)
  
  df_join <- rnaturalearth::ne_countries(returnclass = "sf") %>% 
    left_join(df, by = join_by(iso_a3 == ISO3))
  
  plot(df_join["Value"],
       border = 'grey80',
       pal = colorRampPalette(c("white", "darkgreen"))(100),
       breaks = c(0:100))
}

# Shiny 
ui <- fluidPage(
  titlePanel("Shiny for Indicators"), 
  
  sidebarLayout(

      selectInput(inputId = "var", 
                  label = "Choose a variable to display", 
                  choices = list("Ind1", "Ind2"), 
                  selected = "Ind1"),
      
      selectInput(inputId = "groups", 
                  label = "Choose a Subgroup to display", 
                  choices = list("Group1", "Group2"), 
                  selected = "Group1")
    ),
    
    mainPanel(plotOutput("map"))
  )
)

server <- function(input, output){
  output$map <- renderPlot({
    
    args$data <- df
    args$var <- switch(input$var,
                       "Ind1"= df[df$Indicator == "Ind1", ],
                       "Ind2" = df[df$Indicator == "Ind2",]
    )
    args$group <- switch(input$groups,
                         "Group1"= df[df$Subgroup == "Group1", ],
                         "Group2" = df[df$Subgroup == "Group2", ]
    )
    do.call(MapValue, args)
  })
}

shinyApp(ui = ui, server = server)

Solution

  • There were a couple of things going on here:

    1. You should put the data in the server function, rather than just defining it outside.

    2. The MapValue() function had data as an argument, but you were calling it in the function as df

    MapValue <- function(data, var, group){
      
      df <-  df %>%
        filter(Indicator == var & Subgroup == group)
      
    ...
    }
    

    you can fix this this either by using MapValue <- function(df, var, group) or by using data instead of df in the body of the function.

    1. The MapValue() function group and var arguments should just be character strings identifying the desired group and indicator, not the values of the group and indicators themselves. So, all you need to do is use group = input$groups and var = input$var and it should work.

    2. You're using args as a list, but you don't initialize the list first. So, before you start filling up args you need to do args <- list().

    One other point, the object of type 'closure' is not subsettable error generally happens when you think something is defined as data, but R thinks it is a function. Both df and args are functions in R. When making objects, the best practice would be to stay away from function names - that will make the debugging a bit easier. My default is always dat. See below for a full working App.


    Full App

    library(dplyr)
    library(readxl)
    library(ggplot2)
    library(sf)
    library(rnaturalearth)
    library(shiny)
    
    # Creating a test data frame
    
    # Function to use for mapping an indicator
    MapValue <- function(data, var, group){
      
      data <-  data %>%
        filter(Indicator == var & Subgroup == group)
      
      df_join <- rnaturalearth::ne_countries(returnclass = "sf") %>% 
        left_join(data, by = join_by(iso_a3 == ISO3))
      
      plot(df_join["Value"],
           border = 'grey80',
           pal = colorRampPalette(c("white", "darkgreen"))(100),
           breaks = c(0:100))
    }
    
    # Shiny 
    ui <- fluidPage(
      titlePanel("Shiny for Indicators"), 
      
      sidebarLayout(
        
        selectInput(inputId = "var", 
                    label = "Choose a variable to display", 
                    choices = list("Ind1", "Ind2"), 
                    selected = "Ind1"),
        
        selectInput(inputId = "groups", 
                    label = "Choose a Subgroup to display", 
                    choices = list("Group1", "Group2"), 
                    selected = "Group1")
      ),
      
      mainPanel(plotOutput("map"))
    )
    
    
    server <- function(input, output){
      dat <- tribble(
        ~Country, ~ISO3, ~Subgroup, ~Indicator, ~Value,
        "Jordan", "JOR", "Group1", "Ind1", 25.6,
        "Turkey", "TUR", "Group1", "Ind1", 56.4,
        "Jordan", "JOR", "Group1", "Ind2", 63.4,
        "Turkey", "TUR", "Group1", "Ind2", 87.5,
        "Jordan", "JOR", "Group2", "Ind1", 13.2,
        "Turkey", "TUR", "Group2", "Ind1", 22.6,
        "Jordan", "JOR", "Group2", "Ind2", 44.9,
        "Turkey", "TUR", "Group2", "Ind2", 78.5,
        
      )
      
      output$map <- renderPlot({
        args <- list()
        args$data <- dat 
        args$var <- input$var
        args$group <- input$groups
        do.call(MapValue, args)
      })
    }
    
    shinyApp(ui = ui, server = server)