add test case for fix for #58

NEWS.md

@@ -740,7 +740,7 @@ plm()): Between, between, Sum, Within.
         before (all default to FALSE).
   * warning issued if an index variable is to be constructed that subsequently 
         overwrites an already present column of the same name ('id' and/or 'time').
-  * pacified warning in subsetting with with non-existent rows and columns due
+  * pacified warning in subsetting with non-existent rows and columns due
         to deprecation of 'structure(NULL, *)' in R >= 3.4.0.
   * \$<-.pdata.frame: preserves storage mode and sets correct class if propagation
                          to higher class occurred for a pseries prior to assignment

R/deprecated.R

@@ -87,7 +87,7 @@ plm.data <- function(x, indexes = NULL) {
   class(x) <- setdiff(class(x), "pdata.frame")
 
   # class "plm.dim" always has indexes in first two columns (id, time)
-  # while "pdata.frame" leaves the index variables at it's place (if not dropped at all with drop.index = T)
+  # while "pdata.frame" leaves the index variables at its place (if not dropped at all with drop.index = T)
   x <- x[ , c(names_indexes, setdiff(orig_col_order, names_indexes))]
 
   # set class

R/detect_lin_dep_alias.R

@@ -101,7 +101,7 @@
 #' form <- price ~ 0 + cpi + fact1 + fact2
 #' mf <- model.frame(Cigar.p, form)
 #' # no linear dependence in the pooling model's model matrix
-#' # (with intercept in the formula, there would be linear depedence)
+#' # (with intercept in the formula, there would be linear dependence)
 #' detect.lindep(model.matrix(mf, model = "pooling"))
 #' # linear dependence present in the FE transformed model matrix
 #' modmat_FE <- model.matrix(mf, model = "within")

R/est_pi.R

@@ -55,7 +55,7 @@ aneweytest <- function(formula, data, subset, na.action, index = NULL,  ...){
 
     ht <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "na.action",
-                 "effect", "model", "inst.method", "restict.matrix",
+                 "effect", "model", "inst.method", "restrict.matrix",
                  "restrict.rhs", "index"), names(ht), 0)
     ht <- ht[c(1L, m)]
     ht[[1L]] <- as.name("plm")

R/tool_ranfixef.R

@@ -448,7 +448,7 @@ ranef.plm <- function(object, effect = NULL, ...) {
 #' Overall Intercept for Within Models Along its Standard Error
 #' 
 #' This function gives an overall intercept for within models and its
-#' accompanying standard error or an within model with the overall intercept
+#' accompanying standard error or a within model with the overall intercept
 #' 
 #' The (somewhat artificial) intercept for within models (fixed
 #' effects models) was made popular by Stata of StataCorp

R/tool_transformations_collapse.R

@@ -666,7 +666,7 @@ pdiff.collapse <- function(x, effect = c("individual", "time"), has.intercept =
     }
   }
 
-  ## last data preperation before return
+  ## last data preparation before return
   res <- na.omit(res)
   if(is.matrix(x)) {
     # original pdiff (coded in base R) removes constant columns in matrix, 

inst/removed/test_model.matrix_pmodel.response_NA.R

@@ -1,7 +1,7 @@
 ## Tests for correct construction in case of NAs of model.matrix[.pFormula|.plm] and pmodel.response.[pFormula|.plm]
 
 # see, if NA dropping in construction of model.matrix and pmodel.response is done correctly.
-# Some special NA patterns were not handeled correctly pre rev. 192 if pmodel.repsonse or model.matrix were called directly
+# Some special NA patterns were not handeled correctly pre rev. 192 if pmodel.response or model.matrix were called directly
 
 # 1) model.matrix[.pFormula|.plm] 
 # 2) pmodel.response.[pFormula|.plm]
@@ -190,7 +190,7 @@ resp_pFormula_NA_depvar_fe   <- plm:::pmodel.response.formula(form, data = pGrun
 #Error in model.matrix.pFormula(pFormula(formula), data = data, model = model,  : 
 #  dims [product 199] do not match the length of object [0] 
 
-# pmodel.repsonse.plm
+# pmodel.response.plm
 resp_plm_NA_depvar_pool  <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_dep_var, model = "pooling"))
 resp_plm_NA_depvar_fe    <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_dep_var, model = "within"))
 resp_plm_NA_depvar_fe_tw <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_dep_var, model = "within", effect = "twoways"))
