---
title: "article"
format:
  html:
    toc: true
    html-math-method: katex
    code-fold: true
execute:
  warning: false
knitr:
  opts_chunk: 
    fig-width: 7
    fig-height: 5
    out.width: "80%"
    collapse: true
    comment: "#>" 
---


# RQ1. La crise sanitaire a-t-elle modifié les habitudes de mobilité des actifs franciliens en terme de choix modal et de fréquence de déplacement pour les différents motifs personnels et professionnels ?

Il s'agit ici de comparer avant et après même s'il n'y a pas d'impact je trouve ça très intéressant, notamment car l'augmentation de l'usage des modes actifs et la baisse de l'usage des TC est assez communément défendue dans la littérature.
Pour les achats non alimentaires (voire peut-être alimentaires), certains défendent l'idée que la crise a augmenté le recours aux achats en ligne et baissé la fréquence de ce type de déplacement. Mais il n'y a pas énormément de travaux dans la littérature. 


```{r}
library(splines)
library(MASS)
library(readxl)
library(ggplot2)
library(kableExtra)
library(dplyr)
library(tidygeocoder)
library(sf)
library(mapview)
library(units)
COMOPOCOV = read_excel("data/COMOPOCOV_transmis Etienne et Emmanuel(1).xlsx")

# Q1 -> Q22 contexte
# Q23 -> Q34 Avant
# Q35 -> Q47 Pendant
# Q48 -> Q59 Après
# Q60 -> Q64 Futur


# 
# villes = tibble(ville=unique(c(COMOPOCOV$nameVillex1,COMOPOCOV$nameVille))) |>
#   mutate(id=1:n(),addr=paste(ville, ", France"))
# 
# villes_lat_longs <- villes |>
#    geocode(addr, method = 'osm', lat = latitude , long = longitude)
# 
# villes.sf = st_as_sf(villes_lat_longs|>filter(!is.na(latitude)),coords = c("longitude","latitude"),crs=4326)
# 
# write_sf(villes.sf,'villes.sf.geojson')

villes.sf=read_sf("villes.sf.geojson")
mapview(villes.sf)

dists_domtrav= st_distance(COMOPOCOV|>left_join(villes.sf,by=c("nameVille"="ville")) |> st_as_sf(), COMOPOCOV|>left_join(villes.sf,by=c("nameVillex1"="ville")) |> st_as_sf(),by_element = TRUE)
COMOPOCOV$distancedomtrav=set_units(dists_domtrav,"km")

lab_freq = c("Jamais","Moins de 1","1 à 3 / mois",
             "1 à 3 / sem","4 à 5 / semaine","Tous les jours")

lab_mode =  c("Conducteur","Passager","TC","deux-roues",
              "La marche","Le vélo","Trottinette","Pas")

COMAVANT_FREQ = COMOPOCOV |> select(uuid,Q28bis_1:Q28bis_8) |> 
  mutate(across(Q28bis_1:Q28bis_8, ~ factor(lab_freq[.x],levels=lab_freq)))
colnames(COMAVANT_FREQ)=c("uiid",paste0("FREQMO",1:8))


COMAVANT_MODE =  COMOPOCOV |> select(uuid,Q29_1:Q29_8) |> 
  mutate(across(Q29_1:Q29_8, ~ factor(lab_mode[.x],levels=lab_mode))) |>
  mutate(across(Q29_1:Q29_8, ~ factor(case_when(.x %in% c("Conducteur","Passager","deux-roues") ~ "Motorisé",.x=="TC"~ "TC",.default="Actif"))))
colnames(COMAVANT_MODE)=c("uiid",paste0("MODEMO",1:8))



COMAPRES_FREQ = COMOPOCOV |> select(uuid,Q48_1:Q48_8) |> 
  mutate(across(Q48_1:Q48_8, ~ factor(lab_freq[.x],levels=lab_freq)))
colnames(COMAPRES_FREQ)=c("uiid",paste0("FREQMO",1:8))

COMAPRES_MODE =  COMOPOCOV |> select(uuid,Q49_1:Q49_8) |> 
  mutate(across(Q49_1:Q49_8, ~ factor(lab_mode[.x],levels=lab_mode)))|>
  mutate(across(Q49_1:Q49_8, ~ factor(case_when(.x %in% c("Conducteur","Passager","deux-roues") ~ "Motorisé",.x=="TC"~ "TC",.default="Actif"))))
colnames(COMAPRES_MODE)=c("uiid",paste0("MODEMO",1:8))

Xmob=bind_rows(COMAPRES_FREQ[,c(0,1,4,5,7,8)+1] |> left_join(COMAPRES_MODE[,c(0,1,4,5,7,8)+1]),
COMAVANT_FREQ[,c(0,1,4,5,7,8)+1]  |> left_join(COMAVANT_MODE[,c(0,1,4,5,7,8)+1])) 

gg_evol = COMAVANT_FREQ|> rename_all(~paste0("AVANT_",.)) |> left_join(
  COMAPRES_FREQ|> rename_all(~paste0("APRES_",.)),
  by=c("AVANT_uiid"="APRES_uiid"))

gg_evol_mode = COMAVANT_MODE|> rename_all(~paste0("AVANT_",.)) |> left_join(
  COMAPRES_MODE|> rename_all(~paste0("APRES_",.)),
  by=c("AVANT_uiid"="APRES_uiid"))



lab_freq = c("Jamais","Moins de 1","1 à 3 / mois",
             "1 à 3 / sem","4 à 5 / semaine","Tous les jours")
             
             
lab_freq_p = c("--","-","=","+","++","0")

lab_mode =  c("Conducteur","Passager","TC","deux-roues",
              "La marche","Le vélo","Trottinette","Pas")

lab_age=c("18-24","25-34","35-44","45-54","55-64","65+")

lab_ouinon = c("Oui","Non")

lab_csp_detail =  c("Agriculteur","Artisan·e", "Cadre","Prof Intermédiaire","Employé·e","Ouvrièr·e","Retraité·e","Etudiant·e","Rech. emploi","Autre ina")

old_names_pre_freq=paste0("Q28bis_",1:8)
new_names_pre_freq=paste0("FREQMOPRE",1:8)

old_names_in_freq=paste0("Q35_",1:8)
new_names_in_freq=paste0("FREQMOIN",1:8)

old_names_in_chfreq=paste0("Q36_",1:7)
new_names_in_chfreq=paste0("CHANGEFREQIN",1:7)

old_names_in_mode=paste0("Q39_",1:8)
new_names_in_mode=paste0("MODEMOIN",1:8)

old_names_in_tele=paste0("Q46_",1:9)
new_names_in_tele=paste0("TELEINPER",1:9)

old_names_post_freq=paste0("Q48_",1:8)
new_names_post_freq=paste0("FREQMOPOST",1:8)

old_names_pre_mode=paste0("Q29_",1:8)
new_names_pre_mode=paste0("MODEMOPRE",1:8)

old_names_post_mode=paste0("Q49_",1:8)
new_names_post_mode=paste0("MODEMOPOST",1:8)


lab_courone=c("Paris","Petite","Grande")
lab_sexe = c("femme","homme","nsp")
lab_diplo = c("nodiplo","Brevet","CAP","Bac","Bac+2","Bac+3","Bac+4","Bac+5", ">Bac+5","nsp")
lab_situ_fam = c("Seul","Seul + enf(s)","Couple","Couple + enf(s)","Autres") 
lab_situ_trav =c("TP","P80","P80_50","P50","PM50")
lab_hab = c("maison","appartement")
lab_rev = c("M500","M500_1000","M1001_2500","M2501_4000","M4001_6000","M6001_9000","P9000","Jnsp","Jnspr") 
  
lab_5lev=c("--","-","=","+","++")





COMPOCOV_CLEAN =  COMOPOCOV |> 
  mutate(across(Q28bis_1:Q28bis_8, ~ factor(lab_freq[.x],levels=lab_freq))) |>
  rename_with(~ new_names_pre_freq, all_of(old_names_pre_freq)) |>
  mutate(across(Q29_1:Q29_8, ~ factor(lab_mode[.x],levels=lab_mode))) |>
  rename_with(~ new_names_pre_mode, all_of(old_names_pre_mode)) |>
  mutate(across(Q48_1:Q48_8, ~ factor(lab_freq[.x],levels=lab_freq))) |>
  rename_with(~ new_names_post_freq, all_of(old_names_post_freq)) |>
  mutate(across(Q35_1:Q35_8, ~ factor(lab_freq_p[.x],levels=lab_freq_p))) |>
  rename_with(~ new_names_in_freq, all_of(old_names_in_freq)) |>
  mutate(across(Q36_1:Q36_7, ~ factor(lab_ouinon[.x],levels=lab_ouinon))) |>
  rename_with(~ new_names_in_chfreq, all_of(old_names_in_chfreq)) |>
  mutate(across(Q39_1:Q39_8, ~ factor(lab_mode[.x],levels=lab_mode))) |>
  rename_with(~ new_names_in_mode, all_of(old_names_in_mode)) |>
  mutate(across(Q49_1:Q49_8, ~ factor(lab_mode[.x],levels=lab_mode))) |>
  rename_with(~ new_names_post_mode, all_of(old_names_post_mode)) |>
  mutate(across(Q46_1:Q46_9, ~ factor(lab_5lev[.x],levels=lab_5lev))) |>
  rename_with(~ new_names_in_tele, all_of(old_names_in_tele)) |>
  mutate(age= Q1) |>
  mutate(sexe= factor(lab_sexe[Q2]  ,levels=  lab_sexe)) |>  
  mutate(diplo= factor(lab_diplo[Q3]  ,levels=  lab_diplo)) |>  
  mutate(csp = factor(case_when(Q4<3 ~ "AgrArt",Q4 ==3 ~"CSP+",Q4 %in% 4:6 ~ "CSP-",Q4>6~"Ina"))) |>
  mutate(cspd = factor(lab_csp_detail[Q4],levels = lab_csp_detail)) |>
  mutate(tp = factor(lab_situ_trav[Q5],levels=lab_situ_trav)) |>
  mutate(situ_fam = factor(lab_situ_fam[Q7],levels=lab_situ_fam)) |>
  mutate(hab=factor(lab_hab[Q12],levels=lab_hab)) |>
  mutate(rev=factor(lab_rev[Q16],levels=lab_rev)) |>
  mutate(change_sociopro=factor(lab_ouinon[Q23])) |>
  mutate(tele_pre=if_else(is.na(Q33),0,Q33)) |>
  mutate(tele_pre=if_else(tele_pre>5,5,tele_pre)) |>
  mutate(tele_post=if_else(is.na(Q53),0,Q53)) |>
  mutate(depf=factor(dep),couronne=factor(lab_courone[Couronne])) |>
  dplyr::select(uuid,depf,couronne,distancedomtrav,age:tele_post,nb_tele_pre=Q33,nb_tele_post=Q53,FREQMOPRE1:MODEMOPRE8,FREQMOIN1:FREQMOIN8,TELEINPER1:TELEINPER9,FREQMOPOST1:MODEMOPOST8,MODEMOIN1:MODEMOIN8,CHANGEFREQIN1:CHANGEFREQIN7) |>
  mutate(change = (unclass(FREQMOPOST1)-unclass(FREQMOPRE1))<0)|> 
  mutate(change_tele=tele_post-tele_pre) |>
  mutate(change_alim = (unclass(FREQMOPOST4)-unclass(FREQMOPRE4))<0) |> 

  mutate(across(MODEMOPRE1:MODEMOPRE8, ~ factor(case_when(.x %in% c("Conducteur","Passager","deux-roues") ~ "Motorisé",.x=="TC"~ "TC",.default="Actif")))) |>
  mutate(across(MODEMOPOST1:MODEMOPOST8, ~ factor(case_when(.x %in% c("Conducteur","Passager","deux-roues") ~ "Motorisé",.x=="TC"~ "TC",.default="Actif")))) |>
  mutate(across(MODEMOIN1:MODEMOIN8, ~ factor(case_when(.x %in% c("Conducteur","Passager","deux-roues") ~ "Motorisé",.x=="TC"~ "TC",.default="Actif"))))


data = COMPOCOV_CLEAN |> 
  dplyr::select(depf:change_sociopro,distancedomtrav,FREQMOPRE1:MODEMOPRE8,FREQMOPOST1:MODEMOPOST8,FREQMOIN1,FREQMOIN4,FREQMOIN5,FREQMOIN7,TELEINPER1:TELEINPER9,change,change_alim,change_tele,tele_post,tele_pre,MODEMOIN1:MODEMOIN8,CHANGEFREQIN1:CHANGEFREQIN7) |>
    mutate(change_mode1 =(MODEMOPRE1!='Actif' & MODEMOPOST1=="Actif")) |>
  mutate(change_modealim = (MODEMOPRE4!='Actif' & MODEMOPOST4=="Actif")) 

kable(table(data$csp))



```


