Podcast ADV #6: Reprise de la 7e visualisation de Sara Leo

 

Qu’est-ce qu’on fait quand il y a beaucoup de données à visualiser sur un même graphique? Comment est-ce qu’on s’arrange pour que le message qu’on veut passer soit clair? Je vous présente ma démarche et mes réflexions sur le 7e exemple de l’article de Sara Leo. Vous trouverez les liens vers son article et les données dans mon article de blog en lien avec cet épisode.

Voici le graphique original de The Economist:

1*7GJIxnYsyFSGgQV537Ittg

 

Et voici mes essais:

1)rank fra

2)bar fra

3)dot fra

MakeoverMonday | 2019W17: Stephen Curry et son Pop-Corn

Cette semaine, nous avons eu l’occasion de regarder les notes données par Stephen Carry pour le popcorn de tous les stades de la NBA.

Voici le graphique original à réviser et l’article en lien avec notre travail de cette semaine:

 

Ce qui fonctionne:

  • Les étiquettes des axes et des données sont bien utilisé, ce qui rend clair la visualisation.
  • Titre présent.
  • Couleurs bien utilisées.
  • Source des données présente.
  • Le design est bien pensé: on voit bien quel stade a mérité quel pointage pour chaque catégorie de point.

Ce qui peut être amélioré:

  • Il y a beaucoup d’information dans cette visualidation.
  • Je ne suis pas certaine que c’est pertinent de savoir quel est le pointage de chaque catégorie pour chacun des states. J’ai l’impression que ça allourdit le tout, surtout qu’il n’y a pas de patron précis qu’on peut en tirer et que la visualisation ne l’explique pas précisément.
  • L’explication des notes n’est pas présentée: quel est le score maximal possible par catégorie, au total?

Sur quoi je me suis concentrée:

  • Simplifier la visualisation en montrant uniquement les notes totales.
  • Expliquer les notes.
  • Garder ça clair et simple!

Voici mon graphique:

Final BAR FRA

 

TyT2019|W13: Population pyramid ou comment utiliser des histrogrammes pour comparer des populations

Pour le #Tidytuesday de cette semaine, nous avons accès aux données des animaux de compagnie enregistrés à Seatle. On retrouve les données brutes sur le site Seattle’s open data portal. Peu de données sont présentes, mais nous disposons tout de même de la date de délivrance de la licence, du nom de l’animal, de son espèce, de sa race et de son code postal. On devrait pourvoir s’amuser!

Mes objectifs pour cette semaine:
1) Comparer les noms les plus populaires pour les chats et les chiens.
2) Apprendre comment faire des pyramides de populations

IMPORTER

data<- read_csv("Seattle_Pet_Licenses.csv",
               col_names = TRUE) #identifier la première ligne comme nom de colonne
FALSE Parsed with column specification:
FALSE cols(
FALSE   `License Issue Date` = col_character(),
FALSE   `License Number` = col_character(),
FALSE   `Animal's Name` = col_character(),
FALSE   Species = col_character(),
FALSE   `Primary Breed` = col_character(),
FALSE   `Secondary Breed` = col_character(),
FALSE   `ZIP Code` = col_character()
FALSE )

EXPLORER

glimpse(data)
## Observations: 52,519
## Variables: 7
## $ `License Issue Date` <chr> "November 16 2018", "November 11 2018", "No…
## $ `License Number`     <chr> "8002756", "S124529", "903793", "824666", "…
## $ `Animal's Name`      <chr> "Wall-E", "Andre", "Mac", "Melb", "Gingersn…
## $ Species              <chr> "Dog", "Dog", "Dog", "Cat", "Cat", "Dog", "…
## $ `Primary Breed`      <chr> "Mixed Breed, Medium (up to 44 lbs fully gr…
## $ `Secondary Breed`    <chr> "Mix", "Dachshund, Standard Wire Haired", N…
## $ `ZIP Code`           <chr> "98108", "98117", "98136", "98117", "98144"…
Hmisc::describe(data$Species)
## data$Species 
##        n  missing distinct 
##    52519        0        4 
##                                   
## Value        Cat   Dog  Goat   Pig
## Frequency  17294 35181    38     6
## Proportion 0.329 0.670 0.001 0.000
Hmisc::describe(data$`License Issue Date`)
## data$`License Issue Date` 
##        n  missing distinct 
##    52519        0     1064 
## 
## lowest : April 01 2017     April 01 2018     April 02 2017     April 02 2018     April 03 2014    
## highest: September 29 2017 September 29 2018 September 30 2015 September 30 2017 September 30 2018

Nous disposons de plusieurs variables, mais pour ce que j’ai en tête j’ai besion de créer un ensemble de données où on voit la fréquence des noms pour les chats et les chiens. Voici comment je m’y prend:

PRÉPARER

data_name%
  filter(Species %in% c("Cat", "Dog"))%>% #garder seulement les chiens et les chat
  select(Species,`Animal's Name`)%>% # conserver seulement les colonnes pertinentes pour l'analyse
  group_by(Species,`Animal's Name`)%>%
  summarise(nombre=dplyr::n())%>%
  filter(!`Animal's Name`%in% NA)%>%
  filter(nombre>=100)%>% #sélectionner les 37 noms les plus populaires
  mutate(nombre=ifelse(Species=="Cat", -nombre, nombre))#nécessaire pour faire le grapgique

VISUALISER

