Homework #3 Data Aggregation

In this homework we start to deal with data aggregation methods in R.

Loading Data File

gdURL <- "http://www.stat.ubc.ca/~jenny/notOcto/STAT545A/examples/gapminder/data/gapminderDataFiveYear.txt"
gDat <- read.delim(file = gdURL)

library(plyr)
library(xtable)

Maximum and Minimum of GDP Per Capita for All Continents

We have sorted the data for different continents based on the maximum GDP per capita in each continent. As we see, excepting Africa, the other four continents are sorted on their minimum GDP per capita from the highest to the lowest- with the reverse order of the maximum GDP per capita. This means roughly that the continents with the richest country have also the poorest one. In other words, the wealth gap between the richest and the poorest country among different countries in a continent increases with the level of wealth of the richest. This general rule has an exception, Africa, which not only has the poorest country, but also its wealthiest country is not as wealthy as those of other continents.

# Produce a data.frame with 3 variables: a continent factor, the minimum GDP
# per capita, the maximum GDP per capita.
MinMaxPPP <- ddply(gDat, ~continent, summarize, ContMinPPP = min(gdpPercap), 
    ContMaxPPP = max(gdpPercap))
# Sort on the maximum
MaxSortedPPP <- arrange(MinMaxPPP, ContMaxPPP)
MaxPPPTable <- xtable(MaxSortedPPP)
print(MaxPPPTable, type = "html", include.rownames = FALSE)

Maximum and Minimum of GDP Per Capita for All Continents in a “Tall” Format

We have used a function which returns for each continent, the minimum life expectancy as well as the maximum life expectancy. At last, everything is reported in a table.

# Get the maximum and minimum of Life Expectancy for all continents in a
# 'tall' format.

# this function for each input makes a data frame of two rows, one
# containing the maximum life expectancy and the other has the minimum
# (among countries in a continent)
MinMaxLife <- function(x) {
    MinLife <- min(x$lifeExp)
    MaxLife <- max(x$lifeExp)
    staname <- c("Minimum Life Expectancy", "Maximum Life Expectancy")
    val <- c(MinLife, MaxLife)
    fdat <- data.frame(staname, val)
    return(fdat)
}
MinMaxLifeData <- ddply(gDat, ~continent, MinMaxLife)
MinMaxLifeTable <- xtable(MinMaxLifeData)
print(MinMaxLifeTable, type = "html", include.rownames = FALSE)

Spread of GDP Per Capita Within the Continents

We have produced a data.frame with one row per continent and variables containing the different measures of spread for GDP per capita. Then we sorted on Median Absolute Deviation –which we prefer due to our belief in its robustness. Ignoring Asia for a minute, we can observe that, the data based on other two measures is also fairly sorted. About Asia, we would rather say that it has the second least Median Absolute Deviation. On the other hand, it has the highest standard deviation. This implies that, in Asia, countries with extreme levels of GDP per capita –outlier countries- have extremely high weights in their GDP levels, which influence standard deviation a lot but since are they include small number of countries, their impact on Median Absolute Deviation is not that much. This is somehow the case in Americas as well. This partly shows that, sometimes, it is not reasonable to trust on standard deviation as a measure of the spread of the data.

# Spread of GDP per capita within the continents
gdpSpread <- ddply(gDat, ~continent, summarize, StdDev = sd(gdpPercap), MedAbsDev = mad(gdpPercap), 
    InQuartRange = IQR(gdpPercap))
SortedgdpSpread <- arrange(gdpSpread, MedAbsDev)
SortedSpreadTable <- xtable(SortedgdpSpread)
print(SortedSpreadTable, type = "html", include.rownames = FALSE)

Trimmed Mean of Life Expectancy for Different Years

In this part we see the trimmed mean of life expectancy among countries in different years. We have chosen a trim fraction of 0.2 (or 20%). The results are as follows:

## Computing a trimmed mean (with 20% trim level) of life expectancy for
## different years
TrimLevel <- 0.2
TrimMeanLifeExp <- ddply(gDat, ~year, summarize, meanlifeExp = mean(lifeExp, 
    TrimLevel))
names(TrimMeanLifeExp) <- c("Year", "Trimmed Mean- level: 20%")
TrimMeanTable <- xtable(TrimMeanLifeExp)
print(TrimMeanTable, type = "html", include.rownames = FALSE)

The Trend of Change in Life Expectancy Over Time on Different Continents

We have produced a data.frame with 3 variables: continent, year, and median life expectancy. In general we observe an increase over time in median life expectancy in all of the continents. But it is not too straightforward to compare the rate of this increase across different continents. I think a graph will work way better than this table.