@@ -202,17 +202,17 @@ resp_plm_NA_indepvar_fe_tw <- plm:::pmodel.response.plm(plm(form, data = pGrunfe
 resp_plm_NA_indepvar_re    <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_indep_var, model = "random"))
 
 
-# pmodel.repsonse.pFormula with NA in dependent variable
+# pmodel.response.pFormula with NA in dependent variable
 resp_pFormula_NA_depvar_pool  <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_dep_var, model = "pooling")
 resp_pFormula_NA_depvar_fe    <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_dep_var, model = "within")
 resp_pFormula_NA_depvar_fe_tw <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_dep_var, model = "within", effect = "twoways")
 # NOT OK: error
 #resp_pFormula_NA_depvar_re    <- plm:::pmodel.response.pFormula(form, data = pGrunfeld_NA_dep_var, model = "random")
 
-# pmodel.repsonse.pFormula with NA in _in_dependent variable
+# pmodel.response.pFormula with NA in _in_dependent variable
 # NA in independent variable is detected and vector of dependent variable (response) adjusted according (drop the observation)
 # -> resulting response has 199 entries, albeit there are 200 obs for the response but NA in independent variable
-# -> thus, the results of pmodel.repsonse and model.matrix match
+# -> thus, the results of pmodel.response and model.matrix match
 resp_pFormula_NA_indepvar_pool  <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_indep_var, model = "pooling")
 resp_pFormula_NA_indepvar_fe    <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_indep_var, model = "within")
 resp_pFormula_NA_indepvar_fe_tw <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_indep_var, model = "within", effect = "twoways")

inst/tests/test_FD_models.R

@@ -36,3 +36,24 @@ vcovHC(fd_plm2)
 ## vcovHC does not run on pggls models/not implemented
 # vcovHC(fd_pggls)
 # vcovHC(fd_pggls2)
+
+# vcovXX on FD models
+data("Grunfeld", package = "plm")
+pGrun <- pdata.frame(Grunfeld)
+pGrun1 <- pGrun[-c(61:200), ]
+pGrun1 <- pGrun1[-c(2:20), ]
+pdim(pGrun1)
+pdim(pGrun1)$Tint
+mod <- plm(inv ~ value + capital, data = pGrun1, model="fd")
+vcovHC(mod)
+vcovBK(mod)
+diff(pGrun1$inv)
+
+pGrun2 <- pGrun[-c(21, 41, 61, 81, 101, 121, 141, 161, 181), ]
+mod2 <- plm(inv ~ value + capital, data = pGrun2, model="fd")
+vcovHC(mod2)
+# vcovBK(mod2) # errors with Error in demX[groupinds, , drop = FALSE] : subscript out of bounds
+
+# data with one time period per group -> first-differenced away -> empty model
+#pGrun3 <- pGrun[c(1, 21, 41, 61, 81, 101, 121, 141, 161, 181), ]
+#mod3 <- plm(inv ~ value + capital, data = pGrun3, model="fd")

inst/tests/test_FD_models.Rout.save

@@ -1,7 +1,7 @@
 
-R version 4.2.0 (2022-04-22 ucrt) -- "Vigorous Calisthenics"
-Copyright (C) 2022 The R Foundation for Statistical Computing
-Platform: x86_64-w64-mingw32/x64 (64-bit)
+R version 4.4.1 (2024-06-14 ucrt) -- "Race for Your Life"
+Copyright (C) 2024 The R Foundation for Statistical Computing
+Platform: x86_64-w64-mingw32/x64
 
 R is free software and comes with ABSOLUTELY NO WARRANTY.
 You are welcome to redistribute it under certain conditions.
@@ -279,6 +279,64 @@ attr(,"cluster")
 > # vcovHC(fd_pggls)
 > # vcovHC(fd_pggls2)
 > 
