Как добавить всплывающую листовку с условными строками? - PullRequest
Новая
       42

Как добавить всплывающую листовку с условными строками?

2 голосов
/ 24 февраля 2020

У меня есть этот фрейм данных: 

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")

И я буду sh, чтобы выполнить сопоставление листовок с ним таким образом, чтобы при нажатии на соответствующий маркер отображалось название страны, сопровождаемый каждым ТОПИ C = НОМЕР ниже. У меня было такое трудное время, потому что везде, где я видел, они в основном используют paste0 или paste, и это способно выполнить работу. На этот раз в каждой стране могут быть все темы или только одна, я пытался сделать это так, как они делают на официальной веб-странице без удачи. Кажется, просто, но я не могу это сделать, кто-то может знать как? Ниже вы можете увидеть, какую кодировку я использую. Заранее спасибо! 

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) )))

И это ожидаемое всплывающее окно (Китай), но с предварительным добавлением названия страны: 

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

China sample

Это то, как он отображается с указанным ответом, было бы прекрасно, если бы он отображался так же, как и для @Wimpel

Error display

1 Ответ

3 голосов
/ 24 февраля 2020

Я тоже боролся с этим в прошлом. Вот мое решение:

сначала создайте вспомогательный data.frame со значениями для каждой страны с именем df.helper.
Затем, создайте список с метками (в виде строки с html -tags) для каждой страны. Наконец, создайте листовку и создайте метки, используя lapply и HTML из htmltools -пакета, чтобы получить хороший HTML -код для всплывающих окон.

Вы, конечно, можете отредактируйте строку внутри команды paste0, которая создает custom.labels в соответствии с желаемым форматом. Все HTML -метки разрешены, поэтому go гайки; -) 

#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

...