#Graphique
gg<-ggplot(data=data_name, aes(x=reorder(`Animal's Name`,desc(`Animal's Name`)), y=nombre, fill=Species))
gg<-gg + geom_bar(stat = "identity")
gg<-gg + facet_share(~Species, dir = "h", scales = "free", reverse_num = TRUE)
gg<-gg + coord_flip()
gg<-gg + scale_fill_manual(values = c("#C1292E", "#235789"))
#modifier la légende
gg<-gg + theme(legend.position="none")
#modifier le thème
gg<-gg +theme(panel.border = element_rect(size=0.5, color="#A9A9A9", fill = NA),
              panel.background = element_blank(),
              plot.background = element_blank(),
              panel.grid.major.y= element_blank(),
              panel.grid.major.x= element_blank(),
              panel.grid.minor = element_blank(),
              axis.line.y = element_blank(),
              axis.line.x = element_blank(),
              axis.ticks.y = element_blank(),
              axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title="Quels sont les noms d'animaux de compagnie les plus populaires à Seatle?",
              subtitle=NULL,
              y=NULL,
              x=NULL)
gg<-gg + theme(plot.title    = element_text(hjust=0,size=14, color="#000000", face="bold"),
               plot.subtitle = element_text(hjust=0,size=12, color="#000000"),
               axis.title.y  = element_blank(),
               axis.title.x  = element_blank(),
               axis.text.x   = element_blank(),
               axis.text.y   = element_text(hjust=0,size=10, color="#000000"))

Voici ce que ça donne:

On cosntate que les noms les plus populaires pour les chiens ne sont pas nécessairement populaires pour les chats. C’est intéressant, mais ce n’est pas ce que j’avais en tête comme graphique. J’aimerais voir quels sont les noms les plus populaires à la fois pour les chiens et pour les chats. Voici comment on peut ajuster ça:

PRÉPARER

data_name_pop%
  filter(Species %in% c("Cat", "Dog"))%>% #garder seulement les chiens et les chat
  select(Species,`Animal's Name`)%>% # conserver seulement les colonnes pertinentes pour l'analyse
  group_by(Species,`Animal's Name`)%>%
  summarise(nombre=dplyr::n())%>%
  filter(!`Animal's Name`%in% NA)%>% # retirer les lignes sans noms
  spread(Species, nombre)%>%
  filter(!Cat %in% NA)%>% #retirer les lignes ou le nom ne s'applique pas au chat
  filter(!Dog %in% NA)%>% #retirer les lignes ou le nom ne s'applique pas au chien
  mutate(somme=Cat+Dog)%>%
  filter(somme >=173)%>% #garder les 20 noms les plus populaires
  select(`Animal's Name`, Cat, Dog)%>%
  gather(key=Species, value=nombre, -`Animal's Name`)%>%
  mutate(nombre=ifelse(Species=="Cat", -nombre, nombre))#nécessaire pour faire le graphique

VISUALISER

#Graphique
gg<-ggplot(data=data_name_pop, aes(x=reorder(`Animal's Name`,desc(`Animal's Name`)), y=nombre, fill=Species))
gg<-gg + geom_bar(stat = "identity")
gg<-gg + facet_share(~Species, dir = "h", scales = "free", reverse_num = TRUE)
gg<-gg + coord_flip()
gg<-gg + scale_fill_manual(values = c("#C1292E", "#235789"))
#modifier la légende
gg<-gg + theme(legend.position="none")
#modifier le thème
gg<-gg +theme(panel.border = element_rect(size=0.5, color="#A9A9A9", fill = NA),
              panel.background = element_blank(),
              plot.background = element_blank(),
              panel.grid.major.y= element_blank(),
              panel.grid.major.x= element_blank(),
              panel.grid.minor = element_blank(),
              axis.line.y = element_blank(),
              axis.line.x = element_blank(),
              axis.ticks.y = element_blank(),
              axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title="Quels sont les noms les plus populaires pour les chats et les chiens de Seatle?",
              subtitle="Lucy est le nom le plus utilisé pour leur animaux de compagine",
              y=NULL,
              x=NULL)
gg<-gg + theme(plot.title    = element_text(hjust=0,size=14, color="#000000", face="bold"),
               plot.subtitle = element_text(hjust=0,size=12, color="#000000"),
               axis.title.y  = element_blank(),
               axis.title.x  = element_blank(),
               axis.text.x   = element_blank(),
               axis.text.y   = element_text(hjust=0,size=10, color="#000000"))

Voici ce que ça donne:

 

On obtient deux histogrammes dos à dos qui montrent les fréquences des noms qui sont à la fois utilisés pour les chiens et les chats.

 

Vous voulez en apprendre plus sur ma démarche? Allez écouter l’épisode de podcast dans lequel j’explique mes réflexions pour arriver à ce résultat.

TyT2019|W11: Divergent Bar Chart ou comment utiliser un histogramme pour montrer des différences par rapport à la moyenne

Pour le #Tidytiuesday de cette semaine, nous avons accès à des données qui notent les jeux de société parus entre 1950 et 2016. Il y a pas moins de 10 532 jeux de société qui ont été crées, de quoi s’ammuser! Les données brutes proviennent du site Board Game Geek.

Les graphiques présentés dans l’article font un bon travail pour montrer les grandes tendances qu’on peut ressortir de ces données. J’aime particulièrement les titres acrocheurs. On peut donc y apprendre que c’est plus agréable d’être 3 joueurs et qu’on peut avoir du plaisir pendant 5 heures.

