01_data_download

Capacité et usage des hébergements touristiques

#skim(force(capacites)) # n'amène rien sur une time series au format long
#summary(force(capacites))
# TODO c'est une time-série, on fera un petit ridge-line plot: https://www.data-to-viz.com/graph/ridgeline.html
hebergement_ts <- force(capacites) %>%
  select(dep,starts_with("sem_")) %>% 
  mutate(sem_53 = 7*sem_53, dep = as.factor(dep)) %>% # la derniere semaine ne fait qu'une journee, ça fait tâche sur les graphes
  pivot_longer(-dep, names_to = "semaine", names_prefix = "sem_", values_to="touristes") %>%
  mutate_at("semaine",as.numeric) %>% 
  mutate(date = ymd("2018-01-01")+(semaine-1)*7) %>% 
  as_tsibble(index=date, key=dep)
# on plot pour voir
ggplot(hebergement_ts)+
  geom_line(aes(x=date,y=touristes/1e6, color=dep), size=1)+
  geom_area(data=vacances_tsbl() %>%  mutate(vacances = as.numeric(vacances) * max(hebergement_ts$touristes , na.rm = TRUE)/1e6), 
            aes(x = date, y = vacances),
            position=position_dodge(1), alpha = 0.1) + 
  scale_fill_continuous(guide = guide_legend()) +
  theme_minimal()+
  theme(legend.position="bottom") +
  ggtitle("Capacité occupée par departement et par semaine") + ylab("Nombre de voyageurs hebdomadaires (Millions)")

# le meme en ridge line plot
ggplot(hebergement_ts)+
  geom_ridgeline( aes(x = date, height = touristes/1e6, y = fct_reorder(dep,touristes)), alpha=0.7) +
  geom_area(data=vacances_tsbl()  %>% mutate(vacances = as.numeric(vacances) *15.6), 
            aes(x = date, y = vacances),
            position=position_dodge(1), alpha = 0.1) +
  ggtitle("Mais qui dort où et quand ?", subtitle ="Occupation des hébergements touristiques par département") + 
  ylab("Nombre de voyageurs hebdomadaires (Millions)") + 
  scale_fill_continuous(guide = guide_legend()) +
  theme(legend.position="bottom") + 
  scale_x_date(expand = c(0.005,0.005))+
  theme_minimal()

~~Un ordre s’impose parmi les départements pour rendre ça beau… Ici, c’est l’ordre imposé par le nombre de touristes qui s’applique.~~ On voit une difference entre les departements à tourisme saisonnier et la Haute-Garonne

Nuitées occupées relativement à la capacité totale

Si on veut developper le tourisme, il faut remplir les trous… On a le total de capacité alors on y va

hebergement_pcent_ts <-  force(capacites) %>%
  mutate(dpt = as.factor(dep)) %>% 
  group_by(dep) %>% 
  mutate_at(vars(starts_with("sem_")), ~./hbgt_total/7) %>% 
  select(dep,starts_with("sem_")) %>% 
  mutate(sem_53 = 7*sem_53) %>% # la derniere semaine ne fait qu'une journee, ça fait tache sur les graphes
  pivot_longer(-dep, names_to = "semaine", names_prefix = "sem_", values_to="touristes") %>%
  mutate_at("semaine",as.numeric) %>% 
  mutate(date = ymd("2018-01-01")+(semaine-1)*7) %>% 
  as_tsibble(index=date, key=dep)

Sont-ils bien tous des touristes ?

ggplot(hebergement_pcent_ts)+
  geom_ridgeline( aes(x = date, height = touristes, y = fct_reorder(dep,touristes)), alpha=0.5, color="darkred", min_height = .3, scale=.5) +
  geom_ridgeline( aes(x = date, height = 1, y = fct_reorder(dep,touristes)), alpha=0.01, color="black", scale=.5, size=0.1) +
  geom_area(data=vacances_tsbl()  %>% mutate(vacances = as.numeric(vacances) *15), 
            aes(x = date, y = vacances),
            position=position_dodge(1), alpha = 0.1) +
  ggtitle("Quelle saison touristique dans chaque département ?", subtitle="Taux d'occupation des hébergements touristiques par departement, 100 % représenté par la fine ligne noire, on ne représente pas en dessous de 30%") + ylab("Nombre de voyageurs par semaine (pourcent) ")+  
  scale_fill_continuous(guide = guide_legend()) +
  theme(legend.position="bottom") + 
  scale_x_date(expand = c(0,0)) +
  theme_minimal()

