Code
require(ggplot2)
require(dplyr)
require(lubridate) # Pour manipuler les dates plus facilement
require(zoo) # Pour as.yearmon et as.Date
require(tidyr) # Pour pivot_longer
require(patchwork) # Pour arranger les graphiques (optionnel)
# Fonction utilitaire MODIFIÉE pour convertir un objet ts en dataframe avec colonne Date
ts_to_dataframe <- function(ts_obj) {
# Utilise zoo pour convertir le temps en objet Date (premier jour du mois/trimestre)
time_index <- tryCatch({
# Pour mensuel ou trimestriel, as.Date(as.yearmon(...)) fonctionne
# frequency() récupère la fréquence de l'objet ts
if (frequency(ts_obj) %in% c(4, 12)) {
as.Date(as.yearmon(time(ts_obj)))
} else if (frequency(ts_obj) == 1) {
as.Date(paste0(floor(time(ts_obj)), "-01-01")) # Annuel: 1er Jan
} else {
# Si fréquence inconnue ou autre, utiliser index numérique
as.numeric(time(ts_obj))
}
}, error = function(e) {
# Fallback si conversion échoue
as.numeric(time(ts_obj))
})
is_numeric_time <- is.numeric(time_index)
df <- data.frame(
Time = time_index,
Value = as.numeric(ts_obj)
)
df <- na.omit(df)
attr(df, "is_numeric_time") <- is_numeric_time
return(df)
}
# Fonction pour convertir les résultats de decompose en dataframe long (MODIFIÉE pour Date)
decompose_to_long_df <- function(decomp_obj, series_name = "Value") {
# Utilise zoo pour convertir le temps en objet Date
time_index <- tryCatch({
if (frequency(decomp_obj$x) %in% c(4, 12)) {
as.Date(as.yearmon(time(decomp_obj$x)))
} else if (frequency(decomp_obj$x) == 1) {
as.Date(paste0(floor(time(decomp_obj$x)), "-01-01"))
} else {
as.numeric(time(decomp_obj$x))
}
}, error = function(e) {
as.numeric(time(decomp_obj$x))
})
is_numeric_time <- is.numeric(time_index)
df <- data.frame(
Time = time_index,
Observed = as.numeric(decomp_obj$x),
Trend = as.numeric(decomp_obj$trend),
Seasonal = as.numeric(decomp_obj$seasonal),
Random = as.numeric(decomp_obj$random)
) %>%
pivot_longer(cols = -Time, names_to = "Component", values_to = series_name) %>%
mutate(Component = factor(Component, levels = c("Observed", "Trend", "Seasonal", "Random"))) %>%
na.omit() # Enlève les NA dus aux calculs de tendance/résidus
attr(df, "is_numeric_time") <- is_numeric_time
return(df)
}
# Helper function pour choisir l'échelle X
choose_scale_x <- function(df) {
if (is.null(attr(df, "is_numeric_time")) || !attr(df, "is_numeric_time")) {
# Si le temps est Date (ou par défaut si attribut absent)
freq <- frequency(df$Time) # Ceci peut échouer si Time n'est pas ts/zoo
# Heuristique simple basée sur l'intervalle moyen si freq non dispo
interval <- mean(diff(as.numeric(df$Time)), na.rm = TRUE)
if(interval > 25 && interval < 40) freq <- 12 # Probablement mensuel
else if(interval > 80 && interval < 100) freq <- 4 # Probablement trimestriel
else freq <- 0 # Autre
if (freq == 4) { # Trimestriel
return(scale_x_date(date_labels = "%Y-Q%q", date_breaks = "1 year"))
} else if (freq == 12) { # Mensuel
return(scale_x_date(date_labels = "%Y-%m", date_breaks = "1 year"))
} else { # Annuel ou autre
return(scale_x_date(date_labels = "%Y", date_breaks = "2 years"))
}
} else {
# Si le temps est numérique
return(scale_x_continuous())
}
}
# Adaptation pour scale_x_date qui ne connait pas %q pour trimestre
# On utilisera %Y-%m (début du trimestre) ou juste %Y
scale_x_date_auto <- function(df, format_q = "%Y-%m", format_m = "%Y-%m", format_a = "%Y", breaks_q = "1 year", breaks_m = "1 year", breaks_a = "2 years") {
time_class <- class(df$Time)[1]
if (time_class == "Date") {
# Estimer la fréquence basé sur les diffs
diff_days <- mean(diff(df$Time), na.rm=TRUE)
if (diff_days > 80 && diff_days < 100) { # Trimestriel
scale_x_date(date_labels = format_q, date_breaks = breaks_q)
} else if (diff_days > 25 && diff_days < 35) { # Mensuel
scale_x_date(date_labels = format_m, date_breaks = breaks_m)
} else { # Annuel ou autre
scale_x_date(date_labels = format_a, date_breaks = breaks_a)
}
} else { # Si numérique ou autre
scale_x_continuous()
}
}
