Arbres-gbif.Rmd

Une forêt de données:

Enrichir ses données à l’aide des catalogues de données ouvertes et des interfaces de programmation publiques

Ce projet utilise des données provenant du catalogue de données de la Ville de Québec. Ces données sont disponibles sous la version 4.0 de la licence Creative Commons Attribution.

L’objectif de ce projet est de tirer un maximum d’information du jeu de données Arbres répertoriés.

Chargement du jeu de données

Le jeu de données contient 122825 observations de 16 variables.

Classe de chaque variable

Le tableau suivant décrit la classe attribuée par R à chaque variable.

Variable	Classe
TYPE_LIEU	character
NOM_LAT	character
NOM_FR	character
TYPE_ARBRE	character
DIAMETRE	integer
POS_MESURE	character
MULTI_TRONC	character
DATE_PLANTE	POSIXct
TYPE_PROP	character
LONGITUDE	numeric
LATITUDE	numeric
GENERIQUE	character
LIAISON	character
SPECIFIQUE	character
DIRECTION	character
NOM_TOPO	character

Exploration de base du jeu de données

Description des variables qualitatives

TYPE_LIEU

Valeur	Fréquence
Voie publique	73126
Lieu public	49698
Non disponible	1
NA	0

NOM_LAT

Valeur	Fréquence
Ulmus americana	14351
Acer platanoides	10901
Acer saccharinum	7743
Fraxinus pennsylvanica	7363
Quercus rubra	4920
Tilia cordata	3509
Syringa reticulata ‘Ivory Silk’	3487
Picea glauca	3004
Ulmus ‘Morton Accolade’	2848
Acer rubrum	2628

NOM_FR

Valeur	Fréquence
orme d’Amérique	14351
érable de Norvège	10901
érable argenté	7743
frêne rouge	7363
chêne rouge	4920
tilleul à petites feuilles	3509
lilas Japonais ‘Ivory Silk’	3487
épinette blanche	3004
orme ‘Morton Accolade’	2848
érable rouge	2628

TYPE_ARBRE

Valeur	Fréquence
Feuillu	109765
Conifère	13043
NON DISPONIBLE	17
NA	0

POS_MESURE

Valeur	Fréquence
DHP	87549
DHS	27426
M	7835
	15
NA	0

MULTI_TRONC

Valeur	Fréquence
N	115222
O	7526
ND	77
NA	0

TYPE_PROP

Valeur	Fréquence
Public	93804
Privés	14544
Public:Terrain Privé	3917
Privés:OMHQ	2102
Public:Arbre mitoyen	1681
Privés:Frais Partagé	1331
Privés:C.S. de la Capitale	900
Public:Parc-École	713
Cas Spéciaux	600
Public:Entretenu Par La Ville	578

GENERIQUE

Valeur	Fréquence
Rue	43252
Parc	21339
Îlot	18276
Avenue	14968
Boulevard	7651
Chemin	2276
Piste cyclable	2210
Parc linéaire	1944
Bassin de rétention	1507
Parc-école	1259

LIAISON

Valeur	Fréquence
	81197
des	10566
de la	9546
du	8353
de	7244
de l’	5240
d’	469
aux	60
l’	56
les	51

SPECIFIQUE

Valeur	Fréquence
Rivière Saint-Charles	1940
Robert-Bourassa	1214
Corridor des Cheminots	931
Plage-Jacques-Cartier	918
Victoria	917
Exposition	880
Arboretum	775
Sainte-Foy	723
Saint-Louis	688
Pointe-aux-Lièvres	571

DIRECTION

Valeur	Fréquence
	116985
O	3031
E	2597
N	159
S	53
NA	0

NOM_TOPO

Valeur	Fréquence
Parc linéaire de la Rivière Saint-Charles	1940
Ilot Robert-Bourassa	1214
Piste cyclable Corridor des Cheminots	931
Parc Victoria	917
Parc de la Plage-Jacques-Cartier	905
Parc de l’Exposition	880
Parc de l’Arboretum	775
Chemin Saint-Louis	660
Domaine de Maizerets	539
Parc de la Pointe-aux-Lièvres	523

Description des variables quantitatives

Valeur	Fréquence
moyDIA	24.84
minDIA	0
maxDIA	958
minLON	-71.54
minLAT	46.72
maxLON	-71.15
maxLAT	46.94

minDATE	maxDATE
1951-12-31	2016-11-13

On remarque entre autres qu’il y a des erreurs dans les données de diamètres. Certaines valeurs semblent inscrites en millimètres.

Distributions

Diamètre des arbres

range <- quantile(dA$DIAMETRE,probs=c(0.02,0.98), na.rm=TRUE)
ggplot(data = (dA %>% filter(range[1] <= DIAMETRE & DIAMETRE < range[2] & POS_MESURE != "")),
       mapping = aes(x = DIAMETRE, fill=POS_MESURE)) + geom_histogram() + facet_wrap("POS_MESURE")