+> # vcovXX on FD models
+> data("Grunfeld", package = "plm")
+> pGrun <- pdata.frame(Grunfeld)
+> pGrun1 <- pGrun[-c(61:200), ]
+> pGrun1 <- pGrun1[-c(2:20), ]
+> pdim(pGrun1)
+Unbalanced Panel: n = 3, T = 1-20, N = 41
+> pdim(pGrun1)$Tint
+$Ti
+ 1  2  3 
+ 1 20 20 
+
+$nt
+1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 
+   3    2    2    2    2    2    2    2    2    2    2    2    2    2    2    2 
+1951 1952 1953 1954 
+   2    2    2    2 
+
+> mod <- plm(inv ~ value + capital, data = pGrun1, model="fd")
+> vcovHC(mod)
+            (Intercept)        value      capital
+(Intercept)   9.9316457 -0.182458536 -0.150584023
+value        -0.1824585  0.003352024  0.002766444
+capital      -0.1505840  0.002766444  0.002283161
+attr(,"cluster")
+[1] "group"
+> vcovBK(mod)
+            (Intercept)        value      capital
+(Intercept)  5.15120917 -0.085738400 -0.076423494
+value       -0.08573840  0.001957880  0.001465764
+capital     -0.07642349  0.001465764  0.001261444
+attr(,"cluster")
+[1] "group"
+> diff(pGrun1$inv)
+1-1935 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 
+    NA     NA  145.4  114.6 -207.6  -31.9  131.2  111.2  -27.2  -84.0  -73.4 
+2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 3-1935 
+ -29.5  161.6    0.2   74.0  -89.4   13.7  169.4   57.3   -4.5 -181.7     NA 
+3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 3-1945 3-1946 
+  11.9   32.2  -32.6    3.5   26.3   38.6  -21.1  -30.6   -4.5   36.8   66.3 
+3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 
+ -12.7   -0.9  -48.0   -4.8   41.7   22.1   22.2   10.1 
+> 
+> pGrun2 <- pGrun[-c(21, 41, 61, 81, 101, 121, 141, 161, 181), ]
+> mod2 <- plm(inv ~ value + capital, data = pGrun2, model="fd")
+> vcovHC(mod2)
+            (Intercept)         value      capital
+(Intercept)  7.75100710  0.0272456499 -0.370440306
+value        0.02724565  0.0001316189 -0.001260823
+capital     -0.37044031 -0.0012608229  0.020684253
+attr(,"cluster")
+[1] "group"
+> # vcovBK(mod2) # errors with Error in demX[groupinds, , drop = FALSE] : subscript out of bounds
+> 
+> # data with one time period per group -> first-differenced away -> empty model
+> #pGrun3 <- pGrun[c(1, 21, 41, 61, 81, 101, 121, 141, 161, 181), ]
+> #mod3 <- plm(inv ~ value + capital, data = pGrun3, model="fd")
+> 
 > proc.time()
    user  system elapsed 
-   1.89    0.12    2.03 
+   1.53    0.32    1.81 

inst/tests/test_detect_lin_dep_alias.R

@@ -1,7 +1,7 @@
 # Tests for functions:
 #  * detect.lindep
 #  * alias
-# YC 2017/10/09 :  RE model par defaut pb because the between model is empty
+# YC 2017/10/09 :  RE model par default pb because the between model is empty
 
 
 library(plm)

inst/tests/test_groupGenerics_pseries.R

@@ -67,7 +67,7 @@ print(summary(zz2))
 if (!isTRUE(all.equal(zz$coefficients, zz2$coefficients))) stop("estimation results not equal")
 
 
-############# (3) assinging to a pdata.frame #############
+############# (3) assigning to a pdata.frame #############
 ## test for assigning by $<- to a pdata.frame
 ## pre rev. 634: decimals which had been integers previously were converted to integers with typeof == integer
 ##               and gave wrong results.
@@ -188,7 +188,7 @@ mode(x2)
 typeof(x2)
 
 y2 <- y / 10
