In CedricMondy/afbBNVD: Explore the BNVD

library(flexdashboard)
library(shiny)

library(dplyr)
library(tidyr)
library(sf)

library(leaflet)
library(ggplot2)
library(plotly)
library(streamgraph)
library(viridis)

library(afbBNVD)

session$onSessionEnded(stopApp)

# data("dernieres_ventes")
dernieres_ventes <- st_read(system.file("extdata", "dernieres_ventes.gpkg", package = "afbBNVD"))
data("tendances")
data("top_substances")

Ventes totales

Column {data-width=600}

palette_tendance <- colorNumeric(c(afb_cols(1:2), "white", afb_cols(3:4)), domain = NULL)

radius_lims <- c(5, 25)

coeffs <- as.data.frame(dernieres_ventes) %>% 
  mutate(x = sqrt(quantite)) %>% 
  filter(x %in% c(min(x), max(x))) %>% 
  select(x) %>% 
  arrange(x) %>% 
  mutate(y = radius_lims) %>% 
  lm(data = ., formula = y ~ x) %>% 
  coefficients() %>% 
  (function(x) {
    list(a = x[["x"]],
         b = x[["(Intercept)"]])
  })

calc_radius <- scales::trans_new(
  name = "calc_radius",
  transform = function(x) {
      sqrt(x) %>% 
      (function(x) coeffs$a * x + coeffs$b)
  },
  inverse = function(y) {
    ((y - coeffs$b) / coeffs$a)^2 
  }
)

roundCustom <- function(x) {
  roundedX <- round(x)
  nBig <- nchar(roundedX) - 1

  round(roundedX / 10^(nBig))* 10^nBig
}

# https://stackoverflow.com/questions/37446283/creating-legend-with-circles-leaflet-r

tags$style(type = "text/css", "html, body {width:100%;height:100%}",
      ".leaflet .legend i{
      border-radius: 50%;
      width: 10px;
      height: 10px;
      margin-top: 4px;
      },
      .leaflet .legend label{
      float: right;
      text-align: left;
      }
    ")

addLegendSize <- function(map, colors, labels, sizes, opacity = 0.5, ...){
      colorAdditions <- paste0(colors, "; width:", sizes, "px; height:", sizes, "px")
      labelAdditions <- paste0("<div style='display: inline-block;height: ", sizes, "px;margin-top: 4px;line-height: ", sizes, "px;'>", labels, "</div>")

      return(addLegend(map, colors = colorAdditions, labels = labelAdditions, opacity = opacity, ...))
}

dernieres_ventes <- mutate(dernieres_ventes,
                           rayon = calc_radius$transform(quantite))


quantite_lims <- as.data.frame(dernieres_ventes) %>% 
  select(quantite) %>% 
  summarise(min = min(quantite),
            mean = mean(quantite),
            max = max(quantite)) %>% 
  gather() %>% 
  mutate(lim = roundCustom(value)) %>% 
  mutate(rayon = calc_radius$transform(lim))

output$map <- renderLeaflet({
    leaflet() %>% 
    addTiles() %>% 
    fitBounds(lng1 = -61.9, lat1 = -22,
              lng2 = 55.85, lat2 = 50) %>%
    addCircleMarkers(data = dernieres_ventes,
                     radius = ~ rayon,
                     layerId = ~ departement,
                     fillColor = ~palette_tendance(pente_trunc),
                     fillOpacity = 1, 
                     stroke = TRUE, weight = 1,
                     popup = ~ paste0(departement, "<br>",
                                      round(quantite),
                                      " tonnes en 2017 <br>",
                                      round(pente, 2), " % par an")) %>% 
    addLayersControl(overlayGroups = "legend",
                     options = layersControlOptions(collapsed = FALSE))%>% 
    addLegend(title = "Evolution temporelle<br>(% par an)",
              pal = palette_tendance,
          values = dernieres_ventes$pente_trunc,
          labFormat = labelFormat(transform = function(x) round(x, 2)),
          opacity = 1,
          group = "legend") %>%
    addLegendSize(title = "Quantité totale de<br>substances vendues<br>en 2017 (tonnes)",
                  colors = afb_cols("bleu"), 
                  sizes = quantite_lims$rayon,
                  labels = format(quantite_lims$lim, scientific = TRUE),
                  group = "legend") 
})

leafletOutput('map', height= "100%")

Column {data-width=400}

department_clicked <- reactiveValues(name = "FRANCE")

observeEvent(input$map_marker_click,
             {department_clicked$name <- input$map_marker_click$id})

observeEvent(input$map_click,
             {department_clicked$name <- "FRANCE"})

trend_dpt <- reactive({
    filter(tendances, 
           departement %in% department_clicked$name,
           substance %in% "total phytosanitaires")
    })