Hormis dans l’Aveyron et les Hautes Py., la capacité d’hébergement touristique est toujours dépassée. On a donc capturé ici des voyageurs qui ne sont pas des touristes.

nuités.xlsx

# skim(force(nuitees))# n'amène rien sur une time series au format long
summary(nuitees)

##       date                dpt_09          dpt_11           dpt_12     
##  Min.   :2018-01-01   Min.   :    0   Min.   :     0   Min.   :    0  
##  1st Qu.:2018-04-02   1st Qu.: 7192   1st Qu.: 22268   1st Qu.:11089  
##  Median :2018-07-02   Median :10169   Median : 36910   Median :17433  
##  Mean   :2018-07-02   Mean   :12810   Mean   : 44248   Mean   :21766  
##  3rd Qu.:2018-10-01   3rd Qu.:14890   3rd Qu.: 53581   3rd Qu.:26522  
##  Max.   :2018-12-31   Max.   :38392   Max.   :136945   Max.   :71531  
##      dpt_30           dpt_31           dpt_32          dpt_34      
##  Min.   :     0   Min.   :     0   Min.   :    0   Min.   :     0  
##  1st Qu.: 32914   1st Qu.: 65346   1st Qu.: 8723   1st Qu.: 73504  
##  Median : 50704   Median : 76484   Median :13027   Median :116519  
##  Mean   : 58577   Mean   : 78391   Mean   :15607   Mean   :136345  
##  3rd Qu.: 71167   3rd Qu.: 93139   3rd Qu.:17892   3rd Qu.:166126  
##  Max.   :152483   Max.   :161793   Max.   :55238   Max.   :401637  
##      dpt_46          dpt_48          dpt_65          dpt_66      
##  Min.   :    0   Min.   :    0   Min.   :    0   Min.   :     0  
##  1st Qu.: 9775   1st Qu.: 4174   1st Qu.:16688   1st Qu.: 43922  
##  Median :16892   Median : 8263   Median :27593   Median : 65600  
##  Mean   :21588   Mean   : 9642   Mean   :30036   Mean   : 87119  
##  3rd Qu.:25517   3rd Qu.:11919   3rd Qu.:38164   3rd Qu.:100942  
##  Max.   :73458   Max.   :34037   Max.   :94459   Max.   :283421  
##      dpt_81          dpt_82      total_occitanie  
##  Min.   :    0   Min.   :    0   Min.   :      0  
##  1st Qu.:11270   1st Qu.:11288   1st Qu.: 321768  
##  Median :15073   Median :15263   Median : 461712  
##  Mean   :17363   Mean   :16520   Mean   : 550011  
##  3rd Qu.:20689   3rd Qu.:19651   3rd Qu.: 656451  
##  Max.   :44735   Max.   :38910   Max.   :1491112

# TODO c'est une time-série, on fera un petit ridge-line plot: https://www.data-to-viz.com/graph/ridgeline.html
nuitee_ts <- nuitees_td %>% as_tsibble(index= date, key=dep)
ggplot(nuitee_ts)+
  geom_line(aes(x=date,y=`nuitees`, color=dep), size=1)+
  geom_area(data=vacances_tsbl() %>%  mutate(vacances = as.numeric(vacances) *max(nuitee_ts$nuitees, na.rm = T)), 
            aes(x = date, y = vacances),
            position=position_dodge(1), alpha = 0.1) +
  scale_fill_continuous(guide = guide_legend()) +
  theme_minimal()+
  theme(legend.position="bottom")

# les NA dans les valeurs rends impossible la comparaison entre nuités et le fct_reorder bouhhh
median_na <- function(x) {
  median(x,na.rm = TRUE)
}
# le meme en ridge line plot
ggplot(nuitee_ts)+
  geom_ridgeline( aes(x = date, height = nuitees/1e5, y = fct_reorder(dep, `nuitees`, .fun=median_na)), alpha=0.5) +
  geom_area(data=vacances_tsbl()  %>% mutate(vacances = as.numeric(vacances) *17), 
            aes(x = date, y = vacances),
            position=position_dodge(1), alpha = 0.1) +
  ggtitle("nombre de nuitées (x100k)") + 
  scale_fill_continuous(guide = guide_legend()) +
  theme(legend.position="bottom")+
  scale_x_date(expand = c(0,0)) +
  theme_minimal()

