Leaflet - сюжет о пространственной сети Европы и удаленном удалении острова - PullRequest
Новая
       7

Leaflet - сюжет о пространственной сети Европы и удаленном удалении острова

0 голосов
/ 06 января 2020

У меня, вероятно, очень сложный вопрос, связанный с листовкой, я пытаюсь построить несколько стран Европы (данные загружены из GADM), а затем создать сетевую матрицу для стран, однако во Франции есть остров и по некоторым причинам вычисление матрицы веса. работать, однако, при создании кадра данных, он не может быть создан (когда Франция отбрасывается data6 это работает)

Есть ли способ, как удалить этот остров из данных Франции, или есть страницы пейджера, где Можно ли получить и легко нанести на карту страны, как в моем примере?

также, когда Франция отбрасывается и карта создается в листовке, появляется странная горизонтальная линия, ее можно как-то стереть?

пример вниз здесь (кажется, очень долго, но это из-за геоданных многих стран) 

library(leaflet)
library(ggplot2)
library(sf)
library(spdep)
library(leaflet.minicharts)
library(leafletCN)

# Regions of each country selected

URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_1_sp.rds"
data <- readRDS(url(URL))

URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CZE_1_sp.rds"
data2 <- readRDS(url(URL2))

URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_POL_1_sp.rds"
data3 <- readRDS(url(URL3))

URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_SVK_1_sp.rds"
data4 <- readRDS(url(URL4))

URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_AUT_1_sp.rds"
data5 <- readRDS(url(URL5))

URL6 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_1_sp.rds"
data6 <- readRDS(url(URL6))

URL7 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_HUN_1_sp.rds"
data7 <- readRDS(url(URL7))

URL8 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_BEL_1_sp.rds"
data8 <- readRDS(url(URL8))

URL9 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_NLD_1_sp.rds"
data9 <- readRDS(url(URL9))

URL10 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CHE_1_sp.rds"
data10 <- readRDS(url(URL10))
# Country borders of all countries

B_URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_0_sp.rds"
Bdata <- readRDS(url(B_URL))

B_URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CZE_0_sp.rds"
Bdata2 <- readRDS(url(B_URL2))

B_URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_POL_0_sp.rds"
Bdata3 <- readRDS(url(B_URL3))

B_URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_SVK_0_sp.rds"
Bdata4 <- readRDS(url(B_URL4))

B_URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_AUT_0_sp.rds"
Bdata5 <- readRDS(url(B_URL5))

B_URL6 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_0_sp.rds"
Bdata6 <- readRDS(url(B_URL6))

B_URL7 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_HUN_0_sp.rds"
Bdata7 <- readRDS(url(B_URL7))

B_URL8 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_BEL_0_sp.rds"
Bdata8 <- readRDS(url(B_URL8))

B_URL9 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_NLD_0_sp.rds"
Bdata9 <- readRDS(url(B_URL9))

B_URL10 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CHE_0_sp.rds"
Bdata10 <- readRDS(url(B_URL10))


# Trying to perform network base on QUEEN AND ROOK
A <- rbind(data, data2, data3, data4, data5,data6, data7, data8, data9, data10)
queen_data <- poly2nb(A, queen = F)
queen_data <- nb2listw(queen_data, style = "W", zero.policy = TRUE)

# Creating dataframe for plot purposes
data_df <- data.frame(coordinates(A))
colnames(data_df) <- c("long", "lat")

n = length(attributes(queen_data$neighbours)$region.id)
DA = data.frame(
  from = rep(1:n,sapply(queen_data$neighbours,length)),
  to = unlist(queen_data$neighbours),
  weight = unlist(queen_data$weights)
)
DA = cbind(DA, data_df[DA$from,], data_df[DA$to,])
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")


leaflet() %>% addProviderTiles("CartoDB.Positron") %>% 
  addPolygons(data=data, weight = 1, fill = F, color = "red") %>% 
  addPolygons(data=data2, weight = 1, fill = F, color = "red") %>% 
  addPolygons(data=data3, weight = 1, fill = F, color = "red") %>% 
  addPolygons(data=data4, weight = 1, fill = F, color = "red") %>% 
  addPolygons(data=data5, weight = 1, fill = F, color = "red") %>% 
  addPolygons(data=data7, weight = 1, fill = F, color = "red") %>%  
  addPolygons(data=data8, weight = 1, fill = F, color = "red") %>%  
  addPolygons(data=data9, weight = 1, fill = F, color = "red") %>%  
  addPolygons(data=data10, weight = 1, fill = F, color = "red") %>%  
  addPolygons(data=Bdata, weight = 3, fill = F, color = "black") %>% 
  addPolygons(data=Bdata2, weight = 3, fill = F, color = "black") %>% 
  addPolygons(data=Bdata3, weight = 3, fill = F, color = "black") %>% 
  addPolygons(data=Bdata4, weight = 3, fill = F, color = "black") %>% 
  addPolygons(data=Bdata5, weight = 3, fill = F, color = "black") %>%
  addPolygons(data=Bdata6, weight = 3, fill = F, color = "black") %>%
  addPolygons(data=Bdata7, weight = 3, fill = F, color = "black") %>%
  addPolygons(data=Bdata8, weight = 3, fill = F, color = "black") %>%
  addPolygons(data=Bdata9, weight = 3, fill = F, color = "black") %>%
  addPolygons(data=Bdata10, weight = 3, fill = F, color = "black") %>%
  addCircles(lng = data_df$long, lat = data_df$lat, weight = 9) %>% 
  #addCircles(lng = data_df2$long, lat = data_df2$lat) %>% 
  addFlows(lng0 = DA$long, lat0 = DA$lat,lng1 = DA$long_to, lat1 = DA$lat_to,
           dir = 0, maxThickness= 0.85)

1 Ответ

0 голосов
/ 06 января 2020

Я придумал механическое решение, в котором мы должны механически вычислять силу data.frame, чтобы иметь одинаковое количество строк, однако этот подход не годится. 

A <- rbind(data, data2, data3, data4, data5, data6, data7, data8, data9, data10)
queen_data <- poly2nb(A, queen = T)
queen_data <- nb2listw(queen_data, zero.policy = T)

plot(A)
plot(queen_data, coordinates(A), add = T, col = "red")

# Creating dataframe for plot purposes
data_df <- data.frame(coordinates(A))
colnames(data_df) <- c("long", "lat")

n = length(attributes(queen_data$neighbours)$region.id)
weights = unlist(queen_data$weights)
data_df[DA$from,] %>% dim()
da_to = data_df[DA$to,]
da_to[709, c(1, 2)] = NA
weight[709] = NA
DA = data.frame(
  from = rep(1:n,sapply(queen_data$neighbours,length)),
  to = unlist(queen_data$neighbours),
  weight = weight
)
DA = cbind(DA, data_df[DA$from,], da_to)
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")

окончательный график должен выглядеть как plot(A) plot(queen_data, coordinates(A), add = T, col = "red"), и когда построение этого DA кадра данных leaflet это НЕ то же самое и, следовательно, не правильно.

...