---
title: "Les déplacements au sens de FV, quelle signification"
author: Etienne Côme
lang: fr-FR
format: 
  revealjs:
    code-fold: true
    code-tools: true
    warning: false
---


## Définition d'un déplacement FV 


- Sensiblement $\neq$ de l'acceptation de ce qu'est un trajet dans les enquêtes de mobilités classiques. 
- 2 périodes d'immobilités d'une durée $\geq$ à un seuil (1h ou 3h) ont lieu dans deux zones (des triris dans le cas des OD les plus fines) différentes. </br>
$\Rightarrow$ pas de déplacements dans la même zone (boucles), fusion des déplacements de courtes durée, ...</br>
$\Rightarrow$ reconstruction des déplacements qui seraient observés dans les données de l'enquête EMC² si cette définition était appliquée 



## Extraction des trajet de l'EMC² au sens de Flux Vision

```{r}
library(readr)
library(dplyr)
library(sf)
library(ggplot2)
library(lubridate)
library(stringr)
library(patchwork)
library(ggtext)
# Chargement des données et pré-traietements

# Données gégographique
triris = read_sf("./data/TRIRIS/Data Transport TRIRIS/TRAG_MOBITIC_zonage_TRIRIS.geojson") |> st_transform(3035)
zf = read_sf('./EGT_lyon/doc/SIG/EDGT_AML2015_ZF_GT.TAB') |> 
  st_transform(3035) |> 
  rename(id=ZF2015_Nouveau_codage)
zf_centroid= zf |> st_centroid()

# Déplacement de l'EGT
depl_egt = read_delim('./EGT_lyon/depl.csv', delim=';') |> 
  select(id_per,id_dep, zf_o=D3, h_o=D4, zf_d=D7, h_d=D8, 
         mot_o=origin_motive,mot_d=destination_motive,mode=MODP,typed=TYPD) |>
  mutate(zf_o=as.character(zf_o),zf_d=as.character(zf_d)) |>
  left_join(zf_centroid|>select(id),by=c("zf_o"="id")) |>
  st_as_sf() |>
  st_join(triris|>select(-perimetre)) |>
  rename(triris_o=id_regroupement,triris_desc_o=regroupement_desc) |>
  st_drop_geometry() |>
  left_join(zf_centroid|>select(id),by=c("zf_d"="id")) |>
  st_as_sf() |>
  st_join(triris|>select(-perimetre)) |>
  rename(triris_d=id_regroupement,triris_desc_d=regroupement_desc) |>
  st_drop_geometry() |>
  mutate(h_o_sec=as.numeric(str_sub(h_o,1,2))*3600+as.numeric(str_sub(h_o,3,4))*60) |>
  mutate(h_d_sec=as.numeric(str_sub(h_d,1,2))*3600+as.numeric(str_sub(h_d,3,4))*60)

# Echantillons d'individus de l'enquêtes pur illustrer
sel_per = c("00104752482","00112004422","00216004701","002280021431","00227008371","00123001102","006120074433","001290041351","001280041392","00101002991")

```

## Vision déplacements / activités



```{r, fig.cap="Les données de l'enquête contiennent des calendriers avec les déplacement associés. Nous passons tout d'abord d'une vision déplacement à une vision activité comme illustré sur la figure suivante."}
# Question sur les effet de bord des journées comment sont-il traités + 23-1h ? 
# depl_egt_fv= depl_egt |> filter(triris_o!=triris_d) |> 
#   group_by(id_per) |>
#   mutate(dur_act_prec = h_o_sec-if_else(!is.na(lag(h_d_sec)),lag(h_d_sec),last(h_d_sec)-24*3600)) |>
#   mutate(dur_act_next = if_else(!is.na(lead(h_o_sec)),lead(h_o_sec),first(h_o_sec)+24*3600)-h_d_sec) |>
#   mutate(is_obs = dur_act_prec>= 3600 & dur_act_next>=3600)
# Question est-ce un traitement séquentiel ?

cal0= ggplot(depl_egt |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1))+facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  coord_cartesian(xlim=c(4,28))+
  theme_bw()+
  labs(title="Echantillon de calendriers",subtitle="(déplacements)",x="Heure")


# Passage au format activité
last_act_egt = depl_egt |>
  group_by(id_per) |>
  summarise(h_deb_act = last(h_d_sec),
         h_fin_act = first(h_o_sec)+24*3600,
         dur_act=h_fin_act-h_deb_act,
         triris_act = last(triris_d)) |>
  ungroup() |>
  select(id_per,h_deb_act ,h_fin_act ,dur_act,triris_act) 

act_egt = depl_egt |>
  group_by(id_per) |>
  mutate(h_deb_act = if_else(!is.na(lag(h_d_sec)),lag(h_d_sec),last(h_d_sec)-24*3600),
         h_fin_act = h_o_sec,
         dur_act=h_fin_act-h_deb_act) |>
  mutate(triris_act = triris_o) |>
  select(id_per,h_deb_act ,h_fin_act,dur_act,triris_act) |> 
  ungroup() |>
  bind_rows(last_act_egt) |>
  arrange(id_per,h_deb_act)

triris_lev = unique(act_egt |> filter(id_per %in% sel_per)|>pull(triris_act))
cols=c(RColorBrewer::brewer.pal(12, "Paired"),RColorBrewer::brewer.pal(12, "Paired"),RColorBrewer::brewer.pal(4, "Paired"))
names(cols)=triris_lev

cal1=ggplot(act_egt |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  #geom_text(aes(x=(h_deb_act+h_fin_act)/(2*3600),y=0.5,label=triris_act))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  labs(title="Echantillon de calendriers",subtitle="(activités, couleurs=triris)",x="Heure")

cal0|cal1

```