-class(y2) # c("myclass", "interger") - not propagated to c("myclass", "numeric")
+class(y2) # c("myclass", "integer") - not propagated to c("myclass", "numeric")
 mode(y2)
 typeof(y2)
 y2 # 0.1 0.2 0.3 - class is c("myclass", "integer") but result is decimals!

inst/tests/test_lag_lead.R

@@ -35,13 +35,13 @@ plm:::lagr.pseries(Grunfeld$firm2)
 # from the sample's unique factor levels, but it should stay in the levels
 plm:::lagr.pseries(Grunfeld$fac)
 if (!(length(unique(Grunfeld$fac)) == 200)) stop("wrong factor values") # 200
-if (!(length(unique(plm:::lagr.pseries(Grunfeld$fac))) == 191)) stop("plm:::lagr.pseries: wrong actually uniquely occuring factor values")  # 191
+if (!(length(unique(plm:::lagr.pseries(Grunfeld$fac))) == 191)) stop("plm:::lagr.pseries: wrong actually uniquely occurring factor values")  # 191
 if (!(length(levels(plm:::lagr.pseries(Grunfeld$fac))) == 200)) stop("wrong factor levels")  # 200
 
 # plm::lead eliminates e.g., level "200"
 plm:::leadr.pseries(Grunfeld$fac)
 if (!(length(unique(Grunfeld$fac)) == 200)) stop("wrong factor levels") # 200
-if (!(length(unique(plm:::leadr.pseries(Grunfeld$fac))) == 191)) stop("plm:::leadr.pseries: wrong actually uniquely occuring factor values") # 191
+if (!(length(unique(plm:::leadr.pseries(Grunfeld$fac))) == 191)) stop("plm:::leadr.pseries: wrong actually uniquely occurring factor values") # 191
 if (!(length(levels(plm:::leadr.pseries(Grunfeld$fac))) == 200)) stop("plm:::leadr.pseries: wrong factor levels")  # 200
 
 

inst/tests/test_lagt_leadt.R

@@ -36,7 +36,7 @@ lag(Grunfeld$firm2)
 # from the sample's unique factor levels, but it should stay in the levels
 lag(Grunfeld$fac)
 if (!(length(unique(Grunfeld$fac)) == 200)) stop("wrong factor levels") # 200
-if (!(length(unique(lag(Grunfeld$fac))) == 191)) stop("wrong actually uniquely occuring factor levels")  # 191
+if (!(length(unique(lag(Grunfeld$fac))) == 191)) stop("wrong actually uniquely occurring factor levels")  # 191
 if (!(length(levels(lag(Grunfeld$fac))) == 200)) stop("wrong factor levels")  # 200
 
 # lead eliminates e.g., level "200"

inst/tests/test_pbgtest.R

@@ -33,7 +33,7 @@ g_fe_lm <- lm(inv ~ factor(firm) + value + capital, data = Grunfeld)
 
   # compare plm::pbgtest to lmtest::bgtest
   # Hint: for lm::bgtest(), if no order argument is supplied, order=1 is default,
-  #      while plm::pbgtest() assues mininum number of obs over time (typically != 1)
+  #      while plm::pbgtest() assumes minimum number of obs over time (typically != 1)
 
   # panelmodel interface
   plm::pbgtest(g_pool, order = 1)
@@ -129,4 +129,4 @@ g_fe_lm <- lm(inv ~ factor(firm) + value + capital, data = Grunfeld)
   pbgtest(g_re, order = 1)
 
 
-
+

inst/tests/test_pdata.frame_print_duplicated_rownames.R

@@ -1,6 +1,6 @@
 # Currently, duplicated row names are allowed for pdata frames.
 # This leads to an error when printing pdata frames with duplicate
-# row names, becase print.pdata.frame uses print.data.frame
+# row names, because print.pdata.frame uses print.data.frame
 #
 # This is a testfile to check if the workaround works
 library(plm)

inst/tests/test_pdata.frame_unused_levels.R

