Shiny app problem using shapefiles and leaflet to call data

shiny
,
1

once again I turn to the kind people here, as I have a problem with a shiny app. I want to make an app that when selecting a certain variable renders a chorophet map in leaflet, something like this:

Captura de Pantalla 2021-07-11 a la(s) 1.58.39
Captura de Pantalla 2021-07-11 a la(s) 1.58.392076×1606 185 KB

But I'm not quite sure how to work the inputs. I leave you the code that I have used so far (without success), in case you have any idea what I am doing wrong:

library(spdplyr)
library(dplyr)
library(rgdal)
library(leaflet)


# Datos
shp_mex <- readOGR("/Users/jorge_hca/Downloads/México_Estados/México_Estados.shp")
ing_mex <- read_excel("/Users/jorge_hca/Desktop/ingresos_mex.xlsx")

# Uniendo las bases
shp_mex@data <- shp_mex@data |> 
  left_join(ing_mex, by = c("ESTADO" = "ESTADO"))

# Cuadro de texto

mytext <- paste(
  "Estado: ", shp_mex$ESTADO,"<br/>", 
  "Decil más bajo: ", shp_mex```
Decil 1`, "<br/>", 
  "Decil más alto: ", shp_mex```
Decil 10`, "<br/>", 
  "Total: ", shp_mex$Total, 
  sep="") %>%
  lapply(htmltools::HTML)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                selectInput("variable", "Escoge un decil:",
                            c("Total" = "Total",
                              "Decil 1" = "Decil 1",
                              "Decil 2" = "Decil 2",
                              "Decil 3" = "Decil 3",
                              "Decil 4" = "Decil 4",
                              "Decil 5" = "Decil 5",
                              "Decil 6" = "Decil 6",
                              "Decil 7" = "Decil 7",
                              "Decil 8" = "Decil 8",
                              "Decil 9" = "Decil 9",
                              "Decil 10" = "Decil 10"))
                
  )
)
server <- function(input, output, session) {
  
  mypalette <- reactive({
    colorBin( palette="RdGy", domain=shp_mex$input$variable, na.color="transparent", bins=4)
  })
  
  output$map <- renderLeaflet({
    
    leaflet(shp_mex) %>% 
      addTiles("http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png",
               attribution = paste(
                 "&copy; <a href=\"http://openstreetmap.org\">OpenStreetMap</a> contributors",
                 "&copy; <a href=\"http://cartodb.com/attributions\">CartoDB</a>"
               ))  %>% 
      setView( lat=23, lng=-100 , zoom=4) %>%
      addPolygons( 
        fillColor = ~mypalette(shp_mex$input$variable), 
        stroke=TRUE, 
        fillOpacity = 0.85, 
        color="white", 
        weight=0.3,
        label = mytext,
        labelOptions = labelOptions( 
          style = list("font-weight" = "normal", padding = "3px 8px"), 
          textsize = "13px", 
          direction = "auto"
        )
      ) %>%
      addLegend( pal=mypalette, values=~shp_mex$input$variable, opacity=0.9, title = "Ingresos en México", position = "bottomleft" )
    
    
  })

  
  
  
}

shinyApp(ui, server)

I also leave the equivalent code to make the graph, in case it is also helpful to find the error in the leaflet map:

library(readxl)
library(dplyr)
library(rgdal)

# Datos
shp_mex <- readOGR("/Users/jorge_hca/Downloads/México_Estados/México_Estados.shp")
ing_mex <- read_excel("/Users/jorge_hca/Desktop/ingresos_mex.xlsx")

# Uniendo las bases
shp_mex@data <- shp_mex@data |> 
  left_join(ing_mex, by = c("ESTADO" = "ESTADO"))
  


# Mapa
mypalette <- colorBin( palette="RdGy", domain=dato```
Decil 1`, na.color="transparent", bins=4)

mytext <- paste(
  "Estado: ", shp_mex$ESTADO,"<br/>", 
  "Decil más bajo: ", shp_mex```
Decil 1`, "<br/>", 
  "Decil más alto: ", shp_mex```
Decil 10`, "<br/>", 
  "Total: ", shp_mex$Total, 
  sep="") %>%
  lapply(htmltools::HTML)

# Final Map
leaflet(shp_mex) %>% 
  addTiles("http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png",
           attribution = paste(
             "&copy; <a href=\"http://openstreetmap.org\">OpenStreetMap</a> contributors",
             "&copy; <a href=\"http://cartodb.com/attributions\">CartoDB</a>"
           ))  %>% 
  setView( lat=23, lng=-100 , zoom=4) %>%
  addPolygons( 
    fillColor = ~mypalette(dato```
Decil 1`), 
    stroke=TRUE, 
    fillOpacity = 0.85, 
    color="white", 
    weight=0.3,
    label = mytext,
    labelOptions = labelOptions( 
      style = list("font-weight" = "normal", padding = "3px 8px"), 
      textsize = "13px", 
      direction = "auto"
    )
  ) %>%
  addLegend( pal=mypalette, values=~dato```
Decil 10`, opacity=0.9, title = "Ingresos en México", position = "bottomleft" )
2