## Pas de changement de zone


```{r, fig.cap="Différentes activités adjacentes temporellement et se situant dans la même zone ne peuvent être distinguées avec la définition de déplacement d'Orange elles sont donc regroupées."}
# regroupement des activités statiques
act_egt_grouped_static =  act_egt |> group_by(id_per) |> 
  mutate(triris_prec=lag(triris_act), id_act=cumsum(triris_prec!=triris_act|is.na(triris_prec))) |>
  ungroup() |>
  group_by(id_per,id_act) |>
  summarize(h_deb_act=first(h_deb_act),h_fin_act=last(h_fin_act),dur_act=h_fin_act-h_deb_act,triris_act=first(triris_act)) 

cal2=ggplot(act_egt_grouped_static |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  labs(title="Echantillon de calendriers",subtitle="(activités, regroupement même triris)",x="Heure")


cal1|cal2
```

## Suppression des activités trop courtes


```{r, fig.cap="Les activités trop courte, n’entraînent pas d'immobilités et sont donc supprimées."}

# filtrage des activité trop courte
act_egt_grouped_static_long = act_egt_grouped_static |> filter(dur_act>=3600) 

cal3=ggplot(act_egt_grouped_static_long |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  labs(title="Echantillon de calendriers",subtitle="(activités, suppresion des activités courtes)",x="Heure")

cal2|cal3

```

```{r}

# nouveau regroupement des activité statique (ou juste suppression) ?
act_fv  =  act_egt_grouped_static_long  |> group_by(id_per) |> 
  mutate(triris_prec=lag(triris_act), id_act=cumsum(triris_prec!=triris_act|is.na(triris_prec))) |>
  ungroup() |>
  group_by(id_per,id_act) |>
  summarize(h_deb_act=first(h_deb_act),h_fin_act=last(h_fin_act),dur_act=h_fin_act-h_deb_act,triris_act=first(triris_act)) 

cal4=ggplot(act_fv |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  theme_bw()+
  labs(title="Echantillon de calendriers",subtitle="(activités, regroupement)",x="Heure")

#cal3|cal4
```

## Détection des déplacements au sens FV