### Motif travail

Sur l'ensemble de la base on observe un certain nombre de transitions "4 à 5 / semaine" vers "1 à 3 / semaine" idem de "Tous les jours" vers les deux niveaux inférieurs.

```{r}
kable(table(COMAVANT_FREQ$FREQMO1,COMAPRES_FREQ$FREQMO1))
kable(table(COMAVANT_FREQ$FREQMO1)/sum(table(COMAVANT_FREQ$FREQMO1))*100,digits=1)
kable(table(COMAPRES_FREQ$FREQMO1)/sum(table(COMAPRES_FREQ$FREQMO1))*100,digits=1)
prop.test(cbind(table(COMAVANT_FREQ$FREQMO1),table(COMAPRES_FREQ$FREQMO1)))
ggplot(gg_evol|> count(AVANT_FREQMO1,APRES_FREQMO1,name = "nm")  |> add_count(AVANT_FREQMO1,wt=nm))+
  geom_point(aes(y=AVANT_FREQMO1,x=APRES_FREQMO1,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

En restreignant à la population active on trouve avec une regression ordinale un effet significatif de la période, de l'age, du temps partiel et de la situation familliale.

```{r}
data_reg_periode = data   |> filter(csp!="Ina") |> dplyr::select(depf:rev,freq=FREQMOPRE1) |> mutate(period="pre") |> bind_rows(
data |> dplyr::select(depf:rev,freq=FREQMOPOST1) |> mutate(period="post"))



