Having trouble with leafletProxy, observeEvent and shiny / leaflet application

1
votes

For the last few hours I have been playing with my coding, using forms of if statements, observeEvent and leafletProxy, but I can't seem to get it working. The life table is life expectancy data. It is three columns, COUNTY, male, female. I can't seem to get the radio button to work and it always stays at male.

Basically, I want my leaflet map to give different layouts based on the input of the radio button. Either getting male life expectancy and female, as well as getting the popup.

library(shiny)
library(leaflet)
library(tigris)
library(dplyr)

lnd <- counties(state = 'IN', cb = TRUE, resolution = '20m')

#Read life table
life <- read.table("life.txt",sep="\t", header=TRUE)

lnd@data <- left_join(lnd@data, life, by = c('NAME' = 'county'))

popup <- paste0("County name: ", lnd$NAME, "<br>", "Life Expectancy: ", round(lnd$male,2))
popup2 <- paste0("County name: ", lnd$NAME, "<br>", "Life Expectancy: ", round(lnd$female,2))


ui <- shinyUI(fluidPage(#theme = "bootstrap.css",

titlePanel("Life Exptectancy in Indiana Counties: "),
h3("A Spatial Analysis Project"),
br(),
sidebarLayout(position = "right",

            sidebarPanel(
              tags$b("Life Expectancy in Indiana, U.S.A."),
              hr(),
              radioButtons("gender",     "Gender:",c("Male"="Male","Female"="Female")),

              hr()
            ),
            mainPanel(
              leafletOutput("map")
            )
   )
))

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet(lnd) %>%
      addPolygons() %>%
      addProviderTiles(providers$CartoDB.Positron)
  })
  observeEvent (input$gender == "Male", {
    leafletProxy("map", data=lnd) %>%
      clearShapes() %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup)
  })
  observeEvent (input$gender == "Female", {
    leafletProxy("map", data=lnd) %>%
      clearShapes() %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup2)
  })
}
shinyApp(ui, server)

This is a photo of my appThe app remains blue, and keeps the same male data no matter if I click female or male. I know it has to do with something with leafletProxy but cant figure it out

2
rshinyleaflet
This is kind of old, but I just stumbled on it. The problem is that you are providing it with same data 'lnd' no matter theinput$gender. You need to create a reactive function that filters the data based on selected gender. - sebdalgarno

2 Answers

1
votes

The two observeEvent for input$gender is creating the problem as only the first observeEvent will get executed. If you change your server using only one observeEvent and putting if and else condition inside that it should work. Since I don't have your data life.txt, I have produced the life expectancy with some random values.

library(shiny)
library(leaflet)
library(tigris)
library(dplyr)

dat <- data.frame(long = rnorm(40) * 2 + 13, lat = rnorm(40) + 48)

#Read life table
life <- read.table("life.txt",sep="\t", header=TRUE)

#lnd@data <- left_join(lnd@data, life, by = c('NAME' = 'county'))
lnd@data <- cbind(lnd@data, male = rnorm(nrow(lnd@data), 50, 10), female = rnorm(nrow(lnd@data), 40, 5))


popup <- paste0("County name: ", lnd$NAME, "<br>", "Life Expectancy: ", round(lnd$male,2))
popup2 <- paste0("County name: ", lnd$NAME, "<br>", "Life Expectancy: ", round(lnd$female,2))


ui <- shinyUI(fluidPage(#theme = "bootstrap.css",

  titlePanel("Life Exptectancy in Indiana Counties: "),
  h3("A Spatial Analysis Project"),
  br(),
  sidebarLayout(position = "right",

                sidebarPanel(
                  tags$b("Life Expectancy in Indiana, U.S.A."),
                  hr(),
                  radioButtons("gender",     "Gender:",c("Male"="Male","Female"="Female")),

                  hr()
                ),
                mainPanel(
                  leafletOutput("map")
                )
  )
))

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet(lnd) %>%
      addPolygons() %>%
      addProviderTiles(providers$CartoDB.Positron)
  })
  observeEvent (input$gender , {
    if(input$gender == "Male"){
      leafletProxy("map", data=lnd) %>%
        clearShapes() %>%
        addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup) 
    }else
    {
      leafletProxy("map", data=lnd) %>%
        clearShapes() %>%
        addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup2)
    }

  })

}
shinyApp(ui, server)

Hope it helps!

0
votes

You need to create a reactive dataset for the user inputs. You are using the same dataset lnd in your code.

I don't know how your data is structured and since I don't have your data, I hope it is understood in this example.

# Data filtered male
lndMale <- reactive({
      lnd[lnd$gender == input$gender, ]
})  


# Data filtered female
lndFemale <- reactive({
      lnd[lnd$gender == input$gender, ]
})

Then you use the reactive dataset where it needs to be.

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet(lnd) %>%
      addPolygons() %>%
      addProviderTiles(providers$CartoDB.Positron)
  })
  observeEvent (input$gender == "Male", {
    leafletProxy("map", data=lndMale()) %>%
      clearShapes() %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup)
  })
  observeEvent (input$gender == "Female", {
    leafletProxy("map", data=lndFemale()) %>%
      clearShapes() %>%
      addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, popup = popup2)
  })
}

Maybe you have to change part of the code, and use isolate somewhere, I don't have the dataset.