TyT2019W34 - Stack of Histograms

By Johanie Fournier, agr. in rstats tidyverse tidytuesday

August 20, 2019

Get the data

nuclear_explosions <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-08-20/nuclear_explosions.csv")
## Rows: 2051 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (6): country, region, source, purpose, name, type
## dbl (10): date_long, year, id_no, latitude, longitude, magnitude_body, magni...
## 
## ℹ 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(nuclear_explosions)
##    date_long             year          id_no         country         
##  Min.   :19450716   Min.   :1945   Min.   :45001   Length:2051       
##  1st Qu.:19621066   1st Qu.:1962   1st Qu.:62140   Class :character  
##  Median :19700501   Median :1970   Median :70021   Mode  :character  
##  Mean   :19709736   Mean   :1971   Mean   :70934                     
##  3rd Qu.:19790920   3rd Qu.:1979   3rd Qu.:79044                     
##  Max.   :19980530   Max.   :1998   Max.   :98005                     
##                                                                      
##     region             source             latitude        longitude      
##  Length:2051        Length:2051        Min.   :-49.50   Min.   :-169.32  
##  Class :character   Class :character   1st Qu.: 37.00   1st Qu.:-116.05  
##  Mode  :character   Mode  :character   Median : 37.10   Median :-116.00  
##                                        Mean   : 35.40   Mean   : -36.05  
##                                        3rd Qu.: 49.87   3rd Qu.:  78.00  
##                                        Max.   : 75.10   Max.   : 179.22  
##                                                                          
##  magnitude_body  magnitude_surface     depth            yield_lower     
##  Min.   :0.000   Min.   :0.0000    Min.   :-400.0000   Min.   :    0.0  
##  1st Qu.:0.000   1st Qu.:0.0000    1st Qu.:   0.0000   1st Qu.:    0.0  
##  Median :0.000   Median :0.0000    Median :   0.0000   Median :    0.0  
##  Mean   :2.145   Mean   :0.3558    Mean   :  -0.4896   Mean   :  209.2  
##  3rd Qu.:5.100   3rd Qu.:0.0000    3rd Qu.:   0.0000   3rd Qu.:   20.0  
##  Max.   :7.400   Max.   :6.0000    Max.   :   1.4510   Max.   :50000.0  
##                                                        NA's   :3        
##   yield_upper         purpose              name               type          
##  Min.   :    0.00   Length:2051        Length:2051        Length:2051       
##  1st Qu.:   18.25   Class :character   Class :character   Class :character  
##  Median :   20.00   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :  323.43                                                           
##  3rd Qu.:  150.00                                                           
##  Max.   :50000.00                                                           
##  NA's   :5

Prepare the data

#quel est le pays qui enregistre le plus d'explosion nucléaire?
nuclear_explosions_cat <- nuclear_explosions %>% 
  inspect_cat()
pct_country<-nuclear_explosions_cat$levels$country %>% 
  mutate(type="country")
#rep=USA avec 50%

#Dans quel région les États-Unis font-ils exploser leurs bombes?
nuclear_explosions_cat <- nuclear_explosions %>% 
  filter(country=="USA") %>% 
  inspect_cat()
pct_region<-nuclear_explosions_cat$levels$region %>% 
  mutate(type="country")
#rep: NTS avec 88% (Nevada Test Site)

#Pour quel raison?
nuclear_explosions_cat <- nuclear_explosions %>% 
  filter(country=="USA") %>% 
  mutate(raison="autres") %>% 
  mutate(raison=ifelse(purpose=="COMBAT", "COMBAT", raison)) %>% 
  mutate(raison=ifelse(purpose %in% c("WR", "WE", "WE/WR", "WR/WE", "SE/WR", "WR/SE"), "Training", raison)) %>% 
  inspect_cat()
pct_purpose<-nuclear_explosions_cat$levels$purpose
pct_purpose<-nuclear_explosions_cat$levels$raison %>% 
  mutate(type="country")

Visualize the data

