Aires 3D

CONTEXTE

Les données du #Tidytuesday de cette semaine proviennent de The Wallstreet Journal.

OBJECTIFS

Montrer l’évolution des performances des joueurs (nombre de but) en fonction de l’âge et de la décennie.

IMPORTER

#tuesdata <- tidytuesdayR::tt_load('2020-03-03')  
game_goals <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-03/game_goals.csv')

FALSE Parsed with column specification:  
FALSE cols(  
FALSE   .default = col_double(),  
FALSE   player = col_character(),  
FALSE   date = col_date(format = ""),  
FALSE   age = col_character(),  
FALSE   team = col_character(),  
FALSE   at = col_character(),  
FALSE   opp = col_character(),  
FALSE   location = col_character(),  
FALSE   outcome = col_character()  
FALSE )

FALSE See spec(...) for full column specifications.

EXPLORER

#Sélectionner seulement les variables qui m'intéressent  
game<-game_goals %>%
     separate(age,into=c("annee", "jour"), "-") %>%
     mutate(annee=as.numeric(annee)) %>%
     select(season, annee, goals)    

glimpse(game)

## Observations: 49,384  
## Variables: 3  
## $ season <dbl> 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 200…  
## $ annee  <dbl> 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 2…  
## $ goals  <dbl> 2, 0, 0, 1, 1, 0, 0, 2, 0, 0, 2, 0, 0, 2, 2, 1, 0, 1, 1, …

summary(game)

##      season         annee           goals         
##  Min.   :1980   Min.   :18.00   Min.   :0.0000    
##  1st Qu.:1997   1st Qu.:23.00   1st Qu.:0.0000    
##  Median :2008   Median :27.00   Median :0.0000    
##  Mean   :2005   Mean   :27.77   Mean   :0.4136    
##  3rd Qu.:2014   3rd Qu.:32.00   3rd Qu.:1.0000    
##  Max.   :2020   Max.   :45.00   Max.   :5.0000

plt1 <-game %>%
     ggplot(aes(x=" ", y = goals)) +
     geom_boxplot(fill = "#FFFFFF", color = "black") +
     coord_flip() +    theme_classic() +    xlab("") +
    ylab("Nombre de but")+
    theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())    

plt2 <-game %>%
    ggplot() +
    geom_histogram(aes(x = goals, y = (..count..)/sum(..count..)),                         position = "identity", binwidth = 1,
                          fill = "#FFFFFF", 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))

game %>% 
    group_by(season,annee) %>%
     summarise(nb=sum(goals, na.rm=TRUE)) %>%
     spread(annee, nb) %>%
     knitr::kable()

season	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
1980	30	34	35	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1981	NA	34	84	58	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1982	NA	NA	93	124	47	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1983	NA	14	NA	72	127	40	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1984	39	NA	38	NA	79	134	41	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1985	NA	73	NA	31	NA	58	122	52	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1986	NA	NA	62	NA	36	NA	55	127	52	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1987	NA	NA	33	97	1	25	NA	66	131	49	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1988	4	3	NA	36	137	32	30	NA	57	97	55	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1989	NA	28	17	NA	38	158	41	28	NA	47	116	45	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1990	NA	NA	57	12	NA	40	119	72	40	NA	54	98	52	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1991	18	9	NA	65	12	NA	33	82	86	36	NA	34	42	47	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1992	NA	23	9	NA	49	13	NA	34	99	70	41	NA	40	81	46	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1993	NA	NA	22	12	76	73	26	NA	38	152	54	54	NA	21	75	58	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1994	NA	NA	NA	20	12	25	57	23	NA	31	54	57	53	NA	36	83	38	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1995	NA	NA	NA	NA	13	19	22	19	20	NA	7	28	29	22	NA	1	37	25	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
1996	NA	NA	NA	NA	NA	45	17	40	72	23	NA	19	109	43	28	NA	44	59	42	NA	NA	NA	NA	NA	NA	NA	NA	NA
1997	NA	21	NA	NA	NA	NA	44	3	51	47	22	NA	23	73	42	27	NA	41	62	38	NA	NA	NA	NA	NA	NA	NA	NA
1998	16	NA	13	NA	NA	NA	NA	25	10	52	47	8	NA	16	24	27	14	NA	28	37	13	NA	NA	NA	NA	NA	NA	NA
1999	NA	37	NA	28	NA	NA	NA	NA	26	18	47	58	14	NA	29	39	32	15	NA	19	9	NA	NA	NA	NA	NA	NA	NA
2000	NA	NA	40	NA	29	NA	NA	NA	NA	37	5	33	54	15	NA	29	42	24	20	NA	7	10	NA	NA	NA	NA	NA	NA
2001	NA	12	NA	62	NA	31	NA	NA	NA	NA	31	21	33	71	14	NA	28	62	39	20	NA	16	8	NA	NA	NA	NA	NA
2002	29	NA	17	NA	43	NA	52	NA	NA	NA	NA	18	13	29	52	11	NA	23	26	30	21	NA	7	0	NA	NA	NA	NA
2003	NA	45	NA	8	NA	64	NA	35	NA	NA	NA	NA	31	5	28	42	14	NA	6	35	37	20	NA	13	5	NA	NA	NA
2004	17	11	63	NA	11	NA	51	NA	41	NA	NA	NA	NA	20	11	16	50	8	NA	14	27	25	21	NA	13	5	NA	NA
2006	39	NA	132	74	71	0	31	NA	63	NA	35	NA	NA	NA	NA	40	14	40	54	18	NA	13	23	0	6	NA	NA	NA
2007	NA	67	33	123	93	76	NA	33	NA	54	NA	39	NA	NA	NA	NA	21	9	48	60	5	NA	NA	NA	NA	NA	NA	NA
2008	7	38	75	47	149	123	86	0	9	NA	48	NA	50	NA	NA	NA	NA	15	10	12	28	8	NA	NA	NA	NA	NA	NA
2009	6	25	54	120	35	155	146	75	NA	4	NA	63	NA	35	NA	NA	NA	NA	NA	NA	27	3	5	NA	NA	NA	NA	NA
2010	NA	56	50	49	142	28	136	128	64	0	10	NA	64	NA	32	NA	NA	NA	NA	NA	NA	27	NA	NA	NA	NA	NA	NA
2011	7	4	69	34	87	111	15	147	96	52	NA	22	NA	58	NA	43	NA	NA	NA	NA	NA	NA	31	NA	NA	NA	NA	NA
2012	NA	19	10	65	68	97	110	50	124	113	71	NA	22	NA	48	NA	32	NA	NA	NA	NA	13	6	26	NA	NA	NA	NA
2013	NA	NA	1	15	35	34	79	66	9	72	96	12	1	11	NA	24	NA	14	NA	NA	NA	NA	4	12	12	NA	NA	NA
2014	NA	NA	NA	24	13	38	61	105	129	23	174	114	23	0	19	NA	44	NA	30	NA	NA	NA	NA	17	7	9	NA	NA
2015	NA	NA	NA	NA	28	9	66	64	102	92	28	146	120	17	NA	18	NA	35	NA	29	NA	NA	NA	NA	11	6	NA	NA
2016	NA	NA	NA	NA	NA	25	8	54	79	118	118	27	143	97	33	NA	22	NA	44	NA	22	NA	NA	NA	NA	17	10	NA
2017	NA	NA	NA	NA	NA	NA	18	8	37	36	119	102	33	112	98	15	NA	24	NA	34	NA	14	NA	NA	NA	NA	10	6
2018	NA	NA	NA	NA	NA	NA	NA	23	17	56	57	85	123	42	117	110	8	NA	16	NA	40	NA	NA	NA	NA	NA	NA	1
2019	NA	NA	NA	NA	NA	NA	NA	NA	18	15	75	60	121	91	21	115	111	24	NA	23	NA	32	NA	NA	NA	NA	NA	NA
2020	NA	NA	NA	NA	NA	NA	NA	NA	NA	11	5	51	41	80	63	21	107	65	18	NA	2	NA	14	NA	NA	NA	NA	NA

