Creating an operator to extract a named member of a list that is in a list. Why? Read on. [Now part of the "pdata" library at github.com/garyfeng/pdata.

getListAttribute.r

# To create an operator to extract a named member of a list that is in a list. 
# This may sound confusing, but imagine you have a data.frame where a variable/column is a list of lists,
# and the lists have named members, e.g.,
#     df$itinary <- list(list(from="NYC", to="LA", via="train"), list(from="LA", to="SF"), ...)
# You want to get the "from" value of itinary as a vector. You can do
#     df$itinary@"from" or `@`(df$itinary, "via")
# Typically you'd use ```sapply(x, function(m) {m[["from"]]})```. The following is an extention to the idea in 2 ways:
# 1). We define a in-fix operator `@` that does so in a way that is syntactically more natural 
# 2). We added error handling, in the case of bad indecies, etc.
require(testthat)

# %@@% is the permissive operator that returns a vector or, in the case of non-atomic properties, a list
`%@@%` <- function(x, key) {
  # makesure the input vars are valid
  force(x); force(key); 
  if(missing(key)) stop()
  if(!is.list(x)) stop("First parameter must be a list")
    
  sapply(x, function(c) {
   result <- tryCatch(
     # test the following code
     {`[[`(c, key);}
     , warning = function(war) {print(war)}
     , error = function(err) {print(err); result<-NA}
     #, finally = {stop("Error `@`: will reach this step no matter what.")}
     )
   if (is.null(result)) result<-NA
   result
 })
}

# @ and %@% are strict versions of @@ that only returns a vector of atomic values, replacing everything else with NA
`@` <- `%@%` <- function(x, key) {
  result <-x%@@%key
  if(is.list(result)) {
    sapply(result, function(x){
      if(is.atomic(x)) x else NA
    })
  } else {
    result
  }
}
  
  
### Unit testing ###
testvec <- list(
  list(from=1, to="here", date="1990-12-12"), 
  list(from=2, to="there", via=list("train", "airplane"), date=123.45)
)

key <- "from"

test_that("`@` and `@@` return the desired properties as a vector", {
  expect_equal(testvec%@%"from", c(1,2))
  expect_equal(testvec%@%"to", c("here", "there"))
  expect_equal(testvec@key, c(1,2))
  expect_equal(testvec@"to", c("here", "there"))
  expect_equal(`@`(testvec, 2), c("here", "there"))
  
  expect_equal(testvec%@@%"from", c(1,2))
  expect_equal(testvec%@@%"to", c("here", "there"))
  expect_equal(`%@@%`(testvec, 2), c("here", "there"))
})

test_that("`@` and `%@@%` return a vector of NA when the property 
          does not exist in the element, without a warning or a message", {
  expect_equal(testvec%@%"not a property", c(NA, NA))
  expect_equal(testvec%@@%"not a property", c(NA, NA))
})

test_that("`@` and `%@@%` coerce returned vector into the class of first element", {
  expect_equal(testvec@"date", c("1990-12-12", "123.45"))
  expect_equal(testvec%@@%"date", c("1990-12-12", "123.45"))
})

test_that("`@` returns a vector of NA when the property does not exist, whereas
           the more permissive `%@@%` will return a list", {
  expect_equal(testvec%@@%"via", list(NA, list("train", "airplane")))
  expect_equal(testvec%@%"via", c(NA, NA))
})

test_that("`@` and `%@@%` return a vector of NA when the index is out of bound, and prints a message", {
  expect_equal(`@`(testvec, 10), c(NA, NA))
  expect_equal(`%@%`(testvec, list(1,"that")), c(NA, NA))
  expect_equal(`%@@%`(testvec, 10), c(NA, NA))
  expect_equal(`%@@%`(testvec, list(1,"that")), c(NA, NA))
})

test_that("`@` and `%@@%` throw errors in the following tests", {
  expect_error(`@`(whatever, 10))
  expect_error(`@`(testvec, nonsenseKey))
  expect_error(`%@%`(list(1,"that")))
  expect_error(`%@%`("that", 1))
  expect_error(`%@@%`(c(1,2,3), 1))
})