Introduction

You will use this code as a template for your Visualization 3 assignment. The first step is to call a set of packages that you might use in this assignment. The final choices belong to you.

Note that each code chunk is set off with special tags.

#install.packages(c("tidyverse", "knitr", "markdown", "ggvis", "WDI", "plotly", "Rcpp", "digest"))
library(ggplot2)
library(dplyr)
library(ggvis)
library(WDI)
library(plotly)
library(tidyr)
library(gridExtra)
library(cowplot)
library(scales)

Call package `WDI` to retrieve most updated figures available.

In this assignment, we need to update 8 data series from the WDI:

Tableau Name	WDI Series
Birth Rate	SP.DYN.CBRT.IN
Health Exp % GDP	SH.XPD.TOTL.ZS
Health Exp/Capita	SH.XPD.PCAP
Infant Mortality Rate	SP.DYN.IMRT.IN
Internet Usage	IT.NET.USER.ZS
Life Expectancy (Total)	SP.DYN.LE00.IN
Mobile Phone Usage	IT.CEL.SETS.P2
Population Total	SP.POP.TOTL

The next code chunk will call the WDI API and fetch the years 2000 through 2017, as available. It will then remove the country regional and other aggregates.

birth <- "SP.DYN.CBRT.IN"
hxpgdp <- "SH.XPD.TOTL.ZS"
hxpcap <- "SH.XPD.PCAP"
infmort <- "SP.DYN.IMRT.IN"
net <-"IT.NET.USER.ZS"
lifeexp <- "SP.DYN.LE00.IN"
mobile <- "IT.CEL.SETS.P2"
pop <- "SP.POP.TOTL"

# create a vector of the desired indicator series
indicators <- c(birth, hxpgdp, hxpcap, infmort, net, lifeexp, mobile, pop)

newdata <- WDI(country="all", indicator = indicators, 
     start = 2000, end = 2017, extra = TRUE)

# remove country groupings
newdata$longitude[newdata$longitude==""] <- NA
countries <- filter(newdata, !is.na(longitude))  # drop aggregate groups
## rename columns for each of reference
countries <- rename(countries, birth = SP.DYN.CBRT.IN, 
       hxpgdp = SH.XPD.TOTL.ZS, hxpcap = SH.XPD.PCAP, 
       infmort = SP.DYN.IMRT.IN, net  = IT.NET.USER.ZS,
       lifeexp = SP.DYN.LE00.IN, mobile = IT.CEL.SETS.P2, 
       pop = SP.POP.TOTL)

glimpse(countries) ## data frame column names appear here

## Observations: 3,775
## Variables: 18
## $ iso2c     <chr> "AD", "AD", "AD", "AD", "AD", "AD", "AD", "AD", "AD"...
## $ country   <chr> "Andorra", "Andorra", "Andorra", "Andorra", "Andorra...
## $ year      <dbl> 2016, 2005, 2000, 2004, 2015, 2014, 2006, 2017, 2002...
## $ birth     <dbl> 8.800, 10.700, 11.300, 10.900, NA, NA, 10.600, NA, 1...
## $ hxpgdp    <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ hxpcap    <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ infmort   <dbl> 3.3, 4.1, 4.7, 4.2, 3.4, 3.5, 4.1, 3.2, 4.5, 3.9, 4....
## $ net       <dbl> 97.93064, 37.60577, 10.53884, 26.83795, 96.91000, 95...
## $ lifeexp   <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ mobile    <dbl> 98.51322, 81.85933, 36.00398, 76.55160, 91.44000, 83...
## $ pop       <dbl> 77281, 78867, 65390, 76244, 78014, 79223, 80991, 769...
## $ iso3c     <fct> AND, AND, AND, AND, AND, AND, AND, AND, AND, AND, AN...
## $ region    <fct> Europe & Central Asia, Europe & Central Asia, Europe...
## $ capital   <fct> Andorra la Vella, Andorra la Vella, Andorra la Vella...
## $ longitude <fct> 1.5218, 1.5218, 1.5218, 1.5218, 1.5218, 1.5218, 1.52...
## $ latitude  <fct> 42.5075, 42.5075, 42.5075, 42.5075, 42.5075, 42.5075...
## $ income    <fct> High income, High income, High income, High income, ...
## $ lending   <fct> Not classified, Not classified, Not classified, Not ...

