#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
#
# script linéaire à transposer en Shiny
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("sf", "tidyverse", "gt", "paletteer", "mapsf", "leaflet")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(gt)
library(paletteer)
library(mapsf)
library(leaflet)
# Chargement des données ----
# Consulter le contenu du gpkg :
st_layers("data/data_seance_shiny.gpkg")
# Lecture des données
donnees <- st_read("data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct")
# Plot 1 : vue de la table des données ----
# avec un simple view
view(donnees)
# avec la librairie gt()
donnees %>%
st_drop_geometry() %>%
gt::gt()
# On s'intéresse à la variable cpis_7am, soit la proportion de cadres et professions intellectuelles
# présents dans chacun des 66 secteurs de l'agglomération de Toulouse à 7h du matin (un jour type de semaine)
# Plot 2 : observer la distribution stat de la variable d'intérêt ----
donnees %>%
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
# Plot 3a : cartographie statique de la variable d'intérêt ----
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees %>%
st_transform(crs = 2154) %>%
mf_map(var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
# Plot 3b : cartographie dynamique de la variable d'intérêt ----
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal),
domain = donnees$cpis5_7am,
bins = bks
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal),
domain = round(donnees$cpis_7am),
bins = round(bks)
)
donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(cpis_7am),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(cpis_7am), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees$cpis_7am,
opacity = 1,
title = "Présence des CPIS à 7h (%)",
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)Créer une application interactive avec Shiny
Création d’une application web, avec le package shiny, pour mettre en place une interface graphique interactive autour d’un script R.
Aurélie Douet
CNRS
Centre de Recherches Historiques
Robin Cura 
Université Paris 1 Panthéon-Sorbonne
UMR PRODIG
Objectifs de la séance
- Comprendre le fonctionnement global d’une application Shiny
- Convertir un code R statique en application visible dans un navigateur
- Rendre interactif un code R statique
- Rendre accessible l’utilisation d’une chaîne de traitement sur des données externes
- Déployer une application Shiny
Cas d’application
- Cette séance ElementR est construite autour d’un projet pas-à-pas de conversion d’un script statique R d’exploration de données spatiales en une application Shiny permettant de mener cette exploration sur tout jeu de données.
Thématique
Le cas d’étude (minimaliste) consiste en l’exploration d’un jeu de données géographique vectoriel en observant :
- Une carte choroplèthe de la distribution géographique d’une variable
- Un histogramme de la distribution statistique de cette variable
- Un tableau des données
Données
Les données mobilisées dans cet exemple sont issues du Mobiliscope, et représentent
- La part d’individus de chaque PCS (inactifs, ouvriers, employés, professions intermédiaires, CPIS),
- présents dans les différents secteurs de l’agglomération de Toulouse,
- à différentes heures de la journée (7h, 12h, 17h, 23h).
]
Présentation du script statique
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
#
# script linéaire à transposer en Shiny
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("sf", "tidyverse", "gt", "paletteer", "mapsf", "leaflet")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(gt)
library(paletteer)
library(mapsf)
library(leaflet)
# Chargement des données ----
# Consulter le contenu du gpkg :
st_layers("data/data_seance_shiny.gpkg")
# Lecture des données
donnees <- st_read("data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct")
# Plot 1 : vue de la table des données ----
# avec un simple view
view(donnees)
# avec la librairie gt()
donnees %>%
st_drop_geometry() %>%
gt::gt()
# On s'intéresse à la variable cpis_7am, soit la proportion de cadres et professions intellectuelles
# présents dans chacun des 66 secteurs de l'agglomération de Toulouse à 7h du matin (un jour type de semaine)
# Plot 2 : observer la distribution stat de la variable d'intérêt ----
donnees %>%
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
# Plot 3a : cartographie statique de la variable d'intérêt ----
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees %>%
st_transform(crs = 2154) %>%
mf_map(var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
# Plot 3b : cartographie dynamique de la variable d'intérêt ----
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal),
domain = donnees$cpis5_7am,
bins = bks
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal),
domain = round(donnees$cpis_7am),
bins = round(bks)
)
donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(cpis_7am),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(cpis_7am), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees$cpis_7am,
opacity = 1,
title = "Présence des CPIS à 7h (%)",
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)Sorties (1/4)
Driver: GPKG
Available layers:
layer_name geometry_type features fields crs_name
1 toulouse_secteurs_cs_pct Multi Polygon 66 25 WGS 84
2 toulouse_secteurs_cs_nb Multi Polygon 66 25 WGS 84Reading layer `toulouse_secteurs_cs_pct' from data source
`D:\Dropbox\95_ElementR\20251216_Shiny\support\data\data_seance_shiny.gpkg'
using driver `GPKG'
Simple feature collection with 66 features and 25 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 1.006273 ymin: 43.3228 xmax: 1.742355 ymax: 43.82714
Geodetic CRS: WGS 84Sorties (2/4)
| ENQUETE | ANNEE | CODE_SEC | LIB | ZONAGE_SEC | inactifs_7am | inactifs_12am | inactifs_5pm | inactifs_11pm | ouvriers_7am | ouvriers_12am | ouvriers_5pm | ouvriers_11pm | employes_7am | employes_12am | employes_5pm | employes_11pm | intermediaires_7am | intermediaires_12am | intermediaires_5pm | intermediaires_11pm | cpis_7am | cpis_12am | cpis_5pm | cpis_11pm |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| TOULOUSE | 2013 | 001 | TOULOUSE CARMES | ville centre | 3.0018 | 5.4917 | 3.0252 | 3.2333 | 2.6128 | 4.4041 | 6.8511 | 9.3084 | 12.1759 | 27.4022 | 19.8981 | 8.8796 | 28.5843 | 21.9904 | 24.9851 | 30.2467 | 53.6253 | 40.7117 | 45.2404 | 48.3320 |
| TOULOUSE | 2013 | 002 | TOULOUSE CAPITOLE | ville centre | 3.7535 | 2.3185 | 2.9945 | 4.1771 | 9.1665 | 6.4797 | 7.1884 | 6.4788 | 17.7694 | 28.5786 | 24.3479 | 16.7722 | 41.2032 | 32.8021 | 32.8077 | 36.6289 | 28.1073 | 29.8211 | 32.6616 | 35.9430 |
| TOULOUSE | 2013 | 003 | TOULOUSE COMPANS | ville centre | 1.2891 | 0.9522 | 1.6180 | 0.6302 | 3.2782 | 4.9694 | 4.0607 | 3.6999 | 18.9937 | 25.6147 | 22.1775 | 21.5985 | 36.1723 | 32.1349 | 33.2155 | 33.8239 | 40.2667 | 36.3288 | 38.9282 | 40.2475 |
| TOULOUSE | 2013 | 004 | TOULOUSE JEAN JAURÈS | ville centre | 7.2107 | 5.9295 | 2.2528 | 6.0121 | 5.3986 | 4.2089 | 6.6112 | 2.4542 | 17.9943 | 27.8358 | 26.9701 | 19.3683 | 25.2039 | 23.8295 | 27.0970 | 32.0943 | 44.1925 | 38.1964 | 37.0689 | 40.0711 |
| TOULOUSE | 2013 | 005 | TOULOUSE ST-MICHEL | ville centre | 5.5000 | 5.3732 | 3.8286 | 5.8636 | 7.7478 | 5.8002 | 8.0197 | 7.5780 | 10.5762 | 21.8246 | 25.8313 | 13.9558 | 23.3080 | 28.9163 | 29.3988 | 24.2981 | 52.8680 | 38.0857 | 32.9217 | 48.3046 |
| TOULOUSE | 2013 | 006 | TOULOUSE FONDEYRE | ville centre | 4.2105 | 4.4476 | 4.0143 | 5.3764 | 13.5768 | 13.9158 | 15.9786 | 12.1599 | 22.1243 | 30.4427 | 29.3233 | 18.5431 | 30.0584 | 26.8035 | 26.7553 | 30.5733 | 30.0300 | 24.3904 | 23.9286 | 33.3472 |
| TOULOUSE | 2013 | 007 | TOULOUSE MINIMES | ville centre | 3.8880 | 4.2254 | 4.7740 | 4.9267 | 14.4368 | 17.8002 | 21.2313 | 20.0945 | 35.9966 | 34.6147 | 33.8984 | 31.9624 | 23.7442 | 25.7432 | 23.8532 | 23.7237 | 21.9344 | 17.6165 | 16.2430 | 19.2926 |
| TOULOUSE | 2013 | 008 | TOULOUSE MARENGO | ville centre | 3.7134 | 2.7141 | 5.0568 | 3.0764 | 9.3458 | 9.5138 | 5.1420 | 10.6057 | 31.9065 | 36.4044 | 34.5537 | 31.9053 | 25.5577 | 27.8033 | 30.8385 | 26.6711 | 29.4766 | 23.5643 | 24.4090 | 27.7415 |
| TOULOUSE | 2013 | 009 | TOULOUSE GUILHEMERY | ville centre | 0.7908 | 1.0834 | 2.5723 | 1.1514 | 12.1450 | 15.2963 | 13.8453 | 11.8504 | 21.3640 | 27.7444 | 27.0158 | 21.1906 | 26.1865 | 28.2222 | 27.5037 | 26.2348 | 39.5138 | 27.6537 | 29.0629 | 39.5729 |
| TOULOUSE | 2013 | 010 | TOULOUSE PONT DES DEMOISELLES | ville centre | 4.3013 | 5.4495 | 4.7544 | 4.9465 | 15.9861 | 15.1727 | 16.3625 | 13.4349 | 34.2739 | 36.3474 | 28.4894 | 32.8976 | 17.5358 | 19.4184 | 20.4651 | 18.1159 | 27.9029 | 23.6121 | 29.9286 | 30.6051 |
| TOULOUSE | 2013 | 011 | TOULOUSE ST-AGNE | ville centre | 4.9014 | 5.9832 | 5.6179 | 4.1660 | 7.6719 | 12.4811 | 10.8183 | 7.0006 | 26.2224 | 30.9673 | 33.7205 | 27.7437 | 29.6197 | 25.9683 | 28.3047 | 29.6943 | 31.5846 | 24.6001 | 21.5386 | 31.3954 |
| TOULOUSE | 2013 | 012 | TOULOUSE EMPALOT | ville centre | 14.2469 | 14.3219 | 12.5160 | 13.4266 | 21.6382 | 16.1922 | 13.0416 | 26.3229 | 43.6766 | 32.4780 | 42.4682 | 37.8433 | 17.5855 | 20.2244 | 18.9399 | 16.5606 | 2.8528 | 16.7834 | 13.0343 | 5.8466 |
| TOULOUSE | 2013 | 013 | TOULOUSE ST-CYPRIEN | ville centre | 5.9159 | 5.4688 | 6.5743 | 5.7739 | 6.6085 | 4.4341 | 8.8155 | 8.5099 | 29.0369 | 33.3426 | 32.2890 | 30.1003 | 31.6818 | 31.1662 | 28.0068 | 30.5978 | 26.7568 | 25.5883 | 24.3143 | 25.0182 |
| TOULOUSE | 2013 | 014 | TOULOUSE CROIX DE PIERRE | ville centre | 8.0384 | 7.5576 | 6.4543 | 6.2216 | 6.8035 | 7.6330 | 10.1605 | 7.7249 | 26.4613 | 28.3775 | 25.8934 | 26.3578 | 31.0815 | 30.1340 | 36.6738 | 30.5407 | 27.6154 | 26.2979 | 20.8180 | 29.1551 |
| TOULOUSE | 2013 | 015 | TOULOUSE BAGATELLE | ville centre | 5.6103 | 7.1826 | 5.0680 | 5.6987 | 20.7845 | 24.3649 | 20.0784 | 21.0923 | 42.6475 | 40.1387 | 40.3598 | 40.1162 | 22.1575 | 19.2136 | 22.2647 | 23.8998 | 8.8003 | 9.1002 | 12.2290 | 9.1930 |
| TOULOUSE | 2013 | 016 | TOULOUSE CÉPIÈRE | ville centre | 0.9543 | 4.4832 | 3.1403 | 1.1516 | 12.4203 | 20.1441 | 16.6866 | 14.8033 | 20.1787 | 24.4645 | 25.1467 | 21.6538 | 32.7492 | 28.5188 | 30.3428 | 29.2958 | 33.6975 | 22.3894 | 24.6836 | 33.0956 |
| TOULOUSE | 2013 | 017 | TOULOUSE PURPAN | ville centre | 1.7108 | 2.2424 | 3.1451 | 1.8628 | 16.6336 | 9.5277 | 17.2662 | 19.8941 | 27.6613 | 27.6952 | 25.0497 | 22.8640 | 34.8511 | 32.7904 | 28.8550 | 34.7165 | 19.1433 | 27.7443 | 25.6840 | 20.6626 |
| TOULOUSE | 2013 | 018 | TOULOUSE SEPT DENIERS | ville centre | 2.6107 | 4.2289 | 1.0438 | 2.2934 | 14.4722 | 15.7246 | 17.3764 | 10.4812 | 23.0993 | 17.8116 | 19.8180 | 24.2137 | 38.8682 | 38.3678 | 36.7788 | 39.6210 | 20.9496 | 23.8672 | 24.9829 | 23.3906 |
| TOULOUSE | 2013 | 019 | TOULOUSE LALANDE | ville centre | 7.2988 | 10.2419 | 8.3756 | 7.2518 | 20.7438 | 20.5666 | 21.3320 | 21.4316 | 29.2262 | 29.4912 | 33.8488 | 29.7000 | 25.9411 | 27.9673 | 27.2941 | 24.8537 | 16.7901 | 11.7330 | 9.1496 | 16.7629 |
| TOULOUSE | 2013 | 020 | TOULOUSE BORDEROUGE | ville centre | 4.1803 | 4.9132 | 4.9556 | 3.4775 | 16.4383 | 19.2210 | 18.7791 | 14.5571 | 38.4396 | 32.2375 | 29.9645 | 39.0909 | 24.1833 | 29.0287 | 27.4018 | 24.3833 | 16.7585 | 14.5996 | 18.8990 | 18.4911 |
| TOULOUSE | 2013 | 021 | TOULOUSE ARGOULETS | ville centre | 7.6362 | 9.4473 | 8.6705 | 8.1760 | 16.4833 | 13.1323 | 13.2424 | 20.6094 | 27.3327 | 29.6124 | 36.9174 | 26.7484 | 21.8800 | 26.1952 | 26.7322 | 20.8037 | 26.6677 | 21.6128 | 14.4375 | 23.6625 |
| TOULOUSE | 2013 | 022 | TOULOUSE CHÂTEAU DE L'HERS | ville centre | 5.4032 | 7.3795 | 5.9027 | 5.1567 | 10.2603 | 14.1776 | 14.2946 | 12.8768 | 31.2005 | 33.0598 | 34.1575 | 31.5273 | 25.0626 | 27.0079 | 27.0363 | 22.8566 | 28.0735 | 18.3752 | 18.6089 | 27.5826 |
| TOULOUSE | 2013 | 023 | TOULOUSE MONTAUDRAN | ville centre | 1.1830 | 0.6479 | 0.9701 | 1.1206 | 7.1624 | 5.0209 | 5.6621 | 7.5251 | 37.2914 | 23.6998 | 21.2192 | 33.7514 | 25.1155 | 24.5376 | 24.3237 | 27.0935 | 29.2477 | 46.0938 | 47.8248 | 30.5094 |
| TOULOUSE | 2013 | 024 | TOULOUSE RANGUEIL | ville centre | 2.9901 | 2.7443 | 2.7969 | 3.2710 | 5.1837 | 6.0538 | 3.8011 | 4.3738 | 24.9073 | 24.9710 | 21.5475 | 24.0387 | 29.3701 | 27.4971 | 25.0709 | 28.8761 | 37.5488 | 38.7337 | 46.7837 | 39.4404 |
| TOULOUSE | 2013 | 025 | TOULOUSE LAFOURGUETTE | ville centre | 6.3189 | 3.2286 | 4.8158 | 7.9298 | 20.2229 | 13.8745 | 13.6510 | 18.8781 | 29.6964 | 20.6710 | 20.7263 | 30.6247 | 30.5948 | 32.7601 | 30.3306 | 27.4232 | 13.1669 | 29.4658 | 30.4764 | 15.1443 |
| TOULOUSE | 2013 | 026 | TOULOUSE ST-SIMON | ville centre | 5.8003 | 6.6945 | 4.9808 | 5.7814 | 9.6237 | 12.2519 | 8.6174 | 8.0092 | 18.6708 | 12.7939 | 14.2233 | 20.6158 | 37.6760 | 30.9201 | 36.8432 | 38.2236 | 28.2292 | 37.3396 | 35.3354 | 27.3700 |
| TOULOUSE | 2013 | 027 | TOULOUSE REYNERIE | ville centre | 20.6699 | 14.6549 | 18.0719 | 19.2076 | 36.3695 | 26.8963 | 27.7983 | 33.2187 | 32.8300 | 26.9475 | 23.9514 | 34.6934 | 6.8523 | 19.5159 | 20.7163 | 8.2532 | 3.2783 | 11.9854 | 9.4621 | 4.6272 |
| TOULOUSE | 2013 | 028 | TOULOUSE PRADETTES | ville centre | 4.4914 | 1.1099 | 2.5651 | 4.2790 | 20.1728 | 9.3961 | 7.7619 | 20.7461 | 27.0060 | 19.7466 | 18.5103 | 26.5656 | 28.6367 | 25.3509 | 25.0005 | 28.2804 | 19.6932 | 44.3965 | 46.1622 | 20.1289 |
| TOULOUSE | 2013 | 029 | TOULOUSE ST-MARTIN-DU-TOUCH | ville centre | 2.6444 | 1.1987 | 1.4346 | 3.1988 | 17.2665 | 9.8663 | 7.6056 | 15.7004 | 22.2108 | 13.5437 | 12.8177 | 22.7812 | 28.0641 | 23.9309 | 21.4504 | 27.1528 | 29.8142 | 51.4604 | 56.6917 | 31.1667 |
| TOULOUSE | 2013 | 030 | BLAGNAC | zone urbaine | 1.9452 | 1.4504 | 1.0815 | 2.0989 | 11.1554 | 7.3908 | 8.3502 | 11.5346 | 29.0134 | 18.9902 | 19.6760 | 33.4010 | 27.2853 | 25.7479 | 22.8359 | 26.5716 | 30.6007 | 46.4207 | 48.0563 | 26.3939 |
| TOULOUSE | 2013 | 031 | L'UNION | zone urbaine | 6.0670 | 6.9719 | 6.7144 | 5.2770 | 6.1031 | 6.9452 | 7.3870 | 6.2210 | 35.4266 | 38.4670 | 29.4533 | 36.5574 | 25.2799 | 28.7853 | 28.2201 | 24.5501 | 27.1234 | 18.8306 | 28.2251 | 27.3945 |
| TOULOUSE | 2013 | 032 | BALMA | zone urbaine | 5.0792 | 3.0594 | 3.8534 | 5.2888 | 15.3797 | 13.0773 | 8.1827 | 7.8584 | 29.7267 | 28.7401 | 29.2182 | 35.0040 | 22.5420 | 28.6793 | 28.4598 | 24.7350 | 27.2723 | 26.4438 | 30.2859 | 27.1139 |
| TOULOUSE | 2013 | 033 | ST-ORENS-DE-GAMEVILLE | zone urbaine | 5.2461 | 4.2923 | 3.7700 | 4.5278 | 6.4640 | 10.6331 | 10.7381 | 7.5583 | 25.1132 | 31.4527 | 38.2112 | 25.4754 | 27.9508 | 35.4522 | 29.4660 | 28.3966 | 35.2259 | 18.1698 | 17.8148 | 34.0420 |
| TOULOUSE | 2013 | 034 | RAMONVILLE-ST-AGNE | zone urbaine | 3.1565 | 3.4760 | 4.8447 | 3.0752 | 3.6613 | 8.6578 | 7.6648 | 6.5449 | 27.8057 | 29.8710 | 22.5926 | 25.8266 | 22.9024 | 25.6013 | 29.4535 | 21.1646 | 42.4741 | 32.3939 | 35.4444 | 43.3887 |
| TOULOUSE | 2013 | 035 | CUGNAUX | zone urbaine | 5.2202 | 6.6568 | 6.6503 | 4.3670 | 12.5292 | 20.3984 | 20.5169 | 10.2881 | 26.8980 | 28.3204 | 26.8904 | 25.7515 | 30.3462 | 30.3453 | 32.9998 | 31.5697 | 25.0063 | 14.2791 | 12.9426 | 28.0237 |
| TOULOUSE | 2013 | 036 | TOURNEFEUILLE | zone urbaine | 2.6451 | 3.7178 | 4.0503 | 2.5191 | 9.0037 | 14.3729 | 15.9737 | 10.3718 | 24.1473 | 27.3391 | 30.1623 | 24.9583 | 35.2342 | 34.6834 | 34.4954 | 34.1484 | 28.9696 | 19.8868 | 15.3183 | 28.0023 |
| TOULOUSE | 2013 | 037 | COLOMIERS SUD | zone urbaine | 2.9882 | 2.2448 | 1.5673 | 3.0104 | 15.5536 | 16.1020 | 14.7821 | 13.7256 | 18.3681 | 21.6247 | 23.7995 | 19.1326 | 22.6886 | 27.6866 | 27.4247 | 24.6835 | 40.4015 | 32.3418 | 32.4264 | 39.4479 |
| TOULOUSE | 2013 | 038 | COLOMIERS NORD | zone urbaine | 7.5213 | 6.3887 | 7.2330 | 7.4167 | 22.0103 | 19.7475 | 17.9365 | 21.0558 | 31.6149 | 32.1125 | 30.1869 | 30.4985 | 26.3820 | 24.8268 | 25.1840 | 27.1845 | 12.4716 | 16.9244 | 19.4596 | 13.8445 |
| TOULOUSE | 2013 | 039 | CORNEBARRIEU ; MONDONVILLE | zone urbaine | 2.3481 | 3.1428 | 4.6976 | 1.5325 | 5.7984 | 9.5919 | 4.8133 | 7.0242 | 31.7561 | 26.6770 | 28.6149 | 31.2845 | 30.0561 | 34.2137 | 35.0643 | 28.6226 | 30.0413 | 26.3747 | 26.8099 | 31.5362 |
| TOULOUSE | 2013 | 040 | AUSSONNE ; BEAUZELLE ; SEILH | zone urbaine | 3.4606 | 4.8702 | 3.1863 | 2.5306 | 10.2897 | 16.0528 | 10.6085 | 11.0905 | 30.2967 | 35.7821 | 38.0146 | 28.7492 | 31.1332 | 29.1450 | 29.9502 | 33.0445 | 24.8198 | 14.1498 | 18.2404 | 24.5852 |
| TOULOUSE | 2013 | 041 | AUCAMVILLE ; ST-ALBAN ; FENOUILLET | zone urbaine | 7.4268 | 7.3315 | 8.8136 | 7.9475 | 18.7574 | 21.7414 | 24.8372 | 18.8646 | 27.0218 | 30.1094 | 24.7419 | 24.9066 | 27.7395 | 26.1985 | 28.1544 | 29.6041 | 19.0544 | 14.6192 | 13.4529 | 18.6773 |
| TOULOUSE | 2013 | 042 | BRUGUIÈRES ; GAGNAC-SUR-GARONNE ; LESPINASSE | zone urbaine | 8.3446 | 8.5175 | 9.6507 | 6.7129 | 22.2377 | 21.6852 | 23.9546 | 21.4308 | 22.0337 | 22.5367 | 22.3772 | 23.9492 | 27.7519 | 31.2222 | 29.0668 | 26.9582 | 19.6321 | 16.0385 | 14.9507 | 20.9489 |
| TOULOUSE | 2013 | 043 | CASTELGINEST ; LAUNAGUET ; FONBEAUZARD | zone urbaine | 2.9830 | 2.2856 | 3.8890 | 3.5152 | 14.7597 | 18.0810 | 21.5812 | 15.7687 | 27.9329 | 32.4185 | 31.6680 | 28.8280 | 38.2593 | 37.7719 | 31.8466 | 36.3705 | 16.0652 | 9.4431 | 11.0153 | 15.5176 |
| TOULOUSE | 2013 | 044 | ST-JEAN | zone urbaine | 2.7069 | 2.9452 | 2.9849 | 2.6626 | 11.7304 | 11.7107 | 8.1875 | 11.0766 | 32.5885 | 32.2409 | 36.4780 | 31.1103 | 27.2010 | 27.1171 | 27.6453 | 27.8521 | 25.7732 | 25.9860 | 24.7043 | 27.2984 |
| TOULOUSE | 2013 | 045 | QUINT-FONSEGRIVES ; DRÉMIL-LAFAGE ; FLOURENS... | zone périphérique | 4.2981 | 6.6190 | 6.7273 | 4.2941 | 7.4735 | 12.3484 | 16.0007 | 6.8352 | 22.1745 | 29.9326 | 24.2832 | 21.7118 | 33.9057 | 35.0783 | 39.1574 | 38.6215 | 32.1481 | 16.0217 | 13.8315 | 28.5373 |
| TOULOUSE | 2013 | 046 | ESCALQUENS ; LABÈGE ; AUZIELLE | zone urbaine | 3.4362 | 1.8237 | 2.8483 | 3.1479 | 13.2486 | 8.5354 | 6.3709 | 9.5554 | 20.6806 | 23.5385 | 26.5637 | 25.4352 | 25.8007 | 32.7472 | 26.2128 | 29.4508 | 36.8339 | 33.3552 | 38.0044 | 32.4106 |
| TOULOUSE | 2013 | 047 | CASTANET-TOLOSAN ; AUZEVILLE-TOLOSANE | zone urbaine | 7.0979 | 7.9243 | 7.5207 | 7.2903 | 6.1033 | 8.5264 | 9.8031 | 7.3223 | 21.1460 | 15.6379 | 23.9847 | 19.5071 | 31.7596 | 38.8940 | 29.7915 | 30.1509 | 33.8931 | 29.0174 | 28.9000 | 35.7294 |
| TOULOUSE | 2013 | 048 | LACROIX-FALGARDE ; VIEILLE-TOULOUSE ; PECHBUSQUE... | zone urbaine | 3.8916 | 5.9554 | 6.3470 | 3.7760 | 1.4533 | 2.8423 | 1.3808 | 3.6161 | 11.7371 | 16.4543 | 16.9149 | 11.3885 | 35.7116 | 35.5108 | 38.9647 | 35.2394 | 47.2065 | 39.2372 | 36.3925 | 45.9801 |
| TOULOUSE | 2013 | 049 | PORTET-SUR-GARONNE ; ROQUES | zone urbaine | 1.9627 | 2.3743 | 2.0092 | 2.0971 | 21.1573 | 22.8291 | 18.0181 | 16.0686 | 28.8813 | 25.8728 | 29.0160 | 29.1845 | 32.1350 | 31.7000 | 32.1599 | 36.8740 | 15.8638 | 17.2238 | 18.7967 | 15.7757 |
| TOULOUSE | 2013 | 050 | VILLENEUVE-TOLOSANE ; SEYSSES ; FROUZINS | zone urbaine | 1.8998 | 2.6188 | 2.4129 | 2.3370 | 13.5249 | 18.0583 | 19.0215 | 15.0177 | 28.1319 | 29.9850 | 29.0483 | 26.6832 | 40.1878 | 39.4098 | 39.4235 | 39.8693 | 16.2557 | 9.9281 | 10.0938 | 16.0928 |
| TOULOUSE | 2013 | 051 | PLAISANCE-DU-TOUCH ; LA SALVETAT-ST-GILLES | zone urbaine | 2.4060 | 4.5231 | 3.5909 | 2.7621 | 12.9695 | 13.1918 | 14.6295 | 16.8913 | 24.8178 | 29.0926 | 29.7147 | 23.6094 | 35.2086 | 33.0608 | 33.0449 | 33.1387 | 24.5980 | 20.1316 | 19.0199 | 23.5986 |
| TOULOUSE | 2013 | 052 | LÉGUEVIN ; PIBRAC ; BRAX | zone urbaine | 2.4368 | 3.3092 | 1.7956 | 2.2994 | 1.8110 | 6.4375 | 3.2391 | 4.6497 | 30.4123 | 34.6733 | 40.9185 | 29.5748 | 26.4884 | 35.8556 | 32.3533 | 26.6043 | 38.8515 | 19.7243 | 21.6935 | 36.8719 |
| TOULOUSE | 2013 | 053 | LABARTHE-SUR-LÈZE ; PINS-JUSTARET ; ROQUETTES... | zone urbaine | 4.3990 | 4.9443 | 6.5639 | 3.9326 | 15.1969 | 19.1944 | 12.4816 | 17.1817 | 23.4977 | 28.2144 | 27.1763 | 19.8441 | 37.4607 | 30.6356 | 31.7501 | 39.4379 | 19.4457 | 17.0113 | 22.0281 | 19.6037 |
| TOULOUSE | 2013 | 054 | MURET | zone urbaine | 1.5700 | 2.1020 | 1.9478 | 1.5032 | 16.1171 | 16.8352 | 17.1075 | 14.8227 | 38.9827 | 39.4111 | 37.9424 | 38.7833 | 29.1051 | 24.8767 | 25.8349 | 29.5529 | 14.2252 | 16.7750 | 17.1673 | 15.3378 |
| TOULOUSE | 2013 | 055 | PECHBONNIEU ; GRATENTOUR ; MONTBERON... | zone urbaine | 2.3912 | 4.1589 | 3.8273 | 2.1952 | 8.8499 | 12.9986 | 14.9292 | 9.7321 | 22.5286 | 33.0227 | 31.8283 | 22.9216 | 37.1974 | 40.5627 | 41.5726 | 37.4492 | 29.0329 | 9.2570 | 7.8426 | 27.7019 |
| TOULOUSE | 2013 | 056 | CASTELMAUROU ; MONTRABÉ ; ROUFFIAC-TOLOSAN... | zone urbaine | 3.0038 | 3.4792 | 3.3018 | 2.9736 | 9.0656 | 11.7672 | 14.7530 | 8.5392 | 29.9272 | 34.2102 | 35.6030 | 28.5307 | 29.4024 | 32.5926 | 29.5110 | 29.6199 | 28.6009 | 17.9507 | 16.8311 | 30.3367 |
| TOULOUSE | 2013 | 057 | VERFEIL ; MONTASTRUC-LA-CONSEILLÈRE ; GRAGNAGUE... | zone périphérique | 1.8117 | 1.0525 | 2.4550 | 1.5663 | 12.2525 | 15.1989 | 17.4798 | 14.0431 | 32.2491 | 32.1494 | 25.3552 | 29.9843 | 32.9500 | 32.1579 | 41.7414 | 30.0859 | 20.7368 | 19.4413 | 12.9686 | 24.3205 |
| TOULOUSE | 2013 | 058 | STE-FOY-D'AIGREFEUILLE ; LANTA ; LAUZERVILLE... | zone périphérique | 0.7029 | 1.6602 | 1.1299 | 0.6421 | 8.4231 | 18.2331 | 13.9122 | 10.0864 | 25.5673 | 17.0235 | 16.4752 | 24.7374 | 33.4583 | 43.1596 | 38.2747 | 30.1744 | 31.8483 | 19.9236 | 30.2079 | 34.3597 |
| TOULOUSE | 2013 | 059 | BAZIÈGE ; AYGUESVIVES ; MONTGISCARD... | zone périphérique | 0.9180 | 1.4638 | 1.3203 | 0.8263 | 4.7160 | 6.5110 | 5.6660 | 7.3681 | 30.7014 | 39.3854 | 41.9062 | 30.9085 | 29.6073 | 32.0812 | 33.3997 | 28.9902 | 34.0573 | 20.5586 | 17.7078 | 31.9069 |
| TOULOUSE | 2013 | 060 | EAUNES ; LAGARDELLE-SUR-LÈZE ; VERNET... | zone périphérique | 3.7507 | 5.8644 | 4.8523 | 3.1280 | 14.0360 | 18.5267 | 20.9601 | 19.1680 | 22.7666 | 22.4363 | 25.1653 | 22.0156 | 35.5335 | 40.3608 | 35.0181 | 31.5893 | 23.9133 | 12.8119 | 14.0042 | 24.0991 |
| TOULOUSE | 2013 | 061 | LHERM ; LAVERNOSE-LACASSE ; LONGAGES... | zone périphérique | 3.5676 | 5.0607 | 3.6985 | 3.2760 | 14.8878 | 20.7538 | 14.3574 | 15.8426 | 27.8356 | 28.2280 | 29.4694 | 28.9700 | 40.7090 | 35.3625 | 40.4471 | 40.5332 | 13.0000 | 10.5950 | 12.0276 | 11.3783 |
| TOULOUSE | 2013 | 062 | FONSORBES ; ST-LYS ; FONTENILLES | zone périphérique | 5.1449 | 4.6957 | 4.6621 | 4.5438 | 9.5809 | 9.5436 | 15.9341 | 11.1184 | 38.1871 | 37.5884 | 36.2479 | 36.6490 | 28.6346 | 35.1293 | 29.0400 | 28.9588 | 18.4525 | 13.0430 | 14.1158 | 18.7299 |
| TOULOUSE | 2013 | 063 | STE-FOY-DE-PEYROLIÈRES ; BONREPOS-SUR-AUSSONNELLE ; SAIGUÈDE... | zone périphérique | 4.4396 | 7.1500 | 6.3040 | 4.1296 | 7.0472 | 7.9336 | 5.8580 | 6.5551 | 23.6385 | 27.7978 | 31.4073 | 25.2530 | 35.5567 | 38.9577 | 37.1352 | 35.1884 | 29.3179 | 18.1609 | 19.2955 | 28.8739 |
| TOULOUSE | 2013 | 064 | L'ISLE-JOURDAIN ; DAUX ; LÉVIGNAC... | zone périphérique | 5.4138 | 6.9731 | 7.1527 | 5.1746 | 11.0270 | 11.1078 | 12.1026 | 9.4940 | 26.1167 | 29.5806 | 29.9615 | 28.3674 | 34.2132 | 32.8002 | 32.0890 | 33.9510 | 23.2293 | 19.5383 | 18.6941 | 23.0130 |
| TOULOUSE | 2013 | 065 | GRENADE ; MERVILLE ; LARRA... | zone périphérique | 4.6239 | 5.8597 | 8.3136 | 5.1906 | 15.2411 | 15.8007 | 13.4023 | 13.9732 | 36.9907 | 38.7847 | 37.4037 | 34.4330 | 23.6774 | 25.9986 | 27.7332 | 26.2770 | 19.4668 | 13.5562 | 13.1472 | 20.1262 |
| TOULOUSE | 2013 | 066 | CASTELNAU-D'ESTRÉTEFONDS ; ST-JORY ; BOULOC... | zone périphérique | 5.0888 | 7.5439 | 5.5803 | 4.8182 | 10.9498 | 16.7173 | 13.8961 | 10.4438 | 28.6889 | 25.7289 | 23.4847 | 26.1021 | 39.5255 | 39.6591 | 42.9980 | 42.2333 | 15.7469 | 10.3509 | 14.0409 | 16.4026 |
Sorties (3/4)
Sorties (4/4)
# Plot 3a : cartographie statique
# de la variable d'intérêt ----
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees %>%
st_transform(crs = 2154) %>%
mf_map(var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10, pos = c(541000, 6248559))
Introduction à Shiny
Utilité et principes
Shiny est un package R qui permet de réaliser des applications web interactives et réactives au moyen d’une syntaxe dédiée.
Dans le détail,
shinyest un package R, qui s’appuie sur un serveur (shiny-server) pour exécuter du code R dont le résultat sera affiché (en HTML) dans un navigateur web.Une application shiny est composée de deux parties :
- Une partie décrivant l’apparence de l’application et son contenu, ie. son interface graphique : l’
UI(User Interface) - Une partie décrivant les traitements R à réaliser pour remplir l’UI et la manière dont les composants interagissent les uns avec les autres : le
server
- Une partie décrivant l’apparence de l’application et son contenu, ie. son interface graphique : l’
UI
L’UI est la partie graphique de l’application, c’est-à-dire ce qui est affiché dans le navigateur de l’utilisateur.
L’UI est codée avec une syntaxe spécifique, appuyée sur des composants Bootstrap, qui sont ensuite convertis en HTML et stylés en CSS.
On y définit la mise en page globale de l’application (le layout) à l’aide de composants statiques (textes, menus, etc.) et dynamiques : les inputs et outputs
Les input sont un ensemble d’outils interactifs avec lesquels l’utilisateur pourra agir sur l’état de l’application (menu de sélection, curseur, bouton radio, etc.)
Les output sont les éléments qui sont calculés par R et qui seront ensuite affichés dans l’interface graphique (ie. un graphique, une carte, un tableau, etc.)
Server
Le serveur (server) est la machinerie d’une application Shiny. C’est cette partie qui définit ce qui sera affiché dans les espaces définis dans l’UI, et qui effectue donc les calculs nécessaires à cela.
De manière générale, le serveur va permettre d’exécuter des fonctions en prenant en compte les paramètres donnés par l’utilisateur (les input), et renvoyer les résultats sous la forme de textes, graphiques ou objets spécifiques (les output).
L’un des éléments les plus pratiques de Shiny est la gestion de la réactivité, c’est-à-dire que quand l’utilisateur change la valeur d’un input, Shiny ré-exécutera l’ensemble des fonctions qui mobilisent cet input, ce qui engendrera l’actualisation des output qui en dépendent.
Récap : UI & server
Pour créer une application shiny, on doit définir deux ensembles :
- Une UI, composée de composants, d’inputs, et d’outputs, qui définissent la forme de l’application
- Un server, composé de fonctions, qui produisent des output à partir des valeurs des input
Pratique : créer une première application Shiny dans Rstudio
Construire son UI
Layout d’une UI
Dans une application shiny, on part d’une page “vide” organisée sous forme d’une grille de 12 colonnes.
on peut donc définir l’apparence des blocs et composants en utilisant des largeurs multiples de 12
chaque colonne peut elle-même être subdivisée en multiple de 12 colonnes (
column())la composante verticale est définie par des lignes (
fluidRow()) : ici, 4 rows avec différentes compositions de colonnes
Les Outputs : fonctions xOutput()
On peut définir des blocs statiques (titres h1(), h2(), h3() etc., textes en HTML, images etc.), mais une des plus-value de Shiny est la facilité d’insertion d’un résultat d’exécution de code R dans l’UI.
On utilise pour cela des fonctions “Output”, avec les variantes possibles :
plotOutput()pour afficher une figure résultant de calculimageOutput()pour afficher une image statiquetextOutput()pour afficher un texte mis en forme (équivalent auprint())verbatimTextOutput()pour afficher un texte “brut”tableOutput()pour afficher un data.frameuiOutput()pour affiche des éléments HTML dynamiques (HTML évalué)
Création de l’UI de notre application
Conception graphique
Nous avons 3 sorties graphiques dans notre code linéaire :
- une carte
- un histogramme
- un tableau
Nous souhaitons organiser ces sorties d’une manière simple
Implémentation
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(width = 6,
plotOutput(outputId = "map")
),
column(width = 6,
fluidRow(
plotOutput(outputId = "barplot")
),
fluidRow(
tableOutput(outputId = "table")
)
)
)Remplir l’UI
Les fonctions renderX()
Pour générer le contenu des xOutput() de la partie UI, on définit dans la partie server un ensemble d’objets correspondant aux output de l’UI qui sont remplis par des fonctions de type renderX :
renderPlot()permet de générer un plot qui sera affiché dans l’UI viaplotOutput()renderImage()pourimageOutput()renderPrint()pourtextOutput()renderText()pourverbatimTextOutput()renderTable()pourtableOutput()renderUI()pouruiOutput()
Remplissage d’un Output dans le server
Les objets UI xOutput() sont déclarés avec un identifiant (outputId), et on les retrouve dans un objet global output, via lequel on définit le contenu de l’objet à générer
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
ui <- fluidPage(
plotOutput(outputId = "MonPLOT")
)
server <- function(input, output, session){
output$MonPLOT <- renderPlot({
plot(1:10, 1:10)
})
}
shinyApp(ui = ui, server = server) # Exécution de l'applicationApplication exemple : première implémentation
Un peu de pratique : à partir du script linéaire, remplissez votre première application Shiny (app.R générée via l’interface RStudio) de manière à y afficher nos trois sorties graphiques.
Chargements
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)UI
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)UI (HTML)
<h1>Exploration de ma variable d'intérêt</h1>
<h3>Présence des CPIS à 7h dans l'agglomération toulousaine</h3>
<div class="col-sm-6">
<div class="shiny-plot-output html-fill-item" id="map" style="width:100%;height:400px;"></div>
</div>
<div class="col-sm-6">
<div class="row">
<div class="shiny-plot-output html-fill-item" id="barplot" style="width:100%;height:400px;"></div>
</div>
<div class="row">
<div id="table" class="shiny-html-output"></div>
</div>
</div>Server - Carte
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)Server - Histogramme
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)Server - Tableau
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)Execution
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)Résultat
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 0 : app minimale sans contrôle ni mise en page
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
ui <- shiny::fillPage(
padding = "10px",
h1("Exploration de ma variable d'intérêt"),
h3("Présence des CPIS à 7h dans l'agglomération toulousaine"),
column(6,
plotOutput(outputId = "map")
),
column(6,
fluidRow(plotOutput(outputId = "barplot")),
fluidRow(tableOutput(outputId = "table"))
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees |>
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
mf_scale(size = 10,
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees |>
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees |>
st_drop_geometry()
return(donnees_table)
}, striped = TRUE)
}
shinyApp(ui = ui, server = server)Un peu de style
Par défaut, cette interface, bien que fonctionnelle, a de multiples défauts : on ne peut pas simplement et élégamment légender les composants de l’interface, et le tableau de données s’affiche de manière “coupée”.
De plus, quitte à faire une application web de présentation statique de sorties graphiques, autant que ces dernières soient mises en page de manière plus esthétique.
Shiny s’appuie par défaut sur le framework graphique web Bootstrap, mais en utilisant des composants et attributs très basiques de ce framework puissant.
Le package
bslib(rstudio.github.io/bslib/) propose des composants graphiques bien plus avancés et personnalisables, eux aussi basés sur Bootstrap.
bslib
Organisation de la page : page_sidebar() vs fillPage()
fillPage()
library(shiny)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
shinyApp(ui1, server)page_sidebar()
library(shiny)
library(bslib)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui1, server) #
shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace verticalfillPage()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
shinyApp(ui1, server)page_sidebar()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui1, server) #
shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
Organisation de la page : layout_columns() vs column()
column()
library(shiny)
library(bslib)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui1, server) #
shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace verticallayout_columns()
library(shiny)
library(bslib)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
shinyApp(ui3, server) # Sidebar et colonnescolumn()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui1 <- shiny::fillPage(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui1, server) #
shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
layout_columns()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
shinyApp(ui3, server) # Sidebar et colonnesEsthétique des composants : ajout de card()
Rendu brut
library(shiny)
library(bslib)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
shinyApp(ui3, server) # Sidebar et colonnescard()
library(shiny)
library(bslib)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui3, server) # Sidebar et colonnes
shinyApp(ui4, server) # Sidebar, colonnes et cards videsRendu brut
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui2 <- bslib::page_sidebar(
fluidRow(
column(6, plotOutput("A")),
column(6, plotOutput("B")),
),
fluidRow(
column(12, plotOutput("C"))
)
)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui2, server) # Ajout d'une sidebar, n'occupe pas l'espace vertical
shinyApp(ui3, server) # Sidebar et colonnescard()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui3, server) # Sidebar et colonnes
shinyApp(ui4, server) # Sidebar, colonnes et cards vides
Esthétique des composants : options de card()
card()
library(shiny)
library(bslib)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui3, server) # Sidebar et colonnes
shinyApp(ui4, server) # Sidebar, colonnes et cards videscard_header() et card_body()
library(shiny)
library(bslib)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui4, server) # Sidebar, colonnes et cards vides
shinyApp(ui5, server) # Sidebar, colonnes et cards titréescard()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui3 <- bslib::page_sidebar(
layout_columns(
plotOutput("A"),
plotOutput("B"),
col_widths = c(6, 6)
),
layout_columns(
plotOutput("C"),
col_widths = c(12)
)
)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui3, server) # Sidebar et colonnes
shinyApp(ui4, server) # Sidebar, colonnes et cards vides
card_header() et card_body()
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui4, server) # Sidebar, colonnes et cards vides
shinyApp(ui5, server) # Sidebar, colonnes et cards titréesEsthétique globale : bslib::bs_theme()
thème natif
library(shiny)
library(bslib)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui4, server) # Sidebar, colonnes et cards vides
shinyApp(ui5, server) # Sidebar, colonnes et cards titréesthème bootswatch
library(shiny)
library(bslib)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
ui6 <- bslib::page_sidebar(
theme = bs_theme(bootswatch = "sketchy"),
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui5, server) # Sidebar, colonnes et cards titrées
shinyApp(ui6, server) # Sidebar, colonnes et cards titrées, thèmethème natif
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui4 <- bslib::page_sidebar(
layout_columns(
bslib::card(
plotOutput("A")
),
bslib::card(
plotOutput("B")
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
plotOutput("C")
),
col_widths = c(12)
)
)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui4, server) # Sidebar, colonnes et cards vides
shinyApp(ui5, server) # Sidebar, colonnes et cards titréesthème bootswatch
Esthétique globale : créer son thème avec bs_themer()
thème bootswatch
library(shiny)
library(bslib)
ui5 <- bslib::page_sidebar(
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
ui6 <- bslib::page_sidebar(
theme = bs_theme(bootswatch = "sketchy"),
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui5, server) # Sidebar, colonnes et cards titrées
shinyApp(ui6, server) # Sidebar, colonnes et cards titrées, thèmebs_themer()
library(shiny)
library(bslib)
ui6 <- bslib::page_sidebar(
theme = bs_theme(bootswatch = "sketchy"),
layout_columns(
bslib::card(
card_header("Plot A"),
card_body(plotOutput("A"))
),
bslib::card(
card_header("Plot B"),
card_body(plotOutput("B"))
),
col_widths = c(6, 6)
),
layout_columns(
bslib::card(
card_header("Plot C"),
card_body(plotOutput("C"))
),
col_widths = c(12)
)
)
server <- function(input, output, session){
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
server2 <- function(input, output, session){
bs_themer()
output$A <- renderPlot({plot(rnorm(n = 50))})
output$B <- renderPlot({plot(rnorm(n = 50))})
output$C <- renderPlot({plot(rnorm(n = 50))})
}
# shinyApp(ui6, server) # Sidebar, colonnes et cards titrées, thème
shinyApp(ui6, server2) # Sidebar, colonnes et cards titrées, thème, themerthème bootswatch
bs_themer()
Modification du style de notre exemple
Changement du type de page et ajout d’un thème
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 1 : app minimale sans contrôle
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration de ma variable d'intérêt",
card(
card_header("Présence des CPIS à 7h dans l'agglomération toulousaine"),
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Outil de création du thème interactif
# bs_themer( )
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees %>%
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Remplacement des columns et ajout de cards
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 1 : app minimale sans contrôle
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
# Installer les packages si nécessaires
packages <- c("shiny", "bslib")
installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
install.packages(packages[!installed_packages])
}
# Charger les packages
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration de ma variable d'intérêt",
card(
card_header("Présence des CPIS à 7h dans l'agglomération toulousaine"),
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Outil de création du thème interactif
# bs_themer( )
output$map <- renderPlot({
bks <- mf_get_breaks(x = donnees$cpis_7am,
nbreaks = 5,
breaks = "quantile")
pal <- paletteer_d("musculusColors::Bmsurface", n = 5)
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
output$barplot <- renderPlot({
histo <- donnees %>%
ggplot() +
geom_histogram(aes(x = cpis_7am), binwidth = 10, color = "white") +
labs(x = "", y = "") +
theme_minimal()
return(histo)
})
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app1)
Rendre son application interactive
UI : les inputs (1/3)
A cette étape, l’application est certes générée par du code, mais elle est statique.
L’intérêt principal de Shiny est de permettre à l’utilisateur de modifier les paramètres utilisés dans le code graphiquement, c’est-à-dire de rendre l’application interactive.
Dans Shiny, on utilise pour cela des composants d’UI spécifiques : les input
UI : les inputs (2/3)
Ce sont des composants graphiques, qui :
- sont déclarés dans l’UI
UI : les inputs (3/3)
ui <- fillPage(
textInput(
inputId = "monINPUT",
label = "Nom",
value = "toi"
),
plotOutput(
outputId = "monPLOT"
)
)
server <- function(input, output, session){
output$monPLOT <- renderPlot({
plot(
x = 1:10, y = 1:10,
main = paste("Bonjour", input$monINPUT)
)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui <- page_fill(
textInput(
inputId = "monINPUT",
label = "Nom",
value = "toi"
),
plotOutput(
outputId = "monPLOT"
)
)
server <- function(input, output) {
output$monPLOT <- renderPlot({
plot(
x = 1:10, y = 1:10,
main = paste("Bonjour", input$monINPUT)
)
})
}
shinyApp(ui = ui, server = server)Ajout des inputs dans l’application
Que peut-on rendre paramétrable dans notre application ?
- le choix de la variable à explorer
- la méthode de discrétisation
- le choix du nombre de classes (carte et histogramme)
varSelectInput()
selectInput()
sliderInput()
Choix de la variable
UI
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Server
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Choix de la discrétisation
UI
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Server
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Choix du nombre de classes
UI
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Server
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 2 : app avec contrôle :
# - choix variable
# - choix n classe
# - choix discrétisation
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- bslib::page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# La carte
output$map <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = "cpis_7am",
type = "choro",
breaks = bks,
pal = pal,
border = "grey30",
leg_title = "Part (%)",
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# Récupérer la variable sélectionnée
var_selected <- as.character(input$variable)
# Récupérer la méthode de discrétisation choisie
discret_selected <- input$discretisation
# Récupérer le nombre de classe
nclasse_selected <- input$nclasse
# Bornes de classe de la discrétisation
bks <- mf_get_breaks(x = donnees[[var_selected]],
nbreaks = nclasse_selected,
breaks = discret_selected)
# Variable visuelle valeur
# pal <- paletteer_d("musculusColors::Bmsurface", n = nclasse_selected) # ici remplacer par une palette d'une plus grande longueur
pal <- paletteer_d("MoMAColors::Exter", n = nclasse_selected)
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected]]),
# binwidth = 10,
breaks = bks,
fill = pal,
color = "white") +
labs(x = var_selected, y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app2)
Les fonctions reactive()
A cette étape, l’application fonctionne comme demandé, mais on constate des redondances dans le code qui en complexifient la maintenance ou l’évolution
La discrétisation est calculée deux fois :
Pour l’attribution des classes dans la carte
Pour la découpe des classes dans l’histogramme
On a utilisé une réactivité “naïve”, qui peut être mieux contrôlée à l’aide de fonctions dédiées : les fonctions réactive (reactive(), reactiveVal(), reactiveValues())
Principe d’une fonction reactive()
Dans Shiny, l’usage de la fonction reactive permet d’assigner un résultat dynamique à une sortie : à chaque fois que l’un des composants réactifs qu’elle appelle est mis à jour, la sortie de la fonction le sera aussi.
Exemple d’application sans reactive()
ui <- bslib::page_fillable(
textInput(
inputId = "monINPUT",
label = "Titre",
value = "Exemple de titre"
),
column(6,plotOutput(outputId = "monPLOT1")),
column(6,plotOutput(outputId = "monPLOT2"))
)
server <- function(input, output, session){
output$monPLOT1 <- renderPlot({
data <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
plot(data$x, data$y, main = input$monINPUT)
})
output$monPLOT2 <- renderPlot({
data <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
plot(data$x, data$y, main = input$monINPUT)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui <- bslib::page_fillable(
textInput(
inputId = "monINPUT",
label = "Titre",
value = "Exemple de titre"
),
column(6,plotOutput(outputId = "monPLOT1")),
column(6,plotOutput(outputId = "monPLOT2"))
)
server <- function(input, output, session){
output$monPLOT1 <- renderPlot({
data <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
plot(data$x, data$y, main = input$monINPUT)
})
output$monPLOT2 <- renderPlot({
data <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
plot(data$x, data$y, main = input$monINPUT)
})
}
shinyApp(ui = ui, server = server)Exemple avec reactive()
ui <- bslib::page_fillable(
textInput(
inputId = "monINPUT",
label = "Titre",
value = "Exemple de titre"
),
column(6,plotOutput(outputId = "monPLOT1")),
column(6,plotOutput(outputId = "monPLOT2"))
)
server <- function(input, output, session){
data_reactive <- reactive({
data_exemple <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
return(data_exemple)
})
output$monPLOT1 <- renderPlot({
plot(data_reactive()$x, data_reactive()$y, main = input$monINPUT)
})
output$monPLOT2 <- renderPlot({
plot(data_reactive()$x, data_reactive()$y, main = input$monINPUT)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui <- bslib::page_fillable(
textInput(
inputId = "monINPUT",
label = "Titre",
value = "Exemple de titre"
),
column(6,plotOutput(outputId = "monPLOT1")),
column(6,plotOutput(outputId = "monPLOT2"))
)
server <- function(input, output, session){
data_reactive <- reactive({
data_exemple <- data.frame(x = rnorm(n = 100), y = rnorm(n = 100))
return(data_exemple)
})
output$monPLOT1 <- renderPlot({
plot(data_reactive()$x, data_reactive()$y, main = input$monINPUT)
})
output$monPLOT2 <- renderPlot({
plot(data_reactive()$x, data_reactive()$y, main = input$monINPUT)
})
}
shinyApp(ui = ui, server = server)En utilisant des fonctions reactive(), on factorise son code et on décide de la réactivité : on contrôle l’effet des paramètres sur les sorties.
Utilisation de fonctions reactive dans notre exemple
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 3 : discrétisation en reactive()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderPlot({
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = var_selected(),
type = "choro",
breaks = bks(),
pal = pal(),
border = "grey30",
leg_title = paste0("Part (%) - ", var_selected()),
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app3)
Rendre les sorties interactives : Shiny et les packages htmlwidgets()
Notre application fonctionne actuellement, mais ne tire pas entièrement parti de son support de publication : les sorties graphiques sont statiques.
En plus des
outputnatifs présentés jusque là, il est possible d’étendre la diversité des composants Shiny en faisant appel à de nombreux packages basés sur le packagehtmlwidgets, qui permet à ces packages de générer des sorties interactives via des fonctionsxxxOutput()etrenderXXX()
Gallerie htmlwidgets
Remplacement de la carte statique par une carte leaflet()
Changements dans l’UI
Avant
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 3 : discrétisation en reactive()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderPlot({
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = var_selected(),
type = "choro",
breaks = bks(),
pal = pal(),
border = "grey30",
leg_title = paste0("Part (%) - ", var_selected()),
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 4 : remplacement de la carte statique par une carte leaflet()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
# La carte
map_leaflet <- donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Changements dans le server
Avant
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 3 : discrétisation en reactive()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
plotOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderPlot({
# La carte
donnees_L93 <- donnees %>%
st_transform(crs = 2154)
mf_map(x = donnees_L93,
var = var_selected(),
type = "choro",
breaks = bks(),
pal = pal(),
border = "grey30",
leg_title = paste0("Part (%) - ", var_selected()),
# leg_pos = "interactive",
leg_pos = c(571894, 6253211),
leg_val_rnd = 0,
leg_horiz = TRUE,
leg_box_border = "grey30")
# mf_title(txt = "Présence des CPIS à 7h")
mf_scale(size = 10,
# pos = "interactive",
pos = c(541000, 6248559))
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 4 : remplacement de la carte statique par une carte leaflet()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
# La carte
map_leaflet <- donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app4)
Execution de code arbitraire réactif avec observe()
- Dans l’application actuelle, tout fonctionne correctement, mais il y a des interactions peu intuitives. A chaque changement d’
input, l’ensemble calculs sont ré-exécutés et créent de nouvelles sorties. - Pour la carte interactive, ça signifie qu’au moindre changement de paramètre, on recrée toute la carte : perte de zoom, de choix de fond de carte etc.
Quand on veut exécuter un comportement réactif sans nécessairement mettre à jour un output, on peut utiliser la famille de fonctions
observe()(observe()etobserveEvent())Un bloc
observe()permet l’exécution d’un code arbitraire quand l’un de ses composants change de valeur.
Fonctionnement d’un bloc observe()
ui <- bslib::page_fillable(
textInput(inputId = "monINPUT"),
plotOutput(outputId = "monPLOT1")
)
server <- function(input, output, session){
output$monPLOT1 <- renderPlot({
plot(mtcars$cyl, mtcars$mpg, main = input$monINPUT)
})
observe({
showModal(
modalDialog(input$monINPUT)
)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
ui <- bslib::page_fillable(
textInput(inputId = "monINPUT", label = NULL),
plotOutput(outputId = "monPLOT1")
)
server <- function(input, output, session){
output$monPLOT1 <- renderPlot({
plot(mtcars$cyl, mtcars$mpg, main = input$monINPUT)
})
observe({
showModal(
modalDialog(input$monINPUT)
)
})
}
shinyApp(ui = ui, server = server)Agir sur l’état de l’application
En utilisant un bloc
observe(), on peut donc changer des valeurs, des input, des output etc.On utilise par exemple souvent un
observe()pour modifier des valeurs de l’UI, par exemple en adaptant la valeur maximale d’un input aux contraintes d’autres input.Un autre cas d’application fréquent est d’agir sur le contenu d’un output interactif sans le redessiner entièrement : les output de
htmlwidgetssont le plus souvent modifiables, ie. on peut en changer les paramètres et contenus sans avoir à les re-créer entièrement.
Exemple de modification de contenu leaflet
Sans observe()
library(shiny)
library(bslib)
library(leaflet)
data_paris <- data.frame(
long = rnorm(n = 50, mean = 2.349, sd = 0.01),
lat = rnorm(n = 50, mean = 48.853, sd = 0.01)
)
ui <- bslib::page_fillable(
sliderInput(inputId = "rayon", min = 5, max = 50,
label = "Rayon", value = 5),
leafletOutput(outputId = "carte")
)
server <- function(input, output, session){
output$carte <- renderLeaflet({
leaflet(data = data_paris) |>
addTiles() |>
addCircleMarkers(~long, ~lat,
radius = input$rayon)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
library(leaflet)
data_paris <- data.frame(
long = rnorm(n = 50, mean = 2.349, sd = 0.01),
lat = rnorm(n = 50, mean = 48.853, sd = 0.01)
)
ui <- bslib::page_fillable(
sliderInput(inputId = "rayon", min = 5, max = 50, label = "Rayon", value = 5),
leafletOutput(outputId = "carte")
)
server <- function(input, output, session){
output$carte <- renderLeaflet({
leaflet(data = data_paris) |>
addTiles() |>
addCircleMarkers(~long, ~lat, radius = input$rayon)
})
}
shinyApp(ui = ui, server = server)Avec observe() et utilisation de leafletProxy()
library(shiny)
library(bslib)
library(leaflet)
data_paris <- data.frame(
long = rnorm(n = 50, mean = 2.349, sd = 0.01),
lat = rnorm(n = 50, mean = 48.853, sd = 0.01)
)
ui <- bslib::page_fillable(
sliderInput(inputId = "rayon", min = 5, max = 50,
label = "Rayon", value = 5),
leafletOutput(outputId = "carte")
)
server <- function(input, output, session){
output$carte <- renderLeaflet({
leaflet(data = data_paris) |>
addTiles() |>
addCircleMarkers(~long, ~lat,
radius = 5)
})
observe({
leafletProxy("carte", data = data_paris) |>
clearMarkers() |>
addCircleMarkers(~long, ~lat,
radius = input$rayon)
})
}
shinyApp(ui = ui, server = server)#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 550
library(shiny)
library(bslib)
library(leaflet)
data_paris <- data.frame(
long = rnorm(n = 50, mean = 2.349, sd = 0.01),
lat = rnorm(n = 50, mean = 48.853, sd = 0.01)
)
ui <- bslib::page_fillable(
sliderInput(inputId = "rayon", min = 5, max = 50,
label = "Rayon", value = 5),
leafletOutput(outputId = "carte")
)
server <- function(input, output, session){
output$carte <- renderLeaflet({
leaflet(data = data_paris) |>
addTiles() |>
addCircleMarkers(~long, ~lat,
radius = 5)
})
observe({
leafletProxy("carte", data = data_paris) |>
clearMarkers() |>
addCircleMarkers(~long, ~lat,
radius = input$rayon)
})
}
shinyApp(ui = ui, server = server)Ajout d’un bloc observe() avec leafletProxy() dans notre application
Suppression de la réactivité du renderLeaflet()
Avant
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 4 : remplacement de la carte statique par une carte leaflet()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
# La carte
map_leaflet <- donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 5 : mise à jour de la carte leaflet via proxy et observe()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# La carte
map_leaflet <- leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
setView(lng = 1.43333, lat = 43.5999999, zoom = 10) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# Mise à jour de la couche des secteurs selon la sélection
observe({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
leafletProxy("map", session) %>%
clearGroup("Secteurs") %>%
clearControls() %>%
addPolygons(
data = donnees,
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Ajout d’un bloc observe
Avant
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 4 : remplacement de la carte statique par une carte leaflet()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bslib::bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
# La carte
map_leaflet <- donnees %>%
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
addPolygons(
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 5 : mise à jour de la carte leaflet via proxy et observe()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# La carte
map_leaflet <- leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
setView(lng = 1.43333, lat = 43.5999999, zoom = 10) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# Mise à jour de la couche des secteurs selon la sélection
observe({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
leafletProxy("map", session) %>%
clearGroup("Secteurs") %>%
clearControls() %>%
addPolygons(
data = donnees,
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app5)
Rendre une application générique : permettre l’exécution sur des données externes
- L’un des comportements les plus puissants (et difficiles à mettre en oeuvre) de Shiny tient en sa capacité à exécuter un comportement prévu sur des fichiers externes, au choix d’un utilisateur externe.
Usage personnel vs usage externe
Sur le principe, la conversion d’une application “fermée” en application “ouverte” n’est pas si difficile, mais elle implique toutefois de garder en tête quelques enjeux :
- On n’a aucune maitrise sur ce que l’utilisateur ajoutera comme données : elles peuvent avoir un format très différent de ce à quoi on s’attend (xlsx à la place d’un CSV), être très lourdes, présenter des erreurs inhérentes (CSV mal encodé ou avec des lignes vides), etc.
- On peut toujours essayer de mettre autant de gardes-fous que possible dans la logique de son application, mais à un moment ou un autre, un jeu de données ne marchera pas et fera planter l’application.
- La meilleure manière de s’en prémunir est encore de faire une documentation extensive sur les formats attendus, facilement accessible au sein de l’application, et de faciliter le retour d’utilisateurs.
Conversion de notre application : exploration d’un jeu de données spatial quelconque
Pour adapter notre application, il va être nécessaire de procéder aux changements suivants :
- A la place de la lecture du geopackage des données Mobiliscope de Toulouse, on souhaite que n’importe-quel geopackage soit lisible
- Ajout d’un élément d’UI
fileInput()acceptant les fichiers “gpkg”
- Ajout d’un élément d’UI
- Un geopackage peut contenir plusieurs couches, il faut que l’on puisse choisir laquelle explorer
- Ajout d’un élement d’UI
selectInput()qui sera peuplé via la liste des couches (st_layers())
- Ajout d’un élement d’UI
- Une fois la couche choisie, il faut encore y choisir la bonne colonne
- Ajout d’un élément d’UI dynamique
varSelectInput()listant les champs numériques de la couche
- Ajout d’un élément d’UI dynamique
- Le mode de représentation choisi est une carte choroplèthe, qui doit être réalisée sur une variable quantitative de ratio.
- Ajout d’un élément d’UI
checkboxInput()permettant de diviser la valeur du champ choisi par la superficie du secteur (st_area())
- Ajout d’un élément d’UI
Adaptation de l’UI
Avant
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 5 : mise à jour de la carte leaflet via proxy et observe()
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# Chargement des données ----
# Lecture des données
donnees <- st_read("../../data/data_seance_shiny.gpkg", "toulouse_secteurs_cs_pct", quiet = TRUE)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle
sidebar = sidebar(
# 1er sélecteur : la variable à explorer
varSelectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
data = donnees %>% select(ends_with(c("am", "pm"))) %>% st_drop_geometry(),
selected = "cpis_7am"
),
# 2e sélecteur : la discrétisation
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
),
# 3e sélecteur : le nombre de classe
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI
server <- function(input, output, session) {
# Récupérer les valeurs sélectionnées en reactive()
# La variable sélectionnée
var_selected <- reactive({
as.character(input$variable)
})
# Les bornes de classe
bks <- reactive({
mf_get_breaks(x = donnees[[var_selected()]],
nbreaks = input$nclasse,
breaks = input$discretisation)
})
# La variable visuelle
pal <- reactive({
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# La carte
output$map <- renderLeaflet({
# La carte
map_leaflet <- leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
setView(lng = 1.43333, lat = 43.5999999, zoom = 10) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
return(map_leaflet)
})
# Mise à jour de la couche des secteurs selon la sélection
observe({
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = donnees[[var_selected()]],
bins = round(bks())
)
leafletProxy("map", session) %>%
clearGroup("Secteurs") %>%
clearControls() %>%
addPolygons(
data = donnees,
fillColor = ~ pal_leaflet(donnees[[var_selected()]]),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(LIB, " : ", round(donnees[[var_selected()]]), "%"),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = donnees[[var_selected()]],
opacity = 1,
title = paste0("Part (%) - ", var_selected()),
position = "bottomleft"
)
})
# L'histogramme
output$barplot <- renderPlot({
# l'histo
histo <- donnees %>%
ggplot() +
geom_histogram(aes(.data[[var_selected()]]),
# binwidth = 10,
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = var_selected(), y = "") +
theme_minimal()
return(histo)
})
# La table
output$table <- renderTable({
donnees_table <- donnees %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 6 : Réécriture de l'app pour inclure le chargement d'un gpkg polygonal
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle : les contrôleurs apparaissent après l'import des données
sidebar = sidebar(
# sélecteur 0 : bouton upload
fileInput(
inputId = "upload_gpkg",
label = "Charger vos données au format geopackage",
accept = ".gpkg"
),
# Les sélecteurs sont définis côté server après l'import des données
# 0 bis : choix du layer
uiOutput(outputId = "layer_selector"),
# 1er sélecteur : la variable à explorer
uiOutput(outputId = "column_selector"),
# 1er sélecteur bis : stock -> taux si besoin
uiOutput(outputId = "density_selector"),
# 2e sélecteur : la discrétisation
uiOutput(outputId = "discret_selector"),
# 3e sélecteur : le nombre de classe
uiOutput(outputId = "nk_selector")
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte choro
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI : renderPlot(), renderLeaflet(), rendertable()
# + construction des contrôleurs renderUI()
# + définition des variables reactive()
server <- function(input, output, session) {
# 1. Lister les layers disponibles dans le gpkg
layers_disponibles <- reactive({
# req() : s'assurer que l'élément est présent avant de poursuivre
# (le choix du fichier dans ce cas)
req(input$upload_gpkg)
st_layers(input$upload_gpkg$datapath)$name
})
# 2. Sélecteur de layer (seulement si plusieurs layers)
output$layer_selector <- renderUI({
req(layers_disponibles())
layers <- layers_disponibles()
# Si un seul layer, pas besoin de sélecteur
if(length(layers) == 1) {
return(NULL)
}
# Sinon, afficher le sélecteur
selectInput(
inputId = "selected_layer",
label = "Choisissez une couche",
choices = layers,
selected = layers[1]
)
})
# 3. Lecture des données avec le layer sélectionné
donnees <- reactive({
req(input$upload_gpkg, layers_disponibles())
# Si un seul layer, le charger directement
if(length(layers_disponibles()) == 1) {
st_read(input$upload_gpkg$datapath, layer = layers_disponibles()[1])
} else {
# Sinon, attendre la sélection
req(input$selected_layer)
st_read(input$upload_gpkg$datapath, layer = input$selected_layer)
}
})
# 4a. Ajout du sélecteur de variable
output$column_selector <- renderUI({
# S'assurer de la présence des données
req(donnees())
# Ne garder que les variables quantitatives
cols <- donnees() %>%
select_if(., is.numeric) %>%
st_drop_geometry() %>%
names(.)
# Définir le contrôleur
selectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
choices = cols,
multiple = FALSE,
selected = NULL
)
})
# 4b. Ajout du checkbox
output$density_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
checkboxInput(
inputId = "densite",
label = "Calculer une densité (stock/km2)"
)
})
# 4c. Ajout du contôleur de la discrétisation
output$discret_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
)
})
# 4d. Ajout du contrôleur du nombre de classe
output$nk_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
})
# 5. Récupérer les valeurs sélectionnées en reactive()
# 5a. stockage du nom de la variable (en caractère)
var_selected <- reactive({
req(input$variable)
as.character(input$variable)
})
# 5b. Transfo de la variable de stock en taux si checkbox est checked
data_to_plot <- reactive({
# S'assurer de la présence des variables réactives suivantes
req(donnees(), var_selected())
req(!is.null(input$densite))
# Pour simplifier l'écriture
data_sf <- donnees()
if(input$densite){
# Calculer la densité et l'ajouter comme nouvelle colonne
data_sf <- data_sf %>%
mutate(
area = as.numeric(st_area(.))/1e6,
var_plot = .data[[var_selected()]] / area
)
} else {
# Renommer la variable sélectionnée en "var_plot"
data_sf <- data_sf %>%
mutate(var_plot = .data[[var_selected()]])
}
return(data_sf)
})
# 5c. Les bornes de classe
bks <- reactive({
req(data_to_plot(), input$nclasse, input$discretisation)
mf_get_breaks(
x = data_to_plot()$var_plot,
nbreaks = input$nclasse,
breaks = input$discretisation
)
})
# 5d. La variable visuelle
pal <- reactive({
req(input$nclasse)
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# 6. La carte Leaflet
# 6a. Calculer le centroide de la couche pour le setview
centro <- reactive({
req(donnees())
donnees() %>%
st_bbox() %>%
st_as_sfc() %>%
st_centroid() %>%
st_coordinates()
})
# 6b. Initialisation de la carte
output$map <- renderLeaflet({
# La carte
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
setView(lng = centro()[1], lat = centro()[2], zoom = 10) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
})
# 7. Mise à jour de la carte selon les sélections
observe({
req(data_to_plot(), bks(), pal())
data_sf <- data_to_plot()
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = data_sf$var_plot,
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = data_sf$var_plot,
bins = round(bks())
)
leafletProxy("map", session) %>%
clearGroup("Secteurs") %>%
clearControls() %>%
addPolygons(
data = data_sf,
fillColor = ~ pal_leaflet(var_plot),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(var_selected(), " : ",
ifelse(input$densite,
round(var_plot, 2),
round(var_plot))),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = data_sf$var_plot,
opacity = 1,
title = ifelse(input$densite,
paste0("Densité - ", var_selected()),
var_selected()),
position = "bottomleft"
)
})
# 8. L'histogramme
output$barplot <- renderPlot({
req(data_to_plot(), bks(), pal())
data_to_plot() %>%
ggplot() +
geom_histogram(
aes(x = var_plot),
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = ifelse(input$densite, "Densité (stock/km²)", var_selected()),
y = "n secteurs") +
theme_minimal(base_size = 16)
})
# 9. La table
output$table <- renderTable({
req(donnees())
donnees_table <- donnees() %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Adaptation de la logique (exemples)
Après
#==============================================================================#
# ElementR - Séance Shiny du 16 décembre 2025
# Création pas à pas d'une application shiny
#
# ÉTAPE 6 : Réécriture de l'app pour inclure le chargement d'un gpkg polygonal
#
#
# AD, novembre 2025
#==============================================================================#
# librairies ----
library(sf)
library(tidyverse)
library(paletteer)
library(leaflet)
library(mapsf)
library(shiny)
library(bslib)
# UI ----
# Construction de l'interface utilisateur (ui) avec 3 plots
ui <- page_sidebar(
theme = bs_theme(
bootswatch = "journal",
bg = "#fff",
fg = "#a21818",
primary = "#7B7474",
secondary = "#aaa",
font_scale = 1.2
),
# Nom de la page
title = "Exploration univariée",
# Panneau de contrôle : les contrôleurs apparaissent après l'import des données
sidebar = sidebar(
# sélecteur 0 : bouton upload
fileInput(
inputId = "upload_gpkg",
label = "Charger vos données au format geopackage",
accept = ".gpkg"
),
# Les sélecteurs sont définis côté server après l'import des données
# 0 bis : choix du layer
uiOutput(outputId = "layer_selector"),
# 1er sélecteur : la variable à explorer
uiOutput(outputId = "column_selector"),
# 1er sélecteur bis : stock -> taux si besoin
uiOutput(outputId = "density_selector"),
# 2e sélecteur : la discrétisation
uiOutput(outputId = "discret_selector"),
# 3e sélecteur : le nombre de classe
uiOutput(outputId = "nk_selector")
),
# Plots
# Colonne 1 : la carte
layout_columns(
# Carte choro
card(
card_header("Distribution géographique de la variable"),
leafletOutput(outputId = "map")
),
# Colonne 2 : l'histo et la table
layout_columns(
# Barplot
card(
card_header("Distribution statistique de la variable"),
plotOutput(outputId = "barplot")
),
# Table
card(
card_header("Tableau de données"),
tableOutput(outputId = "table")
),
col_widths = c(12,12)
)
),
cols_width = c(12,6)
)
# SERVER ----
# Construction des plots à afficher dans l'UI : renderPlot(), renderLeaflet(), rendertable()
# + construction des contrôleurs renderUI()
# + définition des variables reactive()
server <- function(input, output, session) {
# 1. Lister les layers disponibles dans le gpkg
layers_disponibles <- reactive({
# req() : s'assurer que l'élément est présent avant de poursuivre
# (le choix du fichier dans ce cas)
req(input$upload_gpkg)
st_layers(input$upload_gpkg$datapath)$name
})
# 2. Sélecteur de layer (seulement si plusieurs layers)
output$layer_selector <- renderUI({
req(layers_disponibles())
layers <- layers_disponibles()
# Si un seul layer, pas besoin de sélecteur
if(length(layers) == 1) {
return(NULL)
}
# Sinon, afficher le sélecteur
selectInput(
inputId = "selected_layer",
label = "Choisissez une couche",
choices = layers,
selected = layers[1]
)
})
# 3. Lecture des données avec le layer sélectionné
donnees <- reactive({
req(input$upload_gpkg, layers_disponibles())
# Si un seul layer, le charger directement
if(length(layers_disponibles()) == 1) {
st_read(input$upload_gpkg$datapath, layer = layers_disponibles()[1])
} else {
# Sinon, attendre la sélection
req(input$selected_layer)
st_read(input$upload_gpkg$datapath, layer = input$selected_layer)
}
})
# 4a. Ajout du sélecteur de variable
output$column_selector <- renderUI({
# S'assurer de la présence des données
req(donnees())
# Ne garder que les variables quantitatives
cols <- donnees() %>%
select_if(., is.numeric) %>%
st_drop_geometry() %>%
names(.)
# Définir le contrôleur
selectInput(
inputId = "variable",
label = "Choisissez une variable à explorer",
choices = cols,
multiple = FALSE,
selected = NULL
)
})
# 4b. Ajout du checkbox
output$density_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
checkboxInput(
inputId = "densite",
label = "Calculer une densité (stock/km2)"
)
})
# 4c. Ajout du contôleur de la discrétisation
output$discret_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
selectInput(
inputId = "discretisation",
label = "Choisissez une méthode de discrétisation",
choices = c("equal", "quantile", "jenks"),
selected = "quantile"
)
})
# 4d. Ajout du contrôleur du nombre de classe
output$nk_selector <- renderUI({
# S'assurer de la présence des données et de la variable
req(donnees(), input$variable)
# Définir le contrôleur
sliderInput(
inputId = "nclasse",
label = "Choisissez un nombre de classe",
value = 5,
min = 2,
max = 10
)
})
# 5. Récupérer les valeurs sélectionnées en reactive()
# 5a. stockage du nom de la variable (en caractère)
var_selected <- reactive({
req(input$variable)
as.character(input$variable)
})
# 5b. Transfo de la variable de stock en taux si checkbox est checked
data_to_plot <- reactive({
# S'assurer de la présence des variables réactives suivantes
req(donnees(), var_selected())
req(!is.null(input$densite))
# Pour simplifier l'écriture
data_sf <- donnees()
if(input$densite){
# Calculer la densité et l'ajouter comme nouvelle colonne
data_sf <- data_sf %>%
mutate(
area = as.numeric(st_area(.))/1e6,
var_plot = .data[[var_selected()]] / area
)
} else {
# Renommer la variable sélectionnée en "var_plot"
data_sf <- data_sf %>%
mutate(var_plot = .data[[var_selected()]])
}
return(data_sf)
})
# 5c. Les bornes de classe
bks <- reactive({
req(data_to_plot(), input$nclasse, input$discretisation)
mf_get_breaks(
x = data_to_plot()$var_plot,
nbreaks = input$nclasse,
breaks = input$discretisation
)
})
# 5d. La variable visuelle
pal <- reactive({
req(input$nclasse)
paletteer_d("MoMAColors::Exter", n = input$nclasse)
})
# 6. La carte Leaflet
# 6a. Calculer le centroide de la couche pour le setview
centro <- reactive({
req(donnees())
donnees() %>%
st_bbox() %>%
st_as_sfc() %>%
st_centroid() %>%
st_coordinates()
})
# 6b. Initialisation de la carte
output$map <- renderLeaflet({
# La carte
leaflet() %>%
addTiles(group = "OSM") %>%
addProviderTiles(providers$CartoDB.Positron, group = "OSM/CARTO") %>%
setView(lng = centro()[1], lat = centro()[2], zoom = 10) %>%
addLayersControl(
baseGroups = c("OSM/CARTO", "OSM"),
overlayGroups = c("Secteurs"),
options = layersControlOptions(collapsed = FALSE, sortLayers = TRUE)
) %>%
addScaleBar(
position = "bottomright",
options = scaleBarOptions(imperial = FALSE)
)
})
# 7. Mise à jour de la carte selon les sélections
observe({
req(data_to_plot(), bks(), pal())
data_sf <- data_to_plot()
# Discrétisation de la carte leaflet
pal_leaflet <- colorBin(
palette = as.character(pal()),
domain = data_sf$var_plot,
bins = bks()
)
# Discrétisation avec valeurs arrondies pour la légende
pal_leaflet_round <- colorBin(
palette = as.character(pal()),
domain = data_sf$var_plot,
bins = round(bks())
)
leafletProxy("map", session) %>%
clearGroup("Secteurs") %>%
clearControls() %>%
addPolygons(
data = data_sf,
fillColor = ~ pal_leaflet(var_plot),
fillOpacity = .8,
color = "#424242",
weight = 1,
popup = ~ paste0(var_selected(), " : ",
ifelse(input$densite,
round(var_plot, 2),
round(var_plot))),
group = "Secteurs"
) %>%
addLegend(
pal = pal_leaflet_round,
values = data_sf$var_plot,
opacity = 1,
title = ifelse(input$densite,
paste0("Densité - ", var_selected()),
var_selected()),
position = "bottomleft"
)
})
# 8. L'histogramme
output$barplot <- renderPlot({
req(data_to_plot(), bks(), pal())
data_to_plot() %>%
ggplot() +
geom_histogram(
aes(x = var_plot),
breaks = bks(),
fill = pal(),
color = "white") +
labs(x = ifelse(input$densite, "Densité (stock/km²)", var_selected()),
y = "n secteurs") +
theme_minimal(base_size = 16)
})
# 9. La table
output$table <- renderTable({
req(donnees())
donnees_table <- donnees() %>%
st_drop_geometry()
return(donnees_table)
})
}
# Run the application
shinyApp(ui = ui, server = server)Résultat (app6)
Déployer une application Shiny pour la rendre utilisable par d’autres
- Une application Shiny peut tout à fait rester cantonnée à votre ordinateur, voire être partagée sous sa forme brute (script app.R et données), mais il est aussi possible de la déployer, c’est-à-dire de la rendre accessible sur une URL publique (ou protégée).
Des possibilités limitées
Comme Shiny est un package R, cela ne peut pas fonctionner comme le déploiement d’une page HTML classique : il faut que le serveur de publication dispose de R et d’un logiciel dédié,
shiny-server. Ce logiciel va créer l’interface graphique depuis le fichier/composant UI, et gérer les interactions entre l’interface et R (server).Les installations sous-jacentes au déploiement d’une application Shiny rendent donc cette opération assez complexe, et nous reviendrons ici sur les manières de faire les plus accessibles :
- Déploiement via ShinyApps (posit)
- Déploiement via r-tools (Huma-Num)
- Expérimental : déploiement web via shinylive & webR
Déploiement via ShinyApps
Une solution simple et accessible
Démo
- Convivial depuis RStudio
- Pas de gestion des dépendances
- Pas de serveur à maintenir
- Application containerisée : durable dans le temps
MAIS
Déploiement via shiny-server (Huma-Num)
Une solution plus puissante :
- Gestion des packages
- Développement / modifications de l’appli directement dans le rstudio-server de r-tools
- Pas de limites en nombre d’applications, en capacité de connexion
- Repose sur un serveur de calcul puissant : plus adapté aux calculs importants
MAIS
- Demande un compte spécifique (faire la demande de capacité shiny si vous avez déjà un compte)
- Vous place en situation de “mainteneur technique” : mise à jour de packages
- Un futur (et présent) incertain
Déploiement via Shinylive (expérimental)
Démo
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 650
library(shiny)
library(bslib)
ui <- page_sidebar(
title = "Hello Shiny in Quarto",
sidebar = sidebar(
sliderInput("bins", "Number of bins:", min = 5, max = 30, value = 10)
),
plotOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- mtcars$mpg
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "skyblue", border = "white",
main = "Histogram of MPG", xlab = "Miles Per Gallon")
})
}
shinyApp(ui = ui, server = server)