What is the error message that comes up?

You should try using the sf package instead of rgdal, the syntax is a lot tidier and you would avoid things like shp_mex$input$variable.

It would be really useful if you had a reproducible example of you shapefile and dataset (or used a fake dataset something like system.file("shape/nc.shp", package="sf") , because otherwise we can't run it here.

3

Thanks a lot. I tried that and change a few de code, but I get the error: unused argument (dato()$nuevo)

The new code is:

library(spdplyr)
library(dplyr)
library(sf)
library(leaflet)


# Datos
shp_mex <- read_sf("/Users/jorge_hca/Downloads/México_Estados/México_Estados.shp")
ing_mex <- read_excel("/Users/jorge_hca/Desktop/ingresos_mex.xlsx")

# Uniendo las bases
shp_mex <- shp_mex |> 
  left_join(ing_mex, by = c("ESTADO" = "ESTADO"))
# Cuadro de texto

mytext <- paste(
  "Estado: ", shp_mex$ESTADO,"<br/>", 
  "Decil más bajo: ", shp_mex$`Decil 1`, "<br/>", 
  "Decil más alto: ", shp_mex$`Decil 10`, "<br/>", 
  "Total: ", shp_mex$Total, 
  sep="") %>%
  lapply(htmltools::HTML)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                selectInput("variable", "Escoge un decil:",
                            c("Total" = "Total",
                              "Decil 1" = "Decil 1",
                              "Decil 2" = "Decil 2",
                              "Decil 3" = "Decil 3",
                              "Decil 4" = "Decil 4",
                              "Decil 5" = "Decil 5",
                              "Decil 6" = "Decil 6",
                              "Decil 7" = "Decil 7",
                              "Decil 8" = "Decil 8",
                              "Decil 9" = "Decil 9",
                              "Decil 10" = "Decil 10")),
                p(  ing_mex %>%
                      e_charts() %>%
                      e_histogram(Total, name = "Ingresos por decil",breaks = "freedman-diaconis") %>%
                      e_tooltip(trigger = "axis") |> 
                      e_color(color = "#753732") 
                    
                ) 
  )
)
server <- function(input, output, session) {
  dato <- reactive({shp_mex |> 
      mutate(nuevo = input$variable)
    
    
    })
  mypalette <- reactive({
    colorBin( palette="RdGy", domain=dato()$nuevo, na.color="transparent", bins=4)
  })
  
  output$map <- renderLeaflet({
    
    leaflet(dato() ) %>% 
      addTiles("http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png",
               attribution = paste(
                 "&copy; <a href=\"http://openstreetmap.org\">OpenStreetMap</a> contributors",
                 "&copy; <a href=\"http://cartodb.com/attributions\">CartoDB</a>"
               ))  %>% 
      setView( lat=23, lng=-100 , zoom=4) %>%
      addPolygons( 
        fillColor = ~mypalette(dato()$nuevo), 
        stroke=TRUE, 
        fillOpacity = 0.85, 
        color="white", 
        weight=0.3,
        label = mytext,
        labelOptions = labelOptions( 
          style = list("font-weight" = "normal", padding = "3px 8px"), 
          textsize = "13px", 
          direction = "auto"
        )
      ) %>%
      addLegend( pal=mypalette, values=~dato()$nuevo, opacity=0.9, title = "Ingresos en México", position = "bottomleft" )
    
    
  })

  
  
  
}

shinyApp(ui, server)
4

btw, the data I use is this: data shp - Google Drive

5

Can you post the full shapefile (four or five files, not just the .shp). Zip it up if you can.

Edit - I found one here: Shapefiles (*.shp) de México - Geografía, SIG y Cartografía Digital

6

Yup, i update the Drive file

7

Not sure what the issue is. It works without the legend, but the legend should work.

library(dplyr)
library(tidyr)
library(sf)
library(leaflet)
library(readxl)
library(echarts4r)
library(shiny)

# Datos
shp_mex <- st_read("México_Estados.shp") # use projects so yo don't have to read in from your directory
ing_mex <- read_excel("ingresos_mex.xlsx") 

# Uniendo las bases
shp_mex <- shp_mex %>%
    left_join(ing_mex, by = c("ESTADO" = "ESTADO"))
# Cuadro de texto

