rapport_nouvelle_base.Rmd

---
title: "Rapport suite à un nouveau chargement de la base fusion"
author: "olivier-Helene"
date: "22 janvier 2020"
output: 
    bookdown::html_document2:
        theme: readable
        toc: true
        toc_float: true
        number_sections: true
        fig_caption: yes
        code_folding: hide
---


```{r setup, include = FALSE}
library(tidyr)
library(dplyr) # manip données
library(ggplot2) #  graphiques
library(plotly) # graphiques un peu interactif
library(sf)
library(igraph) 
library(crosstalk) # lier des graphs/tableau
library(threejs) # visu 3d 
library(DT) # widget de table
library(waffle) # pie chart en gauffre
```


# Chargement des données

Faut-il prendre en compte un T0new + 1 et un T0new ? 

Plutôt que de reprendre le script de production de `conception_t0relation.R`, je suis parti d'un import spécifique. La première raison est de vouloir garder les doublons idimplantations --- fklinked_implantations car ici il est prévu de poduire les statistiques decriptives sur un pas de temps de 100 ans permettant vraisemblablement d'éviter les doublons. La seconde raison est de travailler avec une colonne geometry uniquement au besoin pour alléger les calculs et éviter l'utilisation de méthodes pour ces objets pas toutes optimisées. Enfin, il y a des relations dont l'implantation n'a pas de lat/lng. 


```{r import_donnee}
#source("conception_t0relation.R")
T0relation <- readRDS("data/T0Newchgt20200122.rds") %>% 
    # filtre sur les relations
    filter(caracNew == "Relations") %>% 
    # pas les déplacement
    filter(modaNiv1 != "Déplacement") %>%
    # on garde un nombre limité de champs
    select(idfactoid, # id du factoid
           idimplantation, # id de l'implantation
           usual_name, # nom de l'implantation
           modaNiv1, # modalité du type relation ex : Relation horizontale
           fklinked_implantation, # id de l' implantation lié, dans le cas d'un choix de graph dirigé idimplantation ---> fklinked_implantation
           linked_implantation_name, # nom de l'implantation lié
           lat, # lat de l'idimplantation
           lng, # lng de l'idimplantation
           date_startC, # date de debut de la relation
           date_stopC # date de fin de la relation
           )


# chargement des couleurs de la visualisation pour les graphiques 
CaracHist <-readxl::read_excel("data/NewModelCaracModalitesColor5.xlsx",
                              sheet = "color")
ColRelations <- filter(CaracHist, caracNew == "Relations") %>% 
                    select(modaNiv1, modaNiv1_Color) %>% 
                    filter(!is.na(modaNiv1_Color)) %>% 
                    distinct(modaNiv1, .keep_all = TRUE) %>% 
                    arrange(modaNiv1)

T0relation <- T0relation %>% 
    left_join(ColRelations, by ="modaNiv1")

rm(CaracHist)
```

# Niveau global

## Modalité des relations

On obtient `r nrow(T0relation)` factoides avec une `relation`. Le tableau \@ref(tab:modalite) donne les fréquences par type de liens (`modaNiv1`). Les relations peuvent être hiérarchiques ou horizontales, dans les cas hiérarchique, elles peuvent être ascendantes et descendantes. Elles peuvent ensuite être ascendantes/descendantes vers une école ou vers un autre type d'implantations. 

(ref:modalite-caption) Distribution des fréquences par type de liens

```{r, modalite}
knitr::kable(t(table(T0relation$modaNiv1)),
             caption = "(ref:modalite-caption)")
```

La figure \@ref(fig:date-modalite) regroupe les relations sur un pas de temps de 100 ans pour les trois modalités : hiérarchique descendante, Relation horizontale et hiérarchique desc. Ecole. 

(ref:date-modalite) Répartition des dates de début par tranches de 100 ans en fonction des modes d'agrégation 

