Yet the Worst Olympic Chart

[This article was first published on Daniel's Blog, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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.


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


The data points


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 =

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(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()

To leave a comment for the author, please follow the link and comment on their blog: Daniel's Blog. offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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)