r renderText(department_clicked$name)

 renderPlotly({
     ggplot(data = trend_dpt(),
            aes(x = annee, y = quantite)) +
         geom_smooth(se = FALSE, linetype = "dashed",
                     size = 0.25, colour = "black", 
                     method = 'loess', formula = y ~ x) +
         geom_point() +
         theme_afb() +
         labs(x = "", y = "quantité de pesticides vendues (tonnes)") +
         scale_x_continuous(
             breaks = seq(from = min(trend_dpt()$annee),
                          to = max(trend_dpt()$annee),
                          by = 2)) +
         theme(axis.text.x = element_text(angle = 45, hjust = 1))
     })

Evolution par substance

Inputs {.sidebar data-width=150}

liste_departements <- list(
    `France`                           = "FRANCE",
    `Auvergne-Rhone-Alpes` = c(
        `Ain (01)`                     = "AIN",
        `Allier (03)`                  = "ALLIER",
        `Ardèche (07)`                 = "ARDECHE",
        `Cantal (15)`                  = "CANTAL",
        `Drôme (26)`                   = "DROME", 
        `Isère (38)`                   = "ISERE",
        `Loire (42)`                   = "LOIRE",
        `Haute-Loire (43)`             = "HAUTE-LOIRE",
        `Puy-de-Dôme (63)`             = "PUY-DE-DOME",
        `Rhône (69)`                   = "RHONE",
        `Savoie (73)`                  = "SAVOIE",
        `Haute-Savoie (74)`            = "HAUTE-SAVOIE"
    ),
    `Bourgogne-Franche-Comté` = c(
        `Côte-d'Or (21)`               = "COTE-D'OR",
        `Doubs (25)`                   = "DOUBS",
        `Jura (39)`                    = "JURA",
        `Nièvre (58)`                  = "NIEVRE",
        `Haute-Saône (70)`             = "HAUTE-SAONE",
        `Saône-et-Loire (71)`          = "SAONE-ET-LOIRE",
        `Yonne (89)`                   = "YONNE",
        `Territoire de Belfort (90)`   = "TERRITOIRE-DE-BELFORT"
    ),
    `Bretagne` = c(
        `Côtes-d'Armor (22)`           = "COTES-D'ARMOR",
        `Finistère (29)`               = "FINISTERE",
        `Ille-et-Vilaine (35)`         = "ILLE-ET-VILAINE",
        `Morbihan (56)`                = "MORBIHAN"
    ),
    `Centre-Val de Loire` = c(
        `Cher (18)`                    = "CHER",
        `Eure-et-Loir (28)`            = "EURE-ET-LOIR",
        `Indre (36)`                   = "INDRE",
        `Indre-et-Loire (37)`          = "INDRE-ET-LOIRE",
        `Loir-et-Cher (41)`            = "LOIR-ET-CHER",
        `Loiret (45)`                  = "LOIRET"
    ),
    `Corse` = c(
        `Corse-du-Sud (2A)`            = "CORSE-DU-SUD",
        `Haute-Corse (2B)`             = "HAUTE-CORSE"
    ),
    `Grand Est` = c(
        `Ardennes (08)`                = "ARDENNES",
        `Aube (10)`                    = "AUBE",
        `Marne (51)`                   = "MARNE",
        `Haute-Marne (52)`             = "HAUTE-MARNE",
        `Meurthe-et-Moselle (54)`      = "MEURTHE-ET-MOSELLE",
        `Meuse (55)`                   = "MEUSE",
        `Moselle (57)`                 = "MOSELLE",
        `Bas-Rhin (67)`                = "BAS-RHIN",
        `Haut-Rhin (68)`               = "HAUT-RHIN",
        `Vosges (88)`                  = "VOSGES"
    ),
    `Guadeloupe` = c(
        `Guadeloupe (971)`             = "GUADELOUPE"
    ),
    `Guyane` = c(
        `Guyane (973)`                 = "GUYANE"
    ),
    `Hauts-de-France` = c(
        `Aisne (02)`                   = "AISNE",
        `Nord (59)`                    = "NORD",
        `Oise (60)`                    = "OISE",
        `Pas-de-Calais (62)`           = "PAS-DE-CALAIS",
        `Somme (80)`                   = "SOMME"
    ),
    `Ile-de-France` = c(
        `Paris (75)`                   = "PARIS",
        `Seine-et-Marne (77)`          = "SEINE-ET-MARNE",
        `Yvelines (78)`                = "YVELINES",
        `Essonne (91)`                 = "ESSONNE",
        `Hauts-de-Seine (92)`          = "HAUTS-DE-SEINE",
        `Seine-Saint-Denis (93)`       = "SEINE-SAINT-DENIS",
        `Val-de-Marne (94)`            = "VAL-DE-MARNE",
        `Val-d'Oise (95)`              = "VAL-D'OISE"
    ),
    `La Réunion` = c(
        `La Réunion (974)`             = "LA REUNION"
    ),
    `Martinique` = c(
        `Martinique (972)`             = "MARTINIQUE"
    ),
    `Mayotte` = c(
        `Mayotte (976)`                = "MAYOTTE"
    ),
    `Normandie` = c(
        `Calvados (14)`                = "CALVADOS",
        `Eure (27)`                    = "EURE",
        `Manche (50)`                  = "MANCHE",
        `Orne (61)`                    = "ORNE",
        `Seine-Maritime (76)`          = "SEINE-MARITIME"
    ),
    `Nouvelle-Aquitaine` = c(
        `Charente (16)`                = "CHARENTE",
        `Charente-Maritime (17)`       = "CHARENTE-MARITIME",
        `Corrèze (19)`                 = "CORREZE",
        `Creuse (23)`                  = "CREUSE",
        `Dordogne (24)`                = "DORDOGNE",
        `Gironde (33)`                 = "GIRONDE",
        `Landes (40)`                  = "LANDES",
        `Lot-et-Garonne (47)`          = "LOT-ET-GARONNE",
        `Pyrénées-Atlantiques (64)`    = "PYRENEES-ATLANTIQUES",
        `Deux-Sèvres (79)`             = "DEUX-SEVRES",
        `Vienne (86)`                  = "VIENNE",
        `Haute-Vienne (87)`            = "HAUTE-VIENNE"
    ),
    `Occitanie` = c(
        `Ariège (09)`                  = "ARIEGE",
        `Aude (11)`                    = "AUDE",
        `Aveyron (12)`                 = "AVEYRON",
        `Gard (30)`                    = "GARD",
        `Haute-Garonne (31)`           = "HAUTE-GARONNE",
        `Gers (32)`                    = "GERS",
        `Hérault (34)`                 = "HERAULT",
        `Lot (46)`                     = "LOT",
        `Lozère (48)`                  = "LOZERE",
        `Hautes-Pyrénées (65)`         = "HAUTES-PYRENEES",
        `Pyrénées-Orientales (66)`     = "PYRENEES-ORIENTALES",
        `Tarn (81)`                    = "TARN",
        `Tarn-et-Garonne (82)`         = "TARN-ET-GARONNE"
    ),
    `Pays de la Loire` = c(
        `Loire-Atlantique (44)`        = "LOIRE-ATLANTIQUE",
        `Maine-et-Loire (49)`          = "MAINE-ET-LOIRE",
        `Mayenne (53)`                 = "MAYENNE",
        `Sarthe (72)`                  = "SARTHE",
        `Vendée (85)`                  = "VENDEE"
    ),
    `Provence-Alpes-Côte d'Azur` = c(
        `Alpes-de-Haute-Provence (04)` = "ALPES-DE-HAUTE-PROVENCE",
        `Hautes-Alpes (05)`            = "HAUTES-ALPES",
        `Alpes-Maritimes (06)`         = "ALPES-MARITIMES",
        `Bouches-du-Rhône (13)`        = "BOUCHES-DU-RHONE",
        `Var (83)`                     = "VAR",
        `Vaucluse (84)`                = "VAUCLUSE"
    )
)

