Stat 290: Assignment 2

Due: 11:59pm Feb 7, 2016

Instructions

Follow these instructions paying full attention to details to get proper credit. Failure to do so will cost you points!

Q1 (Short answers)

1. In lecture 4 code, we showed how to exploit scoping rules (see person.html) and created the function makePerson. Here is the excerpted relevant part.

makePerson <- function(lastName = "", firstName = "") {
  getLastName <- function() lastName
  getFirstName <- function() firstName
  setLastName <- function(what)
      lastName <<- what
  setFirstName <- function(what)
      firstName <<- what
  getFullName <- function()
      paste(lastName, firstName, sep = ", ")
  list(getFullName = getFullName,
       getFirstName = getFirstName,
       getLastName = getLastName,
       setFirstName = setFirstName,
       setLastName = setLastName)
}

1a. What are the local variables to makePerson? Your answers should be a character vector of the local variables like c("a", "b") with a and b replaced appropriately. Empty vectors should be left as c() as shown.

c("getLastName", "getFirstName","setLastName","setFirstName", "getFullName")
## [1] "getLastName"  "getFirstName" "setLastName"  "setFirstName"
## [5] "getFullName"

1b. What are the bound variables to makePerson? Same answer format as 1a.

c("lastName", "firstName", "getLastName", "getFirstName","setLastName","setFirstName", "getFullName")
## [1] "lastName"     "firstName"    "getLastName"  "getFirstName"
## [5] "setLastName"  "setFirstName" "getFullName"

1c. What are the local variables to setLastName?

c("lastName")
## [1] "lastName"

1d. What are the bound variables to setLastName?

c("what","lastName")
## [1] "what"     "lastName"

1e. The above code can be used as follows:

p1 <- makePerson("Blow", "Joe")
p1$setLastName("Sixpack")
p1$getLastName()
## [1] "Sixpack"

Now suppose only the arguments of makePerson above are changed so that it now becomes:

makePerson <- function(x = "", y = "") {
    getLastName <- function() lastName
    getFirstName <- function() firstName
    setLastName <- function(what)
        lastName <<- what
    setFirstName <- function(what)
        firstName <<- what
    getFullName <- function()
        paste(lastName, firstName, sep = ", ")
    list(getFullName = getFullName,
         getFirstName = getFirstName,
         getLastName = getLastName,
         setFirstName = setFirstName,
         setLastName = setLastName)
}

Now consider what happens when we use it in an R session.

p2 <- makePerson("Blow", "Joe")
p2$setLastName("Sixpack")
p2$getLastName()
## [1] "Sixpack"

Are the above two versions of makePerson equivalent? Answer TRUE if yes, FALSE if no. (Not quoted "TRUE" or "FALSE", just plain R values, without quotes.)

FALSE
## [1] FALSE

1f. Justify your answer to 1e (1-2 sentences). Your answer should be a quoted string (line breaks ok). If you need to use quotes within the answer, use single quote.

"If lastName and firstName are not defined in the makerPerson function call, then the returned objects getFullName, getFirstName and getLastName will not have an intial value when called. You'll need to manually assign the inital values by calling setFirstname and setLastname "

Q2. Data Summary

2. Robert Carver in the paper describes a data cleaning exercise. This data, scraped from http://www.centennialofflight.net/chrono/log/1904HuffmanPrairie.htm is provided to you in 1904Prarie.rds as a data frame named d and also the paper as carver.pdf. Produce the numbers for table 2 on page 133 of the paper using simple one-liners that we will evaluate. Most of your numbers should match the table, although some will differ as noted. Hint: see help on sum, grep.

d <- readRDS("1904Prarie.rds")

2a. Total number of flights documented (will get 90 instead)

length(d$FLIGHT) - length(grep("1",d$FLIGHT))
## [1] 90

2b. Some flight data reported (will get 87 instead)

sum(grepl(paste(as.character(1:max(d$FLIGHT)),collapse="|"), d$FLIGHT)|grepl("[a-z]",d$PILOT,ignore.case=T) | grepl("[a-z]",d$TIME) | grepl("[a-z]",d$DISTANCE) | grepl("[a-z]",d$ALTITUDE) | grepl("[a-z]",d$REMARKS))
## [1] 93

2c. Pilot identified

length(grep("W",d$PILOT))
## [1] 78

2d. Time (flight duration)

length(grep("[a-z]",d$TIME))
## [1] 68

2e. Distance (ground covered)

length(grep("[a-z]",d$DISTANCE))
## [1] 80

2f. Altitude

length(grep("[a-z]",d$ALTITUDE))
## [1] 1

2g. Both time and distance recorded

sum(grepl("[a-z]",d$DISTANCE) & grepl("[a-z]",d$TIME))
## [1] 68

2h. Distance measured in feet

length(grep(" ft",d$DISTANCE))
## [1] 26

2i. Distance measured in meters (will get 52 instead)

length(grep(" m.",d$DISTANCE))
## [1] 52

2j. Other distance metric

length(grep("[a-z]",d$DISTANCE,ignore.case=T)) - sum(grepl(" ft",d$DISTANCE) | grepl(" m.",d$DISTANCE))
## [1] 2