fit=polr(freq~period+bs(age,4)+couronne+sexe+csp+diplo+tp+situ_fam+rev,data_reg_periode,Hess = TRUE)

(ctable <- coef(summary(fit)))

p <- pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2

## combined table
res_table <- data.frame(cbind(ctable[,c("Value","Std. Error")], "p value" = p)) |>
mutate(signif = if_else(p<0.01,"*",""))
kableExtra::kable(res_table,digits=3)
```

### Motif travail modes 

Les évolutions ne semble pas énormes sur les modes mais il y a tout de même quelques changements.

```{r}
kable(table(COMAVANT_MODE$MODEMO1,COMAPRES_MODE$MODEMO1))
kable(table(COMAVANT_MODE$MODEMO1)/sum(table(COMAVANT_MODE$MODEMO1))*100,digits=1)
kable(table(COMAPRES_MODE$MODEMO1)/sum(table(COMAPRES_MODE$MODEMO1))*100,digits=1)
ptest = prop.test(cbind(table(COMAVANT_MODE$MODEMO1),table(COMAPRES_MODE$MODEMO1)));
ggplot(gg_evol_mode|> count(AVANT_MODEMO1,APRES_MODEMO1,name = "nm")  |> add_count(AVANT_MODEMO1,wt=nm))+
  geom_point(aes(y=AVANT_MODEMO1,x=APRES_MODEMO1,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

Avec un test d'égalité de proportions on trouve une p-value de `{r} round(ptest$p.value,3)`.

Mais en utilisant un test d'églité de proportion pour données apairées (test de Mc Nemar) on trouve tout de même une différence significative pour la marche et les TC. i.e ce qui se dit dans la littérature.


```{r}
pvals = sapply( levels(COMAVANT_MODE$MODEMO1),\(lev){
  M= data.frame(av=COMAVANT_MODE$MODEMO1,ap=COMAPRES_MODE$MODEMO1) |> 
    filter(!is.na(av),!is.na(ap)) |> 
    mutate(av=av==lev,ap=ap==lev) |> 
    table()
    mcnemar.test(M)$p.value}
)
kable(t(pvals),digits=3)
```

### Motif achat alimentaires 

Sur l'ensemble la population on voit un peu de transitions de "Tous les jours" vers les deux niveaux inférieurs (de même pour "4 à 5 par semaine"). Sur les niveaux intermédiaires les transitions on lieux dans les deux sens.


```{r}
kable(table(COMAVANT_FREQ$FREQMO4,COMAPRES_FREQ$FREQMO4))
kable(table(COMAVANT_FREQ$FREQMO4)/sum(table(COMAVANT_FREQ$FREQMO4))*100,digits=1)
kable(table(COMAPRES_FREQ$FREQMO4)/sum(table(COMAPRES_FREQ$FREQMO4))*100,digits=1)
prop.test(cbind(table(COMAVANT_FREQ$FREQMO4),table(COMAPRES_FREQ$FREQMO4)))
ggplot(gg_evol|> count(AVANT_FREQMO4,APRES_FREQMO4,name = "nm")  |> add_count(AVANT_FREQMO4,wt=nm))+
  geom_point(aes(y=AVANT_FREQMO4,x=APRES_FREQMO4,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```




Avec la même approche que précement (mais pour ce motif et les autres pas de filtre sur les actifs) l'effet de la période a ici une p-value de 2% donc difficile de juger avec trop de certitude mais un effet post covid de baisse des déplacements de ce type ne peut pas être écarté. Les autres facteur significatifs : un effet parisien et de revenu.

```{r}



data_reg_periode = data |> dplyr::select(depf:rev,freq=FREQMOPRE4) |> mutate(period="pre") |> bind_rows(
data |> dplyr::select(depf:rev,freq=FREQMOPOST4) |> mutate(period="post"))



fit=polr(freq~period+bs(age,4)+couronne+sexe+csp+diplo+tp+situ_fam+rev,data_reg_periode,Hess = TRUE)

(ctable <- coef(summary(fit)))

p <- pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2

## combined table
res_table <- data.frame(cbind(ctable[,c("Value","Std. Error")], "p value" = p)) |>
mutate(signif = if_else(p<0.01,"*",""))
kableExtra::kable(res_table,digits=3)
```


### Motif achat alimentaires  modes 

Rien de vraiment probant les parts modale ne sont pas significativement différentes entre avant / après.

```{r}
kable(table(COMAVANT_MODE$MODEMO4,COMAPRES_MODE$MODEMO4))
kable(table(COMAVANT_MODE$MODEMO4)/sum(table(COMAVANT_MODE$MODEMO4))*100,digits=1)
kable(table(COMAPRES_MODE$MODEMO4)/sum(table(COMAPRES_MODE$MODEMO4))*100,digits=1)
ptest=prop.test(cbind(table(COMAVANT_MODE$MODEMO4),table(COMAPRES_MODE$MODEMO4)))
ggplot(gg_evol_mode|> count(AVANT_MODEMO4,APRES_MODEMO4,name = "nm")  |> add_count(AVANT_MODEMO4,wt=nm))+
  geom_point(aes(y=AVANT_MODEMO4,x=APRES_MODEMO4,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```



Avec un test d'égalité de proportions on trouve une p-value de `{r} round(ptest$p.value,3)`.


Mais en utilisant un test d'églité de proportion pour données apairées (test de Mc Nemar) on trouve tout de même une différence significative pour la marche et conducteur a 5%.


```{r}
pvals = sapply( levels(COMAVANT_MODE$MODEMO4),\(lev){
  M= data.frame(av=COMAVANT_MODE$MODEMO4,ap=COMAPRES_MODE$MODEMO4) |> 
    filter(!is.na(av),!is.na(ap)) |> 
    mutate(av=av==lev,ap=ap==lev) |> 
    table()
    mcnemar.test(M)$p.value}
)
kable(t(pvals),digits=3)
```


### Motif achat non alimentaires 

La matrice de transition ne fait pas apparaître de motif clair. Les test de détecte pas de différence significative entre avant / après.


```{r}
kable(table(COMAVANT_FREQ$FREQMO5,COMAPRES_FREQ$FREQMO5))
kable(table(COMAVANT_FREQ$FREQMO5)/sum(table(COMAVANT_FREQ$FREQMO5))*100,digits=1)
kable(table(COMAPRES_FREQ$FREQMO5)/sum(table(COMAPRES_FREQ$FREQMO5))*100,digits=1)
prop.test(cbind(table(COMAVANT_FREQ$FREQMO5),table(COMAPRES_FREQ$FREQMO5)))
ggplot(gg_evol|> count(AVANT_FREQMO5,APRES_FREQMO5,name = "nm")  |> add_count(AVANT_FREQMO5,wt=nm))+
  geom_point(aes(y=AVANT_FREQMO5,x=APRES_FREQMO5,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

De même avec la même approche de régression que précement l'effet de la période n'est ici pas significatif. Il reste un effet Paris, sexe et situation familiale.

```{r}



data_reg_periode = data |> dplyr::select(depf:rev,freq=FREQMOPRE5) |> mutate(period="pre") |> bind_rows(
data |> dplyr::select(depf:rev,freq=FREQMOPOST5) |> mutate(period="post"))



fit=polr(freq~period+bs(age,4)+couronne+sexe+csp+diplo+tp+situ_fam+rev,data_reg_periode,Hess = TRUE)

(ctable <- coef(summary(fit)))

p <- pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2

## combined table
res_table <- data.frame(cbind(ctable[,c("Value","Std. Error")], "p value" = p)) |>
mutate(signif = if_else(p<0.01,"*",""))
kableExtra::kable(res_table,digits=3)
```


### Motif achat non alimentaires  modes 

Rien de vraiment probant, les parts modale ne sont pas significativement différentes entre avant / après pour ce motif.

```{r}
kable(table(COMAVANT_MODE$MODEMO5,COMAPRES_MODE$MODEMO5))
kable(table(COMAVANT_MODE$MODEMO5)/sum(table(COMAVANT_MODE$MODEMO5))*100,digits=1)
kable(table(COMAPRES_MODE$MODEMO5)/sum(table(COMAPRES_MODE$MODEMO5))*100,digits=1)
ptest = prop.test(cbind(table(COMAVANT_MODE$MODEMO5),table(COMAVANT_MODE$MODEMO5)))
ggplot(gg_evol_mode|> count(AVANT_MODEMO5,APRES_MODEMO5,name = "nm")  |> add_count(AVANT_MODEMO5,wt=nm))+
  geom_point(aes(y=AVANT_MODEMO5,x=APRES_MODEMO5,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

Avec un test d'égalité de proportions on trouve une p-value de `{r} round(ptest$p.value,3)`.

Cette fois ci même en utilisant un test d'églité de proportion pour données apairées (test de Mc Nemar) on ne trouve  pas de différence significatives.
```{r}
pvals = sapply( levels(COMAVANT_MODE$MODEMO5),\(lev){
  M= data.frame(av=COMAVANT_MODE$MODEMO5,ap=COMAPRES_MODE$MODEMO5) |> 
    filter(!is.na(av),!is.na(ap)) |> 
    mutate(av=av==lev,ap=ap==lev) |> 
    table()
    mcnemar.test(M)$p.value}
)
kable(t(pvals),digits=3)
```


### Motif sport loisir

Idem pas de motif clair pour la matrice de transition, et pas de différences significative dans les fréqeunces entre avant / après.
```{r}
kable(table(COMAVANT_FREQ$FREQMO7,COMAPRES_FREQ$FREQMO7))
kable(table(COMAVANT_FREQ$FREQMO7)/sum(table(COMAVANT_FREQ$FREQMO7))*100,digits=1)
kable(table(COMAPRES_FREQ$FREQMO7)/sum(table(COMAPRES_FREQ$FREQMO7))*100,digits=1)
prop.test(cbind(table(COMAVANT_FREQ$FREQMO7),table(COMAPRES_FREQ$FREQMO7)))
ggplot(gg_evol|> count(AVANT_FREQMO7,APRES_FREQMO7,name = "nm")  |> add_count(AVANT_FREQMO7,wt=nm))+
  geom_point(aes(y=AVANT_FREQMO7,x=APRES_FREQMO7,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

Pas d'effet notable de la période de détecté avec une regression ordinale p-value de 0.22.

```{r}



data_reg_periode = data |> dplyr::select(depf:rev,freq=FREQMOPRE7) |> mutate(period="pre") |> bind_rows(
data |> dplyr::select(depf:rev,freq=FREQMOPOST7) |> mutate(period="post"))



fit=polr(freq~period+bs(age,4)+couronne+sexe+csp+diplo+tp+situ_fam+rev,data_reg_periode,Hess = TRUE)

(ctable <- coef(summary(fit)))

p <- pnorm(abs(ctable[, "t value"]), lower.tail = FALSE) * 2

## combined table
res_table <- data.frame(cbind(ctable[,c("Value","Std. Error")], "p value" = p)) |>
mutate(signif = if_else(p<0.01,"*",""))
kableExtra::kable(res_table,digits=3)
```


### Motif achat sports loisirs modes 

Rien de vraiment probant, les parts modale ne sont pas significativement différentes entre avant / après pour ce motif.

```{r}
kable(table(COMAVANT_MODE$MODEMO7,COMAPRES_MODE$MODEMO7))
kable(table(COMAVANT_MODE$MODEMO7)/sum(table(COMAVANT_MODE$MODEMO7))*100,digits=1)
kable(table(COMAPRES_MODE$MODEMO7)/sum(table(COMAPRES_MODE$MODEMO7))*100,digits=1)
ptest = prop.test(cbind(table(COMAVANT_MODE$MODEMO7),table(COMAVANT_MODE$MODEMO7)))
ggplot(gg_evol_mode|> count(AVANT_MODEMO7,APRES_MODEMO7,name = "nm")  |> add_count(AVANT_MODEMO7,wt=nm))+
  geom_point(aes(y=AVANT_MODEMO7,x=APRES_MODEMO7,size=nm,color=nm/n))+scale_color_distiller(palette="Reds",direction=1)+
  theme_bw()
```

Avec un test d'égalité de proportions on trouve une p-value de `{r} round(ptest$p.value,3)`.

Cette fois ci même en utilisant un test d'églité de proportion pour données apairées (test de Mc Nemar) on ne trouve  pas de différence significatives.
```{r}
pvals = sapply( levels(COMAVANT_MODE$MODEMO5),\(lev){
  M= data.frame(av=COMAVANT_MODE$MODEMO5,ap=COMAPRES_MODE$MODEMO5) |> 
    filter(!is.na(av),!is.na(ap)) |> 
    mutate(av=av==lev,ap=ap==lev) |> 
    table()
    mcnemar.test(M)$p.value}
)
kable(t(pvals),digits=3)
```


## RQ1. Conclusion

- Il y a un effet significatif sur la fréquence de déplacement dom-trav.
- Pour les achat alimentaire il y a aussi une petite évolution significative a 5% sur les fréquences. 
- Pour ce qui est des parts modales on observe un changement significatif pour la marche et les TCs pour le motif domicile travail et sur la marche et conducteur pour les achat alimentaire. 


# RQ2. Qui est le plus concernés par ces changements ?
Il s'agit de voir s'il y a des profils de personnes qui ont changé et qui n'ont pas changé. Peut-être que c'est limité à la possibilité de faire du télétravail mais peut-être pas.


### changement freq dom-trav.

On se concentre sur les actifs qui n'ont pas changés de travail et à temps plein pour éviter les facteurs confondants.

```{r}
fit=glm(change ~ couronne + bs(age,4) + sexe + cspd + diplo + rev+hab+change_tele+situ_fam+tele_pre +distancedomtrav,data=data|> filter(csp!='Ina',tp=="TP",change_sociopro=="Non"),family = binomial)
co = summary(fit)$coefficients
kableExtra::kable(co[co[,4]<0.1,],digits=3)
```

```{r}
data_comp = data|> filter(csp!='Ina',tp=="TP",change_sociopro=="Non") 
chisq.test(data_comp$couronne,data_comp$change)
ttcour= table(data_comp$couronne,data_comp$change)
kable(ttcour/rowSums(ttcour)*100,digits=1)
```


Pas d'effet géo par type de couronne.

```{r}
chisq.test(data_comp$depf,data_comp$change)
ttcour= table(data_comp$depf,data_comp$change)
ttcour/rowSums(ttcour)
```

```{r}
chisq.test(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change)
ttcour= table(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change)
ttcour/rowSums(ttcour)
```


Pas d'effet Age significatif.

```{r}
chisq.test(factor(data_comp$sexe,levels=c("femme","homme")),data_comp$change)
ttcour= table(factor(data_comp$sexe,levels=c("femme","homme")),data_comp$change)
ttcour/rowSums(ttcour)
```


Pas d'effet sexe même si la p-valeur est un poil plus faible echantillon trop petit.

```{r}
data_comp=data_comp |> mutate(diplo_agg=case_when(diplo %in% c("nodiplo","Brevet","CAP","Bac")~ "<Bac+2", diplo %in% c("Bac+2","Bac+3","Bac+4")~"Bac+2,3,4",.default="Bac+5"))

chisq.test(data_comp$diplo_agg,data_comp$change)
ttcour= table(data_comp$diplo_agg,data_comp$change)
ttcour/rowSums(ttcour)
```

Un effet du diplome.



```{r}
chisq.test(table(data_comp$change,data_comp$csp)[,1:3])
ttcour= table(data_comp$csp,data_comp$change)
ttcour/rowSums(ttcour)
```

Un effet de la csp.



```{r}
chisq.test(data_comp$change,data_comp$situ_fam)
ttcour= table(data_comp$situ_fam,data_comp$change)
ttcour/rowSums(ttcour)
```


```{r}
chisq.test(data_comp$change,data_comp$hab)
ttcour= table(data_comp$hab,data_comp$change)
ttcour/rowSums(ttcour)
```

```{r}
chisq.test(data_comp$change,factor(unclass(data_comp$rev)<4))
ttcour= table(factor(unclass(data_comp$rev)<4),data_comp$change)
ttcour/rowSums(ttcour)
```

Petit effet de revenu.


```{r}
chisq.test(data_comp$change,data_comp$MODEMOPRE1)
ttcour= table(data_comp$MODEMOPRE1,data_comp$change)
ttcour/rowSums(ttcour)
```

Un effet mode moins de changement pour ceux qui utilisent des modes actifs. Trajets plus court ? As t'on des infos sur la distance/temps domicile - travail ?


```{r}
ggplot(data_comp)+geom_boxplot(aes(x=change,y=distancedomtrav))+theme_bw()
t.test(as.numeric(data_comp$distancedomtrav[data_comp$change=="TRUE"]),as.numeric(data_comp$distancedomtrav[data_comp$change=="FALSE"]),alternative="greater",var.equal=TRUE)
coin::wilcox_test(distancedomtrav~ factor(change),data=data_comp)
chisq.test(data_comp$change,data_comp$distancedomtrav==set_units(0,"km"))
ttcour= table(data_comp$distancedomtrav==set_units(0,"km"),data_comp$change)
ttcour/rowSums(ttcour)
```

On ne peut pas conclure sur un effet de la distance domicile travail avec un t-test mais un test de Wilcoxon-Mann-Whitney rejette l'hypothèse s'égalité des distribution. Et la distance domicile travail a une mediane de `r{median(data_comp$distancedomtrav[data_comp$change=="TRUE"])}` pour les individus ayant changés leurs fréquence de déplacement domicile travail et de `r{median(data_comp$distancedomtrav[data_comp$change=="TRUE"])}` pour ceux n'ayant pas changés.

### changement mode dom-trav passage aux modes actif ?

```{r}
fit=glm(change_mode1 ~ couronne + bs(age,4) + sexe + cspd + diplo + rev+hab+change+situ_fam+tele_pre +distancedomtrav,data=data|> filter(csp!='Ina',tp=="TP",change_sociopro=="Non"),family = binomial)
co = summary(fit)$coefficients
kableExtra::kable(co[co[,4]<0.1,],digits=3)
```


```{r}
chisq.test(data_comp$couronne,data_comp$change_mode1)
ttcour= table(data_comp$couronne,data_comp$change_mode1)
kable(ttcour/rowSums(ttcour)*100,digits=1)
```


Pas d'effet géo par type de couronne.

```{r}
chisq.test(data_comp$depf,data_comp$change_mode1)
ttcour= table(data_comp$depf,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```

```{r}
chisq.test(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change_mode1)
ttcour= table(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change_mode1)
ttcour/rowSums(ttcour)
```


Pas d'effet Age significatif.

```{r}
chisq.test(factor(data_comp$sexe,levels=c("femme","homme")),data_comp$change_mode1)
ttcour= table(factor(data_comp$sexe,levels=c("femme","homme")),data_comp$change_mode1)
ttcour/rowSums(ttcour)
```


Pas d'effet sexe.

```{r}
data_comp=data_comp |> mutate(diplo_agg=case_when(diplo %in% c("nodiplo","Brevet","CAP","Bac")~ "<Bac+2", diplo %in% c("Bac+2","Bac+3","Bac+4")~"Bac+2,3,4",.default="Bac+5"))

chisq.test(data_comp$diplo_agg,data_comp$change_mode1)
ttcour= table(data_comp$diplo_agg,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```

Pas d'effet siginificatif du diplome.



```{r}
chisq.test(table(data_comp$change_mode1,data_comp$csp)[,1:3])
ttcour= table(data_comp$csp,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```

Pas d'effet de la csp.



```{r}
chisq.test(data_comp$change_mode1,data_comp$situ_fam)
ttcour= table(data_comp$situ_fam,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```

Pas d'effet significatrif de le situation familiale.

```{r}
chisq.test(data_comp$change_mode1,data_comp$hab)
ttcour= table(data_comp$hab,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```
Idem pour maison/appart.
```{r}
chisq.test(data_comp$change_mode1,data_comp$rev)
ttcour= table(data_comp$rev,data_comp$change_mode1)
ttcour/rowSums(ttcour)
```

Idem pour revenus.





```{r}
ggplot(data_comp)+geom_boxplot(aes(x=change_mode1,y=distancedomtrav))+theme_bw()
t.test(as.numeric(data_comp$distancedomtrav[data_comp$change_mode1]),as.numeric(data_comp$distancedomtrav[data_comp$change_mode1]),alternative="greater",var.equal=TRUE)
coin::wilcox_test(distancedomtrav~ factor(change),data=data_comp)
chisq.test(data_comp$change,data_comp$distancedomtrav==set_units(0,"km"))
ttcour= table(data_comp$distancedomtrav==set_units(0,"km"),data_comp$change)
ttcour/rowSums(ttcour)
```

### changement freq achat alim.


```{r}
fit=glm(change_alim ~ couronne + bs(age,4) + sexe + cspd + diplo + rev+hab+change+situ_fam+tele_pre +distancedomtrav,data=data,family = binomial)
co = summary(fit)$coefficients
kableExtra::kable(co[co[,4]<0.1,],digits=3)
```

```{r}
chisq.test(data$couronne,data$change_alim)
ttcour= table(data$couronne,data$change_alim)
ttcour/rowSums(ttcour)
```
```{r}

chisq.test(data$MODEMOPRE4,data$change_alim)
ttcour= table(data$MODEMOPRE4,data$change_alim)
ttcour/rowSums(ttcour)
```

Pas d'effet des modes.

```{r}
chisq.test(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change_alim)
ttcour= table(cut(data_comp$age,c(0,25,30,40,50,75)),data_comp$change_alim)
ttcour/rowSums(ttcour)
```

Un effet age a réfléchir


```{r}

chisq.test(data$sexe,data$change_alim)
ttcour= table(data$sexe,data$change_alim)
ttcour/rowSums(ttcour)
```

Pas d'effet sexe.

```{r}
data=data|> mutate(diplo_agg=case_when(diplo %in% c("nodiplo","Brevet","CAP","Bac")~ "<Bac+2", diplo %in% c("Bac+2","Bac+3","Bac+4")~"Bac+2,3,4",.default="Bac+5"))

chisq.test(data$diplo_agg,data$change_alim)
ttcour= table(data$diplo_agg,data$change_alim)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data$csp,data$change_alim)
ttcour= table(data$csp,data$change_alim)
ttcour/rowSums(ttcour)
```

Pas d'effet diplome / csp.

```{r}
chisq.test(data$situ_fam,data$change_alim)
ttcour= table(data$situ_fam,data$change_alim)
ttcour/rowSums(ttcour)
```

Pas d'effet situation fam.


```{r}
chisq.test(data$hab,data$change_alim)
ttcour= table(data$hab,data$change_alim)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data$rev,data$change_alim)
ttcour= table(data$rev,data$change_alim)
ttcour/rowSums(ttcour)
```

Un effet revenus.


```{r}
chisq.test(data_comp$change,data_comp$MODEMOPRE4)
ttcour= table(data_comp$MODEMOPRE4,data_comp$change_alim)
ttcour/rowSums(ttcour)
```

Pas d'effet du mode.





### changement mode achat alim.

```{r}
fit=glm(change_modealim ~ couronne + bs(age,4) + sexe + cspd + diplo + rev+hab+change+situ_fam+tele_pre +distancedomtrav,data=data,family = binomial)
co = summary(fit)$coefficients
kableExtra::kable(co[co[,4]<0.1,],digits=3)
```


```{r}
chisq.test(data$couronne,data$change_modealim)
ttcour= table(data$couronne,data$change_modealim)
ttcour/rowSums(ttcour)
```


```{r}
chisq.test(cut(data_comp$age,c(0,35,75)),data_comp$change_modealim)
ttcour= table(cut(data_comp$age,c(0,35,75)),data_comp$change_modealim)
ttcour/rowSums(ttcour)
```

Un effet age a réfléchir.


```{r}

chisq.test(data$sexe,data$change_modealim)
ttcour= table(data$sexe,data$change_modealim)
ttcour/rowSums(ttcour)
```

Pas d'effet sexe.

```{r}
data=data|> mutate(diplo_agg=case_when(diplo %in% c("nodiplo","Brevet","CAP","Bac")~ "<Bac+2", diplo %in% c("Bac+2","Bac+3","Bac+4")~"Bac+2,3,4",.default="Bac+5"))

chisq.test(data$diplo_agg,data$change_modealim)
ttcour= table(data$diplo_agg,data$change_modealim)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data$csp,data$change_modealim)
ttcour= table(data$csp,data$change_modealim)
ttcour/rowSums(ttcour)
```

Pas d'effet diplome / csp.

```{r}
chisq.test(data$situ_fam,data$change_modealim)
ttcour= table(data$situ_fam,data$change_modealim)
ttcour/rowSums(ttcour)
```

Pas d'effet situation fam.


```{r}
chisq.test(data$hab,data$change_modealim)
ttcour= table(data$hab,data$change_modealim)
ttcour/rowSums(ttcour)
```

Un effet appartement !

```{r}
chisq.test(factor(unclass(data$rev)<4),data$change_modealim)
ttcour= table(factor(unclass(data$rev)<4),data$change_modealim)
ttcour/rowSums(ttcour)
```

Un effet revenus.








# RQ3. Quel est le rôle du télétravail (et de la crise covid) dans ces changements ?
Ici il s'agit de voir si le fait d'avoir commencé ou augmenté le télétravail pendant la crise a un effet sur la fréquence voire sur le mode de déplacement pour le motif travail. On peut aussi y inclure les questions de perception du télétravail (Q46 sauf la Q46-10) ainsi que quelques parties de la question Q36 et de la question Q61.
# RQ4. Les bouleversements qui ont été causés par la crise sanitaires expliquent-ils en partie ces changements ?
Il s'agirait d'exploiter la partie 3 en comparant ceux qui ont baissé en fréquence et les autres, en adaptant les questions selon le motif de déplacement considéré. 



```{r}
data_rq3 = data |> filter(csp!='Ina',tp=="TP",change_sociopro=="Non") |> dplyr::select(change,change_tele,tele_pre,couronne:rev,CHANGEFREQIN1:CHANGEFREQIN7,FREQMOIN1:TELEINPER9) |>
  mutate(across(TELEINPER1:TELEINPER9, ~ addNA(.x))) |> dplyr::select(-csp) |> mutate(change=factor(change))
fit=glm(change ~  bs(age,4) + sexe + rev+change_tele+tele_pre+situ_fam +CHANGEFREQIN1+CHANGEFREQIN2+CHANGEFREQIN3+CHANGEFREQIN4+CHANGEFREQIN5+CHANGEFREQIN6+CHANGEFREQIN7+TELEINPER1+TELEINPER2+TELEINPER3+TELEINPER4+TELEINPER5+TELEINPER6+TELEINPER7+TELEINPER8,data=data_rq3,family = binomial)
co = summary(fit)$coefficients
kableExtra::kable(co[co[,4]<0.05,],digits=3)
```



```{r}
chisq.test(data_comp$TELEINPER2,data_comp$change)
ttcour= table(data_comp$TELEINPER2,data_comp$change)
ttcour/rowSums(ttcour)
```


```{r}
chisq.test(data_comp$TELEINPER3,data_comp$change)
ttcour= table(data_comp$TELEINPER3,data_comp$change)
ttcour/rowSums(ttcour)
```




```{r}
chisq.test(data_comp$TELEINPER4,data_comp$change)
ttcour= table(data_comp$TELEINPER4,data_comp$change)
ttcour/rowSums(ttcour)
```

```{r}
chisq.test(data_comp$TELEINPER5,data_comp$change)
ttcour= table(data_comp$TELEINPER5,data_comp$change)
ttcour/rowSums(ttcour)
```


```{r}
chisq.test(data_comp$TELEINPER6,data_comp$change)
ttcour= table(data_comp$TELEINPER6,data_comp$change)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data_comp$TELEINPER7,data_comp$change)
ttcour= table(data_comp$TELEINPER7,data_comp$change)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data_comp$TELEINPER9,data_comp$change)
ttcour= table(data_comp$TELEINPER9,data_comp$change)
ttcour/rowSums(ttcour)
```



Q46_2-> changement,Q46_3-> changement,Q46_4-> changement,Q46_5-> changement,Q46_6-> changement,Q46_7-> changement,Q46_9-> changement


```{r}
chisq.test(data_comp$CHANGEFREQIN1,data_comp$change)
ttcour= table(data_comp$CHANGEFREQIN1,data_comp$change)
ttcour/rowSums(ttcour)
```




```{r}
chisq.test(data_comp$CHANGEFREQIN2,data_comp$change)
ttcour= table(data_comp$CHANGEFREQIN2,data_comp$change)
ttcour/rowSums(ttcour)
```



```{r}
chisq.test(data_comp$CHANGEFREQIN3,data_comp$change)
ttcour= table(data_comp$CHANGEFREQIN3,data_comp$change)
ttcour/rowSums(ttcour)
```

Q36_1,2,3-> changement


### effet changement de mode pedant covid ?
```{r}
ch=table(data_comp$MODEMOIN1=="Actif" & data_comp$MODEMOPRE1!="Actif",data_comp$MODEMOPOST1=="Actif" & data_comp$MODEMOPRE1!="Actif")
chisq.test(ch)
```

Oui !! Ceux qui se sont mis aux mode actifs pendant la crise ont une proba plus grande de se déplacer en mode actif après.