Je suis moins certaine par contre de l’évolution des évaluations dans le temps. Les données fournies ne nous donnent pas une liste d’évaluations dans le temps, c’est-à-dire plusieurs mesures de l’évaluation d’un jeu dans le temps. On a seulement une moyenne de l’évaluation du jeu et sa date de création… Donc, je ne suis pas certaine qu’on peut présenter l’évolution des évaluations dans le temps. D’une certaine façon, c’est normal que les jeux créés récemment aient une meilleure note que ceux crées en 1947. Je suis presque sûr que le site Board Game Geek ne permettait pas les évaluations cette année là… Donc, je ne crois pas vraiment pouvoir utiliser les années pour pousser plus loin la visualisation des évaluations. Je préfère me concentrer sur les catégories, d’une part parce que l’article n’aborde pas cet aspect et que je suis curieuse mais aussi parce que je pense que c’est un beau défi de traitement de données à réaliser.

IMPORTER

board_games <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-03-12/board_games.csv")

EXPLORER

glimpse(board_games)
## Observations: 10,532
## Variables: 22
## $ game_id        <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ...
## $ description    <chr> "Die Macher is a game about seven sequential po...
## $ image          <chr> "//cf.geekdo-images.com/images/pic159509.jpg", ...
## $ max_players    <int> 5, 4, 4, 4, 6, 6, 2, 5, 4, 6, 7, 5, 4, 4, 6, 4,...
## $ max_playtime   <int> 240, 30, 60, 60, 90, 240, 20, 120, 90, 60, 45, ...
## $ min_age        <int> 14, 12, 10, 12, 12, 12, 8, 12, 13, 10, 13, 12, ...
## $ min_players    <int> 3, 3, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 3, 3, 2, 3,...
## $ min_playtime   <int> 240, 30, 30, 60, 90, 240, 20, 120, 90, 60, 45, ...
## $ name           <chr> "Die Macher", "Dragonmaster", "Samurai", "Tal d...
## $ playing_time   <int> 240, 30, 60, 60, 90, 240, 20, 120, 90, 60, 45, ...
## $ thumbnail      <chr> "//cf.geekdo-images.com/images/pic159509_t.jpg"...
## $ year_published <int> 1986, 1981, 1998, 1992, 1964, 1989, 1978, 1993,...
## $ artist         <chr> "Marcus Gschwendtner", "Bob Pepper", "Franz Voh...
## $ category       <chr> "Economic,Negotiation,Political", "Card Game,Fa...
## $ compilation    <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,...
## $ designer       <chr> "Karl-Heinz Schmiel", "G. W. \"Jerry\" D'Arcey"...
## $ expansion      <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, "Elfengold,...
## $ family         <chr> "Country: Germany,Valley Games Classic Line", "...
## $ mechanic       <chr> "Area Control / Area Influence,Auction/Bidding,...
## $ publisher      <chr> "Hans im Glück Verlags-GmbH,Moskito Spiele,Vall...
## $ average_rating <dbl> 7.66508, 6.60815, 7.44119, 6.60675, 7.35830, 6....
## $ users_rated    <int> 4498, 478, 12019, 314, 15195, 73, 2751, 186, 12...

Nous disposons de plusieurs variables, mais pour ce que j’ai en tête j’ai besion que des catégories et de la moyenne des évaluations. Donc, je ne pousserai pas plus loin mon analyse du reste des variables de ces données.

PRÉPARER

rate<-board_games%>%
  select(category,average_rating)%>% # conserver seulement les 2 colonnes pertinentes pour l'analyse
    mutate(category = str_replace_all(category, "\\/",","))%>% #uniformiser les séparateurs de catégories
    separate(category, c("no1","no2","no3","no4","no5","no6","no7","no8","no9","no10","no11","no12","no13","no14",
                         "no15"), sep=",")%>% #séparer les catégories en différents colonnes
  gather(key="No", value="Categories", -average_rating)%>%
  select(Categories,average_rating) %>%
  #summarise(mean=mean(average_rating)) # la note moyenne est de 6.37
  mutate(divergence=average_rating-6.37)%>%
  group_by(Categories)%>%
  summarise(average_div_rate=mean(divergence))

top_10<-rate%>%
  top_n(10, average_div_rate) #sélectionner les 10 meilleures évaluations

bottom_10<-rate%>%
  top_n(-10, average_div_rate)#sélectionner les 10 pires évaluations

rate<-top_10%>%
  rbind(bottom_10)

VISUALISER

#Graphique
gg<-ggplot(data=rate, aes(x=reorder(Categories, average_div_rate), y=average_div_rate, fill=Categories))
gg<-gg + geom_bar(stat="identity", width=0.85)
gg<-gg + coord_flip()
gg<-gg + scale_fill_manual(values = c("#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A9A9A9","#A44A3F","#090446","#A9A9A9"))
#Ajouter les étiquettes de données
gg<-gg + annotate(geom="text", x=1,y=-0.84, label="5.6", color="#A44A3F", size=4, hjust=0, fontface="bold")
gg<-gg + annotate(geom="text", x=20,y=0.85, label="7.2", color="#090446", size=4, hjust=0, fontface="bold")
gg<-gg + annotate(geom="text", x=1,y=0.02, label="Trivia", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=2,y=0.02, label="Children's Game", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=3,y=0.02, label="Memory", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=4,y=0.02, label="Math", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=5,y=0.02, label="Radio Theme", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=6,y=0.02, label="TV", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=7,y=0.02, label="Movies", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=8,y=0.02, label="Electronic", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=9,y=0.02, label="Music", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=10,y=0.02, label="Word Game", color="#A9A9A9", size=5, hjust=0)
gg<-gg + annotate(geom="text", x=11,y=-0.02, label="Age of Reason", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=12,y=-0.02, label="Post-Napoleonic", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=13,y=-0.02, label="Miniature", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=14,y=-0.02, label="Civilization", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=15,y=-0.02, label="American Revolutionary War", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=16,y=-0.02, label="American Indian Wars", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=17,y=-0.02, label="Book", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=18,y=-0.02, label="Civil War", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=19,y=-0.02, label="Expansion for Base-game", color="#A9A9A9", size=5, hjust=1)
gg<-gg + annotate(geom="text", x=20,y=-0.02, label="Vietman War", color="#A9A9A9", size=5, hjust=1)
#modifier la légende
gg<-gg + theme(legend.position="none")
#modifier le thème
gg<-gg +theme(panel.border = element_blank(),
              panel.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
              plot.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
              panel.grid.major.y= element_blank(),
              panel.grid.major.x= element_blank(),
              panel.grid.minor = element_blank(),
              axis.line = element_blank(),
              axis.ticks.y = element_blank(),
              axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title="Which categories of board games are the best and worst rated?",
              subtitle=NULL,
              y=NULL,
              x=NULL)
