1library(plm)
2data("Grunfeld", package = "plm")
3pGrunfeld <- pdata.frame(Grunfeld)
4
5# as.list.data.frame used on a pdata.frame strips the attributes (index, classes),
6# thus, need as.list.pdata.frame function to make lapply usable for pdata.frame
7# (otherwise as.list.data.frame is used and that does not work due to stripping the attributes)
8
9# Default behaviour is keep.attributes = TRUE => behaves identical to as.list.data.frame (because it uses it)
10# Do not change this default, because some code relies on it!
11if (!identical(as.list.data.frame(pGrunfeld), as.list(pGrunfeld)))
12  stop("as.list.pdata.frame(x, keep.attributes = FALSE) does not produce identical structure compared as.list.data.frame")
13
14
15# test for keeping attributes (make a list of pseries objects)
16expected_result_classes <- list(firm    = c("pseries", "factor"),
17                                year    = c("pseries", "factor"),
18                                inv     = c("pseries", "numeric"),
19                                value   = c("pseries", "numeric"),
20                                capital = c("pseries", "numeric"))
21
22if (!identical(lapply(as.list(pGrunfeld, keep.attributes = TRUE), class), expected_result_classes)) stop("classes not correct")
23
24if (!class(as.list(pGrunfeld)) == "list") stop("class is not list")
25if (!class(as.list(pGrunfeld, keep.attributes = TRUE)) == "list") stop("class is not list")
26
27
28# test operation with lapply
29list_lags <- lapply(as.list(pGrunfeld, keep.attributes = TRUE), function(x) lag(x))
30if (!all(class(list_lags[[1]]) == c("pseries", "factor"))) stop("wrong extracted class")
31if (!all(class(list_lags[["value"]]) == c("pseries", "numeric"))) stop("wrong extracted class")
32if (!identical(list_lags[["value"]], lag(pGrunfeld$value))) stop("lapply with function on pdata.frame produced incorrect results")
33
34# set on subsetted pdata.frame
35list_lags_sub <- lapply(as.list(pGrunfeld[1:50, ], keep.attributes = TRUE), function(x) lag(x))
36if (!all(class(list_lags_sub[["value"]]) == c("pseries", "numeric"))) stop("wrong extracted class")
37if (!identical(list_lags_sub[["value"]], lag(pGrunfeld[1:50, ]$value))) stop("lapply with function on pdata.frame produced incorrect results")
38
39