```{r, date-modalite, fig.cap="(ref:date-modalite)",  warning=FALSE}
# date de début car moins de pb que fin
# attention les couleurs sont en durs
modalite_h_descendante <- ggplot(T0relation[T0relation$modaNiv1 == "hiérarchique descendante",], aes(date_startC)) +
    geom_freqpoly(binwidth = 100, colour = "#3182bd") + 
    labs(x = "", y = "") +
    theme_bw()

modalite_r_horizontale <- ggplot(T0relation[T0relation$modaNiv1 == "Relation horizontale",], aes(date_startC)) +
    geom_freqpoly(binwidth = 100, colour = "#31a354") + 
    labs(x = "", y = "") +
    theme_bw()

modalite_h_ecole <- ggplot(T0relation[T0relation$modaNiv1 == "hiérarchique desc. Ecole",], aes(date_startC)) +
    geom_freqpoly(binwidth = 100, colour = "#dd1c77") + 
    labs(x = "", y = "") +
    theme_bw()

# c'est du js
f <- list(
  family = "Courier New, monospace",
  size = 18,
  color = "#7f7f7f"
)
x <- list(
  title = "date_startC (pas de 100 ans)",
  titlefont = f
)
y <- list(
  title = "décompte",
  titlefont = f
)
subplot(ggplotly(modalite_h_descendante) %>% 
    layout(xaxis = x, yaxis = y),
    ggplotly(modalite_r_horizontale) %>% 
    layout(xaxis = x, yaxis = y),
        ggplotly(modalite_h_ecole) %>% 
    layout(xaxis = x, yaxis = y))
rm(modalite_h_descendante, modalite_r_horizontale, modalite_h_ecole, f, x, y)
    
```


## Stats sur degré globale et par type

NB : pour le moment on est pas en degré cumulé

Le tableau de contingence (\@ref(tab:degregobaletype)) reprend le nombre d'implantation répartie par type de relation et par degré.  


```{r, degregobaletype, results='asis'}
implantation_relation <- T0relation %>% 
    group_by(idimplantation, modaNiv1) %>% # on groupe par usual name et modaNiv1
    summarize(nb = n()) %>%  # on compte par ce group
    arrange(desc(nb))  # on passe en decroissant

degre_gobale_type <- as.data.frame.matrix(t(table(implantation_relation$modaNiv1, implantation_relation$nb)))
degre_gobale_type$Degré <- row.names(degre_gobale_type)

cat("<Tableau>",paste0("<caption>", "(#tab:degregobaletype)", ' Contingences d\'implantations par degré et type de relation', "</caption>"),"</tableau>", sep ="\n")
DT::datatable(degre_gobale_type , rownames = FALSE)
rm(degre_gobale_type, implantation_relation)
```

## Stats des durées par type

```{r}
# pour les durées il faut ne pas garder les NA dans date_start et stop et calculer 
T0relation_sans_NA <- T0relation %>% 
    filter(!is.na(date_startC)) %>% 
    filter(!is.na(date_stopC)) %>% 
    mutate(durée = date_stopC - date_startC) %>% 
    filter(durée >=  0)
```


Il y a `r nrow(T0relation_sans_NA[T0relation_sans_NA$durée != 0,])` relations ou la durée est nulle. Les autres cas sont representés par la figure \@ref(fig:durremodalite). (attention on doublonne pour les relations hiérarchiques)


(ref:durremodalite) Boites à moustaches des durées en fonction des modalités de relation

```{r durremodalite, fig.cap="(ref:durremodalite)"}
f <- list(
  family = "Courier New, monospace",
  size = 18,
  color = "#7f7f7f"
)

y <- list(
  title = "Durée (années)",
  titlefont = f
)

T0relation_sans_NA <- T0relation_sans_NA[T0relation_sans_NA$durée != 0,]

plot_ly(T0relation_sans_NA, y = ~durée, color = ~modaNiv1, type = "box", colors = ColRelations$modaNiv1_Color, 
        text = paste(T0relation_sans_NA$usual_name, T0relation_sans_NA$modalite, T0relation_sans_NA$linked_implantation, sep = "\n")) %>% 
layout(yaxis = y)   

rm(f, y, T0relation_sans_NA)

```

## Composantes connexes 