```{r, fig.cap="Les déplacements observés sont ceux, se situant entre deux activités suffisamment longues et prenant place dans deux triris différents. Si différents déplacements ont lieux entre les deux même activités ils sont regroupés dans un seul trajet."}


# nombre de déplacement moyen observé par personne 
# act_fv |> count(id_per) |> mutate(n=n-1) |> ungroup() |> summarise(nbt=mean(n))

# reconstruction des déplacements
# les déplacement observés sont ceux qui n'ont pas lieu pendant une activité
depl_fv = depl_egt |> anti_join(act_fv,join_by(id_per,overlaps(x$h_o_sec,x$h_d_sec,y$h_deb_act,y$h_fin_act,bounds="()")))
depl_nofv = depl_egt |> semi_join(act_fv,join_by(id_per,overlaps(x$h_o_sec,x$h_d_sec,y$h_deb_act,y$h_fin_act,bounds="()")))


cal5=ggplot(act_fv |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  geom_rect(data=depl_fv|> filter(id_per %in% sel_per), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  theme_bw()+
  labs(title="Echantillon de calendriers",subtitle="(activités et déplacements non fusionés) ",x="Heure")

# on doit regrouper les déplacements qui on lieu entre les deux même activités 
# ceux-ci ne correspondent qu'a un déplacement pour orange
act_fv.next = act_fv |> select(id_per, id_act_next = id_act,h_deb_act)
act_fv.prev = act_fv |> select(id_per, id_act_prev = id_act,h_fin_act)
depl_fv.gr = depl_fv |> 
  left_join(act_fv.prev,join_by(id_per,closest(x$h_o_sec>=y$h_fin_act))) |>
  left_join(act_fv.next,join_by(id_per,closest(x$h_d_sec<=y$h_deb_act))) |>
  group_by(id_per,id_act_prev,id_act_next) |>
  mutate(dur=h_d_sec-h_o_sec) |>
  reframe(triris_o=first(triris_o),triris_d=last(triris_desc_d),
            triris_o=first(triris_desc_o),triris_desc_d=last(triris_desc_d),
            mot_o=first(mot_o),mot_d=last(mot_d),
            h_o_sec=first(h_o_sec),h_d_sec=last(h_d_sec),
            mode=first(mode,order_by=dur),nbtegt=n())


cal6=ggplot(act_fv |> filter(id_per %in% sel_per))+
  geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
  geom_rect(data=depl_fv.gr|> filter(id_per %in% sel_per), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1))+facet_grid(id_per~.)+
  #geom_text(aes(x=(h_deb_act+h_fin_act)/(2*3600),y=0.5,label=triris_act))+
  facet_grid(id_per~.)+
  scale_y_continuous(breaks=c())+
  scale_x_continuous(breaks=seq(6,26,by=2))+
  scale_fill_manual(guide="none",values = cols)+
  theme_bw()+
  coord_cartesian(xlim=c(4,28))+
  theme_bw()+
  theme_bw()+
  labs(title="Echantillon de calendriers",subtitle="(activités et déplacements fusionés)",x="Heure")

cal5 | cal6

```

## Détection des déplacements au sens FV

```{r, fig.cap="Au final, nous pouvons lister les déplacements détectés, non-détectés et fusionnés."}

depl_fv.merged = depl_fv |> 
  semi_join(depl_fv.gr,join_by(id_per,overlaps(x$h_o_sec,x$h_d_sec,y$h_o_sec,y$h_d_sec,bounds="[]")))


ggplot(act_fv |> filter(id_per %in% sel_per))+
    geom_rect(aes(xmin=h_deb_act/3600,xmax=h_fin_act/3600,ymin=0,ymax=1,fill=factor(triris_act,levels = triris_lev)))+
    geom_rect(data=depl_fv.gr|> filter(id_per %in% sel_per), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1))+
    geom_rect(data=depl_nofv|> filter(id_per %in% sel_per), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1),fill="#d40000") +
    geom_rect(data=depl_fv.merged|> filter(id_per %in% sel_per), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1),fill="#bbbbbb") +
    geom_rect(data=depl_fv.gr|> filter(id_per %in% sel_per,nbtegt==1), aes(xmin=h_o_sec/3600,xmax=h_d_sec/3600,ymin=0,ymax=1))+
    facet_grid(id_per~.)+
    scale_y_continuous(breaks=c())+
    scale_x_continuous(breaks=seq(6,26,by=2))+
    scale_fill_manual(guide="none",values = cols)+
    theme_bw()+
    coord_cartesian(xlim=c(4,28))+
    theme_bw()+
    theme(plot.title = element_markdown(),
          plot.subtitle = element_markdown())+
    labs(title="Echantillon de calendriers",subtitle="(déplacements <span style='color:#d40000'>non détectés</span>,<span style='color:#444444'>détectés</span>, <span style='color:#bbbbbb'>fusionnés</span>)",x="Heure")
```

# Analyse des résultats

<!-- Motifs -->
<!--     0 : Home -->
<!--     1 : Work -->
<!--     2 : Study -->
<!--     3 : Shopping -->
<!--     4 : Personal -->


<!-- Modes (colonne MODP) : -->

<!--     0 : Walking -->
<!--     1 : Bicycle -->
<!--     2 : Private motorized -->
<!--     3 : Public transport -->

## Analyse des résultats
Répartiton des déplacements suivant leurs statut :
```{r}
depl_fv.gr |> mutate(statut=if_else(nbtegt==1,"detectés","fusionés")) |> select(statut,nbtegt) |> bind_rows(depl_nofv|>transmute(statut="non detectés",nbtegt=1))|> count(statut,wt = nbtegt) |> mutate(p=paste(round(n/sum(n)*100),"%"))|> knitr::kable(format="html")
```


