【问题标题】:Leaflet - europe spatial network plot and distanced island removalLeaflet - 欧洲空间网络图和距离岛移除
【发布时间】:2020-01-06 18:19:41
【问题描述】:

我可能有与传单有关的非常复杂的问题,我正在尝试绘制欧洲的多个国家(从 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)

【问题讨论】:

    标签: r leaflet maps


    【解决方案1】:

    我提出了机械解决方案,我们将机械地强制 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时,它不一样,因此不正确。

    【讨论】:

      猜你喜欢
      • 2022-01-25
      • 1970-01-01
      • 2010-09-11
      • 1970-01-01
      • 1970-01-01
      • 2023-03-12
      • 1970-01-01
      • 2020-09-01
      • 2017-12-02
      相关资源
      最近更新 更多