Population Health Indicators graph (Tableau tab 2)

First I used select(), group_by(), and summarize() to get the needed data. A seperate graph was created for each variable, and finally they are combined side by side to form one graph. I added a new column ind, which is 1 for every country, in order to use geom_raster to create a rectangle for each country. Then I fill the rectangles by values of each variable(e.g. birth rates). A rectangle with lighter color means a lower value of a variable. *

## Your plotting code goes here

healthind <- select(countries, country, birth, infmort, hxpgdp, lifeexp) %>% 
  group_by(country) %>% 
  summarize(birthrate = mean(birth, na.rm = TRUE), 
            infmortrate = mean(infmort, na.rm = TRUE), 
            hexpgdp = mean(hxpgdp, na.rm = TRUE), 
            lifeexpec = mean(lifeexp, na.rm = TRUE)) 

healthind[is.na(healthind)] <- 0 
healthind$birlab <- percent(healthind$birthrate/1000, accuracy = 0.01)
healthind$hexlab <- percent(healthind$hexpgdp/100, accuracy = 0.01)
healthind$liflab <- round(healthind$lifeexpec)
healthind$inflab <- round(healthind$infmortrate/1000, 2)

healthind$ind <- rep(1, nrow(healthind))
healthind <- arrange(healthind, desc(birthrate))

p1 <- healthind %>% ggplot(aes(ind, country, fill = birthrate)) + 
  geom_raster() + 
  theme(legend.position = "bottom", axis.text.x=element_blank(), axis.ticks.x=element_blank(), strip.background = element_blank(), strip.text.y = element_blank(), plot.margin = margin(0, 0, 0, 0, "cm"), plot.title = element_text(hjust = 0.5, size = 10), axis.title.x=element_blank(), axis.title.y=element_blank(), axis.line = element_blank(), axis.text.y = element_text(hjust = 0), axis.ticks.y=element_blank()) + 
  scale_fill_gradient(low = "white", high = "dodgerblue4") + ggtitle("Birth Rate") + geom_text(aes(label = birlab), color = "white")

p2 <- healthind %>% ggplot(aes(ind, country, fill = infmortrate)) + 
  geom_raster() + 
  theme(legend.position = "bottom", axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank(), strip.background = element_blank(),
        strip.text.y = element_blank(), axis.ticks.x=element_blank(), plot.margin = margin(0, 0, 0, 0, "cm"), axis.text.x=element_blank(), axis.title.x=element_blank(), plot.title = element_text(hjust = 0.5, size = 10), axis.line = element_blank()) + 
  scale_fill_gradient(low = "white", high = "chocolate2") + ggtitle("Infant Mortality") + geom_text(aes(label =inflab), color = "white")

p3 <- healthind %>% ggplot(aes(ind, country, fill = hexpgdp)) + 
  geom_raster() + 
  theme(legend.position = "bottom", axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank(), strip.background = element_blank(),
        strip.text.y = element_blank(), axis.ticks.x=element_blank(), plot.margin = margin(0, 0, 0, 0, "cm"), axis.text.x=element_blank(), axis.title.x=element_blank(), plot.title = element_text(hjust = 0.5, size = 10), axis.line = element_blank()) + 
  scale_fill_gradient(low = "white", high = "yellow3") + ggtitle("Health EXP % GDP") + geom_text(aes(label = hexlab), color = "white")

p4 <- healthind %>% ggplot(aes(ind, country, fill = lifeexpec)) + 
  geom_raster() + 
  theme(legend.position = "bottom", axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank(), strip.background = element_blank(),
        strip.text.y = element_blank(), axis.ticks.x=element_blank(), plot.margin = margin(0, 0, 0, 0, "cm"), axis.text.x=element_blank(), axis.title.x=element_blank(), plot.title = element_text(hjust = 0.5, size = 10), axis.line = element_blank()) + 
  scale_fill_gradient(low = "white", high = "plum4") + ggtitle("Life Expectancy") + geom_text(aes(label = liflab), color = "white")

