Search code examples
rpopupr-leaflet

How to add a leaflet pop up with conditional lines?


I've got this data frame:

country_groups <- structure(list(country_name = c("Australia", "Brazil", "Canada", 
"China", "China", "China", "China", "China", "China", "China", 
"China", "China", "China", "China", "China", "China", "European Patent Office", 
"European Patent Office", "Germany", "India", "India", "India", 
"India", "India", "India", "Japan", "Japan", "Japan", "Korea [Republic of]", 
"Korea [Republic of]", "Korea [Republic of]", "Korea [Republic of]", 
"Korea [Republic of]", "Romania", "Russian Federation", "Russian Federation", 
"Spain", "Taiwan", "Taiwan", "United Kingdom", "United States", 
"United States", "United States", "United States", "United States", 
"United States", "United States", "United States", "United States", 
"United States", "United States", "United States", "World", "World"
), longitude = c(133.775136, -51.92528, -106.346771, 104.195397, 
104.195397, 104.195397, 104.195397, 104.195397, 104.195397, 104.195397, 
104.195397, 104.195397, 104.195397, 104.195397, 104.195397, 104.195397, 
-20.8685430762787, -20.8685430762787, 10.451526, 78.96288, 78.96288, 
78.96288, 78.96288, 78.96288, 78.96288, 138.252924, 138.252924, 
138.252924, 127.766922, 127.766922, 127.766922, 127.766922, 127.766922, 
24.96676, 105.318756, 105.318756, -3.74922, 120.960515, 120.960515, 
-3.435973, -95.712891, -95.712891, -95.712891, -95.712891, -95.712891, 
-95.712891, -95.712891, -95.712891, -95.712891, -95.712891, -95.712891, 
-95.712891, 71.8853560211639, 71.8853560211639), latitude = c(-25.274398, 
-14.235004, 56.130366, 35.86166, 35.86166, 35.86166, 35.86166, 
35.86166, 35.86166, 35.86166, 35.86166, 35.86166, 35.86166, 35.86166, 
35.86166, 35.86166, 48.2343918029004, 48.2343918029004, 51.165691, 
20.593684, 20.593684, 20.593684, 20.593684, 20.593684, 20.593684, 
36.204824, 36.204824, 36.204824, 35.907757, 35.907757, 35.907757, 
35.907757, 35.907757, 45.943161, 61.52401, 61.52401, 40.463667, 
23.69781, 23.69781, 55.378051, 37.09024, 37.09024, 37.09024, 
37.09024, 37.09024, 37.09024, 37.09024, 37.09024, 37.09024, 37.09024, 
37.09024, 37.09024, -51.681674860461, -51.681674860461), topic = c("Population growth", 
"Education", "Arts", "Sports", "Growing plants", "Reading", "Story telling", 
"Gymnastics", "Cooking classes", "Education", "Arts", "Arcade", 
"Acting", "Population growth", "Movies", "Education", "Sports", 
"Arcade", "Movies", "Sports", "Reading", "Gymnastics", "Cooking classes", 
"Education", "Population growth", "Sports", "Reading", "Gymnastics", 
"Growing plants", "Gymnastics", "Arcade", "Acting", "Movies", 
"Gymnastics", "Sports", "Gymnastics", "Arcade", "Gymnastics", 
"Arcade", "Gymnastics", "Sports", "Growing plants", "Reading", 
"Gymnastics", "Cooking classes", "Education", "Arts", "Arcade", 
"Acting", "Population growth", "Movies", "Education", "Arcade", 
"Movies"), n = c(2L, 1L, 1L, 34L, 31L, 51L, 82L, 63L, 22L, 17L, 
43L, 53L, 34L, 43L, 46L, 22L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 
4L, 3L, 3L, 23L, 1L, 4L, 2L, 2L, 8L, 2L, 3L, 1L, 1L, 1L)), row.names = c(NA, 
-54L), class = "data.frame")

And I wish to perform leaflet mapping with it, in a way that when you click on the corresponding marker, it displays country name, followed by each TOPIC = NUMBER below. I've had such a hard time because everywhere I've seen they mostly use paste0 or paste and that is able to get the job done. This time each country could have all topics or just one, I've tried to get it done as they do in the official webpage with no luck, It seems simple but I can't get it done, somebody might know how to? Below you can see what coding I use. Thanks in advance!

library(leaflet)
library(dplyr)
# Maping
leaflet(country_groups) %>% 
  addTiles() %>% 
  setView( lng = 0, lat = 0, zoom = 1) %>% 
  addProviderTiles("Esri.WorldTopoMap") %>%
  addMarkers(~longitude, ~latitude, popup = ~HTML(paste0("<br>", "Country:", country_name,"<br/>",
                                                    country_groups %>%  
                                                      filter(country_name %in% country_name) %>% 
                                                      select(topic,n) )))

And this is the kind of pop up I expect (China), but adding the Country name upfront:

country_selec <- country_groups %>% filter(country_name == "China")
country_info <- country_selec[c("topic","n")];names(country_info) <- c("Topic","Count")

China sample


This is how it displays with answear provided, it would be perfectly brilliant if it displayed as it does for @Wimpel

Error display


Solution

  • I struggled with this in the past too.. Here is my solution:

    first, create a helper data.frame, with the values for each country, named df.helper.
    Then, create a list with labels ( as a string with html-tags) for each country. Last, build the leaflet, and create the labels using lapply and HTML from the htmltools-package to get nice HTML-code for in the popups.

    You can, of course, edit the string inside the paste0-command that creates the custom.labels to suit your desired format. All HTML-tags are permitted, so go nuts ;-)

    #load libraries
    library(leaflet);library(htmltools)
    #create a helper data.frame with a unique country_name in each row                                                                                                                                                                                                                                            -54L), class = "data.frame")
    df.helper <- country_groups[ !duplicated( country_groups$country_name),  ]
    #create the custom labels by country
    custom.labels <- lapply( seq( nrow( df.helper ) ), function(i) {
       paste0( '<p><b>', df.helper[i, "country_name" ], '</b><br></p><p>',
               paste( country_groups[which(country_groups$country_name == df.helper[i, "country_name"]), "topic"],
                      country_groups[which(country_groups$country_name == df.helper[i, "country_name"]), "n"],
                     sep = " - ", collapse="<br>"), 
               '</p>' ) 
    })
    #create the leaflet
    leaflet(df.helper) %>% 
       addTiles() %>% 
       setView( lng = 0, lat = 0, zoom = 1) %>% 
       addProviderTiles("Esri.WorldTopoMap") %>%
       addMarkers(
          lng = ~longitude, 
          lat = ~latitude, 
          popup = lapply( custom.labels, htmltools::HTML ) 
          )
    

    enter image description here