#Graphique 1: Qui
gg<-ggplot(pct_country, aes(x=type, y=prop, fill=reorder(value, -prop)))
gg <- gg + geom_chicklet(width = 1.8)
gg <- gg + coord_flip()
gg <- gg + scale_fill_manual(values=c("#749594", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB"))
#retirer la légende
gg <- gg + theme(legend.position = "none")
#ajuster les axes 
gg <- gg + expand_limits(y=c(0, 1.3))
gg <- gg + expand_limits(x=c(-4, 3))
#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_blank(),
                    axis.line.y = element_blank(),
                    axis.ticks.y = element_blank(),
                    axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title="Who Plays With Nuclear Weapons?",
              subtitle="\nNuclear weapons technology was developed in the 1930s and 1940s.\nSince then, 2078 bombs have been deployed.\n\nPercentage of nuclear devices deployed by country",
              y=" ", 
              x=" ")
gg<-gg + theme(plot.title    = element_text(size=40, hjust=0,vjust=0, face="bold", family="Tw Cen MT"),
                 plot.subtitle = element_text(size=25, hjust=0,vjust=0, family="Tw Cen MT", color="#7A878E"),
                 axis.title.y  = element_blank(),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_blank(), 
                 axis.text.x   = element_blank())
#ajouter les étiquettes de données
gg<-gg + annotate(geom="text", x=1,y=0.01, label="United States", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")
gg<-gg + annotate(geom="text", x=1,y=0.38, label="50%", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")

#Graphique 2: pourquoi
gg<-ggplot(pct_purpose, aes(x=type, y=prop))
gg <- gg + geom_chicklet(aes(fill=reorder(value, -prop)),width = 1.8)
gg <- gg + coord_flip()
gg <- gg + scale_fill_manual(values=c("#749594", "#AFB7BB", "#AFB7BB"))
#retirer la légende
gg <- gg + theme(legend.position = "none")
#ajuster les axes 
gg <- gg + expand_limits(y=c(0, 1.3))
gg <- gg + expand_limits(x=c(-4, 3))
#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_blank(),
                    axis.line.y = element_blank(),
                    axis.ticks.y = element_blank(),
                    axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title=" ",
              subtitle="Reasons for deploying US bombs",
              y=" ", 
              x=" ")
gg<-gg + theme(plot.title    = element_blank(),
                 plot.subtitle = element_text(size=25, hjust=0,vjust=0, family="Tw Cen MT", color="#7A878E"),
                 axis.title.y  = element_blank(),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_blank(), 
                 axis.text.x   = element_blank())
#Faire des flèches
arrows <- tibble(
  x1 = c(2.2),
  x2 = c(1.9),
  y1 = c(1.20),
  y2 = c(1)
)
gg<-gg +    geom_curve(data = arrows, aes(x = x1, y = y1, xend = x2, yend = y2), 
                              arrow = arrow(length = unit(0.1, "inch")), 
                              size = 0.8, color = "#D33E43", curvature = 0.3)
#ajouter les étiquettes de données
gg<-gg + annotate(geom="text", x=1,y=0.01, label="Training", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")
gg<-gg + annotate(geom="text", x=1,y=0.78, label="90%", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")
gg<-gg + annotate(geom="text", x=1,y=1.2, label="Combat\n0.002%", color="#D33E43", size=7, hjust=0.5,vjust=0.5, fontface="bold", family="Tw Cen MT")

#Graphique 3: ou
gg<-ggplot(pct_region, aes(x=type, y=prop))
gg <- gg + geom_chicklet(aes(fill=reorder(value, -prop)),width = 1.8)
gg <- gg + coord_flip()
gg <- gg + scale_fill_manual(values=c("#749594", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB", "#AFB7BB"))
#retirer la légende
gg <- gg + theme(legend.position = "none")
#ajuster les axes 
gg <- gg + expand_limits(y=c(0, 1.3))
gg <- gg + expand_limits(x=c(-4, 3))
#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_blank(),
                    axis.line.y = element_blank(),
                    axis.ticks.y = element_blank(),
                    axis.ticks.x = element_blank())
#ajouter les titres
gg<-gg + labs(title=" ",
              subtitle="Region where US bombs were deployed",
              y=" ", 
              x=" ",
              caption= "The first nuclear weapons exploded on Hiroshima and Nagasaki in\nAugust 1945 during the Second World War and caused thousands of\ndeaths. Since then, control over the proliferation of nuclear weapons\nhas been an important issue in international relations.\n")
gg<-gg + theme(plot.title    = element_blank(),
                 plot.subtitle = element_text(size=25, hjust=0,vjust=0, family="Tw Cen MT", color="#7A878E"),
                 plot.caption = element_text(size=25, hjust=0,vjust=0, family="Tw Cen MT", color="#7A878E"),
                 axis.title.y  = element_blank(),
                 axis.title.x  = element_blank(),
                 axis.text.y   = element_blank(), 
                 axis.text.x   = element_blank())
#Faire des flèches
arrows <- tibble(
  x1 = c(2.2),
  x2 = c(1.9),
  y1 = c(1.20),
  y2 = c(0.99)
)
gg<-gg +    geom_curve(data = arrows, aes(x = x1, y = y1, xend = x2, yend = y2), 
                              arrow = arrow(length = unit(0.1, "inch")), 
                              size = 0.8, color = "#D33E43", curvature = 0.3)
#ajouter les étiquettes de données
gg<-gg + annotate(geom="text", x=1,y=0.01, label="Nevada test site", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")
gg<-gg + annotate(geom="text", x=1,y=0.76, label="88%", color="black", size=10, hjust=0,vjust=0.5, fontface="bold", family="Tw Cen MT")
gg<-gg + annotate(geom="text", x=1,y=1.2, label="Hiroshima and\nNagasaki 0.002%", color="#D33E43", size=7, hjust=0.5,vjust=0.5, fontface="bold", family="Tw Cen MT")
Posted on:
August 20, 2019
Length:
6 minute read, 1075 words
Categories:
rstats tidyverse tidytuesday
Tags:
rstats tidyverse tidytuesday
See Also:
FADQ historical crops data
I Juste Make my Own Blog!
TyT2020W10 - 3D Aeras