Date de plantation

ggplot(data = dA %>% filter(TYPE_ARBRE != "NON DISPONIBLE"), mapping = aes(x = DATE_PLANTE, fill=TYPE_ARBRE)) + geom_histogram() + facet_wrap("TYPE_ARBRE")

Enrichissement des variétés d’arbres

J’utilise les données provenant du http://www.gbif.org

J’extrais d’abord les noms latins des espèces présentes dans la table avec build_name pour construire les URL de requêtes. Puis, je vais les requêtes en lot avec un mapply sur la fonction get_url_gfib.

get_url_gfib <- function(x) 
  httr::GET(url=paste0("http://api.gbif.org/v1/species/match/?name=",x))

build_name <- function(x) 
  gsub(pattern = " ", 
      replacement = "+", 
      x %>% 
        strsplit("'") %>% 
        unlist %>% 
        '['(1) %>% 
        trimws())

## Noms uniques (incluant la variété locale)
nomsUniques <- 
  dA %>% 
  select(NOM_LAT) %>% 
  distinct() %>% 
  mutate(nom_url = sapply(NOM_LAT,build_name) %>% 
                  tolower())

## Noms uniques pour construire les URL (excluant la variété locale qui ne se trouve pas dans GFIB)
nomsUrlUniques <- 
  nomsUniques %>% 
  select(nom_url) %>%
  distinct()

#data_json_gfib <- t(sapply(nomsUrlUniques$"nom_url",get_url_gfib))
#save(data_json_gfib,file="data_json_gfib.RData")

Je transforme ensuite les données recueillies dans le format JSON en une table que je pourrai joindre aux données source.

load("data_json_gfib.RData")
json_content <- sapply(data_json_gfib %>% 
                         as.data.frame %>% 
                         '$'(content),rawToChar) 
json_content2 <- data.frame(nom_url = names(json_content), 
                            json_content, row.names = NULL, stringsAsFactors = FALSE)
json_content3 <- json_content2$json_content %>% 
  lapply(fromJSON, flatten=TRUE) %>% 
  lapply(as.data.frame) %>% 
  (function(x) do.call(smartbind,x)) %>% 
  cbind(nom_url=json_content2$nom_url)
json_content4 <- merge(json_content3, nomsUniques, by=c("nom_url"))

Je peux maintenant joindre ces nouvelles informations aux données source

dA2 <- dA %>% partition() %>% merge(json_content4,by=c("NOM_LAT")) %>% collect()

Médias par espèces

get_url_media <- function(x) 
  httr::GET(url=paste0("http://api.gbif.org/v1/species/",x,"/media"))

disct_speciesKey <- dA2 %>% select(speciesKey) %>% filter(!is.na(speciesKey)) %>% distinct()
  
#json_media <- t(sapply(disct_speciesKey$speciesKey,get_url_media))
#save(json_media,file="json_media.RData")
load("json_media.RData")

json_media1 <- data.frame(json_content = sapply(json_media %>% 
                         as.data.frame %>% 
                         '$'(content),rawToChar), stringsAsFactors = FALSE)  %>% 
  mutate(json_content1 = json_content %>% lapply(fromJSON, flatten=TRUE) %>% sapply('[',"results"))

json_media1$speciesKey <- disct_speciesKey

json_media2 <- json_media1[lapply(json_media1$json_content1,class) == 'data.frame',] 

json_media3 <- json_media2 %>% 
  '$'(json_content1) %>% 
  sapply(as.data.frame) %>% 
  reshape2::melt() %>% 
  select(value, type, format, identifier, references, title, description, source, creator, publisher, license) %>% 
  distinct(value)

json_media4 <- cbind(json_media3,json_media2$speciesKey)

Joindre les données médias

dA3 <- merge(dA2,json_media4,all.x = TRUE)

Ajout du quartier et de l’arrondissement

qrtqc <- readOGR("QUARTIERS/", layer="QUARTIER") %>% spTransform(CRS("+proj=longlat +datum=WGS84"))

## OGR data source with driver: ESRI Shapefile 
## Source: "QUARTIERS/", layer: "QUARTIER"
## with 35 features
## It has 3 fields

arrqc <- readOGR("ARROND/", layer="ARROND") %>% spTransform(CRS("+proj=longlat +datum=WGS84"))

## OGR data source with driver: ESRI Shapefile 
## Source: "ARROND/", layer: "ARROND"
## with 6 features
## It has 5 fields

names(qrtqc@data) <- paste0(names(qrtqc@data),"_QRT")
names(arrqc@data) <- paste0(names(arrqc@data),"_ARR")

coordinates(dA3) = ~ LONGITUDE + LATITUDE
proj4string(dA3) = CRS("+proj=longlat +datum=WGS84")

