On doit pouvoir separer les touristes des travailleurs - entre saisonnalité annuelle et tendance - entre semaine et WE (travailleur / maison secondaire ) - entre saisonalité trimestrielle (ski / plage)
On constate visuellement une faible saisonnalité sur la courbe du dep_31. Mais est-ce confirmé par le calcul, et est-ce le cas pour d’autres departements ?
Il est d’usage pour quantifier la saisonnalite par rapport a la tendance d’une serie temporelle de comparer les forces de chacune de ces deux composantes. On conidere de separer la serie des nuitees en 3 composantes : la variation hebdomadaire, la tendance qui est a peu de choses pres la constance de la semaine, et le residu qui ne rentre dans aucune des deux autres. C’est ce qu’on fait ici : sur l’axe des X, on trouvera a gauche les series a “faible” tendance, c’est a dire que la tendance est chahutee par la variation hebdomadaire et le residu, et a droite les “fortes” tendances: quand c’est la tendance qui prime. Sur l’axe des Y, Idem avec la force de variation hebdomadaire, qui est ici notre meilleur representant du tourisme organisé et aligné sur les jours de la semaine.
nuitees_stlf <-nuitee_ts %>% features(nuitees, feat_stl)
set.seed(1973)
nuitees_stlf["cluster"] <- kmeans(nuitees_stlf %>% select(trend_strength, seasonal_strength_week),
centers=3)$cluster %>% as.factor
nuitees_stlf %>%
ggplot(aes(x = trend_strength, y = seasonal_strength_week, label=dep, color=cluster)) +
geom_point(size=3)+
geom_text_repel()+ggtitle("Comment distinguer les départements ?", subtitle = "Positionnement de la variation hebdomadaire par rapport à de la composante lissée des nuitées dans chaque départements d'Occitanie (2018)")+
xlab("Force de la composante tendantielle") +
ylab("Force de la variation hebdomadaire")
Ah ! Oui ! la Haute Garonne se distingue bien largement de ses voisins d’Occitanie. Et les autres départements se repartissent naturellement (kMeans, k=3) en deux groupes. Pour être parfaitement honnête, Il y a bien 2 autres groupes, mais quelques départements n’y sont pas rattachés ( le 65 et le 12), et sont considérés comme des électrons libres (par dbscan, epsilon=0.05, 2 points min.) car ils ne participent pas a une densite suffisante. On devra peut être revenir sur ce détail…
Voyons dans les faits ce qu’on mesure par une visualisation de la décomposition sur chacun des groupes:
## Warning: Factor `dep` contains implicit NA, consider using
## `forcats::fct_explicit_na`
## Warning: Factor `dep` contains implicit NA, consider using
## `forcats::fct_explicit_na`
C’est très curieux, le distingo s’établit à l’oeil sur la tendance, pas sur la composante hebdomadaire.
On voit très bien qu’il y a quelque chose à dire ici ! On a meme envie de balancer des small multiples sur chaque departement ! Ça donne meme envie de le faire sur chaque département d’origine, meme si ça risque de faire un pâté…
nuitees_stl_comp %>%
left_join(nuitees_stlf %>% select(dep,cluster), by="dep") %>% # on rapporte les cluster de k-means calcules plus haut
group_by(dep) %>% # pour faire des lignes par departement, il faut des groupes
ggplot(aes(x=date,y=composante_hebdomadaire, color=dep))+
geom_line()+
# geom_area(data=vacances_tsbl() %>% mutate(vacances = as.numeric(vacances) * max(nuitees_stl_comp$season_7)),
# aes(x = date, y = vacances),
# position=position_dodge(1), alpha = 0.1) + # on ajoute les vacances
facet_grid(cols = vars(jour_sem), rows = vars(cluster))+
ylab(" composante_hebdomadaire des nuitées")+
scale_x_date(expand = c(0.01,0.01), date_breaks = "3 months", date_labels = "%b")
Il y a trop de vide, c’est Montpellier qui nous fout dedans avec ses valeurs importantes, mais l’erreur est qu’on garde des valeurs quantitatives, alors qu’on porte un discours qualitatif. Il faut nor-ma-lis-ser (petite musique de pub de vichy saint-yorre dans les 90’, non? , bon tant-pis)
Les courbes sont quantitatives, ca fausse le test statistique visuel, On passe en relatif (a la capacite d’hebergement)
# on normalise par departement ( on calcule les max)
#composante_hebdomadaire_normalisee = composante_hebdomadaire/max(composante_hebdomadaire)
nuitees_stl_comp %>%
group_by(dep) %>% # pour faire des lignes par departement, il faut des groupes
mutate(composante_hebdomadaire_normalisee = composante_hebdomadaire/max(abs(composante_hebdomadaire))) %>%
left_join(nuitees_stlf %>% select(dep,cluster), by="dep") %>% # on rapporte les cluster de k-means calcules plus haut
ggplot(aes(x=date,y=composante_hebdomadaire_normalisee, color=dep))+
geom_line()+
# geom_area(data=vacances_tsbl() %>% mutate(vacances = as.numeric(vacances) * max(nuitees_stl_comp$season_7)),
# aes(x = date, y = vacances),
# position=position_dodge(1), alpha = 0.1) + # on ajoute les vacances
facet_grid(cols = vars(jour_sem), rows = vars(cluster))+
ylab(" composante_hebdomadaire des nuitées")+
scale_x_date(expand = c(0.01,0.01), date_breaks = "3 months", date_labels = "%b")
C’est mieux mais toujours pas terrible. On commence à sentir ici que notre clustering est questionnable, certaines courbes mèriteraient de changer de groupe… Donc cet apres-midi : derniere chance d’amelioration visuelle: on ajoute une surface sous la courbe
# on normalise par departement ( on calcule les max)
#composante_hebdomadaire_normalisee = composante_hebdomadaire/max(composante_hebdomadaire)
nuitees_stl_comp %>%
group_by(dep) %>% # pour faire des lignes par departement, il faut des groupes
mutate(composante_hebdomadaire_normalisee = composante_hebdomadaire/max(abs(composante_hebdomadaire))) %>%
left_join(nuitees_stlf %>% select(dep,cluster), by="dep") %>% # on rapporte les cluster de k-means calcules plus haut
ggplot()+
geom_area(aes(x=date,y=composante_hebdomadaire_normalisee, fill=dep),
position=position_dodge(1), alpha=0.3 , size=.5, colour="white")+
geom_area(data=vacances,
aes(x = date, y = vacance),
position=position_dodge(1), alpha = 0.1) +
geom_area(data=vacances,
aes(x = date, y = -vacance),
position=position_dodge(1), alpha = 0.1) + # on ajoute les vacances
facet_grid(cols = vars(jour_sem), rows = vars(cluster))+
ylab(" composante_hebdomadaire des nuitées")+
scale_x_date(expand = c(0.01,0.01), date_breaks = "3 months", date_labels = "%b")