dev/applis_sdes/pretraitements.R

In CedricMondy/bnvd: Explore French pesticide data

library (leaflet)
library (sf)
library (data.table)
library (tidyverse)
library (leaflet.extras)
library(stringr)
library(readxl)

#library(dplyr)


###################################################### LECTURE DES DONNEES TABULEES

################# A partir des donnees transmises par Antonio Andrare (AFB) le 27/05/2019 et format compressé
# on va créer 6 dataframes contenant :
# achats produits par région
# achats substance par région
# achats produits fr
# achats substances fr
# ventes produits
# achats substances

#########Traitements communs aux 6 types de fichiers

# Décompression et listage des fichiers
data_dir <- '../donnees_brutes/zip'
out_dir <- '../donnees_brutes'
dir (data_dir)
zip_files <- list.files(path = data_dir, pattern = "*.zip", full.names = TRUE)
# plyr::ldply(.data = zip_files, .fun = unzip, exdir = out_dir)
file_names <- dir (out_dir)

######### Fonction d'importation pour les fichiers - Import des tables annuelles dont le nom contient
# une chaîne de caractère donnée
setwd (dir = out_dir)

import_cp <- function (chaine_nom = "ACHAT_CP_PRODUIT") {
    do.call (rbind, lapply (list.files (path = out_dir, pattern = chaine_nom), fread, header = T, sep = ";", dec = ".",
                        stringsAsFactors = F, colClasses = c ("amm" = "character", "code_postal_acheteur" = "character")))
                                                        }

import_fr <- function (chaine_nom = "ACHAT_CP_PRODUIT") {
    do.call (rbind, lapply (list.files (path = out_dir, pattern = chaine_nom), fread, header = T, sep = ";", dec = ".",
                            stringsAsFactors = F, colClasses = c ("amm" = "character"))) }
  
add_sum_all_amm <- function (df) {
  prov <- df %>% 
    group_by (annee, code_postal_acheteur) %>% 
        summarise ()
  
}
                                                  
########## application de la fonction
ACHAT_CP_PRODUIT <- import_cp (chaine_nom = "ACHAT_CP_PRODUIT") %>% 
  mutate (quantite_produit = as.numeric (quantite_produit))

ACHAT_FR_PRODUIT <- import_fr (chaine_nom = "ACHAT_FR_PRODUIT") %>% 
  mutate (quantite_produit = as.numeric (quantite_produit))

ACHAT_CP_SUBSTANCE <- import_cp (chaine_nom = "ACHAT_CP_SUBSTANCE") %>% 
  mutate (quantite_substance = as.numeric (quantite_substance))

ACHAT_FR_SUBSTANCE <- import_fr (chaine_nom = "ACHAT_FR_SUBSTANCE") %>% 
  mutate (quantite_substance = as.numeric (quantite_substance))

VENTE_PRODUIT <- import_fr (chaine_nom = "VENTE_PRODUIT")

VENTE_SUBSTANCE <- import_fr (chaine_nom = "VENTE_SUBSTANCE")




###################################################### DATA QUANTITIE SUBSTANCE 
ACHAT_CP_SUBSTANCE$quantite_substance <- as.numeric(ACHAT_CP_SUBSTANCE$quantite_substance) %>% replace_na(0)
#Ajout du code département
ACHAT_CP_SUBSTANCE <- mutate (ACHAT_CP_SUBSTANCE, DPT= ifelse (str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,3)=='201'|str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,3)=='200','2A',
                                                               ifelse (str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,3)=='202','2B',ifelse (str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,2)=='97',str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,3),str_sub(ACHAT_CP_SUBSTANCE$code_postal_acheteur, 1,2)))))




######################### DATA QUANTITE TOTALE ------- DATA ONGLET ACHAT DPT
####### DATA QUANTITE TOTALE / ANNEE
ACHAT_DPT_SUBSTANCE_TOT <- ACHAT_CP_SUBSTANCE %>% group_by (annee,DPT) %>%
  summarise (QTE_SUBS=sum(quantite_substance,na.rm=T)) %>% mutate("T1"= "Quantite totale", "T2" = "Total")
ACHAT_DPT_SUBSTANCE_TOT$annee <- as.character(ACHAT_DPT_SUBSTANCE_TOT$annee)

####### DATA QUANTITE PAR SUBSTANCE / ANNEE
ACHAT_DPT_SUBSTANCE_SUBS <- ACHAT_CP_SUBSTANCE %>% group_by (annee,DPT,substance) %>%
  summarise (QTE_SUBS=sum(quantite_substance,na.rm=T)) %>% mutate("T1"= "Quantite par substance") %>% rename(T2=substance)