mytext <- paste(
    "Estado: ", shp_mex$ESTADO,"<br/>", 
    "Decil más bajo: ", shp_mex$`Decil 1`, "<br/>", 
    "Decil más alto: ", shp_mex$`Decil 10`, "<br/>", 
    "Total: ", shp_mex$Total, 
    sep="") %>%
    lapply(htmltools::HTML)

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", width = "100%", height = "100%"),
    absolutePanel(top = 10, right = 10,
                  selectInput("variable",
                              "Escoge un decil:",
                              c("Total" = "Total",
                                "Decil 1" = "Decil 1",
                                "Decil 2" = "Decil 2",
                                "Decil 3" = "Decil 3",
                                "Decil 4" = "Decil 4",
                                "Decil 5" = "Decil 5",
                                "Decil 6" = "Decil 6",
                                "Decil 7" = "Decil 7",
                                "Decil 8" = "Decil 8",
                                "Decil 9" = "Decil 9",
                                "Decil 10" = "Decil 10")),
                  p(  ing_mex %>%
                          e_charts() %>%
                          e_histogram(Total, name = "Ingresos por decil",breaks = "freedman-diaconis") %>%
                          e_tooltip(trigger = "axis") %>%  
                          e_color(color = "#753732") 
                      
                  ) 
    )
)

server <- function(input, output, session) {
    
    dato <- reactive({
        
        ing2 <- ing_mex %>%
            select(ESTADO, nuevo = {input$variable})

        left_join(shp_mex, ing2, by = "ESTADO")
    })
    
    output$map <- renderLeaflet({
        
        mypalette <- colorBin(palette="RdBu", domain=dato()$nuevo, na.color="transparent", bins = 4)

        leaflet() %>%
            addTiles()  %>%
            setView( lat=23, lng=-100 , zoom=4) %>%
            addPolygons(
                data = dato(),
                fillColor = ~mypalette(nuevo),
                stroke=TRUE,
                fillOpacity = 0.85,
                color="white",
                weight=0.3,
                label = mytext,
                labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "13px",
                    direction = "auto"
                )
            ) 
        # %>%
        # addLegend(pal = mypalette, values = ~nuevo, opacity = 0.9, title = "Ingresos en México", position = "bottomleft")

    })
    
}

shinyApp(ui, server)

or runs with this in the legend values = dato()$nuevo, but the problem is somewhere else. Perhaps test with a different type of page layout?

8

The addLegend function expects data, and by default gets it from the map object. However, you are supplying the data and to the polygon layer and not the actual map. So, just specify the data in the addLegend call:

library(dplyr)
library(tidyr)
library(sf)
library(leaflet)
library(readxl)
library(echarts4r)
library(shiny)

# Datos
shp_mex <- st_read("Mexico_Estados.shp") # use projects so yo don't have to read in from your directory
ing_mex <- read_excel("ingresos_mex.xlsx") 

# Uniendo las bases
shp_mex <- shp_mex %>%
  left_join(ing_mex, by = c("ESTADO" = "ESTADO"))
# Cuadro de texto

mytext <- paste(
  "Estado: ", shp_mex$ESTADO,"<br/>", 
  "Decil más bajo: ", shp_mex$`Decil 1`, "<br/>", 
  "Decil más alto: ", shp_mex$`Decil 10`, "<br/>", 
  "Total: ", shp_mex$Total, 
  sep="") %>%
  lapply(htmltools::HTML)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                selectInput("variable",
                            "Escoge un decil:",
                            c("Total" = "Total",
                              "Decil 1" = "Decil 1",
                              "Decil 2" = "Decil 2",
                              "Decil 3" = "Decil 3",
                              "Decil 4" = "Decil 4",
                              "Decil 5" = "Decil 5",
                              "Decil 6" = "Decil 6",
                              "Decil 7" = "Decil 7",
                              "Decil 8" = "Decil 8",
                              "Decil 9" = "Decil 9",
                              "Decil 10" = "Decil 10")),
                p(  ing_mex %>%
                      e_charts() %>%
                      e_histogram(Total, name = "Ingresos por decil",breaks = "freedman-diaconis") %>%
                      e_tooltip(trigger = "axis") %>%  
                      e_color(color = "#753732") 
                    
                ) 
  )
)

server <- function(input, output, session) {
  
  dato <- reactive({
    
    ing2 <- ing_mex %>%
      select(ESTADO, nuevo = {input$variable})
    
    left_join(shp_mex, ing2, by = "ESTADO")
  })
  
  output$map <- renderLeaflet({
    
    mypalette <- colorBin(palette="RdBu", domain=dato()$nuevo, na.color="transparent", bins = 4)
    
    leaflet() %>%
      addTiles()  %>%
      setView( lat=23, lng=-100 , zoom=4) %>%
      addPolygons(
        data = dato(),
        fillColor = ~mypalette(nuevo),
        stroke=TRUE,
        fillOpacity = 0.85,
        color="white",
        weight=0.3,
        label = mytext,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal", padding = "3px 8px"),
          textsize = "13px",
          direction = "auto"
        )
      )  %>%
    addLegend(pal = mypalette, values = ~nuevo, opacity = 0.9, title = "Ingresos en México", position = "bottomleft", data = dato())
    
  })
  
}

shinyApp(ui, server)
2 Likes
9

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.