gg<-gg + theme(plot.title    = element_text(hjust=0.5,size=26, color="#8B8B8B", face="bold"),
               plot.subtitle = element_text(hjust=0,size=18, color="#8B8B8B"),
               axis.title.y  = element_blank(),
               axis.title.x  = element_blank(),
               axis.text.y   = element_blank(),
               axis.text.x   = element_blank())

J’ai choisi de travailler sur les catégories de jeu de société. Comme les évaluations fournies sont déjà des moyennes, je n’ai pas inclus les années dans mon analyse. Je voulais voir quelles sont les catégories les mieux et les moins biens notés par rapport à la moyenne. Pour y arriver, j’ai travaillé la colonnes des catégories pour séparer toutes les lignes où il y avait plus d’une catégories dans la même cellule. Pour ensuite refaire une table de données qui associe une note avec une catégorie. À partir de là, j’ai pu sousrtaire la note moyenne de l’évaluation de chaque ligne pour connaire la différence par rapport à la moyenne. Le reste c’est une histoire de présentation graphique. Voici ce que ça donne:

SWD Challenge | 2019M3: Visualise-moi ça!

Le défi de ce mois-ci consiste à être efficace, ni plus ni moins. C’est-à-dire de démontrer nos compétences à traiter les données fournies pour répondre à des questions spécifiques. Les données pour ce défi, abordent les transactions financières entre les pays ainsi que les raisons de ces dons. Les données brutes sont disponibles sur le site de ADIDATA.

Les 3 questions à répondre sont:

  • Qui a donné?
  • Combien est-ce qu’ils ont donné?
  • Pourquoi est-ce qu’ils ont donné?

IMPORTER

data<- read_csv("AidDataCoreThin_ResearchRelease_Level1_v3.1.csv",
               col_names = TRUE) #identifier la première ligne comme nom de colonne

#OMG!!!154 MB de données! du pur plaisir!

EXPLORER

glimpse(data)
## Observations: 1,561,039
## Variables: 8
## $ aiddata_id                     <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
## $ aiddata_2_id                   <chr> NA, NA, NA, NA, NA, NA, NA, NA,...
## $ year                           <int> 2003, 1990, 1991, 1992, 1992, 1...
## $ donor                          <chr> "African Development Bank (AFDB...
## $ recipient                      <chr> "Togo", "Burundi", "Cote d`Ivoi...
## $ commitment_amount_usd_constant <int> 29589911, 9713596, 148139421, 2...
## $ coalesced_purpose_code         <int> 24030, 31100, 31120, 31120, 311...
## $ coalesced_purpose_name         <chr> "Formal sector financial interm...
summary(data)
##    aiddata_id        aiddata_2_id            year         donor          
##  Min.   :        1   Length:1561039     Min.   :1947   Length:1561039    
##  1st Qu.: 57937127   Class :character   1st Qu.:2002   Class :character  
##  Median : 74387020   Mode  :character   Median :2007   Mode  :character  
##  Mean   : 75387177                      Mean   :2005                     
##  3rd Qu.: 94736526                      3rd Qu.:2010                     
##  Max.   :121508987                      Max.   :9999                     
##  NA's   :126989                                                          
##   recipient         commitment_amount_usd_constant coalesced_purpose_code
##  Length:1561039     Min.   :-1.664e+09             Min.   :10000         
##  Class :character   1st Qu.: 2.088e+04             1st Qu.:14020         
##  Mode  :character   Median : 1.071e+05             Median :22040         
##                     Mean   : 4.033e+06             Mean   :35878         
##                     3rd Qu.: 5.923e+05             3rd Qu.:43040         
##                     Max.   : 2.141e+09             Max.   :99820         
##                     NA's   :98                                           
##  coalesced_purpose_name
##  Length:1561039        
##  Class :character      
##  Mode  :character      
##                        
##                        
##                        
## 

Les points importants à considérer pour nettoyer ces données avant de les analyser:

  • Le format des années doit être changé pour numérique
  • Le format de la colonne des dons (commitment_amount_usd_constant) doit aussi être changé pour numérique
  • L’année “9999” doit être retirer, probablement une donnée manquante
  • Il faut aussi faire attention au données manquante des dons pour ne pas causer d’erreurs dans l’analyse
data%
  mutate(year=as.numeric(year))%>% #changer le format pour numérique
  mutate(commitment_amount_usd_constant=as.numeric(commitment_amount_usd_constant))%>%#changer le format pour numérique
  filter(!year %in% 9999)%>% #retirer valeur aberhante
  filter(!is.na(commitment_amount_usd_constant)) #retirer les NAs

