-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathconception_t0relation.R
148 lines (109 loc) · 7.53 KB
/
conception_t0relation.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
# un script qui reprend toutes les fonctions et operations pour produire t0relation
# 14/01/2020
# col&mon
# Lecture des fichiers sources
implantation.dat <- readRDS("data/T0impl20191126.rds")
fait.dat <- readRDS("data/T0New20191126.rds")
# indexage est une liste contenant les variables pour indexer
# tout n'utilise malheureusement pas cet indexage
Indexage <- list(filtrerelation = "caracNew", # le premier item est juste caracNew
# il est utile pour filtrer relation
# ici c'est la liste de pas mal de variables utiles
selectrelation = c("idfactoid", "idimplantation", "usual_name", "fklinked_implantation","linked_implantation_name",
"modaNiv1", "lat", "lng", "date_startC","date_stopC"),
# le nom du debut et fin des relations
buffer = c("date_startC","date_stopC"),
# les identifiants de A ---- B
ident_relation = c("idimplantation", "fklinked_implantation"))
# 1 - une fonction pour filtrer les relations =================
filtrer_relation_select <- function(T0new, selection = names(T0new)) {
if(!is.data.frame(T0new)){stop("La fonction nécessite un tableau et non un.e", class(T0new) ,"." )}
subset(fait.dat, fait.dat[[Indexage[["filtrerelation"]]]] == "Relations", select = selection) # au besoin peut être utiliser Indexage[[2]] pour : selection = Indexage[[2]]
}
T0relation <- filtrer_relation_select(fait.dat, selection = Indexage[["selectrelation"]])
# 2. Renforcement du jeux de données T0News ====================
# 2.a Ajout de role ============================
T0relation$role <- NA
T0relation$role[T0relation$modaNiv1 == "hiérarchique ascendante"] <- "Dominé"
T0relation$role[T0relation$modaNiv1 == "hiérarchique descendante"] <- "Dominant"
T0relation$role[T0relation$modaNiv1 == "Relation horizontale"] <- "Égal"
T0relation$role[T0relation$modaNiv1 == "hiérarchique desc. Ecole"] <- "Dominant_ecole"
#2.b Calcul des degrés pour les difŕents reseaux =======
# ici on fait un identifiant pour chaque couple de liens et on filtre pour ne pas voir les doublons idimplantation --- fklinkedimplantation
T0relation <- T0relation %>%
mutate(lien_id = paste(idimplantation, fklinked_implantation)) %>%
distinct(lien_id, .keep_all = TRUE) %>%
select(-lien_id)
print("Attention : les doublons idimplantation ---- fklinked_implantation ne sont pas gardés")
# comptage des liens par type de modaNiv1
hiérarchique_descendante <- subset(T0relation, T0relation$modaNiv1 == "hiérarchique descendante") %>%
group_by(idimplantation) %>%
summarize(degre_dominant = n())
Relation_horizontale <- subset(T0relation, T0relation$modaNiv1 == "Relation horizontale") %>%
group_by(idimplantation) %>%
summarize(degre_association = n())
degre_ecole <- subset(T0relation, T0relation$modaNiv1 == "hiérarchique desc. Ecole") %>%
group_by(idimplantation) %>%
summarize(degre_ecole = n())
T0relation <- T0relation %>%
left_join(hiérarchique_descendante, by = "idimplantation") %>%
left_join(Relation_horizontale, by = "idimplantation") %>%
left_join(degre_ecole, by = "idimplantation" )
rm(hiérarchique_descendante, Relation_horizontale, degre_ecole)
# 2.c Calculer la distance entre deux implantations liées (pour la portée) ==============================================
distance_entre_implantation <- function(relation, selection = names(relation)){
# chargement des packages, pe cela n'est pas utile
if(require("dplyr") == FALSE)
install.packages("dplyr", dependencies=c("Depends", "Suggests"))
if(require("sf") == FALSE)
install.packages("sf", dependencies=c("Depends", "Suggests"))
# un subset au besoin
relation.temp <- subset(relation, select = selection)
Relation_renomer <- dplyr::rename(relation.temp, # rename est pas mal utilisé donc on precise la library, il y a une dépendance sur dplyr
idimpl_link = fklinked_implantation, # ici on prend l'id lié
usual_name_link = linked_implantation_name) # idem pour le nom lié
# je vais decouper un peu le pipe d'Hélène avec une table produite pour la jointure
# qui va comporter les lat/long des implantations liées
implantation_renomer <- relation.temp %>%
dplyr::select( idimpl_link = idimplantation, # selon la doc on peut directement renomer dans un select
lat_link = lat,
lng_link = lng) %>%
dplyr::distinct(idimpl_link, .keep_all = TRUE)
# Jointure via idimpl_link
relation_total.dat <- dplyr::left_join(Relation_renomer, implantation_renomer, by = "idimpl_link")
# Suppression des fichiers intermediaires
rm(Relation_renomer, implantation_renomer)
# si il y a des valeurs manquantes on les drop
relation_total.dat <- dplyr::filter(relation_total.dat, !is.na(lat) & !is.na(lat_link)) # pourra être supprimé quand la base sera "propre"
# matrice de départ
from.dat <- as.matrix( # on passe tout dans une matrice
dplyr::select(relation_total.dat, lng, lat)) # on selectionne les lat long
#matrice d'arrivé
to.dat <- as.matrix(
dplyr::select(relation_total.dat, lng_link, lat_link) )
relation_total.dat$geometry <- do.call(sf::st_sfc, # on fait une fonction sfc
lapply( # on fait un apply sur chaque lignes
1:nrow(relation_total.dat),
function(i){
sf::st_linestring( # qui va tracer des lignes
matrix( # en prenant les points dans des matrices de from a to
c(from.dat[i,], to.dat[i,]), ncol=2, byrow=TRUE) # composé du couple de point de départ et arrivé
)}))
# Supression des deux matrices intermediaires
rm(from.dat, to.dat)
# Pasage en en sf
relation_total.shp <- sf::st_transform( # on va transformer en 2154
sf::st_as_sf(relation_total.dat, sf_column_name = "geometry", crs = 4326), # ici on fait onjet sf avec la colonne geometry et le crs de base qui était 4326
2154)
# on retire relation_total.dat)
rm(relation_total.dat)
# calcul de la distance
relation_total.shp$distance_km <- round( # on va arrondir le résultats à 2 chiffres
as.numeric( # je drop units,
sf::st_length(relation_total.shp)/1000), 0) # on passe en km
# on rename idimpl_link pour fklinked
relation_total.shp <- dplyr::rename(relation_total.shp, fklinked_implantation = idimpl_link)
return(relation_total.shp)
}
T0relation <- distance_entre_implantation(T0relation)
saveRDS(T0relation, file = "data/T0relation.rds")