library(sf)## Linking to GEOS 3.13.1, GDAL 3.10.2, PROJ 9.5.1; sf_use_s2() is TRUElibrary(dplyr)##
## Attachement du package : 'dplyr'## Les objets suivants sont masqués depuis 'package:stats':
##
## filter, lag## Les objets suivants sont masqués depuis 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(leaflet)
library(readr)
library(leaflet.extras)# Lire les shapefiles
cantons <- st_read("C:/Users/41792/Dropbox/carto/ASPAJU/swissBOUNDARIES3D_1_5_TLM_KANTONSGEBIET.shp", stringsAsFactors = FALSE)## Reading layer `swissBOUNDARIES3D_1_5_TLM_KANTONSGEBIET' from data source
## `C:\Users\41792\Dropbox\carto\ASPAJU\swissBOUNDARIES3D_1_5_TLM_KANTONSGEBIET.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 26 features and 19 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 2485410 ymin: 1075268 xmax: 2833858 ymax: 1295934
## Projected CRS: CH1903+ / LV95 + LN02 heightdistricts <- st_read("C:/Users/41792/Dropbox/carto/ASPAJU/swissBOUNDARIES3D_1_5_TLM_BEZIRKSGEBIET.shp", stringsAsFactors = FALSE)## Reading layer `swissBOUNDARIES3D_1_5_TLM_BEZIRKSGEBIET' from data source
## `C:\Users\41792\Dropbox\carto\ASPAJU\swissBOUNDARIES3D_1_5_TLM_BEZIRKSGEBIET.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 134 features and 20 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 2494306 ymin: 1075268 xmax: 2833858 ymax: 1295934
## Projected CRS: CH1903+ / LV95 + LN02 height# Extraire le Jura
jura <- cantons %>%
filter(NAME == "Jura") %>%
st_transform(4326) # Transformer en WGS84 pour Leaflet
# Extraire les districts du Jura via l'intersection géométrique
districts <- st_transform(districts, st_crs(jura))
districtJU <- st_intersection(districts, jura)## Warning: attribute variables are assumed to be spatially constant throughout
## all geometries# URL du fichier Google Sheets
url <- "https://docs.google.com/spreadsheets/d/e/2PACX-1vRo3AT0o-ofp6cQJ4pm5olIizNpcBBtF7WBH7eFab7myVvBWateHTb4_N_324CWFipX8RmrE64rxvuO/pub?output=csv"
# Lire les points depuis le fichier CSV
points <- read_csv(url)## Rows: 41 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): point, commune, statut
## dbl (2): lat, long
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.View(points)points <- points %>%
mutate(
code_statut = case_when(
statut == "mort" ~ "aucun témoin trouvé",
statut == "extrait" ~ "enquête partielle",
statut == "moitié" ~ "enquête partielle",
statut == "potentiel" ~ "enquête en cours",
statut == "ok" ~ "enquête complète",
TRUE ~ "inconnu"
)
)icons <- iconList(
"aucun témoin trouvé" = makeIcon("https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-red.png", iconWidth = 25, iconHeight = 41, iconAnchorX = 12, iconAnchorY = 41),
"enquête partielle" = makeIcon("https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-orange.png", iconWidth = 25, iconHeight = 41, iconAnchorX = 12, iconAnchorY = 41),
"enquête en cours" = makeIcon("https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-yellow.png", iconWidth = 25, iconHeight = 41, iconAnchorX = 12, iconAnchorY = 41),
"enquête complète" = makeIcon("https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-green.png", iconWidth = 25, iconHeight = 41, iconAnchorX = 12, iconAnchorY = 41)
)leaflet(points) %>%
# Ajouter le fond OpenStreetMap (OSM)
addProviderTiles(providers$OpenStreetMap, group = "OSM") %>%
# Ajouter le fond CartoDB
addProviderTiles(providers$CartoDB.Positron , group = "CartoDB") %>%
# Ajouter le fond Swisstopo gris
addTiles(
urlTemplate = "https://wmts.geo.admin.ch/1.0.0/ch.swisstopo.pixelkarte-grau/default/current/3857/{z}/{x}/{y}.jpeg",
attribution = "© Swisstopo",
group = "Swisstopo (gris)"
) %>%
# Ajouter les districts du Jura
addPolygons(data = districtJU, color = "black", fillColor = "#FFFFF0", weight = 1,
fillOpacity = 0.5, group = "Districts du Jura", dashArray = "3") %>%
# Ajouter le Jura
addPolygons(data = jura, color = "black", weight = 2,
fillOpacity = 0, group = "Canton du Jura") %>%
# Ajouter des points pour Porrentruy et Delémont avec labels
addMarkers(
lng = 7.0894, lat = 47.4167,
label = "Porrentruy", # Afficher le nom sur la carte
group = "Centres urbains"
) %>%
addMarkers(
lng = 7.3485, lat = 47.3670,
label = "Delémont", # Afficher le nom sur la carte
group = "Centres urbains"
) %>%
addMarkers(
lng = 7.371150672608205, lat = 47.278326943489645,
label = "Moutier",
group = "Centres urbains"
) %>%
addMarkers(
lng = 7.4474, lat = 47.4136,
label = "La Chaux-de-Fonds",
group = "Centres urbains"
) %>%
addMarkers(
lng = 7.00000000, lat = 47.25000000,
label = "Saignelégier",
group = "Centres urbains"
) %>%
# Ajouter les points existants avec des icônes
addMarkers(
lng = ~long,
lat = ~lat,
icon = ~icons[code_statut],
label = ~commune,
group = "Points d'enquête"
) %>%
# Ajouter un contrôle de couches pour changer de fond
addLayersControl(
baseGroups = c("OSM", "CartoDB", "Swisstopo (gris)"),
overlayGroups = c("Points d'enquête", "Zones d'enquête", "Centres urbains", "Districts du Jura", "Canton du Jura"),
options = layersControlOptions(collapsed = FALSE)
) %>%
# Ajouter la légende
addLegend(
position = "bottomright",
colors = c("red", "orange", "yellow", "green"),
labels = c("aucun témoin trouvé", "enquête partielle", "enquête en cours", "enquête complète"),
title = "Statut des enquêtes",
opacity = 1
) %>%
# Centrer la vue sur le Jura
setView(lng = 7.2, lat = 47.32, zoom = 10.75) %>%
# Ajouter un bouton pour réinitialiser la vue
# addControl(
# html = '<button onclick="map.setView([47.32, 7.2], 10.75);">Réinitialiser la vue</button>',
# position = "topleft"
# ) %>%
# Ajouter des cercles autour des points
addCircles(
lng = ~long,
lat = ~lat,
radius = 500, # Rayon en mètres
color = "black",
fillOpacity = 0.1,
group = "Zones d'enquête",
weight = 0.5
) %>%
# Ajouter une échelle
addScaleBar(position = "bottomleft", options = scaleBarOptions(imperial = FALSE)) %>%
setMaxBounds(
lng1 = 6.9, lat1 = 47.2,
lng2 = 7.5, lat2 = 47.45
)Vous pouvez maintenant télécharger le fichier R Markdown en cliquant ci-dessous :