glimpse(data)
## Observations: 1,560,882
## Variables: 8
## $ aiddata_id                     <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
## $ aiddata_2_id                   <chr> NA, NA, NA, NA, NA, NA, NA, NA,...
## $ year                           <dbl> 2003, 1990, 1991, 1992, 1992, 1...
## $ donor                          <chr> "African Development Bank (AFDB...
## $ recipient                      <chr> "Togo", "Burundi", "Cote d`Ivoi...
## $ commitment_amount_usd_constant <dbl> 29589911, 9713596, 148139421, 2...
## $ coalesced_purpose_code         <int> 24030, 31100, 31120, 31120, 311...
## $ coalesced_purpose_name         <chr> "Formal sector financial interm...
summary(data)
##    aiddata_id        aiddata_2_id            year         donor          
##  Min.   :        1   Length:1560882     Min.   :1947   Length:1560882    
##  1st Qu.: 57940838   Class :character   1st Qu.:2002   Class :character  
##  Median : 74388871   Mode  :character   Median :2007   Mode  :character  
##  Mean   : 75391640                      Mean   :2005                     
##  3rd Qu.: 94737989                      3rd Qu.:2010                     
##  Max.   :121508987                      Max.   :2013                     
##  NA's   :126989                                                          
##   recipient         commitment_amount_usd_constant coalesced_purpose_code
##  Length:1560882     Min.   :-1.664e+09             Min.   :10000         
##  Class :character   1st Qu.: 2.088e+04             1st Qu.:14020         
##  Mode  :character   Median : 1.071e+05             Median :22040         
##                     Mean   : 4.033e+06             Mean   :35877         
##                     3rd Qu.: 5.921e+05             3rd Qu.:43040         
##                     Max.   : 2.141e+09             Max.   :99820         
##                                                                          
##  coalesced_purpose_name
##  Length:1560882        
##  Class :character      
##  Mode  :character      
##                        
##                        
##                        
## 

EXPLORER

#Quel est le montant total des dons effectués entre 1947 et 2913?
don%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))
#Réponse: 6 295 M$

#Quel pays ou organisation est le donneur le plus important?
don%
  group_by(donor)%>%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))
#Réponse: sur les 96 donneurs, les États Unis sont les plus importants après la banque mondiale.

#regrouper toutes les donneurs qui font parti de l'Amérique du Nord
#Quel est le montant donné par l'Amérique du Nord pendant cette période?
don%
  mutate(donor_cat=donor)%>%
  mutate(donor_cat=ifelse(str_detect(donor, "United"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Bill"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "North"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Canada"), "AM", donor_cat))%>%
  filter(donor_cat=="AM")%>%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))%>%
  mutate(don_million=sum/1000000000)
#Réponse: 1 156 M$

#Quels sont les principaux pays (environ 20%) qui ont reçu cet argent?
recip_NAM%
  mutate(donor_cat=donor)%>%
  mutate(donor_cat=ifelse(str_detect(donor, "United"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Bill"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "North"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Canada"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "World"), "World", donor_cat))%>%
  filter(donor_cat=="AM")%>%
  group_by(recipient)%>%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))%>%
  mutate(don_million=sum/1000000000)%>%
  filter(don_million>28)%>%
  filter(!recipient %in% "Bilateral, unspecified")
#Réponse: Les receveur le plus important des dons sont Egypt, Israel, Iraq, India, Afghanistan, Pakistan

#Quel est l'utilisation principale de cet argent pour chaque pays?
raison_NAM%
  filter(recipient %in% c("Egypt", "Israel", "Iraq", "India", "Afghanistan","Pakistan"))%>%
  mutate(donor_cat=donor)%>%
  mutate(donor_cat=ifelse(str_detect(donor, "United"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Bill"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "North"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Canada"), "AM", donor_cat))%>%
  filter(donor_cat=="AM")%>%
  group_by(recipient, coalesced_purpose_name)%>%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))%>%
  mutate(don_million=sum/1000000000000)
#Réponses:
  #Egypt:Food security programs
  #Israel:General budget support
  #Iraq:Electrical transmission/distribution
  #India:Food security programs
  #Afghanistan:Legal and judicial development
  #Pakistan:Food security programs

VISUALISER

Pour répondre à ces 3 questions, j’ai choisi de me concentrer sur le regroupement de donateurs qui ont le plus donné soit l’Amérique du Nord. Une fois qu’on sait qu’ils ont donné 1 150M$ pour la période à l’étude, c’est plus facile de se concentrer sur les receveurs principaux. J’a choisi de représenter visuellement les pays qui ont reçu 20% de cet argent. Pour répondre à la dernière question, j’ai annoté le graphique pour y indiquer l’utilisation principale de cet argent pour chaque pays receveur. Voici comment j’ai fait et ce que ça donne:

