在 R 中与数据帧进行 left_join 时，空间多边形不匹配

Question

我有一个从开源网站下载的形状文件和数据框。 通过连接它们，数据似乎不再与多边形匹配。

library(sf)
library(leaflet)
library(dplyr)
library(leaflet.extras)

#Create a dataframe from https://www.data.gouv.fr/fr/datasets/r/576fc1c9-ec6e-44bd-817f-f21bc9ebf3a3
raw_data <- read.csv("fr-en-dnb-par-etablissement.csv",sep=";") %>%
  filter(ï..session == 2021)%>%
  filter(code_departement == "075")%>%
  select(patronyme,taux_de_reussite)

#Create a shapefile from https://parisdata.opendatasoft.com/api/explore/v2.1/catalog/datasets/secteurs-scolaires-colleges/exports/shp?lang=fr&timezone=Europe%2FBerlin

my_shapefile <- st_read("secteurs-scolaires-colleges")

#Create a SpatialPolygon object and a copy to be able to compare
spdf <- as_Spatial(my_shapefile)
spdf_copy <- as_Spatial(my_shapefile)

#Join data from the dataframe to one of the SpatialPolygondataframe and print the map

spdffiltered <- spdf[spdf$annee_scol == "2023-2024",]

spdffiltered@data <- spdffiltered@data %>% 
  left_join(raw_data, by = c("libelle" = "patronyme"))

nc_pal1 <- colorFactor("magma", domain = spdffiltered@data$etiquette)

spdffiltered %>%
  leaflet() %>%
  addProviderTiles("CartoDB") %>%
  addPolygons(
    weight = 1, 
    color = ~nc_pal1(etiquette),
    label = ~paste0("Area : ", etiquette),
    highlightOptions = highlightOptions(weight = 5, color = "white", bringToFront = TRUE)
  )

#Print the map of the other SpatialPolygon object without joining

spdffiltered <- spdf_copy[  spdf_copy$annee_scol == "2023-2024",]

nc_pal1 <- colorFactor("magma", domain = spdffiltered@data$etiquette)

spdffiltered %>%
  leaflet() %>%
  addProviderTiles("CartoDB") %>%
  addPolygons(
    weight = 1, 
    color = ~nc_pal1(etiquette),
    label = ~paste0("Area : ", etiquette),
    highlightOptions = highlightOptions(weight = 5, color = "white", bringToFront = TRUE)
  )

在没有加入的地图上，我在图像上显示的正确位置处有例如“BUFFON”。

在加入的地图上，我在图像上显示的相同位置有“JEAN-BAPTISTE SAY”，这是错误的。

我们可以在其他一些位置（但不是全部）上发现相同的不匹配。

您能帮我理解并纠正它吗？

Answer 1

不知道为什么会发生这种情况。但不需要仅仅为了加入/取子集而将其转换为

SpatialPolygons

，可以直接在{sf}中完成：

library(sf)
library(leaflet)
library(dplyr)
library(leaflet.extras)

raw_data <- read.csv("fr-en-dnb-par-etablissement.csv",sep=";") %>%
  filter(session == 2021)%>%
  filter(code_departement == "075")%>%
  select(patronyme,taux_de_reussite)

my_shapefile <- st_read("secteurs-scolaires-colleges.shp")

spdffiltered <- my_shapefile |>
  subset(annee_scol == "2023-2024")

spdffiltered %>%
  leaflet() %>%
  addProviderTiles("CartoDB") %>%
  addPolygons(
    weight = 1, 
    color = ~nc_pal1(etiquette),
    label = ~paste0("Area : ", etiquette),
    highlightOptions = highlightOptions(weight = 5, color = "white", bringToFront = TRUE)
  )

现在让我们加入数据并检查两个数据集/帧中 BUFFON 的几何形状：

spdffiltered_with_join <- spdffiltered |>
  dplyr::left_join(raw_data, by = c("libelle" = "patronyme"))

sf::st_geometry(spdffiltered_with_join[spdffiltered_with_join$libelle == "BUFFON", ,]) ==
  sf::st_geometry(spdffiltered[spdffiltered$libelle == "BUFFON", ,])
#> [1] TRUE

spdffiltered_with_join %>%
  leaflet() %>%
  addProviderTiles("CartoDB") %>%
  addPolygons(
    weight = 1, 
    color = ~nc_pal1(etiquette),
    label = ~paste0("Area : ", etiquette, " / percentage: ", taux_de_reussite),
    highlightOptions = highlightOptions(weight = 5, color = "white", bringToFront = TRUE)
  )

^{创建于 2024 年 10 月 10 日，使用 reprex v2.1.0}