```{r compconnexe1}
# filtre des ascendantes
relation <- subset(T0relation, !(T0relation$modaNiv1 == "hiérarchique asc. Ecole" | T0relation$modaNiv1 == "hiérarchique ascendante") ) %>% 
    # attention c'est important d'avoir les deux premières colonnes qui indiquent les liens A ---- B 
    select(idimplantation, fklinked_implantation, usual_name, linked_implantation_name,modaNiv1, idfactoid)

#graph
partA <- relation %>% 
    select(idimplantation, usual_name)

idimpl_nom <- relation %>% 
    select(idimplantation = fklinked_implantation, usual_name = linked_implantation_name) %>% 
    bind_rows(partA) %>% 
    distinct(idimplantation, .keep_all = TRUE)

rm(partA)

# c'est ici la magie qui permet d'aller chercher les idimplantion/noms dans idimpl et de les mettre dans le meme ordre 
# que les vertices du graph, bien verifier le comportement de match
vertex_v1 <-  idimpl_nom[match(unique(c(relation$idimplantation, relation$fklinked_implantation)), 
                               idimpl_nom$idimplantation),]

graph_relation <- graph.data.frame(relation, directed = FALSE, vertices = vertex_v1)

# components renvoie une liste comportant le nombre de composantes connexes, la taille de chacune d'entre elles et l'appartenance ds 
# vertex, $membership est utile pour savoir a quelle comp connexe apartient un vertex
comps_vertex <- components(graph_relation)
```


Pour les points suivants je n'ai pas gardé les `hiérarchique asc. Ecole` ni les `hiérarchique ascendante` car elles doublonnaient avec leur vis à vis descendantes. On obtient `r comps_vertex$no` composantes connexes. Le tableau \@ref(tab:compconne2) les recense en fonction de leur taille (nombre de vertex et liens ou diamètre) et la figure \@ref(fig:taillecompconnexe) montre la proportion du nombre de liens occupée par ces composantes connexes. id_vertex_prim : correspond aux vertexes (idimplantation) avec le plus haut degré dans la composantes connexes. En cas d'egalité, suivez mon regard les reseaux de deux vertex, c'est le premier qui est pris. 

