rmapsr-leafletrnaturalearth

In R leaflet interactive map, all my values get incorrectly displayed (while values inside data frames are all correct)


For some reason, despite the fact Syria in the dataframe has Value = 1, when I plot the map it shows up as 0.038 and is called Belarus... and all the other countries also get some crazy values and other country names... I don't understand why it happens. Here is the code...

#libraries
library(tidyverse)
library(leaflet)
library(rnaturalearth)
library(rnaturalearthdata)
library(sf)
library(countrycode)

#load world data from natural earth
world <- ne_countries(scale = "large", returnclass = "sf")
world <- st_transform(world, "+proj=longlat +datum=WGS84")

countrynames <- countryname_dict %>% 
  group_by(country.name.en) %>% 
  summarise(country.name.en) %>% 
  distinct()

countrynames <- dplyr::pull(countrynames, country.name.en)

# These values are random just to test out mapping. I wanted for each country to have a color based on the ratio between 0 and 1 with some random numbers. All of them ARE indeed between 0 and 1 in the data frame
world_values <- c(1:284)
df <- cbind (countrynames, world_values)
df <- as.data.frame(df)
df$world_values <- as.numeric(df$world_values)
df$world_values[241] <- 599
df <- df %>% 
  mutate(Value = world_values / 599)

# Match country codes in world data with countrynames
df$iso_a3 <- countrycode(sourcevar = countrynames, origin = "country.name", destination = "iso3c")
df <- df %>% na.omit()

map <- leaflet() %>%
  addProviderTiles("Esri.WorldGrayCanvas") %>%
  setView(lng = 0, lat = 0, zoom = 2)

palette <- colorNumeric(
  palette = "Blues",
  domain = c(0,1)
)

# Add country polygons layer
map <- map %>% 
  addPolygons(
    data = world,
    stroke = TRUE,
    fillColor = ~palette(df$Value),
    fillOpacity = 0.5,
    popup = ~paste("Country:", df$countrynames, "<br>", "Value:", df$Value),
    color = "white",
    weight = 1,
    layerId = ~iso_a3,
    label = NULL
  )

# Print the map
map

I have tried changing layerId, fillColor, palette and popup to other things. I'm at wits' end.


Solution

  • You are using one dataset for polygons and another for attribute data in leaflet. I guess this aproach wold work if number of rows and country order in both world and df would match, but currently first 3 in world are "Indonesia", "Malaysia", "Chile" while in df the top reads "Afghanistan", "Åland Islands", "Albania".

    If you try to make those 2 to match, it would still be quite fragile and difficult to debug, so in most cases you'd want to join attribute table to the spatial dataset and use that with the mapping library. This is also the basis of formula (~) notation in leaflet where data = world, fillColor = ~ palette(Value) means:
    use Value column from world data.frame to calculate fillColor

    library(dplyr)
    library(leaflet)
    library(rnaturalearth)
    library(sf)
    library(countrycode)
    
    # sf object with just counrty polygons and A3 codes
    world_sf <- ne_countries(scale = "large", returnclass = "sf") %>% 
      # tibble printing is more compact
      as_tibble() %>% 
      st_as_sf() %>% 
      select(adm0_a3)
    world_sf 
    #> Simple feature collection with 258 features and 1 field
    #> Geometry type: MULTIPOLYGON
    #> Dimension:     XY
    #> Bounding box:  xmin: -180 ymin: -90 xmax: 180 ymax: 83.6341
    #> Geodetic CRS:  WGS 84
    #> # A tibble: 258 × 2
    #>    adm0_a3                                                              geometry
    #>    <chr>                                                      <MULTIPOLYGON [°]>
    #>  1 IDN     (((117.7036 4.163415, 117.7036 4.163415, 117.7381 4.157242, 117.7836…
    #>  2 MYS     (((117.7036 4.163415, 117.6971 4.169053, 117.6441 4.215237, 117.6401…
    #>  3 CHL     (((-69.51009 -17.50659, -69.50611 -17.58513, -69.49712 -17.6214, -69…
    # ...  
    
    # 2nd dataset, only atributes
    df_ <- distinct(countryname_dict, countrynames = country.name.en) %>% 
      as_tibble() %>% 
      mutate(world_values = row_number() / 599,
             world_values = if_else(countrynames == "Syria", 1, world_values),
             # world_values = replace(world_values, 241, 1),
             iso_a3 = countrycode(countrynames, "country.name", "iso3c")) %>% 
      na.omit()
    df_
    #> # A tibble: 247 × 3
    #>    countrynames      world_values iso_a3
    #>    <chr>                    <dbl> <chr> 
    #>  1 Afghanistan            0.00167 AFG   
    #>  2 Åland Islands          0.00334 ALA   
    #>  3 Albania                0.00501 ALB   
    # ...
    
    # join datasets by world_sf$adm0_a3 == df_$iso_a3, inner join keerp only records 
    # that are present in both datasets
    leaflet_sf <- inner_join(world_sf, df_, by = join_by(adm0_a3 == iso_a3)) 
    leaflet_sf
    #> Simple feature collection with 232 features and 3 fields
    #> Geometry type: MULTIPOLYGON
    #> Dimension:     XY
    #> Bounding box:  xmin: -180 ymin: -90 xmax: 180 ymax: 83.6341
    #> Geodetic CRS:  WGS 84
    #> # A tibble: 232 × 4
    #>    adm0_a3                                    geometry countrynames world_values
    #>    <chr>                            <MULTIPOLYGON [°]> <chr>               <dbl>
    #>  1 IDN     (((117.7036 4.163415, 117.7036 4.163415, 1… Indonesia          0.195 
    #>  2 MYS     (((117.7036 4.163415, 117.6971 4.169053, 1… Malaysia           0.244 
    #>  3 CHL     (((-69.51009 -17.50659, -69.50611 -17.5851… Chile              0.0835
    # ...
    
    
    palette <- colorNumeric(
      palette = "Blues",
      domain = c(0,1)
    )
    
    map_ <- leaflet() %>%
      addProviderTiles("Esri.WorldGrayCanvas") %>%
      setView(lng = 0, lat = 0, zoom = 2) %>% 
      addPolygons(
        data = leaflet_sf,
        stroke = TRUE,
        fillColor = ~ palette(world_values),
        fillOpacity = 0.5,
        popup = ~ paste("Country:", countrynames, "<br>", "Value:", world_values),
        color = "white",
        weight = 1,
        layerId = ~ adm0_a3,
        label = NULL
      )
    map_
    

    Created on 2023-06-06 with reprex v2.0.2