ACHAT_DPT_SUBSTANCE_SUBS$annee <- as.character(ACHAT_DPT_SUBSTANCE_SUBS$annee)

## AJOUTER UNE PARITE POUR NE SELECTIONNER QUE LES 5 PREMIERS PAR DEPARTEMENTS
ACHAT_DPT_SUBSTANCE_SUBS<-ACHAT_DPT_SUBSTANCE_SUBS %>%
  group_by(DPT,annee) %>%
  top_n(5,QTE_SUBS)

####### DATA QUANTITE PAR FONCTION / ANNEE

# read_excel reads both xls and xlsx files
fonction<-read_excel("../donnees_brutes/table_de_passage_CAS_usages.xlsx")
fonction_Reg<-read_excel("../donnees_brutes/Regroupt_des_fonctions.xlsx")


ACHAT_DPT_SUBSTANCE_FONCT <- ACHAT_CP_SUBSTANCE %>% group_by (annee,DPT,cas) %>%
  summarise (QTE_SUBS=sum(quantite_substance,na.rm=T)) %>% left_join(fonction,by=c("cas"="CAS")) %>%
  left_join(fonction_Reg,by=c("TYPE_USAGE2"="Fonctions"))
ACHAT_DPT_SUBSTANCE_FONCT <- ACHAT_DPT_SUBSTANCE_FONCT %>% group_by (annee,DPT,Fonctions_regroupees)  %>%
  summarise (QTE_SUBS=sum(QTE_SUBS,na.rm=T)) %>% filter (Fonctions_regroupees != '') %>% mutate("T1"="Fonction") %>% rename(T2=Fonctions_regroupees)
ACHAT_DPT_SUBSTANCE_FONCT$annee <- as.character(ACHAT_DPT_SUBSTANCE_FONCT$annee)  


########FUSIONNER LES TABLES EN UNE SEULE ET CONVERSION EN TONNE
ACHAT_DPT_SUBSTANCE_STATS <- rbind(ACHAT_DPT_SUBSTANCE_TOT,ACHAT_DPT_SUBSTANCE_SUBS,ACHAT_DPT_SUBSTANCE_FONCT) %>%
  mutate (QTE_SUBS = round(QTE_SUBS / 1000,0))

save(list=c("ACHAT_DPT_SUBSTANCE_STATS"),file="../appli/data/SUBST_STATS.Rdata")


######################### DATA QUANTITE TOTALE ------- DATA ONGLET INDICATEURS
############### CP
##Calcul substance totale
ACHAT_CP_SUBSTANCE_TOT_ALLCP <- ACHAT_CP_SUBSTANCE %>% group_by (annee,code_postal_acheteur,DPT) %>%
  summarise (QTE_SUBS=sum(quantite_substance,na.rm=T)) %>% rename(CP = code_postal_acheteur) 

##CALAGE SUR LES CP CARTOGRAPHIES
CP_Layer <- st_read("F:/20181017_Glyphosate/app/bnvd2/appli/data/codes_postaux_region_wgs84.shp",stringsAsFactors=FALSE)
ACHAT_CP_SUBSTANCE_TOT <- CP_Layer %>% left_join(ACHAT_CP_SUBSTANCE_TOT_ALLCP, by=c("ID"="CP"))
ACHAT_CP_SUBSTANCE_TOT$QTE_SUBS <- as.numeric(ACHAT_CP_SUBSTANCE_TOT$QTE_SUBS) %>% replace_na(0)

####### AJOUT SAU ET STH
#Chargement des données sur le RGA 2010 & nettoyage
rga2010 <- fread(file="rga/rga_2010_v2.csv", header = T, sep=";", stringsAsFactors = F)
rga2010$SAU <- as.numeric(rga2010$SAU) %>% replace_na(0)
rga2010$STH <- as.numeric(rga2010$STH) %>% replace_na(0)

#Calcul du prorata des surfaces table de passage CP / Communes
##load data
##CP_map <- st_read(paste0(dir,"geo/codes_postaux_region.shp"))
#COM_map <-  st_read(paste0(dir,"geo/COMMUNE.shp"))
#
###Contrôle des sysèmes de projection
##st_crs(CP_map)
#st_crs(COM_map)

##run the intersect function, converting the output to a tibble in the process
##int <- st_union(CP_map, COM_map)
##int$Shape_Area <- st_area(int$geometry)
##shp_out <- st_write(int, "Union_CP_COM.shp")