```{r compconne2,  results='asis'}
# decompose.graph divise le graph principal en sous graph par composantes connexes et les renvoies sous forme de liste
comps <- decompose.graph(graph_relation)
comps_synthese <- data.frame(Id_comps = 1:comps_vertex$no, Nb_vertex = sapply(comps, vcount))
comps_synthese$Nb_liens <- sapply(comps, ecount)
comps_synthese$Diamètre <- sapply(comps, diameter)

# une fonction pour connaitre l'id d'un graph avec le plus haut degre
plus_gros_vertex <- function(un_graph) {
# on va chercher l'id
un_Id <- which(degree(un_graph) == max(degree(un_graph)))
# on le retourne
V(un_graph)[un_Id]
}

# le vertex le plus gros
comps_synthese$Id_vertex_prim <- names(sapply(sapply(comps, plus_gros_vertex), `[`, 1)) 

# son nom
comps_synthese$Usual_name <- idimpl_nom$usual_name[match(comps_synthese$Id_vertex_prim, idimpl_nom$idimplantation)]

comps_synthese <- comps_synthese %>% 
    mutate(Taille_réseau = case_when(
                            Nb_vertex > 100 ~ "]100+ vertex",
                            Nb_vertex <= 100 & Nb_vertex > 25 ~ "]25;100] vertex",
                            Nb_vertex <= 25 & Nb_vertex > 10 ~ "]10;25] vertex",
                            Nb_vertex <= 10 & Nb_vertex > 5 ~ "]5;10] vertex",
                            Nb_vertex <= 5 & Nb_vertex > 2 ~ "]2;5] vertex",
                            Nb_vertex == 2 ~ "2 vertex"))
# reorganisation pour le visuel 
comps_synthese <- comps_synthese %>% 
    select(Id_vertex_prim, Usual_name, Nb_vertex, Nb_liens, Taille_réseau,-Id_comps)


cat("<Tableau>",paste0("<caption>", "(#tab:compconne2)", ' Les compossantes connexes et leurs principales caractéristiques', "</caption>"),"</tableau>", sep ="\n")
DT::datatable(comps_synthese, rownames = FALSE)

```

(ref:taillecompconnexe) Repartition (en %) du nombre de liens par taille de réseau

```{r taillecompconnexe, fig.cap="(ref:taillecompconnexe)", fig.align="center"}
type_reseau <- comps_synthese %>%
    group_by(Taille_réseau) %>% 
    summarize(total_edge = sum(Nb_liens)) %>% 
    mutate(percent_edge = round(total_edge/sum(total_edge),2)*100)

type_reseau$Taille_réseau <- factor(type_reseau$Taille_réseau, levels = c("2 vertex", "]2;5] vertex", "]5;10] vertex", "]10;25] vertex", "]25;100] vertex", "]100+ vertex"),ordered = TRUE)

proportion_reseau <- type_reseau$percent_edge[c(6, 3, 5, 1, 4, 2)]
names(proportion_reseau) <- type_reseau$Taille_réseau[c(6, 3, 5, 1, 4, 2)]

waffle::waffle(proportion_reseau, 5, legend_pos = "bottom", xlab = "1 carré = 1% de liens")
rm(type_reseau, proportion_reseau)
    
```



## Exploration du graphe


```{r, fig.align="center"}

# ici on fait un fichier pour avoir les idimplantation et leurs noms, c'est un besoin pour qualifier les vertex
partA <- relation %>% 
    select(idimplantation, usual_name)

idimpl_nom <- relation %>% 
    select(idimplantation = fklinked_implantation, usual_name = linked_implantation_name) %>% 
    bind_rows(partA) %>% 
    distinct(idimplantation, .keep_all = TRUE)

rm(partA)

# c'est ici la magie qui permet d'aller chercher les idimplantion/noms dans idimpl et de les mettre dans le meme ordre 
# que les vertices du graph, bien verifier le comportement de match
vertex_v1 <-  idimpl_nom[match(unique(c(relation$idimplantation, relation$fklinked_implantation)), 
                               idimpl_nom$idimplantation),]

graph_relation <- graph.data.frame(relation, directed = FALSE, vertices = vertex_v1)
# components renvoie une liste comportant le nombre de composantes connexes, la taille de chacune d'entre elles et l'appartenance ds 
V(graph_relation)$comps <- as.numeric(membership(components(graph_relation)))
# centralité intermediaire / eigenvector
V(graph_relation)$centralite_int <- estimate_betweenness(graph_relation, cutoff = -1)
# V(graph_relation)$centralite_eigen <- eigen_centrality(graph_relation)
# je ne l'ai pas garde car pas sur que la matrice soit asymetrique 
# couleur grise pour les nodes
V(graph_relation)$colorV <- "gray60"

# création et renfonrcement d'un df pour l'objet sharedData
temp_sd <- data.frame(Id = V(graph_relation)$name, Noms = V(graph_relation)$usual_name)
temp_sd$Degré <- degree(graph_relation, v = V(graph_relation))
temp_sd$Centralité <- round(V(graph_relation)$centralite_int, 2)
#temp_sd$centralite_eigen <-  V(graph_relation)$centralite_eigen

# on passe en shared data pour partager le brush de graphjs et un DT
sd = SharedData$new(temp_sd)

graphjs(graph_relation,
            vertex.label = paste(V(graph_relation)$usual_name, V(graph_relation)$name), # il faut usual name
            vertex.color = V(graph_relation)$colorV, # il faut colorV
            vertex.size = 0.2, # pe modifier par degree
            brush=TRUE, 
            crosstalk=sd, 
            width=800)

datatable(sd, rownames = FALSE,  width = 800)

rm(temp_sd, comps, comps_synthese, comps_vertex, vertex_v1, sd, relation)

```

# Divisions temporelles

```{r segmentationtemporelle}
# on vire les NA 
T0relation <- T0relation[!is.na(T0relation$date_startC),]

#duplication par pas de temps
T0relation_all <- merge(T0relation, 
                        seq(0,1800,100),
                        all = TRUE)
# un nom plus cool 
names(T0relation_all)[names(T0relation_all) == "y"] <-  "interval_inf"

# interval_sup
T0relation_all$interval_sup <- T0relation_all$interval_inf + 100

# on fait un nouveau tableau ou existe une relation qui est dans la durée
T0relation_filtre <- dplyr::filter(T0relation_all, interval_sup > date_startC) %>% 
                        dplyr::filter(interval_inf <= date_stopC) %>% 
                        dplyr::mutate(interval = (interval_inf + interval_sup)/2)

# on refait un "relation" avec interval et prenant en compte des relations en plus 
relation <- subset(T0relation_filtre, !(T0relation_filtre$modaNiv1 == "hiérarchique asc. Ecole" | T0relation_filtre$modaNiv1 == "hiérarchique ascendante") ) %>% 
    # attention c'est important d'avoir les deux premières colonnes qui indiquent les liens A ---- B 
    dplyr::select(idimplantation, fklinked_implantation, usual_name, linked_implantation_name, modaNiv1, interval, idfactoid) 

# on refait un indice des vertexes

partA <- relation %>% 
    select(idimplantation, usual_name)

idimpl_nom <- relation %>% 
    select(idimplantation = fklinked_implantation, usual_name = linked_implantation_name) %>% 
    bind_rows(partA) %>% 
    distinct(idimplantation, .keep_all = TRUE)

# c'est ici la magie qui permet d'aller chercher les idimplantion/noms dans idimpl et de les mettre dans le meme ordre 
# que les vertices du graph, bien verifier le comportement de match
vertex_v1 <-  idimpl_nom[match(unique(c(relation$idimplantation, relation$fklinked_implantation)), 
                               idimpl_nom$idimplantation),]

g.relation <- graph.data.frame(relation[, c("idimplantation", "fklinked_implantation", "interval", "modaNiv1")], vertices = vertex_v1, directed = FALSE)

# un vecteur d'interval
interval <-  sort(unique(T0relation_filtre$interval))[
  1:length(unique(T0relation_filtre$interval))
  ]/50

### on applique un filtre en selectionnant les edges comprises dans un interval 
# attention il y a un simplify brut à pe affiner
g.relation.100 <- lapply(interval, function(i) {
    g <- subgraph.edges(g.relation, E(g.relation)[interval > 50 * (i-1) &  interval <= 50 * i],
                        delete.vertices=TRUE) # Ici il faut changer si on veut garder les vertexes sans lien 
    # et fait un simplify
    simplify(g)
})

rm(T0relation_all, partA, T0relation_filtre, vertex_v1)
```

En prenant un interval de 100 ans cenrtré sur 50 on obtient `r length(interval)` classes et l'on peut faire un graphe particulier pour chacune d'elles.

Attention, Id_vertex_prim et Usual_name indique le Vertex avec le plus haut degré et par defaut en cas d'egalité en degré je prend juste le premier vertex (Id_vertex_prim). Ici, c'est pour l'ensemble du graphe et pas comme plus haut dans une composante connexe. 

```{r tableauevolgraph}

tableauevolgraph <- data.frame(Interval_temp = interval * 50, Nb_comp = sapply(g.relation.100, count_components))
tableauevolgraph$Nb_vertex <-  sapply(g.relation.100, vcount)
tableauevolgraph$Nb_liens <- sapply(g.relation.100, ecount)
tableauevolgraph$Diamètre <- sapply(g.relation.100, diameter)
tableauevolgraph$Id_vertex_prim <- names(sapply(sapply(g.relation.100, plus_gros_vertex), `[`, 1))
tableauevolgraph$Usual_name <-  idimpl_nom$usual_name[match(tableauevolgraph$Id_vertex_prim, idimpl_nom$idimplantation)]
DT::datatable(tableauevolgraph, rownames = FALSE,  width = 800, options = list(pageLength = length(interval)))
```