p5 <- plot_grid(p1, p2, p3, p4, align = "h", ncol = 4, rel_widths = c(2/5, 1/5, 1/5, 1/5)) 
title <- ggdraw() + draw_label("Health Indicator")
p6 <- plot_grid(title, p5, ncol=1, rel_heights=c(0.1, 5))
p6

The world does not change much as birth rate, infant mortality rate, and percentage of health expenses to GDP only decrease a little bit, and life expectancy only increase slightly.

Care Spending 2015 (Tableau tab 3)

The ggvis package is used for this graph. Health expenses as percentages of GDP are set as x-axis and country is set as y-axis. I first created a slider to allow users to choose a year by using input_slider. Since there is no data for health expenses in 2015, I choose 2009 as the initial value. Based on the year user selected, data of that year is filtered to be the source data for plotting. Then I put another slider that allow user to choose a percentage of health expense to GDP and assign this number to a new column named “inp”. The initial value is set to be 10%. These numbers are then replaced by “TRUE” or “FALSE” by comparing each country’s health expense percentage to them. After that, “TRUE” and “FALSE” are replaced by red and grey. As a result, each country has a corresponding color. Layer_rects is used to create the rectangle for each country. The length of each rectangle represents the corresponding health expense of each country. The rectangles are filled by either red or grey which is decided by the new column “inp”. The graph of health expenses per capita is developed in a similar way except that whether the rectangle of each country is red or grey does not depend on whether its health expense per capita is greater than the number selected by the user, but depend on whether its health expense as a percentage of GDP is greater than the selected number. It is also worth noting that two ggvis graphs are not able to be combined side by side and become one graph, so I plot them seperately. I failed to add the vertical line where x = the chosed number. I also failed to make the title change with the number user chooses. *

## Your plotting code goes here
tab3 <- select(countries, year, country, hxpgdp, hxpcap) %>% 
  group_by(country, year) %>% 
  arrange(desc(hxpgdp)) 
tab3[is.na(tab3)] <- 0

#slider <- eval(input_slider(min = min(tab3$year), max = max(year), value = 2009, step = 1))

pp1 <- ggvis(tab3, ~hxpgdp, ~country) %>% 
  filter(year == eval(input_slider(min = min(tab3$year), max = max(tab3$year), value = 2009, step = 1))) %>% 
  mutate(inp = eval(input_slider(min = 5, max = 15, value = 10, step = 1))) %>% 
  mutate(redorgrey = hxpgdp > inp) %>% 
  mutate(redorgrey = replace(redorgrey, redorgrey == TRUE, "red")) %>% 
  mutate(redorgrey = replace(redorgrey, redorgrey == FALSE, "grey")) %>% 
  layer_rects(x2 = 0, height = band(), fill := ~redorgrey) 
 

pp2 <- ggvis(tab3, ~hxpcap, ~country) %>% 
  filter(year == eval(input_slider(min = min(tab3$year), max = max(tab3$year), value = 2009, step = 1))) %>% 
  mutate(inp = eval(input_slider(min = 5, max = 15, value = 10, step = 1))) %>% 
  mutate(redorgrey = hxpgdp > inp) %>% 
  mutate(redorgrey = replace(redorgrey, redorgrey == TRUE, "red")) %>% 
  mutate(redorgrey = replace(redorgrey, redorgrey == FALSE, "grey")) %>% 
  layer_rects(x2 = 0, height = band(), fill := ~redorgrey) 

pp1

## Warning: Can't output dynamic/interactive ggvis plots in a knitr document.
## Generating a static (non-dynamic, non-interactive) version of the plot.

pp2

## Warning: Can't output dynamic/interactive ggvis plots in a knitr document.
## Generating a static (non-dynamic, non-interactive) version of the plot.