dA4.1 <- dA3 %>% over(qrtqc) %>% cbind(dA3@data)
dA4 <- dA3 %>% over(arrqc) %>% cbind(dA4.1) %>% cbind(dA3@coords)
save(dA4,file="dA4.RData")
readr::write_csv(dA4,"arbres-augmented.csv")

Arbre le plus courant par quartier (ayant une photo disponible)

count_arbre_arr <- dA4 %>% filter(identifier != "" & !is.na(NOM_QRT)) %>% select(NOM_QRT, scientificName, identifier) %>% group_by(NOM_QRT, scientificName, identifier) %>% summarise(freq=n()) %>% group_by(NOM_QRT) %>% top_n(n=1)

pandoc.table(count_arbre_arr %>% select(NOM_QRT, scientificName, freq))

NOM_QRT	scientificName	freq
Cap-Rouge	Ulmus americana L.	978
Chutes-Montmorency	Acer saccharinum L.	429
Cité Universitaire	Ulmus americana L.	484
Des Châtels	Acer platanoides L.	1211
Duberger-Les Saules	Acer platanoides L.	3132
Jésuites	Acer saccharinum L.	399
Lac-Saint-Charles	Ulmus americana L.	317
L’Aéroport	Ulmus americana L.	649
Lairet	Acer platanoides L.	1075
Loretteville	Acer platanoides L.	370
Maizerets	Fraxinus pennsylvanica Marsh.	1465
Montcalm	Ulmus americana L.	610
Neufchâtel-Est/Lebourgneuf	Acer platanoides L.	2431
Notre-Dame-des-Laurentides	Ulmus americana L.	364
Plateau	Acer platanoides L.	319
Pointe-de-Sainte-Foy	Acer platanoides L.	443
Quartier 4-2	Ulmus americana L.	317
Quartier 4-3	Acer platanoides L.	169
Quartier 4-5	Acer platanoides L.	467
Quartier 4-6	Acer platanoides L.	257
Quartier 5-1	Acer platanoides L.	141
Quartier 5-2	Acer platanoides L.	306
Quartier 5-4	Ulmus americana L.	509
Saint-Émile	Acer platanoides L.	326
Saint-Jean-Baptiste	Ulmus americana L.	292
Saint-Louis	Acer platanoides L.	513
Saint-Roch	Acer platanoides L.	436
Saint-Sacrement	Acer platanoides L.	575
Saint-Sauveur	Ulmus americana L.	693
Sillery	Ulmus americana L.	1422
Val-Bélair	Acer platanoides L.	460
Vanier	Fraxinus pennsylvanica Marsh.	418
Vieux-Limoilou	Acer platanoides L.	634
Vieux-Moulin	Acer platanoides L.	202
Vieux-Québec/Cap-Blanc/Colline parlementaire	Ulmus americana L.	718

count_arbre_arr %>% mutate(image=paste0("[",scientificName,"](",identifier,")")) %>% select(NOM_QRT, image) %>% t %>% pandoc.table()

Table continues below

NOM_QRT	Cap-Rouge
image	Ulmus americana L.

Table continues below

NOM_QRT	Chutes-Montmorency
image	Acer saccharinum L.

Table continues below

NOM_QRT	Cité Universitaire
image	Ulmus americana L.

Table continues below

NOM_QRT	Des Châtels
image	Acer platanoides L.

Table continues below

NOM_QRT	Duberger-Les Saules
image	Acer platanoides L.

Table continues below

NOM_QRT	Jésuites
image	Acer saccharinum L.

Table continues below

NOM_QRT	Lac-Saint-Charles
image	Ulmus americana L.

Table continues below

NOM_QRT	L’Aéroport
image	Ulmus americana L.

Table continues below

NOM_QRT	Lairet
image	Acer platanoides L.

Table continues below

NOM_QRT	Loretteville
image	Acer platanoides L.

Table continues below

NOM_QRT	Maizerets
image	Fraxinus pennsylvanica Marsh.

Table continues below

NOM_QRT	Montcalm
image	Ulmus americana L.

Table continues below

NOM_QRT	Neufchâtel-Est/Lebourgneuf
image	Acer platanoides L.

Table continues below

NOM_QRT	Notre-Dame-des-Laurentides
image	Ulmus americana L.

Table continues below

NOM_QRT	Plateau
image	Acer platanoides L.

Table continues below

NOM_QRT	Pointe-de-Sainte-Foy
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 4-2
image	Ulmus americana L.

Table continues below

NOM_QRT	Quartier 4-3
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 4-5
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 4-6
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 5-1
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 5-2
image	Acer platanoides L.

Table continues below

NOM_QRT	Quartier 5-4
image	Ulmus americana L.

Table continues below

NOM_QRT	Saint-Émile
image	Acer platanoides L.

