R/prep_tendances.R

In CedricMondy/afbBNVD: Explore the BNVD

#' Calculate trends
#'
#' @import dplyr
#' 
prep_tendances <- function(df, departements) {

    calc_senslope <- function(df2, ...) {
        if (nrow(filter(df2, quantite > 0)) > 1) {
            sen_slope <- arrange(df2, annee) %>%
                pull(quantite_rel)           %>%
                trend::sens.slope()

            tibble(pente   = sen_slope$estimate * 100,
                   p_value = sen_slope$p.value)
        } else {
            tibble(pente   = NA_real_,
                   p_value = NA_real_)
        }
    }

    group_by(df, departement, annee)                     %>%
        summarise(quantite = sum(quantite))              %>%
        group_by(departement)                            %>%
        mutate(quantite_rel = quantite / mean(quantite)) %>%
        group_map(.f = calc_senslope)                    %>%
        ungroup() %>%
        mutate(pente_trunc = case_when(
            pente < -10 ~ -10,
            pente > 10 ~ 10,
            TRUE ~ pente
        )) %>%
        full_join(departements,
                  by = c("departement" = "nom")) %>%
        sf::st_as_sf() %>%
        filter(!is.na(pente))
}