Yet the Worst Olympic Chart

August 5, 2016
By

(This article was first published on Daniel's Blog, and kindly contributed to R-bloggers)

Ah, the numbers! The Olympic Games are back in high style in Rio. Despite Brazil’s sluggish economy and unfulfilled promises for this Summer Olympic Games, I’d say, my expectations were met yesterday with such a beautiful opening ceremony. Let’s follow the competition over the next few days–the pressure to perform has only just begun.

One interesting aspect about the Olympic games is the way people around the globe cover it. In fact, several news houses are quite excited about telling predictions and showing medals rankings of all sort, starting soon today. Surprisingly, yesterday my eyes catch a stacked bar chart by NBC with a really bad visualization taste. It’s so inaccurate that it deserves the title of Worst Olympic Chart.

center

The colors are fine, but the dimensions are simply misleading. How have the 976 USA Olympic gold medals been given less length in the plot than 797 Russia’s medals (silver and bronze), or all 777.5 medals of Great Britain? Yep, that’s right. One can get half a medal by tying for a placement. Anyway, I believe it shouldn’t be that difficult to make a decent-looking, yet accurate plot for readers. Perhaps, the worst is yet to come.

Top-3 all-time Olympic medals

center

The data points

library(dplyr)

country = c(rep('US',3),rep('RUS',3),rep('GB',3))
Medal = rep(c('Gold','Silver','Bronze'),3)
counts = c(976.0, 759.5, 668.5, 440.0, 357.0,326.0, 233.5, 272.5, 271.5)

Olympics = as.data.frame(
  cbind(country,
        Medal,
        counts))

Olympics$counts = as.numeric(levels(Olympics$counts))[Olympics$counts]
Olympics$Medal <- factor(Olympics$Medal,levels = c('Gold','Silver','Bronze'))

Olympics <- Olympics %>% 
  group_by(country) %>% 
  mutate(mid_y=cumsum(counts) - 0.5*counts)

Do the plot

library(ggplot2)
library(SciencesPo) # for the theme.


g <- ggplot(Olympics,aes(x = country, y=counts, fill = Medal)) 
g <- g + geom_bar(stat = 'identity')
g <- g + scale_fill_manual(values = c('#FFD700','#C0C0C0','#CD7F32')) 
g <- g + scale_y_continuous(limits = c(0, 2500))
g <- g + geom_text(aes(label=counts, y = mid_y), size = 3)
g <- g + labs(x='',y='Number of Medals', title='Olympic Medals')
g <- g + coord_flip() + theme_scipo(base_size = 13)
g <- g + no_y_gridlines()
print(g)

To leave a comment for the author, please follow the link and comment on their blog: Daniel's Blog.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)