## Bibliothèques
library(shiny)
library(readxl)
library(DT)
library(dplyr)
library(visNetwork)
library(tidyr)
library(grDevices)
library(bslib)
# --- USER INTERFACE ---------------------------------------------------------------
ui <- fluidPage(
theme = bs_theme(
version = 5,
bootswatch = "journal",
base_font = "Open Sans",
heading_font = "Open Sans",
primary = "#1C5862"
),
tags$style(HTML("
.card-header {
background-color: #C6D6DA;
}
/* Couleur Card-Titel */
.card-header h1,
.card-header h2,
.card-header h3,
.card-header h4,
.card-header h5,
.card-header h6 {
color: #1C5862;
font-weight: 600;
}
/* Liste à 3 niveaux */
ul li ul { list-style-type: circle; }
ul li ul li ul { list-style-type: square; }
")),
# -- HEADER ---
div(
style = "
display:flex;
justify-content:flex-end;
align-items:center;
margin:20px 0;
",
tags$img(
src = "Logo_Francais.svg",
height = "50px"
)
),
# --- NAV TABS ---
navset_card_tab(
# -------------------------------------
# 1) Landing Page
# -------------------------------------
nav_panel("Start",
tags$div(
style = "
display: flex;
flex-direction: column;
align-items: center;
justify-content: center;
padding: 40px 20px;
text-align: center;
",
h1("Les parties prenantes de la Biodiversité en Suisse",
style = "color:#1C5862; font-weight:600; margin-bottom: 30px;"),
p("Un outil du Centre de Synthèse sur la Biodiversité",
style = "color:#3C5862; font-size:16px; margin-bottom: 40px;"),
tags$img(
src = "Titelbild.jpg",
style = "
width: 100%;
max-width: 900px;
max-height: 600px;
object-fit: cover;
border-radius: 8px;
box-shadow: 0 4px 16px rgba(0,0,0,0.15);
"
)
)
),
# -------------------------------------
# 2) Readme
# -------------------------------------
nav_panel("Readme",
# ----------------------------
# a) À propos du Stakeholder-Tool
# -----------------------------
card(
card_header(
tags$a(h5("À propos du Stakeholder-Tool"),
`data-bs-toggle` = "collapse",
href = "#collapse_ueber",
style = "text-decoration:none; cursor:pointer; color:#1C5862;")
),
tags$div(id = "collapse_ueber", class = "collapse-show",
card_body(
p("L’aperçu des parties prenantes (Stakeholder) de la biodiversité en Suisse
(appelé en bref Stakeholder-Tool) a pour objectif d’identifier
et de rendre visibles les parties prenantes moins évidentes qui
influencent l’état de la biodiversité et qui pourraient être
intégrées dans des projets. Ce Tool a été élaboré en
2024/2025 par le groupe de travail Communication du Centre de Synthèse sur la Biodiversité."),
p("Le Stakeholder-Tool recense les parties prenantes à un niveau
supérieur pour les habitats suivants en Suisse : milieux agricoles,
milieux alpins/montagnards, espace bâti, milieux forestiers et milieux aquatiques.
Le terme", em("supérieur"), "signifie que le Tool ne fournit
pas une liste détaillée de toutes les entités, comme par exemple les bureaux d’ingénierie.
Dans les deux onglets", em("Aperçu des parties prenantes"), "et", em("Réseau"),
"il est possible de filtrer les parties prenantes, les groupes
de parties prenantes et les habitats dans un tableau, et de les visualiser sous forme de réseau."),
p("Malgré une compilation soignée, cet outil ne prétend pas à
l’exhaustivité. Il vise à offrir une première vue d’ensemble
et à servir de base pour l’élaboration de listes d’acteurs spécifiques à un contexte donné."),
p("Le fichier Excel ainsi que le code R de l’application Shiny présentée
sont disponibles pour un traitement individuel sur le",
tags$a(
"site web du Centre de Synthèse sur la Biodiversité",
href = "https://synthesebiodiv.wsl.ch/fr/arbeitsgruppen/kommunikation-rund-um-die-biodiversitaet/outil-des-parties-prenantes/",
target = "_blank"
)
)
)
)
),
# ----------------------------
# b) Classification des groupes de parties prenantes
# -----------------------------
card(
card_header(
tags$a(h5("Classification des groupes de parties prenantes"),
`data-bs-toggle` = "collapse",
href = "#collapse_einteilung",
style = "text-decoration:none; cursor:pointer; color:#1C5862;")
),
tags$div(id = "collapse_einteilung", class = "collapse-show",
p("Par", em("parties prenantes,"), "nous entendons
tous les groupes, organisations, institutions ou particuliers qui
sont directement ou indirectement concernés par la biodiversité
et sa gestion, et/ou qui ont une influence sur celle-ci.
Il s’agit par exemple des autorités législatives telles que
l’Office fédéral de l’environnement (OFEV), d’une organisation
locale de protection de la nature qui valorise et entretient une
zone donnée, ou encore de propriétaires fonciers qui
favorisent la biodiversité par l’aménagement de leur jardin.
Afin de mieux structurer le paysage des parties prenantes, nous
les avons réparties en différents", em("groupes de parties prenantes"),
"et les avons classées selon les", em("habitats"), "dans lesquels
elles interviennent."),
card_body(
tableOutput("akteur_tabelle_static"),
p("Un", em("groupe de parties prenantes"), "regroupe celles qui présentent des caractéristiques ou des fonctions similaires.
Cette classification en groupes de parties prenantes permet d’expliquer le système de manière plus complète.
Elle attire ainsi l’attention sur des groupes
auxquels on n’aurait peut-être pas pensé spontanément."),
p("Une ventilation plus détaillée des", em("habitats"), "est disponible ci-dessous.")
)
)
),
# ----------------------------
# c) Explications habitats
# -----------------------------
card(
card_header(
tags$a(h5("Explications sur les habitats"),
`data-bs-toggle` = "collapse",
href = "#collapse_lebensraeume",
style = "text-decoration:none; cursor:pointer; color:#1C5862;")
),
tags$div(id = "collapse_lebensraeume", class = "collapse-show",
card_body(
p("La classification des habitats s'appuie sur l'ouvrage de référence", em("Guide des milieux naturels de Suisse"), "(Delarze, Gonseth, Eggenberg & Vust, 2015).
Dans le Stakeholder-Tool, les habitats sont regroupés en cinq grandes catégories:", em("Milieux agricoles, Milieux alpins/montagnards, Espace bâti, Milieux forestiers, Milieux aquatiques"),
",mais ils peuvent relever de plusieurs catégories.
Ainsi, on trouve par exemple des sources aussi dans les milieux alpins/montagnards
et une forêt inondable est liées aux zones alluviales et aux eaux stagnantes.
Les lisières herbacées se trouvent dans les zones de transition,
comme entre la forêt et les prairies, ou sont liées aux dynamiques
des plaines alluviales. Les pelouses et pâturages maigres d'altitude ou les combes à neige
sont en partie exploitées à des fins agricoles. De plus, les végétations pionnière des endroits perturbés
par l'homme sites rudéraux peuvent apparaître dans tous les cinq catégories."),
accordion(
id = "lr_accordion",
open = FALSE,
# -- Milieux agricoles ---
# -----------
accordion_panel("Milieux agricoles", "désigne les surfaces utilisées pour des activités agricoles
telles que la fauche, le pâturage, les plantations et la culture des champs.
Cela comprend les plantations, les champs et les cultures, la plupart des pelouses et prairies y compris les régions d'estivage,
certaines landes, lisières et mégaphorbiaies.",
br(), br(),
"Selon TypoCH, il s'agit des habitats suivants :",
tags$ul(
tags$li("2. Rivages et lieux humides"),
tags$ul(
tags$li("2.2 Bas-marais"),
tags$ul(
tags$li("2.2.2 Parvocariçaie acidophile"),
tags$li("2.2.3 Parvocariçaie neutro-basophile"),
tags$li("2.2.5 Groupement pionnier des bords de torrents alpins")
),
tags$li("2.3 Prairies humides")
)
), # ferme 2.
tags$ul(
tags$li("4. Pelouses et prairies"),
tags$ul(
tags$li("4.0 Gazons et prairies artificielles"),
tags$li("4.2 Pelousses sèches thermophiles"),
tags$li("4.3 Pelousses et pâturages maigres d'altitude"),
tags$ul(
tags$li("4.3.1 Pelouse calcaire sèche à seslérie"),
tags$li("4.3.3 Pelouse calcaire fraîche"),
tags$li("4.3.5 Pâturage maigre acide"),
tags$li("4.3.6 Pelouse rocheuse acide"),
tags$li("4.3.7 Pelouse acide de l'étage alpin supérieur")
),
tags$li("4.5 Prairies grasses"),
tags$li("4.6 Friches à graminées")
)
), # ferme 4.
tags$ul(
tags$li("5. Landes, lisières et mégaphorbiaies"),
tags$ul(
tags$li("5.2 Mégaphorbiaies, coupes forestières"),
tags$ul(
tags$li("5.2.4 Mégaphorbiaie de montagne hygrophile à Adenostyles alliariae"),
tags$li("5.2.5 Mégaphorbiaie à Pteridium aquilinum")
),
tags$li("5.4 Landes"),
tags$ul(
tags$li("5.4.1 Lande subatlantique acidophile"),
)
)
), # ferme 5.
tags$ul(
tags$li("7. Végétation pionnière des endroits perturbés par l'homme"),
tags$ul(
tags$li("7.1 Terrains piétinés et rudéraux"),
tags$ul(
tags$li("7.1.0 Terrain piétiné et décombres dépourvus de végétation"),
tags$li("7.1.1 Endroit piétiné humide"),
tags$li("7.1.3 Endroit piétiné subalpin ou alpin"),
tags$li("7.1.4 Rudérales annuelles"),
tags$li("7.1.5 Rudérales pluriannuelles thermophiles"),
tags$li("7.1.6 Rudérales pluriannuelles mésophiles"),
tags$li("7.1.7 Reposoir à bétail subalpin ou alpin"),
tags$li("7.1.8 Reposoir à bétail de basse altitude")
),
)
), # ferme 7.
tags$ul(
tags$li("8. Plantations, champs et cultures"),
tags$ul(
tags$li("8.1 Cultures de plantes ligneuses"),
tags$li("8.2 Cultures de plantes herbacées")
)
) # ferme 8.
), # ferme accordion_panel
# --- Milieux alpins/montagnards ---
# ----------------
accordion_panel("Milieux alpins/montagnards", "désigne les habitats situés
en dehors des zones agricoles et forestières, des pâturages boisés, ainsi que des alpages et des zones d'estivage.
Il s'agit notamment des glaciers, des roches, des éboulis et des moraines,
mais aussi des Végétations des dalles calcaires et lapiez de montagne, ainsi que de certaines mégaphorbiaies, buissons et landes.",
br(), br(),
"Selon TypoCH, il s'agit des habitats suivants :",
tags$ul(
tags$li("2. Rivages et lieux humides"),
tags$ul(
tags$li("2.2 Bas-marais"),
tags$ul(
tags$li("2.2.5 Groupement pionnier des bords de torrents alpins")
)
)
), # ferme 2.
tags$ul(
tags$li("3. Glaciers, rochers, éboulis et moraines"),
tags$ul(
tags$li("3.1 Glaciers, névés"),
tags$li("3.2 Alluvions et moraines"),
tags$li("3.3 Éboulis"),
tags$li("3.4 Parois rocheuses"),
tags$li("3.5 Grottes et cavernes obscures")
)
), # ferme 3.
tags$ul(
tags$li("4. Pelouses et prairies"),
tags$ul(
tags$li("4.1 Dalles rocheuses et lapiez"),
tags$ul(
tags$li("4.1.2 Végétation des dalles calcaires et lapiez de montagne"),
tags$li("4.1.3 Végétation des dalles siliceuses de basse altitude"),
tags$li("4.1.4 Végétation des dalles siliceuses de montagne")
),
tags$li("4.3 Pelouses et pâturages maigres d'altitude"),
tags$ul(
tags$li("4.3.2 Pelouse calcaire sèche à laîche ferme"),
tags$li("4.3.4 Gazon des crêtes ventées"),
tags$li("4.3.6 Pelouse rocheuse acide"),
tags$li("4.3.7 Pelouse acide de l'étage alpin supérieur")
),
tags$li("4.4 Combes à neige")
)
), # ferme 4.
tags$ul(
tags$li("5. Landes, lisières et mégaphorbiaies"),
tags$ul(
tags$li("5.2 Mégaphorbiaies, coupes forestières"),
tags$ul(
tags$li("5.2.3 Mégaphorbiaie de montagne mésophile à graminées"),
tags$li("5.2.4 Mégaphorbiaie de montagne hygrophile à Adenostyles alliariae")
),
tags$li("5.3 Formations buissonnantes (manteau, fourrés, haies)"),
tags$ul(
tags$li("5.3.8 Saulaie buissonnante subalpine"),
tags$li("5.3.9 Aulnaie verte")
),
tags$li("5.4 Landes"),
tags$ul(
tags$li("5.4.3 Lande subalpine calcicole"),
tags$li("5.4.4 Lande subalpine xérophile sur sol acide"),
tags$li("5.4.5 Lande subalpine méso-hygrophile sur sol acide"),
tags$li("5.4.6 Lande alpine ventée")
)
)
) # ferme 5.
), # ferme accordion_panel
# --- Espace bâti ---
# ----------------
accordion_panel("Espace bâti", "désigne les zones où des aménagements ont eu lieu ou sont encore en cours. Il s'agit notamment des gazons et prairies artificielles, de la végétation pionnière des endroits perturbés par l'homme, des jardins et des plantations, ainsi que des arbres isolés.",
br(), br(),
"Selon TypoCH, il s'agit des habitats suivants :",
tags$ul(
tags$li("2. Rivages et lieux humides"),
tags$ul(
tags$li("2.0 Rives artificielles")
)
), # ferme 2.
tags$ul(
tags$li("3. Glaciers, rochers, éboulis et moraines"),
tags$ul(
tags$li("3.3 Éboulis"),
tags$ul(
tags$li("3.3.1.5 Éboulis calcaire thermophile <-- ?"),
tags$li("3.3.2.3 Éboulis siliceux thermophiles")
)
)
), # ferme 3.
tags$ul(
tags$li("4. Pelouses et prairies"),
tags$ul(
tags$li("4.0 Gazons et prairies artificielles"),
tags$li("4.1 Dalles rocheuses et lapiez"),
tags$ul(
tags$li("4.1.1 Végétation des dalles calcaires de basse altitude")
)
)
), # ferme 4.
tags$ul(
tags$li("5. Landes, lisières et mégaphorbiaies"),
tags$ul(
tags$li("5.3 Formations buissonnantes (manteau, fourrés, haies)"),
tags$ul(
tags$li("5.3.0 Plantation artificielle"),
tags$li("5.3.4 Roncier à Rubus fructicosus s.l.")
)
)
), # ferme 5.
tags$ul(
tags$li("6. Forêt"),
tags$ul(
tags$li("6.0 Plantations"),
tags$ul(
tags$li("6.0.3 Arbre isolé")
)
)
), # ferme 6.
tags$ul(
tags$li("7. Végétation pionnière des endroits perturbés par l'homme"),
tags$ul(
tags$li("7.1 Terrains piétinés et rudéraux"),
tags$li("7.2 Milieux rocheux anthropogènes")
)
), # ferme 7.
tags$ul(
tags$li("9. Milieux construits")
) # ferme 9.
), # ferme accordion_panel
# --- Milieux forestiers ---
# ------------
accordion_panel("Milieux forestiers", "désigne les plantations,
les forêts inondables, les hêtraies et autres forêts de feuillus,
les pinèdes thermophiles, les forêts de tourbières et les forêts de conifères d'altitude,
ainsi que certaines Landes, lisières et mégaphorbiaies.",
br(), br(),
"Selon TypoCH, il s'agit des habitats suivants :",
tags$ul(
tags$li("5. Landes, lisières et mégaphorbiaies"),
tags$ul(
tags$li("5.1 Lisières herbacées (ourlets)"),
tags$li("5.2 Mégaphorbiaies, coupes forestières"),
tags$ul(
tags$li("5.2.1 Coupe, clairière sur sol baso-neutrophile"),
tags$li("5.2.2 Coupe, clairière sur sol acide"),
tags$li("5.2.4 Mégaphorbiaie de montagne hygrophile à Adenostyles alliariae")
),
tags$li("5.3 Formations buissonnantes (manteau, fourrés, haies)"),
tags$ul(
tags$li("5.3.1 Buissons thermophiles sur sol acide"),
tags$li("5.3.2 Buissons xérothermophiles sur sol neutre à alcalin"),
tags$li("5.3.3 Buissons mésophiles"),
tags$li("5.3.5 Stade arbustif préforestier"),
),
)
), # ferme 5.
tags$ul(
tags$li("6. Forêts"),
tags$ul(
tags$li("6.0 Plantations"),
tags$li("6.1 Forêts inondables"),
tags$li("6.2 Hêtraies"),
tags$li("6.3 Autres forêts feuillus"),
tags$li("6.4 Pinèdes thermophiles"),
tags$li("6.5 Forêts tourbières"),
tags$li("6.6 Forêts de conifères d'altitude")
)
) # ferme 6.
), # ferme accordion_panel
# --- Milieux aquatiques ---
# --------------
accordion_panel("Milieux aquatiques", "désigne les eaux calmes, courantes et souterraines, ainsi que les sources et suintements, les rivages et lieux humides, certains buissons et les forêts inondables.",
br(), br(),
"Selon TypoCH, il s'agit des habitats suivants :",
tags$ul(
tags$li("1. Eaux libres"),
tags$ul(
tags$li("1.1 Eaux calmes"),
tags$li("1.2 Eaux courantes"),
tags$li("1.3 Sources et suintements"),
tags$li("1.4 Eaux souterraines")
)
), # ferme 1.
tags$ul(
tags$li("2. Rivages et lieux humides"),
tags$ul(
tags$li("2.1 Rivage avec végétations"),
tags$li("2.2 Bas-marais"),
tags$li("2.3 Prairies humides"),
tags$li("2.4 Tourbière bombée"),
tags$li("2.5 Végétation annuelle temporairement inondée")
)
), # ferme 2.
tags$ul(
tags$li("3. Glaciers, rochers, éboulis et moraines"),
tags$ul(
tags$li("3.2 Alluvions et moraines"),
tags$ul(
tags$li("3.2.1.0 Alluvions sans végétation"),
tags$li("3.2.1.1 Alluvions avec végétation pionnière herbacée")
)
)
), # ferme 3.
tags$ul(
tags$li("5. Landes, lisières et mégaphorbiaies"),
tags$ul(
tags$li("5.3 Formations buissonnantes (manteau, fourrés, haies)"),
tags$ul(
tags$li("5.3.6 Saulaie buissonnante alluviale"),
tags$li("5.3.7 Saulaie buissonnante marécageuse")
)
)
), # ferme 5.
tags$ul(
tags$li("6. Forêts"),
tags$ul(
tags$li("6.1 Forêts inondables")
)
), # ferme 6.
tags$ul(
tags$li("7. Végétation pionnière des endroits perturbés par l'homme"),
tags$ul(
tags$li("7.1 Terrains piétinés et rudéraux"),
tags$ul(
tags$li("7.1.1 Endroit piétiné humide")
)
)
) # ferme 7.
) # ferme accordion_panel
) # ferme accordion ()
) # ferme card_body()
) # ferme tags_div()
), # ferme card()
card(
card_header(
tags$a(h5("Impressum"),
`data-bs-toggle` = "collapse",
href = "#collapse_impressum",
style = "text-decoration:none; cursor:pointer; color:#1C5862;")
),
tags$div(id = "collapse_impressum", class = "collapse-show",
card_body(
tags$table(
style = "width:100%; border-collapse:collapse; font-size:14px; line-height:1.8;",
tags$tr(
tags$td(tags$strong("Éditeurs"), style = "width:30%; vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td("Centre de Synthèse sur la Biodiversité, ETH, WSL, Eawag. Le Centre de Synthèse sur la Biodiversité, une initiative conjointe bénéficiant du soutien financier du Conseil des EPF, renforce l’échange de
connaissances entre la recherche et la pratique dans le domaine de la biodiversité et de la protection de la nature en élaborant au sein de groupes
de travail des produits de synthèse axés sur la pratique.", style = "padding:4px 0;")
),
tags$tr(
tags$td(tags$strong("Auteur"), style = "vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td("Ladina Steinegger, Groupe de travail Communication, Centre de Synthèse sur la Biodiversité.", style = "padding:4px 0;")
),
tags$tr(
tags$td(tags$strong("Contact"), style = "vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td(tags$a("ladina.steinegger@wsl.ch", href = "mailto:ladina.steinegger@wsl.ch"), style = "padding:4px 0;")
),
tags$tr(
tags$td(tags$strong("Version"), style = "vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td("1.0, janvier 2026", style = "padding:4px 0;")
),
tags$tr(
tags$td(tags$strong("Vérification professionnelle"), style = "vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td("Cinq expert·e·s externes (2025).", style = "padding:4px 0;")
),
tags$tr(
tags$td(tags$strong("Exhaustivité"), style = "vertical-align:top; padding:4px 12px 4px 0; color:#1C5862;"),
tags$td("Malgré une compilation minutieuse, le Stakeholder-Tool ne prétend pas à l'exhaustivité.", style = "padding:4px 0;")
)
)
)
)
)
), # ferme navPanel() Readme
# -------------------------------------
# 2) Tableau
# -------------------------------------
nav_panel("Aperçu des parties prenantes",
card(
card_header(h5("Utilisation du tableau")),
card_body(
p("Grâce aux filtres, vous pouvez sélectionner de manière ciblée les parties prenantes,
les groupes de parties prenantes et les habitats, puis les afficher dans le tableau.
Une sélection multiple est possible.")
)
),
br(),
fluidRow(
column(
width = 3,
card(
card_header(h5("Filtres")),
card_body(
selectInput("raum", "Habitat", choices = NULL, multiple = TRUE),
selectInput("sektor", "Groupe de parties prenantes", choices = NULL, multiple = TRUE),
selectInput("akteur", "Partie prenante", choices = NULL, multiple = TRUE)
)
)
),
column(
width = 9,
card(
card_header(h5("Tableau")),
card_body(
DTOutput("tabelle")
)
)
)
),
), # ferme navPanel() Tabelle
# -------------------------------------
# 3) Réseau
# -------------------------------------
nav_panel("Réseau",
card(
card_header(h5("Utilisation de l'analyse de réseau")),
card_body(
p("Le réseau permet de visualiser intuitivement les constellations de parties prenantes
selon les différents habitats et groupes de parties prenantes. L'application offre les
fonctionnalités suivantes pour la visualisation :"),
tags$div(
lapply(
list(
"① Sélection entre un et cinq habitats.",
"② Restriction aux parties prenantes présents dans plusieurs habitats.",
"③ Les cases des groupes de parties prenantes de la légende (à gauche de la visualisation)
peuvent être cliquées. Les parties prenantes concernées seront alors mises en évidence
et listées dans la boîte située sous la légende.",
"④ Les nœuds des parties prenantes peuvent être cliqués pour afficher leur nom et,
le cas échéant, le lien vers leur site web."
),
function(txt) tags$p(txt, style = "margin:0;")
)
)
)
),
fluidRow(
column(
width = 12,
tags$div(style = "display:flex; align-items:flex-start; gap:10px;",
tags$span("①", style = "font-family: 'Open Sans', sans-serif; margin-top:0px;"),
div(style = "flex:1;", selectInput("raum_net", "Sélectionner les habitats (1–5)", choices = NULL, multiple = TRUE))
),
tags$div(style = "display:flex; align-items:flex-start; gap:10px; margin-top:0px;",
tags$span("②", style = "font-family: 'Open Sans', sans-serif;"),
checkboxInput("zeige_nur_mehrfach", "Seulement les parties prenantes présents dans plusieurs habitats", FALSE)
),
)
),
fluidRow(
column(
width = 3,
card(
card_header(tags$div(style = "display:flex; align-items:center; gap:8px;",
tags$span("③", style = "font-family: 'Open Sans', sans-serif;"),
"Groupes de parties prenantes"
)),
card_body(uiOutput("sektor_legende"))
),
br(),
card(
card_header("Parties prenantes mises en évidence"),
card_body(uiOutput("akteur_liste"))
)
),
column(
width = 9,
card(
full_screen = TRUE,
card_header(tags$div(style = "display:flex; align-items:center; gap:8px;",
tags$span("④", style = "font-family: 'Open Sans', sans-serif;"),
"Réseau"
)),
card_body(visNetworkOutput("netzwerk", height = "75vh"))
)
)
)
) # ferme navPanel() Netzwerk
), # ferme navset_card_tab()
# --- FOOTER ---
div(
style = "
width:100%;
display:flex;
justify-content:flex-end;
align-items:center;
margin-top:10px;
margin-bottom:5px;
padding-right:1%;
",
tags$img(
src = "All_ETH-Domaine.svg",
height = "30px",
style = "opacity:0.85;"
)
)
) # ferme fluidPage
# --- SERVER: ------------------------------------------------------------------
server <- function(input, output, session) {
# -------------------------------------
# 1) les données
# -------------------------------------
ST <- read_excel("StakeholderTool_Shiny_FR.xlsx", sheet = "Shiny")
ST$Lien <- trimws(ST$Lien)
ST$Lien[ST$Lien == ""] <- NA
aktive_sektoren <- reactiveVal(character(0))
geklickter_knoten <- reactiveVal(NULL)
mehrfach_akteure <- reactive({
req(input$raum_net)
if (!input$zeige_nur_mehrfach) {
return(NULL)
}
ST %>%
filter(Habitat %in% input$raum_net) %>%
group_by(`Partie prenante`) %>%
summarise(n_lr = n_distinct(Habitat), .groups = "drop") %>%
filter(n_lr > 1) %>%
pull(`Partie prenante`)
})
# -------------------------------------
# 2) Filtres options
# -------------------------------------
updateSelectInput(session, "akteur", choices = sort(unique(ST$`Partie prenante`)))
updateSelectInput(session, "sektor", choices = sort(unique(ST$`Groupe de parties prenantes`)))
updateSelectInput(session, "raum", choices = sort(unique(ST$Habitat)))
updateSelectInput(session, "raum_net", choices = sort(unique(ST$Habitat)))
# -------------------------------------
# 3) Donnés réeactives
# -------------------------------------
filtered_data <- reactive({
out <- ST
if (length(input$akteur) > 0)
out <- out[out$`Partie prenante` %in% input$akteur, ]
if (length(input$sektor) > 0)
out <- out[out$`Groupe de parties prenantes` %in% input$sektor, ]
if (length(input$raum) > 0)
out <- out[out$Habitat %in% input$raum, ]
out %>%
group_by(`Partie prenante`, `Groupe de parties prenantes`, Lien, Exemples) %>%
summarise(
Habitat = paste(sort(unique(Habitat)), collapse = ", "),
.groups = "drop"
)
})
# -------------------------------------
# 4) Montrer le tableau
# -------------------------------------
output$tabelle <- renderDT({
table_data <- filtered_data() %>%
mutate(
Lien = ifelse(
!is.na(Lien),
paste0('Site web'),
""
)
)
datatable(
table_data,
escape = FALSE,
options = list(
pageLength = 25,
scrollX = TRUE
)
)
}) # ferme renderDT()
output$akteur_tabelle_static <- renderTable({
data.frame(
`Groupe de parties prenantes` = c("Politique & Administration", "Bureaux de conseil & d'aménagement",
"Fédérations & Associations","Associations environnementales", "Recherche & Formation",
"Centres de données & Monitoring", "Label", "Médias", "Autres"),
Habitats = c("Milieux agricoles","Milieux alpins/montagnards","Espace bâti","Milieux forestiers","Milieux aquatiques","","","",""),
check.names = FALSE
)
})
# -------------------------------------
# 5) Visualisation du réseau
# -------------------------------------
output$netzwerk <- renderVisNetwork({
req(input$raum_net)
n_lr <- length(input$raum_net)
if (n_lr < 1 || n_lr > 5) return(NULL)
# -------------------------
# a) Préparer les données
# -------------------------
df <- ST %>%
filter(
!is.na(`Partie prenante`),
!is.na(`Groupe de parties prenantes`),
!is.na(Habitat),
Habitat %in% input$raum_net
)
if (nrow(df) == 0) return(NULL)
# -------------------------
# b) Identifier parties prenantes des plusieurs habitats
# -------------------------
akteur_counts <- df %>%
group_by(`Partie prenante`) %>%
summarise(
n_lr = n_distinct(Habitat),
sektor = first(`Groupe de parties prenantes`),
.groups = "drop"
)
if (input$zeige_nur_mehrfach)
akteur_counts <- akteur_counts %>% filter(n_lr > 1)
if (nrow(akteur_counts) == 0) return(NULL)
# -------------------------
# c) Palette de couleurs pour les groupes de parties prenantes
# -------------------------
sektoren <- sort(unique(df$`Groupe de parties prenantes`))
farben_fest <- c(
"#C6D6DA", "#3C5862", "#2D8B8B", "#5F9EA0",
"#8FBC8F", "#D2B48C", "#E6956D", "#B08EA2", "#8B7D6B"
)
sektoren_fest <- c(
"Associations environnementales", "Autres", "Bureaux de conseil & d'aménagement",
"Centres de données & Monitoring", "Fédérations & Associations",
"Label", "Médias", "Politique & Administration","Recherche & Formation"
)
sektor_farben <- setNames(farben_fest, sektoren_fest)[sektoren]
# -------------------------
# d) Noeuds
# -------------------------
nodes_lr <- data.frame(
id = paste0("L_", unique(df$Habitat)),
label = unique(df$Habitat),
group = "Habitat",
shape = "box",
font = list(size = 28, face = "Open Sans"),
title = paste0("Habitat: ", unique(df$Habitat)),
stringsAsFactors = FALSE
)
nodes_akteur <- akteur_counts %>%
mutate(
id = paste0("A_", `Partie prenante`),
akteur = `Partie prenante`,
label = "",
group = sektor,
shape = "dot",
size = 12,
font.size = 14,
font.align = "top",
title = paste0("", `Partie prenante`, ""),
mass = 5
) %>%
left_join(
df %>% distinct(`Partie prenante`, Lien),
by = c("akteur" = "Partie prenante")
) %>%
mutate(
url = trimws(Lien),
url = ifelse(!is.na(url) & !grepl("^https?://", url),
paste0("https://", url),
url),
title = ifelse(
!is.na(url),
paste0(
""
),
paste0("", akteur, "")
)
) %>%
select(id, akteur, label, group, shape, size, font.size, title, mass, url)
nodes_akteur$color <- lapply(nodes_akteur$group, function(s) {
col <- sektor_farben[[s]]
list(background = sektor_farben[[s]], border = "black",
highlight = list(background = sektor_farben[[s]], border = "black"))
})
# -------------------------
# e) Liens
# -------------------------
edges <- df %>%
distinct(`Partie prenante`, Habitat, `Groupe de parties prenantes`) %>%
mutate(
from = paste0("A_", `Partie prenante`),
to = paste0("L_", Habitat),
id = paste0("E_", `Partie prenante`, "_", Habitat),
sektor = `Groupe de parties prenantes`,
width = 1,
selectionWidth = 1,
length = 200
) %>%
select(id, from, to, selectionWidth, length, sektor, width)
edges$color <- lapply(seq_len(nrow(edges)), function(i) {
sektor <- edges$sektor[i]
col <- sektor_farben[[sektor]]
col_opacity <- adjustcolor(col, alpha.f = 0.6)
list(
color = col_opacity,
highlight = col,
inherit = FALSE
)
})
# -------------------------------------
# f) Layout
# -------------------------------------
if (n_lr == 1) {
# --- VERSION: 1 Habitat ---
sektor_stats <- nodes_akteur %>%
count(group) %>%
arrange(match(group, sektoren_fest))
total_nodes <- sum(sektor_stats$n)
angle_per_node <- 2 * pi / total_nodes
start_angle <- -pi/2
r_outer <- 350
nodes_akteur$x <- NA
nodes_akteur$y <- NA
for (i in seq_len(nrow(sektor_stats))) {
n <- sektor_stats$n[i]
idx <- which(nodes_akteur$group == sektor_stats$group[i])
if (n == 0) next
angles <- start_angle + angle_per_node * seq_len(n)
nodes_akteur$x[idx] <- r_outer * cos(angles)
nodes_akteur$y[idx] <- r_outer * sin(angles)
start_angle <- start_angle + angle_per_node * n
}
nodes <- bind_rows(nodes_lr, nodes_akteur)
netzwerk <- visNetwork(nodes, edges) %>%
visGroups(groupname = "Habitat", shape = "box", color = list(
background = "#DCE8EB", border = "#5F7F86")) %>%
visEdges(
smooth = list(
enabled = TRUE,
type = "dynamic",
roundness = 0.1
)) %>%
visPhysics(enabled = FALSE) %>%
visLayout(randomSeed = 1) %>%
visOptions(
highlightNearest = list(enabled = TRUE, degree = 1, hover = FALSE),
) %>%
visEvents(click = "function(params) {
if (params.nodes.length > 0) {
Shiny.setInputValue('netzwerk_click', {nodeId: params.nodes[0]}, {priority: 'event'});
}
}")
} else if (n_lr == 2) {
# --- VERSION: 2 Habitats ---
x_left <- -300
x_right <- 300
y_max <- 500
ring_gap <- 40
box_clearance <- 120
nodes_lr <- nodes_lr %>%
mutate(
x = ifelse(label == input$raum_net[1], x_left, x_right),
y = 0
)
akteur_lr <- df %>%
distinct(`Partie prenante`, Habitat) %>%
count(`Partie prenante`, name = "n_lr")
nodes_akteur <- nodes_akteur %>%
left_join(akteur_lr, by = c("akteur" = "Partie prenante"))
nodes_shared <- nodes_akteur %>% filter(n_lr > 1) %>%
arrange(group)
if (nrow(nodes_shared) > 0) {
nodes_shared$x <- 0
nodes_shared$y <- seq(y_max, -y_max, length.out = nrow(nodes_shared))
}
nodes_left <- nodes_akteur %>%
filter(
n_lr == 1,
akteur %in% df$`Partie prenante`[df$Habitat == input$raum_net[1]]) %>%
arrange(group)
if (nrow(nodes_left) > 0) {
nodes_left$x <- x_left - box_clearance - rep(c(0, ring_gap, 2 * ring_gap), length.out = nrow(nodes_left))
nodes_left$y <- seq(y_max, -y_max, length.out = nrow(nodes_left))
}
nodes_right <- nodes_akteur %>%
filter(
n_lr == 1,
akteur %in% df$`Partie prenante`[df$Habitat == input$raum_net[2]]) %>%
arrange(group)
if (nrow(nodes_right) > 0) {
nodes_right$x <- x_right + box_clearance + rep(c(0, ring_gap, 2 * ring_gap), length.out = nrow(nodes_right))
nodes_right$y <- seq(y_max, -y_max, length.out = nrow(nodes_right))
}
nodes <- bind_rows(nodes_lr, nodes_left, nodes_right, nodes_shared)
netzwerk <- visNetwork(nodes, edges) %>%
visGroups(groupname = "Habitat", shape = "box", color = list(
background = "#DCE8EB", border = "#5F7F86")) %>%
visEdges(
smooth = list(
enabled = TRUE,
type = "dynamic",
roundness = 0.1
)) %>%
visPhysics(enabled = FALSE) %>%
visLayout(randomSeed = 1) %>%
visOptions(
highlightNearest = list(enabled = TRUE, degree = 1, hover = FALSE)
) %>%
visEvents(click = "function(params) {
if (params.nodes.length > 0) {
Shiny.setInputValue('netzwerk_click', {nodeId: params.nodes[0]}, {priority: 'event'});
}
}")
} else {
# --- VERSION: 3-5 Habitats ---
lr <- sort(unique(df$Habitat))
n_lr <- length(lr)
r_lr <- 600
angles <- seq(0, 2 * pi, length.out = n_lr + 1)[-(n_lr + 1)]
lr_pos <- data.frame(
Habitat = lr,
x = r_lr * cos(angles),
y = r_lr * sin(angles)
)
nodes_lr <- nodes_lr %>%
left_join(lr_pos, by = c("label" = "Habitat")) %>%
mutate(
fixed = TRUE
)
akteur_lr <- df %>%
distinct(`Partie prenante`, Habitat, `Groupe de parties prenantes`) %>%
group_by(`Partie prenante`) %>%
summarise(
lr_list = list(sort(Habitat)),
n_lr = n(),
combo = paste(sort(Habitat), collapse = " | "),
sektor = first(`Groupe de parties prenantes`),
.groups = "drop"
)
akteur_single <- akteur_lr %>% filter(n_lr == 1) %>%
unnest(lr_list) %>% rename(lr = lr_list)
akteur_multi <- akteur_lr %>% filter(n_lr > 1)
cx <- mean(lr_pos$x)
cy <- mean(lr_pos$y)
outward_dist <- 220
spacing_s <- 32
akteur_pos_single <- akteur_single %>%
left_join(lr_pos, by = c("lr" = "Habitat")) %>%
mutate(
len = sqrt((x - cx)^2 + (y - cy)^2),
dx = (x - cx) / len,
dy = (y - cy) / len,
perp_x = -dy,
perp_y = dx,
base_x = x + dx * outward_dist,
base_y = y + dy * outward_dist
) %>%
arrange(lr, sektor) %>%
group_by(lr) %>%
mutate(
n_sek = n_distinct(sektor),
sektor_idx = match(sektor, sort(unique(sektor))) - 1
) %>%
group_by(lr, sektor) %>%
mutate(
idx_in_sektor = row_number() - 1
) %>%
group_by(lr) %>%
mutate(
sektor_spread = (sektor_idx - (n_sek - 1) / 2) * (spacing_s * 2.8),
node_spread = idx_in_sektor * spacing_s * 0.9,
x = base_x + perp_x * sektor_spread + dx * node_spread,
y = base_y + perp_y * sektor_spread + dy * node_spread
) %>%
ungroup() %>%
select(`Partie prenante`, x, y)
sektoren_multi <- sort(unique(akteur_multi$sektor))
n_sm <- length(sektoren_multi)
r_sektor <- 180
spacing_m <- 30
sektor_anchor_multi <- data.frame(
sektor = sektoren_multi,
sax = cx + r_sektor * cos(seq(0, 2*pi, length.out = n_sm + 1)[-(n_sm + 1)]),
say = cy + r_sektor * sin(seq(0, 2*pi, length.out = n_sm + 1)[-(n_sm + 1)])
)
akteur_pos_multi <- akteur_multi %>%
left_join(sektor_anchor_multi, by = "sektor") %>%
group_by(sektor) %>%
mutate(
idx = row_number() - 1,
angle = idx * 2.4,
radius = spacing_m * sqrt(idx),
x = sax + radius * cos(angle),
y = say + radius * sin(angle)
) %>%
ungroup() %>%
select(`Partie prenante`, x, y)
akteur_pos <- bind_rows(akteur_pos_multi, akteur_pos_single)
nodes_akteur <- nodes_akteur %>%
left_join(akteur_pos, by = c("akteur" = "Partie prenante"))
nodes <- bind_rows(nodes_lr, nodes_akteur)
netzwerk <- visNetwork(nodes, edges) %>%
visGroups(groupname = "Habitat", shape = "box", color = list(
background = "#DCE8EB", border = "#5F7F86")) %>%
{
g <- .
for (s in names(sektor_farben)) {
g <- visGroups(
g,
groupname = s,
color = list(
background = sektor_farben[[s]],
border = "black"
)
)
}
g
} %>%
visEdges(
smooth = list(
enabled = TRUE,
type = "dynamic",
roundness = 0.1
)) %>%
visPhysics(enabled = FALSE) %>%
visLayout(randomSeed = 1) %>%
visOptions(
highlightNearest = list(enabled = TRUE,degree = 1,hover = FALSE),
) %>%
visEvents(click = "function(params) {
if (params.nodes.length > 0) {
Shiny.setInputValue('netzwerk_click', {nodeId: params.nodes[0]}, {priority: 'event'});
}
}")
} # ferme else
}) # ferme VisNetwork
# -------------------------
# Légende
# -------------------------
output$sektor_legende <- renderUI({
req(input$raum_net)
aktiv <- aktive_sektoren()
df <- ST %>%
filter(Habitat %in% input$raum_net)
sektoren <- sort(unique(df$`Groupe de parties prenantes`))
if (length(sektoren) == 0) return(NULL)
farben_legende <- c(
"#C6D6DA", "#3C5862", "#2D8B8B", "#5F9EA0",
"#8FBC8F", "#D2B48C", "#E6956D", "#B08EA2", "#8B7D6B"
)
sektoren_legende <- c(
"Associations environnementales", "Autres", "Bureaux de conseil & d'aménagement",
"Centres de données & Monitoring", "Fédérations & Associations",
"Label", "Médias", "Politique & Administration","Recherche & Formation"
)
sektor_farben <- setNames(farben_legende, sektoren_legende)[sektoren]
tagList(
tags$div(
style = "display:flex; flex-direction:column; gap:6px; align-items:flex-start;",
lapply(sektoren, function(s) {
ist_aktiv <- length(aktiv) > 0 && aktiv == s
actionButton(
inputId = paste0("leg_", make.names(s)),
label = s,
style = paste0(
"background-color:", sektor_farben[[s]], ";",
" border:", ifelse(ist_aktiv, "3px solid black", "1px solid black"), ";",
" color:black;",
" font-weight:", ifelse(ist_aktiv, "bold", "normal"), ";",
" font-size:11px;",
" padding:4px 8px;",
" line-height:1;",
" height:28px;",
" width:60%;"
)
)
})
)
)
})
observe({
req(input$raum_net)
df <- ST %>%
filter(Habitat %in% input$raum_net)
sektoren <- sort(unique(df$`Groupe de parties prenantes`))
for (s in sektoren) {
local({
sektor_name <- s
button_id <- paste0("leg_", make.names(sektor_name))
observeEvent(input[[button_id]], {
aktive_sektoren(sektor_name)
geklickter_knoten(NULL)
df_filtered <- ST %>%
filter(
Habitat %in% input$raum_net,
`Groupe de parties prenantes` == sektor_name
)
if (input$zeige_nur_mehrfach) {
df_filtered <- df_filtered %>%
filter(`Partie prenante` %in% mehrfach_akteure())
}
akteure_ids <- paste0("A_", unique(df_filtered$`Partie prenante`))
visNetworkProxy("netzwerk") %>%
visSelectNodes(id = akteure_ids)
}, ignoreInit = TRUE)
})
}
}) # ferme observe
observeEvent(input$netzwerk_click, {
node_id <- input$netzwerk_click$nodeId
if (is.null(node_id) || node_id == "") return()
aktive_sektoren(character(0))
geklickter_knoten(node_id)
})
# Liste Parties prenantes
output$akteur_liste <- renderUI({
req(input$raum_net)
sektor <- aktive_sektoren()
knoten <- geklickter_knoten()
# --- Cas 1: Légende cliquée ---
if (length(sektor) > 0) {
df_filtered <- ST %>%
filter(Habitat %in% input$raum_net, `Groupe de parties prenantes` == sektor)
if (input$zeige_nur_mehrfach)
df_filtered <- df_filtered %>% filter(`Partie prenante` %in% mehrfach_akteure())
akteure_df <- df_filtered %>%
distinct(`Partie prenante`, Lien) %>%
arrange(`Partie prenante`)
# --- Cas 2: Noeud d'habitat cligué ---
} else if (!is.null(knoten) && startsWith(knoten, "L_")) {
lr_name <- sub("^L_", "", knoten)
df_filtered <- ST %>%
filter(Habitat == lr_name, Habitat %in% input$raum_net)
if (input$zeige_nur_mehrfach)
df_filtered <- df_filtered %>% filter(`Partie prenante` %in% mehrfach_akteure())
akteure_df <- df_filtered %>%
distinct(`Partie prenante`, Lien) %>%
arrange(`Partie prenante`)
# --- Cas 3: Noeud de Staleholder cliqué ---
} else if (!is.null(knoten) && startsWith(knoten, "A_")) {
name <- sub("^A_", "", knoten)
akteure_df <- ST %>%
filter(`Partie prenante` == name) %>%
distinct(`Partie prenante`, Lien)
} else {
return(NULL)
}
# Nettoyer l'URL
akteure_df <- akteure_df %>%
mutate(
url = trimws(Lien),
url = ifelse(!is.na(url) & !grepl("^https?://", url), paste0("https://", url), url),
url = ifelse(is.na(url) | url == "", NA, url)
)
tagList(
tags$div(
style = "max-height:300px; overflow-y:auto; font-size:12px;",
tags$ul(
lapply(seq_len(nrow(akteure_df)), function(i) {
name <- akteure_df$`Partie prenante`[i]
url <- akteure_df$url[i]
if (!is.na(url)) {
tags$li(tags$a(name, href = url, target = "_blank"))
} else {
tags$li(name)
}
})
)
)
)
}) # ferme renderUI()
} # ferme Server
shinyApp(ui, server)