The data relevant to health expense % of GDP and health expense per capita of many countries which are at the top of the list in the original Tableau graph are missing here. As a result, these countries are not contained in this graph. From this perspective, countries at the top of the list are not the same. However, if we only focus on the countries of which both the R graph and Tableau graph have relevant data, we can see that the countries at the top of each list are similar. Liberia, Sierra Leone, and Lesotho always appear at the top of the lists of both graphs.

Technology graph (Tableau tab 4)

I first created a data frame contains mean mobpcap (mobile phone usage per capita) and mean intpcap (internet usage per capita) of all regions and countries, a data frame contains mean mobpcap and mean intpcap for all countries in a certain region, and a data frame contains mean mobpcap and mean intpcap for each country in “all” region. These 3 data frames are merged with the data frame that contains mobpcap and intpcap for each country in each region so that user can select “(All)” region and “(All)” country in the drop-down list to see relevant data. I created a drop-down list that allows users to select region. Another control is also created to allow users to select country. Based on the region and country the user selects, relevant data is filtered to be the source data for ploting. Then layer_bars is used to plot bar for each country. The height of bars represents the mobile phone usage per capita. After that, layer_lines and layer_points are used to plot dots and connect dots with lines. The x-coordinates for the dots are years, and y-coordinates are internet usage per capita. I failed to add title to the graph by using ggvis. *

## Your plotting code goes here
tab4 <- select(countries, country, region, year, mobile, net) %>% 
  group_by(country, region, year) %>% 
  summarize(mobpcap = mean(mobile, na.rm = TRUE), 
            intpcap = mean(net, na.rm = TRUE)) %>%
  arrange(year) 

taballall <- group_by(tab4, year) %>% 
  summarize(mobpcap = mean(mobpcap, na.rm = TRUE), 
            intpcap = mean(intpcap, na.rm = TRUE)) %>% 
  mutate(country = "(All)", 
         region = "(All)") 

taball <- group_by(tab4, region, year) %>% 
  summarize(mobpcap = mean(mobpcap, na.rm = TRUE), 
            intpcap = mean(intpcap, na.rm = TRUE)) %>% 
  mutate(country = "(All)") 

tab_all <- tab4 
tab_all$region <- "(All)"

tab4.1 <- merge(taballall, taball, all = TRUE)
tab4.2 <- merge(tab_all, tab4, all = TRUE)
tab4.3 <- merge(tab4.1, tab4.2, all = TRUE)
tab4.3 <- tab4.3[order(tab4.3$year, tab4.3$country), ]
tab4.3[is.na(tab4.3)] <- 0

ggvis(data = tab4.3, ~factor(year), ~mobpcap) %>% 
  filter(region == eval(input_select(label = "Region:", choices = c("(All)", "South Asia", "East Asia & Pacific", "Europe & Central Asia", "Latin America & Caribbean", "Middle East & North Africa", "North America", "Sub-Saharan Africa"))) & country == eval(input_select(label = "Country:", choices = c(distinct(tab4.3, country)$country)))) %>% 
  layer_bars(fill := "darkslategrey") %>% 
  layer_lines(~factor(year), ~intpcap, stroke := "gold", strokeWidth := 5) %>% 
  layer_points(~factor(year), ~intpcap, fill := "gold", size := 100) %>% 
  add_axis("x", title = "") %>% 
  add_axis("y", title = "Use as Percentage of Population")

## Warning: Can't output dynamic/interactive ggvis plots in a knitr document.
## Generating a static (non-dynamic, non-interactive) version of the plot.

From 2012 to 2017, the mobile phone usage per capita increase constantly from around 100% to 110%, and internet usage per capita increase constantly from around 41% to around 71%.

Conclusion

** In recent years, people’s health conditions in terms of birth rate, infant mortality rate, life expectancy, and health expenses as percentage to GDP are slighly improved. Also, people’s usage of mobile phone and internet significantly increased, showing that people’s living quality improved in recent years. #####