selectInput(inputId = "department_clicked2",
            label = "Département",
            choices = liste_departements, 
            selected = "FRANCE", 
            selectize = TRUE)

n_subst_max <- group_by(tendances, departement) %>% 
    summarise(n = n_distinct(substance)) %>% 
    summarise(n= max(n)) %>% 
    pull(n)

numericInput(inputId = "nb_subst", 
         label   = "Nombre de substances à représenter",
         value   = 5, 
         min = 1, max = n_subst_max)

Column {data-width=300}

top_dpt <- reactive({
    filter(top_substances,
           departement %in% input$department_clicked2) %>% 
            select(Rang, substance, `Part des ventes (%)`, code_sandre) %>% 
        mutate(Substance = paste0("<a href='http://www.sandre.eaufrance.fr/urn.php?urn=urn:sandre:donnees:PAR:FRA:code:", code_sandre, ":::referentiel:2:html' target='_blank'>", substance, "</a>")) %>% 
    select(Rang, substance, Substance, `Part des ventes (%)`)
})

renderTable({
    select(top_dpt(), -substance)
}, sanitize.text.function = function(x) x)

`r renderText(paste0("Substances constituant plus de 50% des quantités de pesticides vendues sur l'ensemble de la chronique (", paste(range(tendances$annee), collapse = "-"), ")"))`

Column {data-width=550}

trend <- reactive({
    trend  <-  filter(tendances,
                   departement %in% input$department_clicked2,
                   substance != "total phytosanitaires",
                   Rang %in% seq(input$nb_subst))

    mutate(trend, 
           substance = factor(substance, 
                              levels = slice(top_dpt(), input$nb_subst:1) %>% 
                                  pull(substance))) %>% 
        arrange(annee, substance)
})

renderStreamgraph({
   n_subst <- n_distinct(trend()$substance)
   subst_colors <- viridis_pal()(n_subst)[n_subst:1]
   names(subst_colors) <- unique(trend()$substance)
   subst_colors <- subst_colors[sort(names(subst_colors))]

   streamgraph(data = trend(), 
               key = "substance", value = "quantite",
               date = "annee", offset="zero") %>%
        sg_axis_x(tick_interval = 2) %>% 
        sg_axis_y(tick_count = 5) %>% 
        sg_fill_manual(values = subst_colors)
})