Il y a plusieurs accidents dans plein de départements simultanément. Là encore même distingo entre le 31 et les autres departements.

Il y a une saisonnalité à la semaine qu’il faut relier aux évènements extérieurs

Est-ce qu’on peut imaginer un effet whaou sur un bubble plot animé style le fameux Gapminder [Gapminder par gganimate] ? Non ? bon…

# # apprends-t-on plus avec un zoom ?
nuiteplus <- nuitees %>% na_if(0) %>%
  select(-total_occitanie) %>%
  timetk::tk_augment_timeseries_signature() %>%
  select(date, starts_with("dpt_"),jour_sem=wday.lbl) %>%
  xts(. , order.by = .$date)

dygraph(nuiteplus) %>% dyRangeSelector() %>%
  dyHighlight(highlightCircleSize = 5, 
              highlightSeriesBackgroundAlpha = 0.2,
              hideOnMouseOut = FALSE) %>% 
  dyLegend(width = 700, hideOnMouseOut = FALSE) %>% 
  dyShading(from = "2018-01-01", to = "2018-01-07") %>%
  dyShading(from = "2018-02-10", to = "2018-02-25") %>%
  dyShading(from = "2018-04-07", to = "2018-04-22") %>%
  dyShading(from = "2018-07-07", to = "2018-09-02") %>%
  dyShading(from = "2018-10-20", to = "2018-11-04") %>%
  dyShading(from = "2018-12-22", to = "2018-12-31")

Jeu de données par_origines

skim(par_origines)

Data summary
Name	par_origines
Number of rows	493235
Number of columns	8
_______________________
Column type frequency:
character	2
Date	1
numeric	5
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
org	0	1	2	8	0	108	0
dest	0	1	2	2	0	13	0

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
date	0	1	2018-01-01	2018-12-31	2018-07-05	365

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
volume	1	407.01	1175.56	0	35	108	324	41517	▇▁▁▁▁
vacances_org	1	0.51	0.67	0	0	0	1	2	▇▁▅▁▁
temp_midi	1	17.12	7.94	-7	11	17	24	36	▁▆▇▇▃
meteo	1	2.04	1.41	0	1	2	3	4	▇▆▇▇▇
nb_evt	1	0.44	0.75	0	0	0	1	6	▇▁▁▁▁

# il y a des duplicates. impossible de le faire rentrer dans ne time-series sans les enlever !
origines_ts <- par_origines_td %>%
  ungroup %>% 
  mutate(dep = fct_relevel(dep, c("34","31","11","66","30","65","12","46","82","81","32","09","48"))) %>% 
  mutate_at("meteo",as.ordered) %>% 
  #group_by(date, dep_org, dep_dest) %>% summarise_all(~last(.)) %>% # filter duplicate
  as_tsibble(index= date, key=c("dep_org","dep"))
# un petit facet-plot pour la route
ggvolume <-ggplot(origines_ts %>% filter(dep_org!="Autres"))+
  geom_line(aes(x=date,y=`volume`/1e3, color=dep_org), size=.4, alpha=.6)+
  facet_wrap("dep") +
  scale_fill_continuous(guide = guide_legend()) + ylim(0,25) +
  ggtitle("Mais d'où viennent-ils", subtitle = "Origine identifiée des voyageurs dans chaque departement visité")+
  theme_minimal()+ theme(legend.position="none")+ scale_color_viridis_d(option="E") 
ggplotly(ggvolume)

Globalement, on n’y voit rien… Un phénomene intéressant d’une origine spécifique des voyageurs de loin majoritaire en Haute-garonne… ~~~Va savoir laquelle sur un graphe, Charles…~~~ Avec plotly, on sait que c’est “Autres”. Super Michel…

Si c’est intéressant, on pourrait faire des catégories aggrégées genre “dep_limitrophes”, “dep_2éme_couronne”, “dep_lointains”, “pays_limitrophes”, “pays_lointains”, mais il y a un peu de boulot…

Complements.

evenements <- comp_evenements %>% 
  mutate_at("num", as.integer)
skim(evenements)

Data summary
Name	evenements
Number of rows	202
Number of columns	5
_______________________
Column type frequency:
character	1
Date	2
factor	1
numeric	1
________________________
Group variables	None