## Analyse des résultats
Déplacement non détectés :
```{r}
labs_modes = c("Marche","Vélo","Voiture","TC")
depl_nofv |> group_by(mode) |> summarise(n.missed=n(),duree=round(mean(h_d_sec-h_o_sec)/60))|>
  left_join(depl_egt|>group_by(mode) |> summarise(n=n(),duree=round(mean(h_d_sec-h_o_sec)/60)),by="mode") |>   mutate(pmiss=round(n.missed/n*100))|>mutate(mode=labs_modes[mode+1]) |>knitr::kable(format="html")
```
## Analyse des résultats

```{r}



modes_egt = depl_egt |> mutate(mode=labs_modes[mode+1]) |> group_by(mode) |> summarise(nbt=n()) |> ungroup() |> mutate(source="egt")
modes_fv = depl_fv.gr |> mutate(mode=labs_modes[mode+1]) |> group_by(mode) |> summarise(nbt=n()) |> ungroup() |> mutate(source="fv")
modes = bind_rows(modes_egt,modes_fv)
ggplot(modes) + 
  geom_col(aes(x=factor(mode),y=nbt,fill=source),position = "dodge2") + 
  theme_bw() + 
  scale_fill_brewer("Source : ",palette = "Set1")+
  labs(title="Mode des trajets et représentation dans les deux jeux de données",
       subtitle="l'EMC² et l'EMC² filtré",x="Mode",y="Nombre de déplacements")

od = read_delim("./data/TRIRIS/Data Transport TRIRIS/TRAG_MOBITIC_TRIRIS_2022_septembre/JaJ/2022-09-07/date_heure_1h_Micro_motif.csv",delim=";",locale=locale(decimal_mark = ",")) 

```


## Analyse des résultats
```{r}
#od |> filter(categorie_domicile!="Résident Externe") |> count(TrancheHoraire,wt=Volume)
pr_t=od |> filter(categorie_domicile!="Résident Externe") |> 
  count(TrancheHoraire,wt=Volume) |> 
  mutate(start=c(1,seq(7,23,by=2)),end=seq(7,25,by=2),dur=end-start)  |> 
  mutate(density=n/sum(n)/dur) 
pr_t = bind_rows(pr_t,pr_t[1,]|> mutate(start=25,end=28))
pr_t$start[1]=4

ggplot()+
  geom_density(data=depl_egt,aes(x=h_d_sec/3600),color="#377eb8")+
  geom_density(data=depl_fv.gr,aes(x=h_d_sec/3600),color="#e41a1c")+
  geom_step(data= pr_t,aes(x=start,y=n/dur/sum(n)),color="#555555")+
  theme_bw()+
  xlim(c(4,28))+
  labs(title="Heure de départ des déplacements dans les deux jeux de données",
       subtitle="l'EMC², l'EMC² filtré et FV",x="Heure",y="Densité")

```


## Analyse des résultats
```{r}
gg_duration=bind_rows(depl_egt |> mutate(dur=h_d_sec-h_o_sec,source="egt")|>select(dur,source),depl_fv.gr |> mutate(dur=h_d_sec-h_o_sec,source="fv")|>select(dur,source))

ggplot(gg_duration |> filter(dur<4*3600))+geom_density(aes(x=dur/3600,color=source,group=source)) + theme_bw() + 
  scale_color_brewer("Source : ",palette = "Set1")+  labs(title="Durée des déplacements dans les deux jeux de données", subtitle="l'EMC² et l'EMC² filtré",x="Durée (heures)",y="")
```
  
  
  
## Analyse des résultats

```{r}
labs_motifs = c("Domicile","Travail","Etude","Achat","Autres")

# a faire rajouter les pondérations individuelles
motifs_egt = depl_egt |> group_by(mot_o,mot_d) |> summarise(nbt=n()) |> ungroup() |> mutate(source="egt")
motifs_fv = depl_fv.gr |> group_by(mot_o,mot_d) |> summarise(nbt=n()) |> ungroup() |> mutate(source="fv")
motifs = bind_rows(motifs_egt,motifs_fv) |> mutate(mot_o=labs_motifs[mot_o+1],mot_d=labs_motifs[mot_d+1])
sel_mot = motifs |> filter(source=="egt") |> arrange(desc(nbt)) |> head(8) |> select(mot_o,mot_d)
ggplot(motifs |> semi_join(sel_mot)) + 
  geom_col(aes(y=factor(paste(mot_o,mot_d,sep="-"),levels=paste(sel_mot$mot_o,sel_mot$mot_d,sep="-")),x=nbt,fill=source),position = "dodge2") + 
  theme_bw() + 
  scale_fill_brewer("Source : ",palette = "Set1")+
  labs(title="Couple de motifs et représentation dans les deux jeux de données",
       subtitle="l'EMC² et l'EMC² filtré",y="couple de motif",x="Nombre de déplacements")

```