Table continues below

NOM_QRT	Saint-Jean-Baptiste
image	Ulmus americana L.

Table continues below

NOM_QRT	Saint-Louis
image	Acer platanoides L.

Table continues below

NOM_QRT	Saint-Roch
image	Acer platanoides L.

Table continues below

NOM_QRT	Saint-Sacrement
image	Acer platanoides L.

Table continues below

NOM_QRT	Saint-Sauveur
image	Ulmus americana L.

Table continues below

NOM_QRT	Sillery
image	Ulmus americana L.

Table continues below

NOM_QRT	Val-Bélair
image	Acer platanoides L.

Table continues below

NOM_QRT	Vanier
image	Fraxinus pennsylvanica Marsh.

Table continues below

NOM_QRT	Vieux-Limoilou
image	Acer platanoides L.

Table continues below

NOM_QRT	Vieux-Moulin
image	Acer platanoides L.

NOM_QRT	Vieux-Québec/Cap-Blanc/Colline parlementaire
image	Ulmus americana L.

Localisation sur une carte

select_for_map <- dA4 %>% select(LONGITUDE,LATITUDE,order)
range_long <- range(select_for_map$LONGITUDE)
range_lat <- range(select_for_map$LATITUDE)

#fond de la carte avec OpenStreetMap
#quebec_map <- get_map(location = c(range_long[1],range_lat[0],range_long[0],range_lat[1]), zoom=10, source = "osm")
#save(quebec_map, file="quebec_map.RData")
load("quebec_map.RData")
#objet ggmap

QuebecMap <- ggmap(quebec_map, base_layer = ggplot(aes(x = LONGITUDE, y = LATITUDE), data = select_for_map))

#Ajout des zones de densité d'arbres
map1 <- QuebecMap + scale_fill_gradient(low = "blue", high = "red")

Carte Simple

map1 + 
  stat_density2d(aes(x = LONGITUDE, y = LATITUDE, fill = ..level..), geom = "polygon", data = select_for_map)

Carte Composée

table_order <- with(select_for_map, table(order))
select_for_map2 <- table_order %>% as.data.frame() %>% merge(select_for_map,all.y=TRUE) %>% filter(Freq>500) 
# Garder seulement les niveaux actifs
select_for_map2$order2 <- factor(select_for_map2$order)

map1 + 
  stat_density2d(aes(x = LONGITUDE, y = LATITUDE, fill = ..level..), geom = "polygon", data = select_for_map2) +
  facet_wrap(facets = "order2")

Arbres recensés par quartier

Source: plotting polygon shapefiles

qrtqc@data$id = rownames(qrtqc@data)
qrtqc.df <- as.data.frame(qrtqc)
qrtqc.fort = fortify(qrtqc, region="id")
qrtqc.line = join(qrtqc.fort, qrtqc.df, by="id")

arrqc@data$id = rownames(arrqc@data)
arrqc.df <- as.data.frame(arrqc)
arrqc.fort = fortify(arrqc, region="id")
arrqc.line = join(arrqc.fort, arrqc.df, by="id")

ggmap_quartiers <-   ggplot(qrtqc.line) + 
  aes(long,lat,group=group,fill=NOM_QRT) + 
  geom_polygon() +
  geom_path(color="white") +
  coord_equal()

ggmap_arrond <- ggplot(arrqc.line) + 
  aes(long,lat,group=group,fill=NOM_ARR) + 
  geom_polygon() +
  geom_path(color="white") +
  coord_equal()

plot_data_quartiers <- 
  ddply(dA4, .(NOM_QRT,order), summarise, freq=length(NOM_QRT)) %>% filter(!is.na(order) && freq>=500)

plot_data_arrond <- 
  ddply(dA4, .(NOM_ARR,order), summarise, freq=length(NOM_ARR)) %>% filter(!is.na(order) && freq>=500)

gg_freq_ordre_quartier <-   ggplot(data=plot_data_quartiers, aes(x = order, y= freq, fill=order)) + 
  geom_bar(position = "stack", stat = "identity") + 
  facet_wrap(facets="NOM_QRT", ncol = 4) + 
  scale_x_discrete(breaks=order, labels=NULL) + 
  xlab("Ordre") +
  ylab("Fréquence") + 
  ggtitle("Ordre par quartier")

gg_freq_ordre_arrond <-   ggplot(data=plot_data_arrond, aes(x = order, y= freq, fill=order)) + 
  geom_bar(position = "stack", stat = "identity") + 
  facet_wrap(facets="NOM_ARR") + 
  scale_x_discrete(breaks=order, labels=NULL) + 
  xlab("Ordre") +
  ylab("Fréquence") + 
  ggtitle("Ordre par arrondissement")

ggmap_quartiers

gg_freq_ordre_quartier

ggmap_arrond

gg_freq_ordre_arrond