#Partie réalisée avec ArcGis  car ne foncitonne pas avec  R
# Intersection communes et CP
# explosion en entité sans multi-partie
#Suppression des artefacts dûs à la différence de contours et de précision des contours communes et CP
# les polygones de moins de 620000m² qui intersectent les labels des communes sont conservées (petites communes)

int <- st_read("geo/Union_CP_COM10_selection.shp")

passage <- data.frame(int) %>%
  rename (DEPCOM=NUM_COM,CP=ID)%>%
  select(DEPCOM,CP,Shape_Area)%>%
  group_by(DEPCOM,CP)%>%
  summarise_all(sum) %>% ungroup() 

#Calcul de la surface des communes
passage_commune <-passage %>% select(DEPCOM, Shape_Area) %>%
  group_by(DEPCOM)%>%
  summarise_all(sum) %>%
  rename (SURF_COM=Shape_Area)

#Calcul de la surface des CP
passage_CP<-passage %>% select(CP, Shape_Area) %>%
  group_by(CP)%>%
  summarise_all(sum) %>%
  rename (SURF_CP=Shape_Area)

##Jointure ddes surfaces des communes et des CP à la table de passage
passage <-passage %>%
  left_join(passage_commune,by="DEPCOM") %>%
  left_join(passage_CP,by="CP")

#Calcul du ratio pour passer d'une donnée à la commune au CP
passage <-  mutate(passage,COM_To_CP =Shape_Area/SURF_COM*100)
#Calcul du ratio pour passer d'une donnée au CP à la commune
passage <-  mutate(passage,CP_To_COM = Shape_Area/SURF_CP*100)
#Renommage du champ shap_area
passage<- passage %>% rename(SURF_INTERCT=Shape_Area)
passage$CP <- as.character(passage$CP)

passage$DEPCOM <- as.character(passage$DEPCOM)

#Jointure avec les données de la table de passage et du RA 
RGA_CP_COM <-passage %>%
  left_join(rga2010,by="DEPCOM")

#Calcul de la SAU rapportée au CP
RGA_CP_COM <- mutate(RGA_CP_COM,SAU_CP=SAU * COM_To_CP /100)  %>%
  mutate(STH_CP=STH * COM_To_CP /100)  %>%   
  select (CP,SAU_CP,STH_CP) %>%
  group_by(CP) %>%
  summarise_all(sum,na.rm = TRUE)

#Ajout de la SAU
ACHAT_CP_SUBSTANCE_TOT <- ACHAT_CP_SUBSTANCE_TOT %>% left_join(RGA_CP_COM,by="CP")

library(reshape)
#Calcul des ratios
INDIC_CP <- mutate(ACHAT_CP_SUBSTANCE_TOT, QTE_SUBS_SAU= round(QTE_SUBS / SAU_CP,2), QTE_SUBS_SAU_STH= round(QTE_SUBS / (SAU_CP-STH_CP),2)) %>% select(CP,annee,QTE_SUBS_SAU,QTE_SUBS_SAU_STH )
INDIC_CP <- data.table::melt(INDIC_CP,id=c("CP","annee"))
INDIC_CP <- cast(INDIC_CP,CP~variable+annee)
INDIC_CP[mapply(is.infinite, INDIC_CP)] <- NA

############### DEPARTEMENT
ACHAT_DPT_SUBSTANCE_TOT_ALLCP <- ACHAT_CP_SUBSTANCE_TOT %>% group_by (annee,DPT) %>%
  summarise (QTE_SUBS=sum(QTE_SUBS,na.rm=T),SAU=sum(SAU_CP,na.rm=T), STH=sum(STH_CP,na.rm=T))
INDIC_DPT <- mutate(ACHAT_DPT_SUBSTANCE_TOT, QTE_SUBS_SAU= round(QTE_SUBS / SAU,2),QTE_SUBS_SAU_STH=  round(QTE_SUBS / (SAU-STH),2)) %>%
  select(DPT,annee,QTE_SUBS_SAU,QTE_SUBS_SAU_STH )
INDIC_DPT <- data.table::melt(INDIC_DPT,id=c("DPT","annee"))
INDIC_DPT <- cast(INDIC_DPT,DPT~variable+annee)

save(list=c("INDIC_CP","INDIC_DPT"),file="../appli/data/SUBST_TOT.Rdata")

################################################## Export du fichier .Rdata
#rm (data_dir, file_names, out_dir, zip_files, import)
#setwd("../appli")
#save.image("data/data.RData")