De l’intégration d’une application Rshiny dans un document Quarto

Traitement des données du 30-12-2025 : Données des VISA
R
RShiny
Quarto
VISA
Auteur·rice

GOLLENTZ Quentin

Date de publication

01-04-2026

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 600
library(bslib)
library(shiny)
library(readr)
library(utils)
library(dplyr)
library(stringr)
library(tidyr)
library(jsonlite)
library(maps)
library(ggplot2)
if (FALSE) {
  library(munsell)
}
country_lists <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-09-09/country_lists.csv')
nodes <- utils::read.delim("https://gist.githubusercontent.com/tadast/8827699/raw/61b2107766d6fd51e2bd02d9f78f6be081340efc/countries_codes_and_coordinates.csv", header = TRUE,
                    quote = '"', sep = ",",
                    col.names = c('name', 'id_1', 'id_2', 'id','lat','lon')) %>%
  mutate_if(is.character, str_trim)
## Interface Utilisateur (UI)
# Définit la structure visuelle de votre application
## Interface Utilisateur (UI)
ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      body {
        background-color: white !important;
      }
      .container-fluid {
        padding: 0 !important;
        /* Ajout de display: flex pour utiliser le modèle de boîte flexible */
        display: flex;
        flex-direction: column;
        height: 100vh; /* La hauteur du conteneur est la hauteur de la fenêtre */
      }
      .row {
        flex-shrink: 0; /* Empêche les lignes du haut de se réduire */
      }
      #visa_plot {
        width: 100% !important;
        /* Le graphique prend l'espace restant */
        flex-grow: 1;
      }
      /* Ajustements pour les marges des lignes */
      .fluid-row {
        margin-left: 0 !important;
        margin-right: 0 !important;
      }
    "))
  ),
 uiOutput("dynamic_title"),
  
  # Nouvelle disposition : l'entrée en haut, le graphique en dessous
  fluidRow(
    column(12,
           selectInput("country_selector", "Choisir un pays :",
                       choices = sort(unique(nodes$id_1)),
                       selected = "FR")
    )
  ),
  fluidRow(
    column(12,
           plotOutput("visa_plot")
    )
  )
)

server <- function(input, output, session) {
    # Titre dynamique
    output$dynamic_title <- renderUI({
    tags$div(
      class = "shiny-title-panel",
      h2(paste("Visas obligatoires pour voyager depuis :", input$country_selector))
    )
  })

  # Expression réactive pour filtrer les données en fonction de la sélection
  reactive_data <- reactive({
    
    data_visa_required <- country_lists %>%
      rename(from = code) %>%
      mutate(
        data_visa_required = lapply(visa_required, fromJSON)
      ) %>%
      unnest(data_visa_required) %>%
      select(from, data_visa_required)
    
    data_visa_required <- unnest(data = data_visa_required , cols=data_visa_required) %>%
      select(from, code) %>%
      rename(to = code) %>%
      filter(from == input$country_selector)
    
    if (nrow(data_visa_required) == 0) {
      return(NULL)
    }
    
    edges_for_plot <- data_visa_required %>%
      inner_join(nodes %>% select(id_1, lon, lat), by = c('from' = 'id_1'),relationship = "many-to-many") %>%
      rename(x = lon, y = lat) %>%
      inner_join(nodes %>% select(id_1, lon, lat), by = c('to' = 'id_1'),relationship = "many-to-many") %>%
      rename(xend = lon, yend = lat)
    
    countries_in_edges <- unique(c(edges_for_plot$from, edges_for_plot$to))
    
    filtered_nodes <- nodes %>%
      filter(id_1 %in% countries_in_edges)
    
    return(list(edges = edges_for_plot, nodes = filtered_nodes))
  })
  
  output$visa_plot <- renderPlot({
    plot_data <- reactive_data()
    
    if (is.null(plot_data)) {
      ggplot() +
        geom_text(aes(x = 0, y = 0, label = "No visa required countries found for this selection."),
                  size = 5) +
        theme_void()
    } else {
      maptheme <- theme(
        panel.background = element_rect(fill = "white", color = NA),
        plot.background = element_rect(fill = "white", color = NA),
        panel.grid = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        legend.position = "bottom",
        legend.background = element_rect(fill = "white", color = NA),
        legend.text = element_text(color = "black"),
        legend.title = element_text(color = "black"),
        plot.margin = unit(c(0, 0, 0, 0), 'cm'),
        text = element_text(color = "black")
      )
      
      country_shapes <- geom_polygon(
        aes(x = long, y = lat, group = group),
        data = map_data('world'),
        fill = "white",
        color = "#4A4A4A",
        linewidth = 0.15
      )
      
      ggplot(plot_data$nodes) +
        country_shapes +
        geom_curve(aes(x = x, y = y, xend = xend, yend = yend),
                   data = plot_data$edges, curvature = 0.33,
                   color = "black", alpha = 0.5) +  
        scale_size_continuous(guide = FALSE, range = c(0.25, 2)) +
        geom_point(aes(x = lon, y = lat),
                   shape = 21, fill = 'black',  
                   color = 'black', stroke = 0.5) +
        scale_size_continuous(guide = FALSE, range = c(1, 6)) +
        geom_text(aes(x = lon, y = lat, label = name),
                  hjust = 0, nudge_x = 1, nudge_y = 4,
                  size = 3, color = "black", fontface = "bold") +
        maptheme
    }
  })
}

# Lancement de l'application
shinyApp(ui = ui, server = server)