TyT2019W41 - Ratios to compare

By Johanie Fournier, agr. in rstats tidyverse tidytuesday

October 10, 2019

Get the data

ipf_lifts <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-08/ipf_lifts.csv")
## Rows: 41152 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (10): name, sex, event, equipment, age_class, division, weight_class_kg...
## dbl   (5): age, bodyweight_kg, best3squat_kg, best3bench_kg, best3deadlift_kg
## date  (1): date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Explore the data

summary(ipf_lifts)
##      name               sex               event            equipment        
##  Length:41152       Length:41152       Length:41152       Length:41152      
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##       age         age_class           division         bodyweight_kg   
##  Min.   : 0.50   Length:41152       Length:41152       Min.   : 37.29  
##  1st Qu.:22.50   Class :character   Class :character   1st Qu.: 60.00  
##  Median :31.50   Mode  :character   Mode  :character   Median : 75.55  
##  Mean   :34.77                                         Mean   : 81.15  
##  3rd Qu.:45.00                                         3rd Qu.: 97.30  
##  Max.   :93.50                                         Max.   :240.00  
##  NA's   :2906                                          NA's   :187     
##  weight_class_kg    best3squat_kg    best3bench_kg    best3deadlift_kg
##  Length:41152       Min.   :-210.0   Min.   :-160.0   Min.   :-215.0  
##  Class :character   1st Qu.: 160.0   1st Qu.:  97.5   1st Qu.: 170.0  
##  Mode  :character   Median : 215.0   Median : 140.0   Median : 222.5  
##                     Mean   : 217.6   Mean   : 144.7   Mean   : 221.8  
##                     3rd Qu.: 270.0   3rd Qu.: 185.0   3rd Qu.: 270.0  
##                     Max.   : 490.0   Max.   : 415.0   Max.   : 420.0  
##                     NA's   :13698    NA's   :2462     NA's   :14028   
##     place                date             federation         meet_name        
##  Length:41152       Min.   :1973-11-09   Length:41152       Length:41152      
##  Class :character   1st Qu.:1998-12-11   Class :character   Class :character  
##  Mode  :character   Median :2007-10-14   Mode  :character   Mode  :character  
##                     Mean   :2006-02-19                                        
##                     3rd Qu.:2015-06-05                                        
##                     Max.   :2019-08-26                                        
## 

Prepare the data

comp_poids<-ipf_lifts %>% 
  mutate(ratio=best3deadlift_kg/bodyweight_kg) %>% 
  filter(!is.na(ratio), !is.na(age_class), !age_class=="5-12") %>% 
  select(age_class, sex, ratio) %>% 
  group_by(sex, age_class) %>% 
  summarise(moyenne=mean(ratio, na.rm=TRUE), et=sd(ratio, na.rm=TRUE)) %>% 
  mutate(age_class=as.factor(age_class))
## `summarise()` has grouped output by 'sex'. You can override using the `.groups` argument.

Visualize the data

#Graphique
gg<-ggplot(data=comp_poids)
gg<-gg + geom_rect(data=comp_poids, aes(x=age_class, y=moyenne), 
                   xmin=as.numeric(comp_poids$age_class[[5]])-0.5,
                   xmax=as.numeric(comp_poids$age_class[[6]])+0.5,
                   ymin=0, 
                   ymax=4,
                   fill="#E7E7E7", alpha=0.6)
gg<-gg + geom_rect(data=comp_poids, aes(x=age_class, y=moyenne), 
                   xmin=as.numeric(comp_poids$age_class[[9]])-0.5,
                   xmax=as.numeric(comp_poids$age_class[[10]])+0.5,
                   ymin=0, 
                   ymax=4,
                   fill="#E7E7E7", alpha=0.6)
gg<-gg + geom_rect(data=comp_poids, aes(x=age_class, y=moyenne), 
                   xmin=as.numeric(comp_poids$age_class[[12]])-0.5,
                   xmax=as.numeric(comp_poids$age_class[[13]])+0.5,
                   ymin=0, 
                   ymax=4,
                   fill="#E7E7E7", alpha=0.6)
gg<-gg + geom_segment( aes(x=as.numeric(comp_poids$age_class[[5]]),xend=as.numeric(comp_poids$age_class[[13]]),
                   y=3.24, 
                   yend=2.2),
                   color="#EA9010", alpha=0.6)
gg<-gg + geom_segment( aes(x=as.numeric(comp_poids$age_class[[5]]),xend=as.numeric(comp_poids$age_class[[13]]),
                   y=2.73, 
                   yend=1.92),
                   color="#4A0D67", alpha=0.6)
gg<-gg + geom_point(data=comp_poids,aes(x=age_class, y=moyenne, group=sex, color=sex), size=4.5)
gg<-gg + geom_errorbar(data=comp_poids, aes(x=age_class, ymin=moyenne-et, ymax=moyenne+et, color=sex), width=0.3, size=0.6, alpha=0.6)
gg<-gg + scale_color_manual(values=c("#4A0D67","#EA9010"))
#retier la légende
gg<-gg + theme(legend.position = "none")
#ajuster les axes
gg<-gg + scale_y_continuous(breaks=seq(0,4,0.5), limits=c(0, 4))
#modifier le thème
gg <- gg +  theme(panel.border = element_blank(),
                    panel.background = element_blank(),
                    plot.background = element_blank(),
                    panel.grid.major.x= element_blank(),
                    panel.grid.major.y= element_blank(),
                    panel.grid.minor = element_blank(),
                    axis.line.x = element_line(size=0.5, color="#A9A9A9"),
                    axis.line.y =element_line(size=0.5, color="#A9A9A9"),
                    axis.ticks = element_blank())
#ajouter les titres
gg<-gg + labs(title="<span style='color:#4A0D67'>**Women**</span>  lose their super power slower than <span style='color:#EA9010'>**Men**</span> !",
              subtitle = "\nAt their best, men can lift 3.2X their body weight at deadlift. Women can lift 2.7X their weight for the same age category.\nWhat is surprising is that women lose their physical capacity less quickly than men.\n",
              x="Age", 
              y="Lift Weight/Body Weight Ratio", 
              caption="\nSOURCE: Open Powerlifting   |  DESIGN: Johanie Fournier, agr.")
gg<-gg + theme(  plot.title    =  element_markdown(lineheight = 1.1,size=29, hjust=0,vjust=0.5, face="bold", color="#404040"),
                 plot.subtitle = element_text(size=14, hjust=0,family="Tw Cen MT", color="#8B8B8B"),
                 plot.caption  = element_text(size=8, hjust=1,vjust=0.5, family="Tw Cen MT", color="#8B8B8B"),
                 axis.title.y  = element_text(size=12, hjust=1,vjust=0.5, family="Tw Cen MT", color="#8B8B8B", angle=90),
                 axis.title.x  = element_text(size=12, hjust=0,vjust=0.5, family="Tw Cen MT", color="#8B8B8B"),
                 axis.text.y   = element_text(size=12, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#8B8B8B"), 
                 axis.text.x   = element_text(size=12, hjust=0.5,vjust=0.5, family="Tw Cen MT", color="#8B8B8B"))
Posted on:
October 10, 2019
Length:
3 minute read, 562 words
Categories:
rstats tidyverse tidytuesday
Tags:
rstats tidyverse tidytuesday
See Also:
FADQ historical crops data
I Juste Make my Own Blog!
TyT2020W10 - 3D Aeras