## The trend of life expectancy median over time in different continents?
MedLifeExp <- ddply(gDat, ~continent + year, summarize, ContMedlifeExp = median(lifeExp))
names(MedLifeExp) <- c("continent", "year", "MedianLifeExpectancy")
MedLifeExpTable <- xtable(MedLifeExp)
print(MedLifeExpTable, type = "html", include.rownames = FALSE)

However, in order to get a better insight into the rate of this increase, I have added another table which shows the slope and intercept of a linear regression of the median of life expectancy based on an adjusted year, for different continents. As we see, Asia has the most rapid increase in life expectancy, even though it has started with a relatively small life expectancy at 1952.

# Finding the Trend of change of the median life expectancy over time across
# continents
yearMin <- 1952
RegLifeYear <- function(x) {
    RegCoefs <- coef(lm(MedianLifeExpectancy ~ I(year - yearMin), x))
    names(RegCoefs) <- c("intercept", "slope")
    return(RegCoefs)
}

LifeYearTrend <- ddply(MedLifeExp, ~continent, RegLifeYear)
LifeYearTrendTable <- xtable(LifeYearTrend)
print(LifeYearTrendTable, type = "html", include.rownames = FALSE)

An Extension : The Trend of Change in Life Expectancy Over Time

In this part I got a data.frame with 1 + 5 = 6 variables: year and then one variable per continent, giving median life expectancy. Compared to the last part, this seems to be more compact and insightful. We have used the potentials of daply() in this part.

## The same Task above using daply (data.frame with 1+5 variables)
MedLifeExp2 <- daply(gDat, ~year + continent, summarize, median(lifeExp))
MedLifeExpTable2 <- xtable(MedLifeExp2)
print(MedLifeExpTable2, type = "html")

The Number of Countries with Low Life Expectancy Over Time by Continent.

I have computed the average of worldwide life expectancy (about 59.5) . Then I determined how many countries on each continent have a life expectancy less than this benchmark, for each year. I produced a data.frame with 3 variables: continent, year, and a country count. We see an overall decrease in the number of low life expectancy over time across different continents. For some continents, such as Asia, this decrease occurs with a higher rate, while for some others such as Europe it is relatively slow. It is not fun to assess this from this tall table, at all! Maybe a graph or a linear regression might be more meaningful.

## Counting the number of countries with low life expectancy over time by
## continent
Benchmark <- mean(gDat$lifeExp)  ## benchmark is the average of Life Expectancy over time
LowLifeCount <- ddply(gDat, ~continent + year, summarize, LowCount = sum(lifeExp < 
    Benchmark))
LowLifeCountTable <- xtable(LowLifeCount)
print(LowLifeCountTable, type = "html", include.rownames = FALSE)

Proportion of Countries with Low Life Expectancy Over Time by Continent.

The continents have very different numbers of countries. First, I counted the number of countries in each continent simply-counting the number of countries with a life expectancy more than zero in each continent. Then the ratio of the low life expectancy countries has been computed. To be more precise I have added another column showing the low life expectancy count besides the ratio. The ratios are more meaningful if we want to compare continents based on some measures describing their growth in life expectancy. However ratios do not tell everything. Sometimes the number of countries that have improved their life expectancy is important for us. So I think adding one column does not cost a lot but gives more comprehensive insight into the data.

## Computing the proportion of countries with low life expectancy over time
## by continent.
Benchmark <- mean(gDat$lifeExp)  ## benchmark is the average of Life Expectancy over time
LowLifeRatio <- ddply(gDat, ~continent + year, summarize, LowRatio = sum(lifeExp < 
    Benchmark)/sum(lifeExp > 0), LowCount = sum(lifeExp < Benchmark))
names(LowLifeRatio) <- c("continent", "year", "Low Life Expectancy Ratio", "Low Life Expectancy Count")
LowLifeRatioTable <- xtable(LowLifeRatio)
print(LowLifeRatioTable, type = "html", include.rownames = FALSE)

Relative Abundance of Countries with Low Life Expectancy Over Time by Continent

In this part I have created a table with one row per year and one column per continent. In that column, I have reported the relative abundance of “low life expectancy” countries. I have took advantage of daply() with one line of programming and a more compact table than that of last part.

## An extension on Computing the proportion of countries with low life
## expectancy over time by continent.
Benchmark <- mean(gDat$lifeExp)  ## benchmark is the average of Life Expectancy over time
LowLifeRatio2 <- daply(gDat, ~continent + year, summarize, LowRatio = sum(lifeExp < 
    Benchmark)/sum(lifeExp > 0))
LowLifeRatioTable2 <- xtable(LowLifeRatio2)
print(LowLifeRatioTable2, type = "html")