@@ -28,7 +28,7 @@ if (!isTRUE(all.equal(levels(iind), levels(droplevels(iind))))) stop("unused lev
 ######## test of dropping unused level in factor (non index variable)
 df <- data.frame(id = c(1,1,2), time = c(1,2,1),
                  f = factor(c("a", "a", "b")),
-                 f2 = factor(c(1,2,3), levels = c(1,2,3,4)), # level 4 is unsed
+                 f2 = factor(c(1,2,3), levels = c(1,2,3,4)), # level 4 is unused
                  n = c(1:3))
 pdf <- pdata.frame(df, drop.unused.levels = TRUE)
 
@@ -41,7 +41,7 @@ if (!isTRUE(all.equal(levels(pdf$f2), c("1", "2", "3")))) stop("used levels in n
 dfindex <- data.frame(id = c(1,1,2), 
                       time = factor(c(1,2,1), levels = c(1,2,9)), # level 9 is unused
                       f = factor(c("a", "a", "b")),
-                      f2 = factor(c(1,2,3), levels = c(1,2,3,4)), # level 4 is unsed
+                      f2 = factor(c(1,2,3), levels = c(1,2,3,4)), # level 4 is unused
                       n = c(1:3))
 pdfindex <- pdata.frame(dfindex, drop.unused.levels = FALSE)
 

inst/tests/test_plm.data.R

@@ -1,13 +1,13 @@
 # testfile to check if the deprecated function plm.data() is correctly
 # reworked by using pdata.frame()
 # 
-# Usefull especially if future changes to pdata.frame() affect the "plm.dim"
+# Useful especially if future changes to pdata.frame() affect the "plm.dim"
 # object onces created by plm.data()
 
 library(plm)
 
 # use a data set that has index variables not in first two columns, because
-# plm.dim objects always have them in the fist two colums (id, time)
+# plm.dim objects always have them in the first two columns (id, time)
 data("Hedonic", package = "plm")
 pHed <- pdata.frame(Hedonic, index = "townid")
 plm:::pos.index(pHed) # gives position of indexes

inst/tests/test_plmtest_unbalanced.R

@@ -27,7 +27,7 @@
 # [...]
 
 ##### Grunfeld data set - balanced ####
-# Table 4.2 [Output from EViews], similiar to above table but with p-values
+# Table 4.2 [Output from EViews], similar to above table but with p-values
 ##### EViews add-in BPTest for some older version of EViews needed:
 ##### http://www.eviews.com/Addins/addins.shtml#addins
 ##### http://forums.eviews.com/viewtopic.php?f=23&t=2228
@@ -280,7 +280,7 @@ p.val_2 <- (1/2)*pchisq(crit_2, df=0, lower.tail = F) + (1/2) * pchisq(crit_2, d
 #                       , data = pnlswork, model = "pooling")
 # 
 # 
-# # Reassembles Exmaple 1 in http://www.stata.com/manuals14/xtxtregpostestimation.pdf
+# # Reassembles Example 1 in http://www.stata.com/manuals14/xtxtregpostestimation.pdf
 # # use modified plmtest() as a wrapper
 # options(digits = 10)
 # plmtest(plm_pool_nlswork, type="bp")

inst/tests/test_preserve_rownames.R

@@ -14,7 +14,7 @@ if(!isTRUE(all.equal(names(residuals(gr)),       row.names(Grunfeld)))) stop("or
 
 
 # make a pdata.frame with "fancy" row.names (default)
-# [i.e., combination of individual index an time index]
+# [i.e., combination of individual index and time index]
 pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year"))
 row.names(pGrunfeld) # fancy row.names
 gr_fancy_rownames <- plm(inv ~ value + capital, data=pGrunfeld, model="pooling")

inst/tests/test_vcovG_lin_dep.R

@@ -61,7 +61,7 @@ if (!identical(vcovBK(mod_fe_lin_dep), vcovBK(mod_fe_no_lin_dep))) {
   vcovBK(cr2)
 
 
-# just run test for for pgmm models (as vcovXX.pgmm methods use vcovXX.plm)
+# just run test for pgmm models (as vcovXX.pgmm methods use vcovXX.plm)
 # (no linear dependence involved here)
 data("EmplUK", package="plm")
 ar <- pgmm(dynformula(log(emp) ~ log(wage) + log(capital) + log(output),