Condition handling

1. Compare the following two implementations of message2error(). What is the main advantage of withCallingHandlers() in this scenario? (Hint: look carefully at the traceback.)

message2error <- function(code) {
  withCallingHandlers(code, message = function(e) stop(e))
}
message2error1 <- function(code) {
  tryCatch(code, message = function(e) stop(e))
}

Defensive programming

1. The goal of the col_means() function defined below is to compute the means of all numeric columns in a data frame.

col_means <- function(df) {
  numeric <- sapply(df, is.numeric)
  numeric_cols <- df[, numeric]

  data.frame(lapply(numeric_cols, mean))
}

However, the function is not robust to unusual inputs. Look at the following results, decide which ones are incorrect, and modify col_means() to be more robust. (Hint: there are two function calls in col_means() that are particularly prone to problems.)

#correct
col_means(mtcars)

##        mpg    cyl     disp       hp     drat      wt     qsec     vs
## 1 20.09062 6.1875 230.7219 146.6875 3.596563 3.21725 17.84875 0.4375
##        am   gear   carb
## 1 0.40625 3.6875 2.8125

col_means(mtcars[, 0])
#Error in .subset(x, j) : invalid subscript type 'list'

mtcars[0, ]

col_means(1:10)
#Error in df[, numeric] : incorrect number of dimensions

#This calculates the row mean
col_means(mtcars[, "mpg", drop = F])

##   X21 X21.1 X22.8 X21.4 X18.7 X18.1 X14.3 X24.4 X22.8.1 X19.2 X17.8 X16.4
## 1  21    21  22.8  21.4  18.7  18.1  14.3  24.4    22.8  19.2  17.8  16.4
##   X17.3 X15.2 X10.4 X10.4.1 X14.7 X32.4 X30.4 X33.9 X21.5 X15.5 X15.2.1
## 1  17.3  15.2  10.4    10.4  14.7  32.4  30.4  33.9  21.5  15.5    15.2
##   X13.3 X19.2.1 X27.3 X26 X30.4.1 X15.8 X19.7 X15 X21.4.1
## 1  13.3    19.2  27.3  26    30.4  15.8  19.7  15    21.4

col_means(as.matrix(mtcars))
#Error in df[, numeric] : (subscript) logical subscript too long

col_means(as.list(mtcars))
#Error in df[, numeric] : incorrect number of dimensions

#
mtcars2 <- mtcars
mtcars2[-1] <- lapply(mtcars2[-1], as.character)
col_means(mtcars2)

##   X21 X21.1 X22.8 X21.4 X18.7 X18.1 X14.3 X24.4 X22.8.1 X19.2 X17.8 X16.4
## 1  21    21  22.8  21.4  18.7  18.1  14.3  24.4    22.8  19.2  17.8  16.4
##   X17.3 X15.2 X10.4 X10.4.1 X14.7 X32.4 X30.4 X33.9 X21.5 X15.5 X15.2.1
## 1  17.3  15.2  10.4    10.4  14.7  32.4  30.4  33.9  21.5  15.5    15.2
##   X13.3 X19.2.1 X27.3 X26 X30.4.1 X15.8 X19.7 X15 X21.4.1
## 1  13.3    19.2  27.3  26    30.4  15.8  19.7  15    21.4

Revised col_means

col_means2 <- function(df) {
  df <- data.frame(df)
  numeric <- vapply(df, is.numeric, logical(1))
  numeric_cols <- df[, numeric, drop = FALSE]

  data.frame(lapply(numeric_cols, mean))
}

col_means2(mtcars)

##        mpg    cyl     disp       hp     drat      wt     qsec     vs
## 1 20.09062 6.1875 230.7219 146.6875 3.596563 3.21725 17.84875 0.4375
##        am   gear   carb
## 1 0.40625 3.6875 2.8125

col_means2(mtcars[, 0])

## data frame with 0 columns and 0 rows

col_means2(mtcars[0, ])

##   mpg cyl disp  hp drat  wt qsec  vs  am gear carb
## 1 NaN NaN  NaN NaN  NaN NaN  NaN NaN NaN  NaN  NaN

col_means2(mtcars[, "mpg", drop = F])

##        mpg
## 1 20.09062

col_means2(1:10)

##    df
## 1 5.5

col_means2(as.matrix(mtcars))

##        mpg    cyl     disp       hp     drat      wt     qsec     vs
## 1 20.09062 6.1875 230.7219 146.6875 3.596563 3.21725 17.84875 0.4375
##        am   gear   carb
## 1 0.40625 3.6875 2.8125

col_means2(as.list(mtcars))

##        mpg    cyl     disp       hp     drat      wt     qsec     vs
## 1 20.09062 6.1875 230.7219 146.6875 3.596563 3.21725 17.84875 0.4375
##        am   gear   carb
## 1 0.40625 3.6875 2.8125

mtcars2 <- mtcars
mtcars2[-1] <- lapply(mtcars2[-1], as.character)
col_means2(mtcars2)

##        mpg
## 1 20.09062

2. The following function “lags” a vector, returning a version of x that is n values behind the original. Improve the function so that it (1) returns a useful error message if n is not a vector, and (2) has reasonable behaviour when n is 0 or longer than x.

lag <- function(x, n = 1L) {
  if (!is.vector(x)){
    stop("x needs to be a vector ")
  } else{
  xlen <- length(x)
  }
  if (n > xlen){
    c(rep(NA, xlen))
  } else{
    c(rep(NA, n), x[seq_len(xlen - n)])
  }
  
}

lag(1:10, 1)

##  [1] NA  1  2  3  4  5  6  7  8  9

lag(1:10, 100)

##  [1] NA NA NA NA NA NA NA NA NA NA