don%
  mutate(donor_cat=donor)%>%
  mutate(donor_cat=ifelse(str_detect(donor, "United"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Bill"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "North"), "AM", donor_cat))%>%
  mutate(donor_cat=ifelse(str_detect(donor, "Canada"), "AM", donor_cat))%>%
  filter(donor_cat=="AM")%>%
  filter(recipient %in% c("Egypt", "Israel", "Iraq", "India", "Afghanistan","Pakistan"))%>%
  group_by(recipient)%>%
  summarise(sum=sum(commitment_amount_usd_constant, na.rm=TRUE))%>%
  mutate(don_million=sum/1000000000)

#Graphique
gg<- ggplot(recip_NAM, aes(x=reorder(recipient, -don_million), y=don_million, fill = recipient))
gg<- gg + geom_bar(stat="identity", width = .1)
gg<- gg + geom_point(size=6, color="#A60067")
gg<- gg + coord_flip()
#Ajuster les couleurs et les axes
gg<- gg + scale_y_continuous(breaks=seq(0,150,10), limits = c(0, 150),position = "top")
gg<- gg + scale_fill_manual(values=c("#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9", "#A9A9A9"))
#Titres, étiquettes et légendes
gg<-gg + labs(x = NULL,
              y = NULL,
              title =NULL,
              subtitle = NULL)
gg<-gg +theme(plot.title    = element_blank(),
              plot.subtitle = element_blank(),
              axis.title.x  = element_blank(),
              axis.title.y  = element_blank(),
              axis.text.x   = element_blank(),
              axis.text.y   = element_text(hjust=0, size=14, color="#8B8B8B", face="bold"))
gg<-gg +theme(legend.position = "none")
gg<-gg +annotate(geom="text", x=1,  y=66, label="62.6M$ pour les programmes de sécurité alimentaire",
                 color="#8B8B8B", size=4, hjust=0)
gg<-gg +annotate(geom="text", x=2,  y=48, label="45.1M$ pour l'appui budgétaire général",
                 color="#8B8B8B", size=4, hjust=0)
gg<-gg +annotate(geom="text", x=3,  y=47, label="43.6M$ pour la transmission/distribution d'électricité",
                 color="#8B8B8B", size=4, hjust=0)
gg<-gg +annotate(geom="text", x=4,  y=45, label="41.5M$ pour les programmes de sécurité alimentaire",
                 color="#8B8B8B", size=4, hjust=0)
gg<-gg +annotate(geom="text", x=5,  y=39, label="36.0M$ pour le développement juridique et judiciaire",
                 color="#8B8B8B", size=4, hjust=0)
gg<-gg +annotate(geom="text", x=6,  y=38, label="35.1M$ pour les programmes de sécurité alimentaire",
                 color="#8B8B8B", size=4, hjust=0)
#adapter le thème du graphique selon les besions:
gg<-gg +theme(panel.border       = element_blank(),
              panel.background   = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
              plot.background    = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
              panel.grid.major.y = element_blank(),
              panel.grid.major.x = element_blank(),
              panel.grid.minor   = element_blank(),
              axis.line.x        = element_blank(),
              axis.ticks.x       = element_blank(),
              axis.line.y        = element_blank(),
              axis.ticks.y       = element_blank())

 

Combien vaut votre lisier de porc?

Toutes les entreprises porcines ont des volumes plus ou moins important de lisier à gérer. Porc Québec, a publié en décembre 2017 un article très intéressant qui estime la valeur du lisier de porc à partir du prix des engrais minéraux de 2017.

Tous les types d’engrais apporte 3 éléments nutritifs essentiels aux plantes soit l’azote, le phosphore et le potassium. Les valeurs fertilisantes apportées par le lisier de porc varient en fonction du type d’épandage, du moment d’application sur la culture et de la rapidité d’enfouissement après l’épandage.

Pour résumé le tout j’ai pris les valeurs économiques brutes du lisier d’engraissement appliqué sur des cultures annuelles, par aspersion basse et incoproré en moins de 24 heures. En faisait la moyenne entre les applications du printemps et de l’automne le lisier de porc d’engraissement aurait une valeur économique de 7,49$/T. En considérant la proportion des éléments fertilisants apportés par les lisiers de maternité et de pouponnière vallent respectivement 4.87$/T et 4,64$/T.

 

MakeoverMonday | 2019W8: L’énergie éolienne aux États Unis

Pour la huitième semaine de #MakeoverMonday, nous avons eu l’occasion de regarder les données des installations d’énergie éolienne aux États Unis.

Voici le graphique original et l’article:

Ce qui fonctionne:

  • Titre bien utilisé
  • Légende présente
  • Bonne utilisation des couleurs
  • La source des données est identifiée au bas du visuel

Ce qui peut être amélioré:

  • Je trouve qu’il y a beaucoup d’information sur ce graphique. On y retrouve l’investissement, la capacité des installations et l’équivalent en nombre de maisons alimentées. On ne sait pas ou poser les yeux.
  • Les images d’éolienne sont très jolies mais, elle viennent allourdir le graphique.
  • L’aligment et la taille du texte de l’axe des X ne sont pas uniformisé. Ce sont des éléments distraillant pour le lecteur.
  • Les états sont identifiés par des abréviations. Pour faciliter la lecture, il est préférable d’utiliser le nom complet.
  • La graduation de l’axe de Y n’est pas continue. Ça crée un élément de distraction supplémentaire.

Sur quoi je me suis concentrée:

  • Réduire la quantité d’information sur le graphique et présenter des résultats qui parlent au lecteur.
  • J’ai choisi de présenter l’investissement en M$ par MW d’équipement installé. Ainsi, on peut comparer les états selon les retours (en MW) sur leur investissement (M$).
  • J’ai choisi de ne pas présenter l’équivament en nombre de maison alimentées parce que c’est un peu redondant, c’est évident que plus il y a d’équipement installé, plus le nombre de maison alimentées sera grand.
  • Garder ça clair et simple!

Voici mon graphique:

Energy final FRA

TidyTuesday | 2019W5: Portrait de la production laitière aux États-Unis

Quoi de mieux que des données du domaine agricole pour me lancer dans les #TidyTuesday! Pour la qinquième semaine, les données à travailler portent sur la production laitière des vaches et sur la consommation de produits laitiers aux États-Unis.

Voici la source, l’article et le répertoire github.

L’objectif des #TidyTuesday est de permettre à la communauté #RStats de pratiquer les techniques de traitement, de nettoyage et de visualidation de données ainsi que de parfaire les aptitudes à tirer des conclusions.

EXPLORATION INITIALE

Après avoir importé et pris connaissance des différentes bases de données fournies, l’agronome en moi est curieuse de voir à quoi ressemble l’évolution de la production laitière des vaches aux États-Unis. J’ai récemment fait un travail similaire pour la production laitière québeçoise, ce sera intéressant de voir comment est-ce que ça de compare.

summary(vaches)
##       year      avg_milk_cow_number  milk_per_cow   milk_production_lbs
##  Min.   :1980   Min.   : 9010000    Min.   :11891   Min.   :1.284e+11  
##  1st Qu.:1988   1st Qu.: 9171000    1st Qu.:14254   1st Qu.:1.445e+11  
##  Median :1997   Median : 9314000    Median :16871   Median :1.561e+11  
##  Mean   :1997   Mean   : 9695743    Mean   :16962   Mean   :1.626e+11  
##  3rd Qu.:2006   3rd Qu.:10135000    3rd Qu.:19722   3rd Qu.:1.794e+11  
##  Max.   :2014   Max.   :11059000    Max.   :22259   Max.   :2.061e+11  
##  avg_price_milk    dairy_ration     milk_feed_price_ratio
##  Min.   :0.1210   Min.   :0.03445   Min.   :1.520        
##  1st Qu.:0.1275   1st Qu.:0.04550   1st Qu.:2.540        
##  Median :0.1360   Median :0.04914   Median :2.700        
##  Mean   :0.1462   Mean   :0.05784   Mean   :2.697        
##  3rd Qu.:0.1530   3rd Qu.:0.05886   3rd Qu.:3.030        
##  Max.   :0.2400   Max.   :0.12150   Max.   :3.640        
##  milk_cow_cost_per_animal milk_volume_to_buy_cow_in_lbs alfalfa_hay_price
##  Min.   : 820             Min.   : 6560                 Min.   : 64.64   
##  1st Qu.:1100             1st Qu.: 7574                 1st Qu.: 79.22   
##  Median :1190             Median : 8626                 Median : 94.03   
##  Mean   :1283             Mean   : 8848                 Mean   :104.59   
##  3rd Qu.:1425             3rd Qu.: 9697                 3rd Qu.:109.20   
##  Max.   :1950             Max.   :13411                 Max.   :206.08   
##  slaughter_cow_price
##  Min.   :0.3300     
##  1st Qu.:0.3988     
##  Median :0.4503     
##  Mean   :0.4875     
##  3rd Qu.:0.5147     
##  Max.   :1.0204

Nous disposons donc de 34 années de 1980 à 2014. Pour chaque année, le nombre moyen de vaches aux États-Unis est donné et varient entre 9 et 11 millions. La moyenne de lait produit par vache est aussi présente et varie entre 11 891 et 22 259 lbs de lait par vache par année. C’est un point de départ intéressant.

Années:

str(vaches$year)
##  num [1:35] 1980 1981 1982 1983 1984 ...
Hmisc::describe(vaches$year)
## vaches$year 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##       35        0       35        1     1997       12     1982     1983 
##      .25      .50      .75      .90      .95 
##     1988     1997     2006     2011     2012 
## 
## lowest : 1980 1981 1982 1983 1984, highest: 2010 2011 2012 2013 2014

Les années sont en format numérique, les 34 années séparant 1980 et 2014 sont présentes, donc aucune données manquante à gérer.

Production de lait:

str(vaches$milk_per_cow)
##  int [1:35] 11891 12183 12306 12622 12541 13024 13285 13819 14185 14323 ...
Hmisc::describe(vaches$milk_per_cow)
## vaches$milk_per_cow 
##        n  missing distinct     Info     Mean      Gmd      .05      .10 
##       35        0       35        1    16962     3756    12269    12573 
##      .25      .50      .75      .90      .95 
##    14254    16871    19722    21257    21750 
## 
## lowest : 11891 12183 12306 12541 12622, highest: 21142 21334 21722 21816 22259

Les données de production laitières sont classées comme des données quantitatives discrètes (integer), on va devoir changer le format pour travailler avec des valeurs quantitative continue (numeric). Les valeurs de production de lait sont présentes pour les 34 années, donc aucune donnée manquante à gérer. Aussi, ces valeurs sont en lbs/vache, au Québec on parle de kg de lait produit par vache par année. Je vais faire la conversion pour des fins de comparaison.

 

plt1 % select(milk_per_cow) %>%
  ggplot(aes(x="", y = milk_per_cow)) +
  geom_boxplot(fill = "#D8EADF", color = "black") +
  coord_flip() +
  theme_classic() +
  xlab("") +
  ylab("Lait par vache")+
  theme(axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

plt2 % select(milk_per_cow) %>%
  ggplot() +
   geom_histogram(aes(x = milk_per_cow, y = (..count..)/sum(..count..)),
                       position = "identity", binwidth = 1500,
                       fill = "#D8EADF", color = "black") +
   ylab("Fréquence Relative")+
   xlab("")+
  theme_classic()+
  theme(axis.text.x = element_blank())+
  theme(axis.ticks.x = element_blank())

plt2 + plt1 + plot_layout(nrow = 2, heights = c(2, 1))

La distribution des données semble normale. Aucune valeur extrème qui pourrait être considérée comme une valeur aberrante.

RANGEMENT

Cette table de donnée répond déjà au 3 grands principe de tidy data donc, pour l’analyse que je veux faire de ces données il n’y a aucun travail à faire pour cette étape.

PRÉPARATION

vaches_prep%
   mutate(milk_per_cow==(as.numeric(milk_per_cow)))%>% #changer le type de la variable
   mutate(milk_per_cow_kg=milk_per_cow/2.2)%>%  #changement des unités de lbs à kg
   select(year, milk_per_cow_kg)  #sélection des variables pour l'analyse

#validation du changement de type
str(vaches_prep$milk_per_cow_kg)
##  num [1:35] 5405 5538 5594 5737 5700 ...

VISUALISATION DES DONNÉES

ggplot(data=vaches_prep, aes(x=year, y = milk_per_cow_kg)) +
  geom_bar(stat="identity", width=0.85, fill='#FFFFFF', color='#B8B8B8') +
  scale_x_continuous(breaks=seq(1980,2014,5), limits = c(1979,2015))+
  scale_y_continuous(breaks=seq(0,12000,2000), limits = c(0,12000))+
  labs(y="Lait (kg) par vache",
      title="Évolution de la production laitière moyenne par vache aux États-Unis",
      subtitle="Elle a plus que doublée au cours des 35 dernières années et surpassait le Québec de 1143 kg/vache en 2014!")+
  theme(plot.title = element_text(hjust=0,  size=22, color="#5D5D5D",face="bold"),
        plot.subtitle = element_text(hjust=0,  size=14, color="#004FFF",face="bold"),
        axis.title.x = element_blank(),
        axis.title.y = element_text(hjust=1,  size=12, color="#B8B8B8"),
        axis.text =  element_text(hjust=0.5,size=12, color="#B8B8B8"))+
  theme( panel.border = element_blank(),
         panel.background = element_blank(),
         panel.grid.major.y= element_blank(),
         panel.grid.major.x= element_blank(),
         panel.grid.minor = element_blank(),
         axis.line = element_line(size = 0.5, linetype = "solid", colour = "#B8B8B8"),
         axis.ticks = element_line(size=0.5, linetype="solid", colour = "#B8B8B8"))+
  annotate(geom="text", x=1980,y=5750, label="4405", color="#004FFF", size=5, hjust=0.5, fontface="bold")+
  annotate(geom="text", x=2014,y=10400, label="10118", color="#004FFF", size=5, hjust=0.5, fontface="bold")+
  annotate(geom="text", x=2015,y=8700, label="Qc", color="#000000", size=5, hjust=0, fontface="bold")+ geom_abline(intercept = -220688.7763, slope = 114.0526, size=1.3)

Mes objectifs sont de montrer l’évolution dans le temps de la production de lait par vache aux États-Unis, mettre l’enphase sur l’amélioration de la période de 35 ans de données disponibles et de comparer ces données avec la moyenne de la production laitières des vaches du Québec que j’ai obtenu suite à mon analyse récente des données de Valacta. Voici le graphique que j’obtient:

MakeoverMonday | 2019W6: Comment le Nouvel An chinois se compare avec Thanksgiving

Pour la sixième semaine de #MakeoverMonday, nous avons utilisé des données de statista pour comparer le Nouvel An chinois avec le Thanksgivig américain.

Voici le graphique original et l’article:

 

Ce qui fonctionne:

  • Titre et sous-titre bien utilisés pour metre en place le sujet et le contexte
  • Les couleurs fonctionnent bien et sont bien choisies pour le thème
  • La légende est présente et bien utilisée
  • Les étiquettes de données sont présentes et illustrées avec les couleurs de la légende
  • La source des données est identifiée au bas du visuel

 

Ce qui peut être amélioré:

  • L’image en arrière plan est distraillante pour l’auditoire, elle est suffisament claire pour qu’on la remarque mais pas suffisament pour qu’on comprenne d’un premier coup d’oeil de quoi il s’agit alors, on passe du temps à essayer de comprendre l’image au lieu de focuser sur le graphique.
  • Les unités ne sont pas claires: bn=?, $=US ou Yuan? (ne peut pas être vérifié même dans l’article).
  • La population total de ces deux pays n’est pas identifiée. Pourtant, la population est beaucoup plus importante en chine et ça a un impact considérable sur l’interprétation des données.
  • Le type de graphique est difficile à comprendre: est-ce que la section en bleu est inclus dans la section en orange? Pour l’argent qui est dépensé au restaurant, il y aurait environ 50nb$ dépensés au États-Unis et 100nb$ dépensé en Chine. Ce ration de ½ n’est pas clairement visible sur la présentation.

 

Sur quoi je me suis concentrée:

  • Diviser les données par la population de chaque pays pour obtenir des chiffres comparables.
  • Représenter les données avec des histogrammes pour obtenir un visuel qui est plus facile à interpréter.
  • Garder ça clair et simple!

Voici mon graphique:

final fra

Voilà!

MakeoverMonday | 2019W5: Classement de lindice DESI en 2018

Cinquième semaine pour #MakeoverMonday.

Voici le graphique original et l’article:

Ce qui fonctionne:

  • Titre bien utilisé
  • Les axes sont présents et bien utilisés
  • La légende est présente

Ce qui ne fonctionne pas:

  • Pour ceux qui ne s’y connaissent pas, il manque la définition de l’indice DESI sur le graphique
  • Il y a trop de couleur sur le graphique, on ne sait pas ce qui est mis de l’avant.

Mes objectifs pour cette visualisation:

  • Utiliser les notions aquises lors de la lecture du livre Storytelling with data de Cole Nussbaumer Knaflic. Tout un chapite a été consacré à ce type de graphique.
  • Garder ça clair et simple!

Voici mon graphique:

J’ai choisi de mettre l’accent sur les catégories de l’indice qui sont directement reliées aux citoyens soit: la connectivité, le capital humain et l’utilisation d’Internet. En combinant ces 3 indices, j’ai pu faire ressortir les 6 pays d’Europe ou les citoyens sont les plus connectés (connectivité) et les plus qualifiés (capital humain). Donc, ces 6 pays sont ceux ou les citoyens utilisent d’avantage les services Internet mis à leur disposition.

Voilà!