dev/applis_sdes/app_stats.R

In CedricMondy/bnvd: Explore French pesticide data

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(leaflet)
library(sf)
library(data.table)
library(dplyr)
#library(rgdal)
library(plotly)
#library(forcats)


#####LECTURE DES DONNEES
DPT_Layer <- st_read("data/dep_wgs84.shp",stringsAsFactors=FALSE)
DPT_point_Layer <- st_read("data/dep_wgs84_pt.shp",stringsAsFactors=FALSE)



load("data/SUBST_STATS.Rdata")

DPT_Layer <- left_join(DPT_Layer,ACHAT_DPT_SUBSTANCE_STATS %>% filter(T1=="Quantite totale" & annee=="2017") ,by= c("DEP" = "DPT"))
DPT_point_Layer <- left_join(DPT_point_Layer,ACHAT_DPT_SUBSTANCE_STATS %>% filter(T1=="Quantite totale" & annee=="2017") ,by= c("DEP" = "DPT"))

my_color <- "#008B8B"

##########INTERFACE UTILISATEUR
ui <- fluidPage(
  
    fluidRow(
      column(7, fluidRow(textOutput("Title_Dep")),
             fluidRow(plotlyOutput("Graph_first", height = 200)),
             fluidRow(plotlyOutput("Graph_second", width="100%")),
             fluidRow(plotlyOutput("Graph_third", height = 200))),
      column(5,fluidRow(h4("Quantite de substances achetees en 2017")), 
             fluidRow(leafletOutput("mymap", width="100%",height = 600)),
                  fluidRow(column(2,leafletOutput("mymapGLP", width="100%",height =80),style =  "padding:1px;border: 1px solid silver"),
                    column(2,leafletOutput("mymapMTQ", width="100%",height =80),style =  "padding:1px;border: 1px solid silver"),
                    column(2,leafletOutput("mymapGUF", width="100%",height =80),style =  "padding:1px;border: 1px solid silver"),
                    column(2,leafletOutput("mymapREU", width="100%",height =80),style =  "padding:1px;border: 1px solid silver"),                  
                    column(2,leafletOutput("mymapMYT", width="100%",height =80),style =  "padding:1px;border: 1px solid silver")
                           )

      )
    )
    


  #div(class="outer",
  #
  #    tags$head(
  #      # Include our custom CSS
  #      includeCSS("styles.css")),    
  #      ######CARTE          
  #      leafletOutput("mymap", width="100%", height="100%"),
  #    
  #      ######PANEAU DE CONTROLE      
  #      absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
  #              draggable = TRUE, top = "auto", left = 0, right = 800, bottom = 0,
  #              width = 330, height = "auto",
  #              h3("Explorer les donnees"),
  #              plotlyOutput("Graph_first", height = 200),
  #              plotlyOutput("Graph_second", height = 200),
  #              plotlyOutput("Graph_third", height = 200)                
  #            )
  #)              
)



