-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #1 from richaben/master
Proposition d'ajouts pour ondetools
- Loading branch information
Showing
51 changed files
with
2,610 additions
and
23 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -7,3 +7,5 @@ | |
| ^pkgdown$ | ||
| ^doc$ | ||
| ^\.github/workflows$ | ||
| ^dev/dev_history_file\.R$ | ||
| ^dev$ | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -7,3 +7,7 @@ | |
| Meta | ||
| raw_data | ||
| docs | ||
| dev/dev_history_file.R | ||
| inst/doc | ||
| /doc/ | ||
| /Meta/ | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,36 @@ | ||
| #' Ajouter les données de zones d'alerte Propluvia au tableau de données onde | ||
| #' | ||
| #' @param onde_df un tableau de données onde téléchargé avec la | ||
| #' fonction \code{telecharger_donnees_onde_api} | ||
| #' @param propluvia_shape la couche spatiale pour les zones d'alerte Propluvia. | ||
| #' Une version existe en tant que jeux de données dans le package : (\code{propluvia_zone}). | ||
| #' | ||
| #' @return un dataframe comprenant les données onde et les données Propluvia jointées spatialement. | ||
| #' @export | ||
| #' | ||
| #' @importFrom dplyr filter | ||
| #' @importFrom sf st_as_sf st_transform st_buffer st_join | ||
| #' | ||
| #' @examples | ||
| #' \dontrun{ | ||
| #' ajouter_zones_propluvia(onde_df = onde_14, propluvia_shape = propluvia_zone) | ||
| #' } | ||
|
|
||
| ajouter_zones_propluvia <- function(onde_df, | ||
| propluvia_shape){ | ||
| onde_df <- | ||
| onde_df %>% | ||
| sf::st_as_sf( | ||
| coords = c("longitude", "latitude"), | ||
| crs = 4326 | ||
| ) %>% | ||
| sf::st_transform(crs = 2154) | ||
|
|
||
| propluvia_shape <- | ||
| propluvia_shape %>% | ||
| dplyr::filter(dpt %in% unique(onde_df$code_departement)) %>% | ||
| sf::st_transform(crs = st_crs(onde_df)) %>% | ||
| sf::st_buffer(dist = 50) | ||
|
|
||
| sf::st_join(onde_df, propluvia_shape) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,41 @@ | ||
| #' Fonction pour calculer les pourcentages de stations en assec | ||
|
|
||
| #' @description | ||
| #' Calcule les pourcentages de stations en assec (sur les mois de campagnes usuelles) | ||
| #' et met en forme du tableau pour le graphique de type \code{heatmap} | ||
| #' | ||
| #' @param onde_df un tableau de données onde téléchargé avec la | ||
| #' fonction \code{telecharger_donnees_onde_api} | ||
| #' | ||
| #' @return un tableau résumant au format pour le graphique avec la | ||
| #' fonction \code{produire_graph_heatmap_assecs} | ||
| #' @export | ||
| #' | ||
| #' @importFrom dplyr filter summarise n mutate arrange | ||
| #' @importFrom glue glue | ||
| #' @importFrom tidyr complete | ||
| #' | ||
| #' @examples | ||
| #' \dontrun{ | ||
| #' onde_14 <- telecharger_donnees_onde_api(dpt = c('14')) | ||
| #' calculer_assecs_heatmap(onde_df = onde_14) | ||
| #' } | ||
|
|
||
| calculer_assecs_heatmap <- function(onde_df) { | ||
| onde_df %>% | ||
| dplyr::filter(libelle_type_campagne == 'usuelle') %>% | ||
| dplyr::mutate(Mois = format(as.Date(date_campagne), '%m')) %>% | ||
| dplyr::group_by(Mois, Annee, libelle_type_campagne, code_campagne, code_departement) %>% | ||
| dplyr::summarise(n_donnees = dplyr::n(), | ||
| n_assecs = length(libelle_ecoulement[libelle_ecoulement == 'Assec']), | ||
| .groups = "drop") %>% | ||
| dplyr::mutate(pourcentage_assecs = round(n_assecs / n_donnees * 100, digits = 2), | ||
| taille_point = sqrt(pourcentage_assecs+1)) %>% | ||
| dplyr::arrange(Annee, Mois) %>% | ||
| tidyr::complete(Annee, Mois, libelle_type_campagne) %>% | ||
| dplyr::mutate(Mois = factor(Mois)) %>% | ||
| # label pourcentage | ||
| dplyr::mutate(Label = ifelse(is.na(n_assecs), "", glue::glue("{n_assecs}/{n_donnees}"))) %>% | ||
| # label (nb stations / nb total) | ||
| dplyr::mutate(Label_p = ifelse(is.na(n_assecs), "", glue::glue("{round(pourcentage_assecs,0)}%"))) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,120 @@ | ||
| #' Calculer un bilan des types d'écoulement pour les campagnes ONDE usuelles selon | ||
| #' la typologie nationale ou départementale | ||
| #' | ||
| #' @param onde_df un tableau de données onde téléchargé avec la fonction \code{telecharger_donnees_onde_api} | ||
| #' @param referentiel_onde le nom de la typologie à utiliser, | ||
| #' soit \code{Typologie nationale} ou \code{Typologie départementale} | ||
| #' @param mod Le nom pour la colonne créée pour la typologie. Par exemple, soit | ||
| #' \code{lib_ecoul3mod} pour la typologie nationale ou \code{lib_ecoul4mod} pour la typologie départementale, | ||
| #' @param mod_levels les niveaux de facteurs souhaités en fonction des typologies. | ||
| #' @param force_complementaire booléen, si TRUE les complémentaires sont prises en compte dans le calcul. Par défaut, FALSE. | ||
| #' @param ... paramètre optionnel | ||
| #' | ||
| #' @return un dataframe avec les pourcentages par types d’écoulement selon la typologie choisie | ||
| #' @export | ||
| #' | ||
| #' @importFrom dplyr filter mutate case_when group_by summarise n arrange desc across | ||
| #' @importFrom glue glue | ||
| #' @importFrom rlang := | ||
| #' | ||
| #' @examples | ||
| #' \dontrun{ | ||
| #' ## bilan écoulement sur typologie nationale sur les usuelles uniquement | ||
| #' calculer_bilan_ecoulement(onde_df = onde_df, | ||
| #' mod = lib_ecoul, | ||
| #' mod_levels = c("Ecoulement visible", | ||
| #' "Ecoulement non visible", | ||
| #' "Assec", | ||
| #' "Observation impossible", | ||
| #' "Donnée manquante"), | ||
| #' referentiel_onde = "Typologie nationale", | ||
| #' force_complementaire = F) | ||
| #' | ||
| #' ## bilan écoulement sur typologie départementale avec les complémentaires | ||
| #' calculer_bilan_ecoulement(onde_df = onde_df, | ||
| #' mod = lib_ecoul, | ||
| #' mod_levels = c("Ecoulement visible acceptable", | ||
| #' "Ecoulement visible faible", | ||
| #' "Ecoulement non visible", | ||
| #' "Assec", | ||
| #' "Observation impossible", | ||
| #' "Donnée manquante"), | ||
| #' referentiel_onde = "Typologie départementale", | ||
| #' force_complementaire = F) | ||
| #' | ||
| #' ## bilan écoulement sur typologie nationale avec les complémentaires | ||
| #' calculer_bilan_ecoulement(onde_df = onde_df, | ||
| #' mod = lib_ecoul, | ||
| #' mod_levels = c("Ecoulement visible", | ||
| #' "Ecoulement non visible", | ||
| #' "Assec", | ||
| #' "Observation impossible", | ||
| #' "Donnée manquante"), | ||
| #' referentiel_onde = "Typologie nationale", | ||
| #' force_complementaire = T) | ||
| #' | ||
| #'} | ||
| calculer_bilan_ecoulement <- | ||
| function(onde_df, | ||
| referentiel_onde = 'Typologie nationale', | ||
| mod, | ||
| mod_levels, | ||
| force_complementaire = F, | ||
| ...) { | ||
|
|
||
| onde_df <- | ||
| if(force_complementaire == FALSE){ | ||
| onde_df %>% | ||
| dplyr::filter(libelle_type_campagne == 'usuelle') | ||
| } else { | ||
| onde_df | ||
| } | ||
|
|
||
| onde_df %>% | ||
| { | ||
| if ({{referentiel_onde}} == 'Typologie nationale'){ | ||
|
|
||
| dplyr::mutate(., | ||
| {{mod}} := dplyr::case_when( | ||
| libelle_ecoulement == 'Ecoulement visible faible' ~ 'Ecoulement visible', | ||
| libelle_ecoulement == 'Ecoulement visible acceptable' ~ 'Ecoulement visible', | ||
| TRUE ~ libelle_ecoulement | ||
| )) %>% | ||
| dplyr::group_by(., | ||
| date_campagne, | ||
| code_campagne, | ||
| code_departement, | ||
| libelle_type_campagne, | ||
| {{mod}}) | ||
| } else { | ||
|
|
||
|
|
||
| dplyr::mutate(., | ||
| {{mod}} := dplyr::case_when( | ||
| libelle_ecoulement == 'Ecoulement visible' ~ 'Ecoulement visible acceptable', | ||
| TRUE ~ libelle_ecoulement | ||
| )) %>% | ||
| dplyr::group_by(., | ||
| date_campagne, | ||
| code_campagne, | ||
| code_departement, | ||
| libelle_type_campagne, | ||
| {{mod}}) | ||
| } } %>% | ||
| dplyr::summarise(NB = dplyr::n(), .groups = "drop_last") %>% | ||
| dplyr::mutate(frq = NB / sum(NB) *100) %>% | ||
| dplyr::arrange(code_departement, dplyr::desc(date_campagne), ...) %>% | ||
| dplyr::mutate(Label = ifelse(is.na(NB),"",glue::glue("{NB}"))) %>% | ||
| dplyr::mutate(Label_p = ifelse(is.na(frq),"",glue::glue("{round(frq,0)}%"))) %>% | ||
| dplyr::mutate(Mois = format(date_campagne, "%m"), | ||
| Annee = format(date_campagne, "%Y")) %>% | ||
| dplyr::mutate(Typologie = rep({{referentiel_onde}}, dplyr::n())) %>% | ||
| dplyr::mutate( | ||
| dplyr::across( | ||
| {{mod}}, | ||
| function(x) { | ||
| factor(x, levels = mod_levels, ordered = TRUE) | ||
| } | ||
| ) | ||
| ) | ||
| } |
Oops, something went wrong.