2k. Distance estimated (e.g. “ca. 25 ft.”)

length(grep("ca..",d$DISTANCE))
## [1] 4

Q3. Data Cleanup

3. The 1904 Huffman Prairie data has a DATE column with some empty values. It would be nice to ensure that all columns have the appropriate date value, even if they are repeated.

3a. Modify the one date July to July 15.

d$DATE[grep("July",d$DATE)] = "July 15"

3b. Modify the FLIGHT variable so that it is integer (NAs are ok).

d$FLIGHT = as.numeric(d$FLIGHT)
d$FLIGHT[is.na(d$FLIGHT)] = 0

3c. Provide code that will ensure all DATE fields are populated correctly. There are many convoluted ways to do this, but the R way (in 3 short lines of code) would use the fact that FLIGHT is an integer in a computable range. This will help you detect rows that have a date versus those that don’t. Exploit this with the function cumsum. Your result should be:

  [1] "May 26"  "Jun 10"  "Jun 21"  "Jun 21"  "Jun 21"  "Jun 21"  "Jun 23"
  [8] "Jun 23"  "Jun 23"  "Jun 25"  "July 15" "Aug 2"   "Aug 2"   "Aug 2"
...
[120] "Dec 1"   "Dec 1"   "Dec 1"   "Dec 5"   "Dec 5"   "Dec 6"   "Dec 6"
[127] "Dec 7"   "Dec 7"   "Dec 9"   "Dec 9"   "Dec 9"
for (i in 1:nrow(d)){
  if (d$FLIGHT[i] > 0) d$DATE[i] = d$DATE[i-1]
}

3d. Assuming that the year is 1904, convert the DATE column to an actual date like:

  [1] "1904-05-26" "1904-06-10" "1904-06-21" "1904-06-21" "1904-06-21"
  [6] "1904-06-21" "1904-06-23" "1904-06-23" "1904-06-23" "1904-06-25"
...
[126] "1904-12-06" "1904-12-07" "1904-12-07" "1904-12-09" "1904-12-09"
[131] "1904-12-09"
library(lubridate)
d$DATE = as.Date(paste(d$DATE,"1940",sep=" "), format="%b %d %Y")

Q4. dplyr manipulations and summaries

4. For this exercise, download the SQLite database named 2012.sqlite3 (783Mb) from here. It has one table called ontime with columns described in Stat. Computing 2009 Expo site. Use dplyr for working with this data set.

Hints There are many functions in R that have no equivalents in SQL. It is advantageous to only bring summaries into R after doing as much processing in SQL as possible. The function collect in dplyr will collect the results of a SQL query and return the results into R as a tbl_df. Of course, the summary has to be of a reasonable size to fit into R, but once it is in R, you can use all the (vectorized) R functions to process them. So the idea is often to decide what can be done in SQL and what can be done in R to get the results desired. Remember dplyr works on SQL databses as well as data frames!

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:lubridate':
## 
##     intersect, setdiff, union
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
airline2012_db <- src_sqlite("2012.sqlite3")
ontime <- tbl(src_sqlite("2012.sqlite3"), "ontime")

4a. Construct a data frame (of class tbl_df in dplyr which is the result of a collect call) that contains the number of flights by each plane (identified by unique tail number). The result should have two columns named TailNum, count with highest count first. (Drop all empty tail numbers.) Your data frame should be named d4a.

d4a <- collect(select(ontime,TailNum) %>% group_by(TailNum) %>% summarize(count=n()))
d4a <- d4a[order(d4a$count,decreasing=T),]
if (exists("d4a") && ("tbl_df" %in% class(d4a))) {
    cat(sprintf("d4a has %d rows\n", nrow(d4a)))
} else {
    cat("d4a missing!\n")
}
## d4a has 4722 rows

4b. Which airline did the plane that flew most frequently belong to? Expected answer is a single row tbl_df with column names TailNum and UniqueCarrier. Your answer data frame should be named d4b.

ch = as.character(d4a[2,1])
d4b <- unique(collect(select(ontime,TailNum,UniqueCarrier) %>% filter(TailNum == ch)))
if (exists("d4b") && ("tbl_df" %in% class(d4b))) {
    cat(sprintf("d4b has %d rows\n", nrow(d4b)))
} else {
    cat("d4b missing!\n")
}
## d4b has 1 rows

4c. Compute the number of flights of this frequently used plane between each origin, destination pair, and the average duration in terms of actual elapsed time (use columns ActualElapsedTime). Your result should be a three column tbl_df with columns airport1, airport2 and avg_ftime. The airport1 should be lexicographically less than airport2 for each row. Hint You can use pmin and pmax functions in R. Your answer should be named d4c.

d4c = collect(ontime %>% filter(TailNum == ch) %>% group_by(Origin,Dest) %>% summarize(Avg = mean(ActualElapsedTime)))
if (exists("d4c") && ("tbl_df" %in% class(d4c))) {
    cat(sprintf("d4c has %d rows\n", nrow(d4c)))
} else {
    cat("d4c missing!\n")
}
## d4c has 14 rows