#########SERVEUR
server <- function(input, output, session) {
  
  #########CARTE AU CHARGEMENT
  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = -5.14,lat1 = 41.36, lng2 = 9.55, lat2 = 51.09)
    })
  
  output$mymapGLP <- renderLeaflet({
    leaflet(options= leafletOptions(zoomControl = FALSE)) %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = -61.83,lat1 = 15.74, lng2 = -61.00, lat2 = 16.50)
  }) 
  
  output$mymapMTQ <- renderLeaflet({
    leaflet(options= leafletOptions(zoomControl = FALSE)) %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = -61.27,lat1 = 14.25, lng2 = -60.74, lat2 = 14.92)
  }) 
  
  output$mymapGUF <- renderLeaflet({
    leaflet(options= leafletOptions(zoomControl = FALSE)) %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = -54.34,lat1 = 1.27, lng2 = -51.89, lat2 = 5.82)
  }) 
  
  output$mymapREU <- renderLeaflet({
    leaflet(options= leafletOptions(zoomControl = FALSE)) %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = 55.21,lat1 = -21.50, lng2 = 55.84, lat2 = -20.86)
  }) 
  
  output$mymapMYT <- renderLeaflet({
    leaflet(options= leafletOptions(zoomControl = FALSE)) %>%
      addTiles(urlTemplate='http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png',options = tileOptions(maxZoom = 12)) %>%
      fitBounds(lng1 = 45.004,lat1 = -13.03, lng2 = 45.31, lat2 = -12.627)
  })   

  #########CARTE AU CHANGEMENT DE VALEUR SELECTIONNEES 
  observe({

    labels <- sprintf(
      "<strong>%s</strong><br/>%g t",
      DPT_Layer$DEP, DPT_Layer$QTE_SUBS
    ) %>% lapply(htmltools::HTML)
    
    
    leafletProxy("mymap", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>% 
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30)%>%
      addPolygons(data=DPT_Layer,
                weight = 1,
                color = "purple",
                opacity = 1,
                fillColor = "transparent",
                layerId=~DEP,
                label = labels,
                labelOptions = labelOptions(
                  style = list("font-weight" = "normal", padding = "3px 8px"),
                  textsize = "15px",
                  direction = "auto")) 
    
    
    leafletProxy("mymapGLP", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>%
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30) %>% 
      addPolygons(data=DPT_Layer,
                  weight = 1,
                  color = "purple",
                  opacity = 1,
                  fillColor = "transparent",
                  layerId=~DEP,
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto")) 
    
    
    leafletProxy("mymapMTQ", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>%
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30) %>% 
      addPolygons(data=DPT_Layer,
                  weight = 1,
                  color = "purple",
                  opacity = 1,
                  fillColor = "transparent",
                  layerId=~DEP,
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"))
    
    
    leafletProxy("mymapGUF", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>%
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30) %>% 
      addPolygons(data=DPT_Layer,
                  weight = 1,
                  color = "purple",
                  opacity = 1,
                  fillColor = "transparent",
                  layerId=~DEP,
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"))
    
    
    
    leafletProxy("mymapREU", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>%
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30)  %>% 
      addPolygons(data=DPT_Layer,
                  weight = 1,
                  color = "purple",
                  opacity = 1,
                  fillColor = "transparent",
                  layerId=~DEP,
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"))
    
    
    leafletProxy("mymapMYT", data = DPT_Layer) %>%
      clearShapes() %>%
      clearControls() %>%
      addCircles(data=DPT_point_Layer,lng = ~long, lat = ~lat, weight = 1,
                 radius = ~sqrt(QTE_SUBS*1000) * 30)  %>% 
      addPolygons(data=DPT_Layer,
                  weight = 1,
                  color = "purple",
                  opacity = 1,
                  fillColor = "transparent",
                  layerId=~DEP,
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"))    
    
  }) 
  
  

  
  data_of_click <- reactiveValues(clickedShape=NULL)
  
  observeEvent(input$mymap_shape_click,{
    data_of_click$clickedShape <- input$mymap_shape_click
  })
  
  observeEvent(input$mymapGLP_shape_click,{
    data_of_click$clickedShape <- input$mymapGLP_shape_click
  })
  
  observeEvent(input$mymapMTQ_shape_click,{
    data_of_click$clickedShape <- input$mymapMTQ_shape_click
  })
  
  observeEvent(input$mymapGUF_shape_click,{
    data_of_click$clickedShape <- input$mymapGUF_shape_click
  })    
   
  observeEvent(input$mymapREU_shape_click,{
    data_of_click$clickedShape <- input$mymapREU_shape_click
  })   
  
  observeEvent(input$mymapMYT_shape_click,{
    data_of_click$clickedShape <- input$mymapMYT_shape_click
  })  
  
 
  output$Title_Dep <- renderText({ if (is.null(data_of_click$clickedShape$id )) {"Explorer les donnees (Cliquer sur un departement de la carte)"}
    else {paste0("Données d'achat du département : ",data_of_click$clickedShape$id)}
  })
  
  # Evolution annuelle
  output$Graph_first <- renderPlotly({
    zone_clic <- data_of_click$clickedShape$id  
    s<-subset(ACHAT_DPT_SUBSTANCE_STATS,ACHAT_DPT_SUBSTANCE_STATS$DPT == zone_clic)
    
    if(is.null(zone_clic)) return(NULL)
    else{
      evol_quantite <- s %>%
        filter (T1 == "Quantite totale") %>%
        ungroup %>%
        select("annee","QTE_SUBS") %>% 
        mutate (annee = as.integer (annee))
      
      
     p <- ggplot(data = evol_quantite, aes(x = annee, 
                                           y = QTE_SUBS)) +
          ggtitle("Quantité totale de substances achetées") +
          xlab("Année") +
          ylab("Quantité (en t)") + 
          geom_point(color = my_color, size = 1.5) +
          geom_line(color = my_color) 
                
  ggplotly(p, tooltip = c("text"))
  
    }
  }) 
  
  
 

  
  #Substances majoritiares
  output$Graph_second <- renderPlotly({
    zone_clic <- data_of_click$clickedShape$id    
    s<-subset(ACHAT_DPT_SUBSTANCE_STATS,ACHAT_DPT_SUBSTANCE_STATS$DPT == zone_clic)
    
    if(is.null(zone_clic)) return(NULL)
    else{
      subs_maj <- s %>%
        filter (T1 == "Quantite par substance" & annee=="2017") %>%
        ungroup %>%
        select(T2,QTE_SUBS) %>% 
        mutate (T2 = forcats::fct_reorder (T2, QTE_SUBS))
      
      ggplotly(
          ggplot(data = subs_maj, aes(x=subs_maj$T2, y=subs_maj$QTE_SUBS)) +
            geom_bar(stat="identity", fill = my_color) + 
            ggtitle("5 principales substances achetées en 2017") +
            theme(legend.position="none") +
            ylab("Quantité (en t)") +
            xlab("") +
            coord_flip())
    }
  })    
    
    
    #Stats par fonction  
  my_fill_palette_by_fonction <- scale_fill_manual (values = c("Autres produits" = "gray50",
                                                               "Fongicides et bactéricides" = "#2B4EAE",
                                                               "Herbicides" = "#2BAE71", 
                                                               "Insecticides et Acaricides" = "brown"))
    output$Graph_third <- renderPlotly({
      zone_clic <- data_of_click$clickedShape$id    
      s <- subset(ACHAT_DPT_SUBSTANCE_STATS,ACHAT_DPT_SUBSTANCE_STATS$DPT == zone_clic)

      
      if(is.null(zone_clic)) return(NULL)
      else{
        fonction <- s %>% filter (T1 == "Fonction" & annee=="2017")  %>% ungroup %>% select("T2","QTE_SUBS") 
        ggplotly(
          ggplot(data = fonction) + 
            geom_bar(mapping = aes(x = 1, y=QTE_SUBS ,fill = T2), stat = "identity") +
            ylab("Quantité (en t)") +
            xlab("") + 
            ggtitle("Répartition des achats par fonction en 2017") +
            theme(axis.title.x=element_blank(),
                  axis.text.x=element_blank(),
                  axis.ticks.x=element_blank())+
            my_fill_palette_by_fonction)
      }
      
    })
    
    
  }


# Run the application 
shinyApp(ui = ui, server = server)