PRÉPARER

#grouper par tranche de 10 ans  
data<-game %>%
     mutate(decade = floor(season/10)*10) %>%
         group_by(decade, annee) %>%
         summarize_all(sum) %>%
         select(-season) %>%
         ungroup() %>%
     filter(!decade==2020)    

glimpse(data)

FALSE Observations: 87  
FALSE Variables: 3  
FALSE $ decade <dbl> 1980, 1980, 1980, 1980, 1980, 1980, 1980, 1980, 1980, 198…  
FALSE $ annee  <dbl> 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 18, 19, 2…  
FALSE $ goals  <dbl> 73, 186, 362, 418, 465, 447, 289, 273, 240, 193, 171, 45,…

VISUALISER

#Graphique
library(ggridges)  
gg <- ggplot(data, aes(x=annee, y=decade, group=decade,height=goals))  
gg <- gg + geom_density_ridges(stat="identity", scale = 2, fill="#0098D5", color="#58595B")  
gg <- gg + theme(legend.position = 'none')  
gg <- gg + scale_x_continuous(breaks = seq(18,48,10), limits=c(18, 48), expand=c(0, 0))  
gg <- gg + scale_y_continuous(breaks = seq(1980,2010,10), limits=c(1980, 2030), expand=c(0, 0))    
#modifier le thème  
gg <- gg +  theme(plot.background = element_rect(fill = "#58595B"),
                    panel.background = element_rect(fill = "#58595B"),
                    panel.grid.major.y= element_blank(),
                    panel.grid.major.x= element_blank(),
                    panel.grid.minor = element_blank(),
                    axis.line.x = element_line(color="white"),
                    axis.line.y = element_line(color="white"),
                    axis.ticks.x = element_blank(),
                     axis.ticks.y = element_blank())  
#ajouter les titres  
gg<-gg + labs(title="Les joueurs de la LNH des années 2010 <span style='color:#0098D5'>comptent plus de but</span> début trentaine",                subtitle = " ",
              x="Âge",
              y=" ",
              caption="\nSOURCE:  HockeyReference.com   |  DESIGN: Johanie Fournier, agr.")  
gg<-gg + theme(  plot.title    = element_markdown(lineheight = 1.1,size=18, hjust=1,vjust=0.5, color="white"),
                   plot.subtitle = element_blank(),
                   plot.caption  = element_text(size=10, hjust=1,vjust=0.5, family="Tw Cen MT", color="white"),
                   axis.title.y  = element_blank(),
                   axis.title.x  = element_text(size=12, hjust=0,vjust=0.5, family="Tw Cen MT", color="white"),
                   axis.text.x   = element_text(size=10, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="white"),
                    axis.text.y   = element_text(size=10, hjust=1,vjust=0.5, family="Tw Cen MT", color="white"))

Voici ce que ça donne:

Alors, tu veux en savoir plus sur ma démarche? Abonne-toi à mon infolettre pour savoir quand est-ce que le prochain épisode de podcast sera disponible. J’y expliquerai toute la réflexion et les concepts de data visualisation qui ont menés à la création de cette viz.

Johanie Fournier, agr.

Agriculture, données, visualisation

Aires 3D

Laisser un commentaire Annuler la réponse.

Partager :

Laisser un commentaire Annuler la réponse.