4d. Construct a data frame that lists each origin, destination pair and the number of flights between them, either way. Your result named flights should be a three column tbl_df with columns airport1, airport2 and count. The airport1 should be lexicographically less than airport2 for each row.

flights <- as.data.frame(collect(ontime %>% group_by(Origin,Dest) %>% summarize(count = count(Dest))))
colnames(flights) <- c('airport1', 'airport2', 'count')
flights = tbl_df(flights)
if (exists("flights") && ("tbl_df" %in% class(flights))) {
    cat(sprintf("flights has %d rows\n", nrow(flights)))
} else {
    cat("flights missing!\n")
}
## flights has 4647 rows

4e. Using the example of Nathan Yau at Flowing Data, use his code to produce a plot shown in figure below.

The code from Nathan is included here as a function so you don’t have to cut and paste. The file airports.RDS provided with this assignment which contains the airport latitudes and longitudes. The function doPlot below expects the flights data from question 4d above and the data frame containing the airport latitudes and longitudes. You need to install the packages maps and geosphere for this exercise.

installIfNeeded <- function(packages, ...) {
    toInstall <- setdiff(packages, installed.packages()[, 1])
    if (length(toInstall) > 0) {
        install.packages(toInstall, ...)
    }
}
installIfNeeded(c("maps", "geosphere"))
library(maps)
## 
##  # ATTENTION: maps v3.0 has an updated 'world' map.        #
##  # Many country borders and names have changed since 1990. #
##  # Type '?world' or 'news(package="maps")'. See README_v3. #
library(geosphere)
## Loading required package: sp
## Nathan's code wrapped into a function
doPlot <- function(flightData, airportInfo) {
    ## SOURCE: Nathan Yau @ flowing data
    ## URL: http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles
    xlim <- c(-171.738281, -56.601563)
    ylim <- c(12.039321, 71.856229)

    ## Color
    pal <- colorRampPalette(c("#333333", "white", "#1292db"))
    colors <- pal(100)

    map("world", col = "#191919", fill = TRUE, bg = "#000000", lwd = 0.05, xlim = xlim, ylim = ylim)
    flightData <- flightData[order(flightData$count), ]
    maxcount <- max(flightData$count)
    for (j in seq_len(nrow(flightData))) {
        air1 <- airportInfo[flightData$airport1[j], ]
        air2 <- airportInfo[flightData$airport2[j], ]
        inter <- gcIntermediate(c(air1[1, ]$long, air1[1, ]$lat),
                                c(air2[1, ]$long, air2[1, ]$lat), n = 100, addStartEnd = TRUE)
        colindex <- round( (flightData$count[j] / maxcount) * length(colors) )
        lines(inter, col = colors[colindex], lwd = 0.6)
    }
}

Use doPlot on your data to produce the graphic.

airportInfo <- readRDS("airports.RDS")
doPlot(flights,airportInfo)

Q5. Package building and checking

5. This exercise leads you through the package building process that will be necessary for project. You will be using some functions and data provided in class lectures. You only submit the resulting package file as noted above, no answers here. However, note the requirements.

5a. Your package should be named stat290.ass2.

5b. The version number of your package will be 1.0.

5c. You are provided a data set that will be part of the package. It is in bitly.RDS. As part of your package, you must include a dataset named bitly, so that when you package is used by a user as below, the following will work.

library(stat290.ass2)
data(bitly)
head(bitly)

5d. Your package should export two functions: one is the plotTzByOS function here and the other is the convolve following function. Use the function as is (no need to modify). Document this function briefly so that it passes checks and include an example in the documentation using the bitly data as shown in class in lecture 10.

plotTzByOS <- function(data, color = c("#999999", "#E69F00")) {
    tz <- unlist(lapply(data, function(x) x$tz))
    tz[tz == ""] <- "Unknown"
    tzTable <- sort(table(tz), decreasing=TRUE)
    d <- head(tzTable, 10)
    d <- data.frame(tz = names(d), count = d, stringsAsFactors = FALSE)
    d$tz <- factor(d$tz, levels=d$tz)
    agents <- unlist(lapply(data, function(x) x$a))
    win <- ifelse(grepl("Windows", agents), "Windows", "Nonwindows")

    tzWin <- table(tz, win)
    d2 <- data.frame(tzWin[as.character(d$tz), ])
    d2$tz <- factor(rownames(d2), levels = rownames(d2))
    d3 <- d2 %>% gather(key=os, value = "value", Nonwindows, Windows)
    ggplot(d3, aes(x = tz, y = value, fill = os)) +
        geom_bar(position = "fill", stat = "identity") +
        scale_y_continuous(labels = percent_format()) +
        scale_fill_manual(values = color) +
        coord_flip()
}

5e. Also place the files convolve.R and convolve.c in the appropriate areas of the package source tree. Document convolve.R with an example. You can borrow from the example in lecture 5.

5f. Build your package, as will be shown in class and ensure that the resulting file, which will be stat290.ass2_1.0.tar.gz passes R CMD check with only NOTEs. No errors, no warnings.

R CMD check stat290.ass2_1.0.tar.gz