plm/0000755000176200001440000000000014200107742011037 5ustar liggesusersplm/NAMESPACE0000644000176200001440000002074114174342732012274 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",pdata.frame) S3method("$<-",pdata.frame) S3method("[",pdata.frame) S3method("[[",pdata.frame) S3method(Between,default) S3method(Between,matrix) S3method(Between,pseries) S3method(Complex,pseries) S3method(Math,pseries) S3method(Ops,pseries) S3method(Sum,default) S3method(Sum,matrix) S3method(Sum,pseries) S3method(Within,default) S3method(Within,matrix) S3method(Within,pseries) S3method(alias,pdata.frame) S3method(alias,plm) S3method(as.Formula,pFormula) S3method(as.data.frame,pdata.frame) S3method(as.list,pdata.frame) S3method(as.matrix,pseries) S3method(between,default) S3method(between,matrix) S3method(between,pseries) S3method(coef,panelmodel) S3method(coef,pgmm) S3method(coef,summary.plm.list) S3method(detect.lindep,data.frame) S3method(detect.lindep,matrix) S3method(detect.lindep,plm) S3method(deviance,panelmodel) S3method(df.residual,panelmodel) S3method(diff,pseries) S3method(ercomp,formula) S3method(ercomp,pdata.frame) S3method(ercomp,plm) S3method(fitted,panelmodel) S3method(fitted,plm) S3method(fixef,pggls) S3method(fixef,plm) S3method(formula,dynformula) S3method(formula,pdata.frame) S3method(formula,plm) S3method(has.intercept,Formula) S3method(has.intercept,default) S3method(has.intercept,formula) S3method(has.intercept,panelmodel) S3method(has.intercept,plm) S3method(index,panelmodel) S3method(index,pdata.frame) S3method(index,pindex) S3method(index,pseries) S3method(is.pbalanced,data.frame) S3method(is.pbalanced,default) S3method(is.pbalanced,panelmodel) S3method(is.pbalanced,pcce) S3method(is.pbalanced,pdata.frame) S3method(is.pbalanced,pggls) S3method(is.pbalanced,pgmm) S3method(is.pbalanced,pmg) S3method(is.pbalanced,pseries) S3method(is.pconsecutive,data.frame) S3method(is.pconsecutive,default) S3method(is.pconsecutive,panelmodel) S3method(is.pconsecutive,pdata.frame) S3method(is.pconsecutive,pseries) S3method(lag,pseries) S3method(lead,pseries) S3method(make.dummies,data.frame) S3method(make.dummies,default) S3method(make.dummies,pdata.frame) S3method(make.pbalanced,data.frame) S3method(make.pbalanced,pdata.frame) S3method(make.pbalanced,pseries) S3method(make.pconsecutive,data.frame) S3method(make.pconsecutive,pdata.frame) S3method(make.pconsecutive,pseries) S3method(model.frame,pFormula) S3method(model.frame,pdata.frame) S3method(model.matrix,pFormula) S3method(model.matrix,pcce) S3method(model.matrix,pdata.frame) S3method(model.matrix,plm) S3method(mtest,pgmm) S3method(nobs,panelmodel) S3method(nobs,pgmm) S3method(pFtest,formula) S3method(pFtest,plm) S3method(pbgtest,formula) S3method(pbgtest,panelmodel) S3method(pbltest,formula) S3method(pbltest,plm) S3method(pbnftest,formula) S3method(pbnftest,panelmodel) S3method(pbsytest,formula) S3method(pbsytest,panelmodel) S3method(pcdtest,formula) S3method(pcdtest,panelmodel) S3method(pcdtest,pseries) S3method(pdim,data.frame) S3method(pdim,default) S3method(pdim,panelmodel) S3method(pdim,pcce) S3method(pdim,pdata.frame) S3method(pdim,pggls) S3method(pdim,pgmm) S3method(pdim,pmg) S3method(pdim,pseries) S3method(pdwtest,formula) S3method(pdwtest,panelmodel) S3method(phtest,formula) S3method(phtest,panelmodel) S3method(plmtest,formula) S3method(plmtest,plm) S3method(plot,plm) S3method(plot,pseries) S3method(plot,summary.pseries) S3method(pmodel.response,data.frame) S3method(pmodel.response,formula) S3method(pmodel.response,pcce) S3method(pmodel.response,plm) S3method(pooltest,formula) S3method(pooltest,plm) S3method(predict,plm) S3method(print,dynformula) S3method(print,ercomp) S3method(print,fixef) S3method(print,panelmodel) S3method(print,pdata.frame) S3method(print,pdim) S3method(print,phansitest) S3method(print,piest) S3method(print,plm.list) S3method(print,pseries) S3method(print,purtest) S3method(print,pvar) S3method(print,summary.fixef) S3method(print,summary.pcce) S3method(print,summary.pggls) S3method(print,summary.pgmm) S3method(print,summary.pht) S3method(print,summary.piest) S3method(print,summary.plm) S3method(print,summary.plm.list) S3method(print,summary.pmg) S3method(print,summary.pseries) S3method(print,summary.purtest) S3method(print,summary.pvcm) S3method(punbalancedness,data.frame) S3method(punbalancedness,panelmodel) S3method(punbalancedness,pdata.frame) S3method(pvar,data.frame) S3method(pvar,matrix) S3method(pvar,pdata.frame) S3method(pvar,pseries) S3method(pwaldtest,pgmm) S3method(pwaldtest,plm) S3method(pwaldtest,pvcm) S3method(pwartest,formula) S3method(pwartest,panelmodel) S3method(pwfdtest,formula) S3method(pwfdtest,panelmodel) S3method(pwtest,formula) S3method(pwtest,panelmodel) S3method(ranef,plm) S3method(residuals,panelmodel) S3method(residuals,pcce) S3method(residuals,pggls) S3method(residuals,plm) S3method(residuals,pmg) S3method(summary,fixef) S3method(summary,pcce) S3method(summary,pggls) S3method(summary,pgmm) S3method(summary,pht) S3method(summary,piest) S3method(summary,plm) S3method(summary,plm.list) S3method(summary,pmg) S3method(summary,pseries) S3method(summary,purtest) S3method(summary,pvcm) S3method(terms,panelmodel) S3method(update,panelmodel) S3method(vcov,panelmodel) S3method(vcovBK,plm) S3method(vcovDC,plm) S3method(vcovG,pcce) S3method(vcovG,plm) S3method(vcovHC,pcce) S3method(vcovHC,pgmm) S3method(vcovHC,plm) S3method(vcovNW,pcce) S3method(vcovNW,plm) S3method(vcovSCC,pcce) S3method(vcovSCC,plm) S3method(within_intercept,plm) export(Between) export(Sum) export(Within) export(aneweytest) export(between) export(cipstest) export(cortab) export(detect.lindep) export(dynformula) export(ercomp) export(fixef) export(has.intercept) export(index) export(is.pbalanced) export(is.pconsecutive) export(is.pseries) export(lag) export(lead) export(make.dummies) export(make.pbalanced) export(make.pconsecutive) export(maxLik) export(mtest) export(nobs) export(pFormula) export(pFtest) export(pbgtest) export(pbltest) export(pbnftest) export(pbsytest) export(pcce) export(pcdtest) export(pdata.frame) export(pdim) export(pdwtest) export(pggls) export(pgmm) export(pgrangertest) export(phansitest) export(pht) export(phtest) export(piest) export(pldv) export(plm) export(plm.data) export(plmtest) export(pmg) export(pmodel.response) export(pooltest) export(pseriesfy) export(punbalancedness) export(purtest) export(pvar) export(pvcm) export(pvcovHC) export(pwaldtest) export(pwartest) export(pwfdtest) export(pwtest) export(r.squared) export(ranef) export(sargan) export(vcovBK) export(vcovDC) export(vcovG) export(vcovHC) export(vcovNW) export(vcovSCC) export(within_intercept) import(Formula) importFrom(MASS,ginv) importFrom(Rdpack,reprompt) importFrom(bdsmatrix,bdsmatrix) importFrom(collapse,dapply) importFrom(collapse,fbetween) importFrom(collapse,fdroplevels) importFrom(collapse,fhdwithin) importFrom(collapse,fwithin) importFrom(grDevices,heat.colors) importFrom(grDevices,rainbow) importFrom(graphics,abline) importFrom(graphics,axis) importFrom(graphics,barplot) importFrom(graphics,legend) importFrom(graphics,lines) importFrom(graphics,plot) importFrom(graphics,points) importFrom(lattice,xyplot) importFrom(lmtest,bgtest) importFrom(lmtest,dwtest) importFrom(maxLik,maxLik) importFrom(nlme,fixef) importFrom(nlme,lme) importFrom(nlme,ranef) importFrom(sandwich,vcovHC) importFrom(stats,.lm.fit) importFrom(stats,alias) importFrom(stats,approx) importFrom(stats,as.formula) importFrom(stats,ave) importFrom(stats,coef) importFrom(stats,coefficients) importFrom(stats,contr.treatment) importFrom(stats,cor) importFrom(stats,delete.response) importFrom(stats,deviance) importFrom(stats,df.residual) importFrom(stats,dnorm) importFrom(stats,fitted) importFrom(stats,formula) importFrom(stats,lag) importFrom(stats,lm) importFrom(stats,lm.fit) importFrom(stats,model.frame) importFrom(stats,model.matrix) importFrom(stats,model.response) importFrom(stats,model.weights) importFrom(stats,na.omit) importFrom(stats,nobs) importFrom(stats,p.adjust) importFrom(stats,pchisq) importFrom(stats,pf) importFrom(stats,pnorm) importFrom(stats,printCoefmat) importFrom(stats,pt) importFrom(stats,qnorm) importFrom(stats,reshape) importFrom(stats,resid) importFrom(stats,residuals) importFrom(stats,sd) importFrom(stats,setNames) importFrom(stats,terms) importFrom(stats,update) importFrom(stats,var) importFrom(stats,vcov) importFrom(stats,weighted.mean) importFrom(zoo,index) plm/THANKS0000644000176200001440000000100314154734502011754 0ustar liggesusersWe've benefited from comments and bug reports from many people on previous versions of the package. We would like to thank especially : Arne Henningsen, Christian Kleiber, Katarzyna Kopczewska, Ott Toomet, and Achim Zeileis. The package was greatly improved during the revision of the Journal of Statistical Software 27(2) article, thanks to the helpful comments of three anonymous referees. We especially thank the co-editor of this journal, Achim Zeileis, for many interesting comments and suggestions. plm/README.md0000644000176200001440000001142314161714630012325 0ustar liggesusers# The `plm` Package - Linear Models and Tests for Panel Data [![CRAN status](https://www.r-pkg.org/badges/version/plm)](https://CRAN.R-project.org/package=plm) [![Downloads](https://cranlogs.r-pkg.org/badges/plm)](https://CRAN.R-project.org/package=plm) ## About `plm` is a package for panel data econometrics for the **R** statistical computing environment. The package includes functions for model estimation, testing, robust covariance matrix estimation, panel data manipulation and information. It was first published on **CRAN** in 2006. Be sure to read the NEWS on [CRAN](https://cran.r-project.org/package=plm) for any changes in new releases (new features, bugfixes, other improvements, ...). Non-exhaustive function overview: - Functions to estimate models: - `plm`: panel data estimators (within/fixed effects, random effects, between, first-difference, nested random effects), incl. instrumental-variable estimation techniques (IV) and Hausman-Taylor-style models, - `pgmm`: generalized method of moments (GMM) estimation for panel data, - `pggls`: estimation of general feasible generalized least squares models, - `pmg`: mean groups (MG), demeaned MG and common correlated effects (CCEMG) estimators, - `pcce`: estimators for common correlated effects mean groups (CCEMG) and pooled (CCEP) for panel data with common factors, - `pvcm`: variable coefficients models, - `pldv`: panel estimators for limited dependent variables. - Testing functions: - model specification (`phtest`, `pFtest`, `pooltest`, `plmtest`, `pwaldtest`, `piest`, `aneweytest`, `mtest`, `sargan`), - serial correlation (`pbgtest`, `pwfdtest`, `pbnftest`, `pdwtest`, `pwartest`, `pbsytest`, `pbltest`), - cross-sectional dependence (`pcdtest`), - panel unit root (`purtest`, `cipstest`, `phansitest`), - panel Granger (non-)causality (`pgrangertest`). - Robust covariance matrix estimators (incl. various weighting schemes for small sample adjustment): - `vcovHC`: Arellano (1987), White (1980), - `vcovBK`: Beck and Katz (1995) (PCSE), - `vcovNW`: Newey and West (1987), - `vcovDC`: double-clustering robust (Thompson (2011), Cameron et al. (2011)), - `vcovSCC`: Driscoll and Kraay (1998). - An enhanced data frame, called `pdata.frame`, to deal with data sets for which observations are identified by a combination of two indexes. - Panel data transformation functions (e.g., `Within`, `Between`, `between`, `lag`, `lead`, `diff`). - Other functions relating to panel data sets, e.g.: - checks for panel data dimensions (individual, time, group) and balancedness (`pdim`), - checks for panel balancedness (`is.pbalanced`) and consecutiveness (regularity) (`is.pconsecutive`) as well as functions to change data to conform to these properties (`make.pbalanced`, `make.pconsecutive`), - measures for unbalancedness of data (`punbalancedness`) (Ahrens/Pincus (1981)). ## Installation To install the released version from **CRAN**: ```{r} install.packages("plm") ``` The package's CRAN website is . The development of package `plm` takes place on GitHub at . To install the development version from **GitHub**, use, e.g.: ```{r} # install.packages("remotes") # remove '#' if pkg 'remotes' is not installed remotes::install_github("ycroissant/plm") ``` ## Documentation Package plm comes with documentation: Besides the usual help pages for each function, the vignettes provide a gentle introduction to the package and some functions. Vignettes are available at the package's CRAN website and can be browsed from within R by `browseVignettes("plm")`. New package users are advised to start with the first vignette *Panel data econometrics in R: the plm package* for an overview of the package. A more in-depth treatment of estimation of error component models and instrument variable models is in the second vignette *Estimation of error component models with the plm function*. Further, many textbooks treat package `plm` and/or use it in their examples: * Croissant/Millo, *Panel Data Econometrics with R*, 2019, John Wiley & Sons, Hoboken. * Kleiber/Zeileis, *Applied Econometrics with R*, 2008, Springer, New York. Esp. chapter 3.6. * Hanck/Arnold/Gerber/Schmelzer, *Econometrics with R*, online book . Esp. chapter 10. * Heiss, *Using R for Introductory Econometrics*, 2nd edition, 2020, Independent Publishing, Düsseldorf, also available online at . A companion book using R to Wooldridge, *Introductory Econometrics*, esp. chapters 13-14. plm/data/0000755000176200001440000000000014124132276011755 5ustar liggesusersplm/data/LaborSupply.rda0000644000176200001440000004227014124132276014726 0ustar liggesusers7zXZi"6!XD|])TW"nRʟXH#&'ƯN?,&%j%jX7/_ !+ jŕ¦uf)#JtT*;{f"w9#]P# N8):I!xlp;IcP =WYo J\[$7(;w_Q J ݖu.Fw򧆪%i{lZE}1-ݲ$d3X')ah(a(dg/ iߗxBأ*[ޢMDg<ۊ0/7<w*/XyU="AB-#1s*jg.]s eMϙfqHo]}'BBO{V7 P MA_!E֚*)Xo |Vcɼe_a-J#Q: iY_lQrӺ*aZtGnTD=k4}s0TvOV\R:Bw䌂XJa3rjuo=ӠT'R&/vJAK^Wj sw85 Ao2cXȜ;Dͫg,F &p,>̱IAAjw70p(bwl3*iY%p0Wk Ʋ"UL&=9p5:ܣ@Q}gq3m*&*O]}$p:lpQ)&O ?sbFRo>v۱T>#M&&vuGe%|mx5ӦFvKZǞU 3_ edev{5q9y~1*{iF}Jf{))gx["Q y?dcl >t+cGٛH ;U}MIP^ IvU{N]8"isgR :^tumJ:@m* ^[C6NS)q[BT(uOp+rKK[~d*ְj1Q`xhWPY4jT7NC}16 G@|W!Oe6"H n†dd]@ TXƳXta I ,ŏmAscĕxZ&ݷwVYOp /.C n(B0\MMJL;kN*"ȡz1D$2ot~O}"ь$FOPOt</t-(0C\i>avQ96Jw4bsV aй%WK!>lP%4 +v2p,TrnDWΠ\#>~NÃm;rKΚJiHmh Ft-G(h }NQnI Rxdؚir,d[bqm![` >4 GHG>ӝ h >a#<~`=58vJj5^Uz jCfRr y+$mZ= &ҽ[W`峧竖#^2beL(XwzbƆGqwqagUS^T>0I\Lm k7|%XtyeD;W5z/~GɧK'iJӪF`ο]. "G@_S[-"Kc':g$ ΗV#aN&njf^}|ꢯ+"w-?/=ƅVhT%( ( V %x-V)w> G>1)|%a (0> m`Iq-(e LoJ EWKOmՠ[_ 4^pN"=&hG=*sW/3j^܈,S'7ð9^@h(3`oو7ֵƽܮ%,^2n߹/Q"TG.O'm>"4pA3ҟ C^cU1U^RuO})*O˰> o+efJ;4j3a0XSOʘ,4ㅵ6hnao;O.ЦT -r)Jx OBk5]گ*da_U:{*3&h#d&A3*Y0 q² K<Xm <1y^%Ɩ']Y%al F>-z"tX2S35w})KH[bQϹ u 卫g0|4bZߡdd/zz Hu}~+Sxfea@%Iٕ 8-i]$M鯉r(2z=L/i)NC .m摅S2X<4̤?Ymodob"K|)2÷{aM٫|}J*]w }P˳m׮Kx$t\pjUrN c(E50> 1d{x!S8<'^< (F܆L ν Tiˠ5Ϋ"(GR''ra!۱Y42զ} kw!IY(>؍B(UtzsVV䤑+=#JyR=rA%DJY|6ىƩx0xFV(YE>,:*,,[t3IB-nxbMz\{<ߙTooDu3%+aT,̎GV:3TU"Z0ebZ&|tݚ}X v Sqp,s͛ʰj&o+E%oQZFi B)'(Ms ^ 6I>[d9:j(NҀ΅4m '.`h7v8DHS?8Iq7ɱ ER\htΥ1x=6zbEף;`z`|Jqyoͨ2W2 71L%,41|V+#0)J/RlvqݼjAubH6Tbօ9MkBXo4}389bu%!e,]BZk^HsyUQ~]tkja\|6NwcCEN BNr٘C\0%ǩRD+Dj?*8񵳰rѓ#s:\Cw)~)CHFgtt,|x$\oƜZ 1 ذ#zh#G₁, lbk\33{` DT[!\As$25,uL̾&@iX,{N*e% ]:Zzt%Zs.C-.ѷ{W> Ptgc5(`Gf6d:L/AEG}oOy5M@}=PY /2ʼը@ QJ!7ڧaP:D) j'=f^coV<͍u<%KF;'dRz>ՐF#Ki(e),*8.@EO w%SGO6bh@4' /PD1&N-9'Ұrߜjx e9|Z}@"mo @ួҳ]*|oKpu OZ΁]Fu~ X]r`w~cx$L2rTǍqIX=RM3̽̃f}VI"{onU߽AހG /z\t MB%&2'ʦ{e. Jwn6Y[U9,5ŽY|]Y|O&&ja-ꥃ~Bb*4C$;>bZCRAԕUOb2rkiWNe6|Bg}\v={z6xFϨFβ HW/•J[| $-OO`BA~TդqlONO &W%Q!i6d8Gr/#IY# CG,@3g8.aX2McbiwCM xѱZzΕ&)?JsJR Po2lVS$ ʏy^xȲF$/RzUx'_7TB#?? d"ox_ 0/џ?"!D%F.vl'8f."_A9zW1?AP`;D+s7SHBN~)(Dg8[v|)vLl 'qĈ%;@ (ѳG̗YgƢLAdV z@rQ>lk֬^3|M9KEGzg@1]%{/5;1q$Υt@G: 3IuѨkavanyY\ew!3;\mEY(BB<5Q\%$OQJR8HiB6#Q.ӈA9&@ 4|@4IjL'Iֺ~̹~kgHl['@zlfTP]R)]J !xYDbrC0eq  /L qsIB‡犭p]"m,"aE#F%Y(S\ L}@mb|wޙfo'n~xygHˈB.as}ZC9yOʝDrx=}/.c9j믿(; 8ђ([J,[/V\7вH;q y(r_3W[5ڭR dcAs-<0ƣ?G1.d2`J~Nc^^M z _p2nɚĒqYWY"17Op=-@ERl}knqP^N>ɼ6X 9 l0nU ivT"g̀+·…5^GXG b1sCwb%lnWo @Z(x>S aS̷ECf]` F_*s)=X=&wOW~_ } ՁRGYw6wF/"`fZ;dfe;cmGIIulCC,xF1OLl r^,c4VXHSx|0_&22cCG8^˜}FPt'8qz,"Kxdn.s6`+Ifs{ fvF֓Y(Lȁq;Iۧ ][^cvQѱn }q_3Ɉ/Frߥ ̳szyJ7L~5 5Q c%;햶1gPSO/F:RJtnzqx)KNH٭pq':9]Y'?a 11IP)O٫NSÄάmB'bW{-롋-GLHBhKhlm:]!}bb_Y>ۗ2t܂EcjFm醢`3%^I (O#Pkl?3Bߚkp:d{El1%tLcZN;J?z|5Z}װ Gh}27b8{d`0[ ԅG~A*|r,&IŅ *T9/i.YgMPM@͔ `(L;8%UNX*--vAxPQ%#۰NzA^sRQ:WsR ,+K VF~- "& uvnY(k+jeenTV^CVmi;p]$5')lEMTcZ}JZ9fG ˊw .w[pQəaǛS#;pERL1j^CȀCh]z Oqs͠o-ǂ/hZZ@f{Nڿڼsi3oE\)aLU6_VHq.E=:WeX*/m34> ]rY_L2v9(6 ō5G#Io$~VD'V$5=v B2go!#/T _J$n tҨ,xun*\#Zzg0|ճ!N> ƆB]~ـ|_[6H뾭jrʹYq1`fω4^;W c?]FJ WȃP]J}A%(|vrGmNpY!Rm%X9MpNKΓ)Jqe> `n!wc)DU輪s"1oet,{9tOB Гv);mIq j9"V4UKjn/Y8k Ia(6HX>iJW?[S JF%7 m$9r#Sv[̺L?d=htk>SUW>"(=0$=U,ThoM/ktE6W}0ʗE7#aK,+T[ Ztף;f^#%~tF hìuT(q>XmbS1|dd8wVQ@yߤ B 6h4F@ ,c.[żT^TA} HrNLy߸I;N{9ӧ'~ټHar@EQQTl(7aôvp^ k4`wW}3N+^h_;m35g\iiP R5;ȍv16D -u&/H~]i>BuH2X_v ed׿> gKpwpj7-IqDip|A s&:a ,>,TKq Ɔv>L7K40H`2{W!+ʒv>5[2x]zgܗZ/c*c%='z?O 1bS1*Jl9ήc9)(9EMJS /{o9$Ӹ]^=пH+\V&3}.,OM Wo'2&!5sNUfuSG(>wG(ע~T7Y =TGjfƩyVy>b`7*y_1tփ㎶bG$zYI ۊ}d=A Y1=DCq~bNUDq>󍈅G!c8F1)MS*[)Y]V8kC˱̎tz|l3ORFzmֱEg a+gvqeO /AUS`C'q>[^w'WON_3NBGl7, peC1Rkͳ|CxɋoOFK-EYr6v~!^4v 7U6{JGo#YM*P$kL;E;%Ix/Lfc߳GkM aN밈/NNVqMzl?Ul;>E)}ˆg,>[DSboXIHn8sѤ>uqNRsHMۊxrU<؆0*Nh-N8GVMlsښLzJykj*C)ƻ9Y|b !(f l`m9Wz7Lz֯qZE} jNco-b^ ]МllԁNs+:t:Bq)"Ϋ>}A+B/aʿC @̋:}7QA׌ #E8:sjbQ NB+Ӎ(;VLZЊ\#v᰺F{}zWQ]Zb9!ˆpoƛ= P֯K"S9'K89@ ,#c˝\spU}x0"D1$ [:='5lX7C/2T[D|xkV9z?4{oG?(1x:S.؉l7]cDM]yIvQG]}hpH">|xثU)H dN"9;x^"ty #$dErXPfi.t\a<Rթ$"¶V<€K̦).>]"ޤRNzx _N@ã&€2l`fJn"O _Q`7ֿƇ:48 }qol4V-5 j)P5Awg|Wh}hhJ wDwg&xÆ* #s-l̥x,}3K˰ͤRlek&70+12}"( Kٱ + ٷ'V MppCÁO6g :jBxXэH7al'_ۥ^V5rtW5 HSʱ a!kѮ}JQ&u:Yylh7]d::Mc9wJ MR<#g2_G&F FtBb2Y߹@ ƛyE/d5O􍎍AUdoU;.˜i%.YNƹׂOɳ;ލYkvYU^3Xc@L~0*aLx1?+ѷR2K{EC/ڽ!8-l\j{&nOؽ><"+ SnM f#ufC2G JTPҬbR.uZBy,k14 _}]ĕ @8}g'n8_U' JWˢeׁ4L!lṋݯus>u`SQ5="FW&͖O5I/m'aqK{߾ heed" 7Iv»"Rm@8w|BonUtZ*2>bE$bU"RU^}S^ ٚqZ- ay `'!Y2] @^z{& އqK{Y1CG-۰?zujF̢fkgX$5s$pxcFKޟ`C8M `֖C{#q!:іJ`>7ϧ@cOiiQpxѲA4\vTB]\ x#Q`*m+BY ) 9z2-lƘ Vچ Φ /]z7(vdmȝ`.oR:Y5rkC.ʹjXq>ѓӧ}jQא:+sy1яlVheN?Ȱrx@<2ӸۯwX'duY0F=gA5cYțo@ZO5U! m YH*AfXo5Jb-sA̍XeYHb_s (nvځeXK@Q&4P"tWJVM!Y5@eZXǨ U3)m׹`n4z@a&i(kYk.5m$(Mⶶ}k 'aA ? _~v9p}= tϻ3^FP KmUR+\=Vqg:z\\w!x3 5J<_*|c ͐zL.4\ϳFJOD/&)}lQ,&D)?S0,sMƧ{QV/Rh!xU*xݑHh z*V:`G"z(kH} !qmϾ=Fd1_d 13ܷ,;Xi¤'%0S6G.\w;A\Yf_VkϬ+h!h^!8ZzfKQGS_Q;ݩu{+"h\˱x\WvՕNTBj4=5KY⢷M3 zb䐓E`S:)^uj͍f`\48?`}wTm݌{l:Cw3QDWqӿjjPO1q-\zD5hWdYI&!?ppq5:0ܾYPK/T`IBV[,c^{\6EWe}_KG#k:Š>`4pGh|3u+xH>3O֍y&k )o9Wh F2b1U-nMσ@00o֩D9=x%"P3#{bUYND^+;Qn2@Whs_" & CNܜHqJ"x# 5AHOG.b>0 YZplm/data/RiceFarms.rda0000644000176200001440000004133014124132276014321 0ustar liggesusers7zXZi"6!XB])TW"nRʟXdA"#&'ƮBg+db_QP'1Дȹy~)bL8uCq^2E90-)n܂R$f F1R-ntb;y_֔-Dam,j-@a|rgbp ir7{R]ڂ-,HV4Y3mh?<(f1 c:sg;[%MJK!(|?,+KU k K>dAϽӠ ` !L2،Z% igKaޥl=5w_k܋j3L9[!x#JL[7\t{($ue*mf zjAZo|{USyX!*5fPJ#ST{D@8P瘇#]: .[2+k~Ff3tgOɯLjktz/(\gǴ%[Cr,%>*9!4P4L8eSuDpuH}i(>jB%'C?mکiuzDQ$I暄oAĿ:';d^ }8sySG@ԕasi?/*MtڌaW^_Cr518'@J\XQM!҅}Vxߩ1vYp&Ú괋^/=|s"ZQH??_yKW 7`GoK&\Q*3V֚1o-%4)*x(:\"~ƫIbZ|$ɽ6ias)>zPr >d-hȟZKϪlY1}-ׄ;WN*㮣f.6K;'c(,MC88? *y[+勎H4hDx+`|0E/=4k.1ise[*;Po4t~n¤|a#ȉ<\Bnaײ|eXץfӯGˮ4Y~Q[l#S#,}3e F9鿋u1VdĺH9EO3HkL@ $A{wZtLPh;p>jd(l \ΎdTsIՑ6A< I5ƎRR1bl-Z3#%W7W~w9Ѷ؟m`@D-V%+vDrE7*A1JOG]G>)ӬEc]*zY5aL͹l B@7PE1g- )| C߷9q\5v0(bTT(7qaT18k  },Y,@TF]m[jvZ g4y@Z +W(n&Wu> ov7ZF!3Evb҈߄2Am@$_e:\vƓE wn+[Eٌš`X_TI Q",Kܪʕ\d#wx0H#|&D ]erLqgh&^'x7|Dc`]d7r#&I@oL7c`5!߫ GnhqT1z{~AF. AžJߧV'c"f(TS9{DJthu2oƆo@L8nЖpݲO6>׻&+Y0OξrL [ZuSLa $W-#;a0*=Ob* ql;8#j`r\%~i$aՙ>lcpti)䂯@% Ց!RIb{Kn."H Qh(6Qvm'7LO(bdUpg?匓yE?-e؅}c Nvݳ-5rlY0ݢIw5HyjFb:w MT  <`V]&2--(m qW/U5i=<^]pφy<%SGY&l_6]F ,9F!/++xR@: 㚇2I1YW(J^ю6K$GJjUpl]~^$Be>h8B\98*,M桞.c4QZPi7NjzG xW]hq% 𜲺uUom0sD* /8Vms2 xgI)B"}CS&u W\D!3ζSw?YFjB8(#Է,i0a-4)\&GNO~?ZV%p-v,sјN-Oj|eU3%7!!6\0<p|Rx6{ ̃Xl髶iLͳ 6WR2;J ɜ\0 ajMCnFn'"`*|eW|-\ z:͞rm܅rkf]H{+̐R( ?6|;Bq~Fg*iG[Jg?t*}|z.5ck}3RI_2Ğ3L *1&RfDpVOT%0']ICU3Go<9B\s kK 5Fdܴ #g17];%~*9ŏxamxI2KU◑мpR ׋_B}3@򦝟B..}G'eUm6ÎRm qtȪW~??@F^Rbdp0DRbb296 lo=*~qA}MkV:3 g Un] 3s^o:Q~ _GH`m AG“繥S,5>U*s|lQz^"e`ƫfnahWlЯ'$4ITc{UrF{gR4>Չ8C@ ("[C;` ̥*"v~D0 j@XUmO~t./C=ď팾v0xM9OE47ݛЗ7/؞D?I;x9ŧ88SoˑoMtPj!{ð vj`գWsjFcJf&Di)ʏK[ÕLd-=:VR` 9{:\=|eRO]B0?#Y3h+ERo$)3ǍniWZ;ļfy?z$3ZCPGASd8_}d+*41xK5Aa0eX_'dAr oKbUj>Y*ࡆD4#ۭVܡ0Dr֛ '͙:3*s* ["7éSMXׯGRpr+K/ޓ,mExlnΩ\Pt~DHf.a{vD3 #Z%lqsCRQ`;6O|πgBN Q<=m(7;AF P2Y+1Հosi@JCUy?Wtk[M[S* g%25%W(T W-tP@Eċ %kˮTձiɥ\sAx[AQվL`Ɓx",v^o=ԩ7| b!Y`}{~ƭ/}dOKȧl&``IK׽m+Ϻߙ#'jV͞Q7B^R1EK|!D+ỳ;XYF%Ww~9Wl(4,q.\p ͶʊE0ԝX# _? 1XB=O؂vשxf @B !e;=I%Q/!6edt-ڛbƞz֧uf0qؠ ;V`[.RfV`OӚJ4*τ 9$&W7'-򏗧/ȜalJx9i_6gxIa>At:QQR)E27pSLOicoWVM:o+Ic,] Y)=;0L=N|Fdsӵ[RkLQGMqcTX^gm[+?msL;tA%FssSʭ멫iԜܜ`ot_KE]6 ޱ{>v_`52gW{]J1C0@t&3-tkhJԡdH՘_ eфl$נn\I=:bSI`:q)Qe -Bq ĔU!I맘) C^Z Dcs;t+_n}=5ގGb+*XsȼlNLh濅< aȦaǟC/3 G gⰈ ٺJ' (õ=|qq1ˣ7lFCs֤>ٸ^X-|W| S2~־*zy/>iG c)RJ0]VүN0L~J()u=`nK䦋Yq`BG !WW2Pm/Rް5T`{_wQAnJ;K>ڊ~ƅCL>i¢?KfT(rAICkGI~#6 av_af]'QƽG$,_bPlPxp5P g4!vz>"+ׇ|cǕ+(Cj?) tX/'~cgN %j!)NKc(cڧt`IQџx݂‰F.q)c/GZT&D.GnY/ㅻ-h|֑ȓ/=V}qąW@^a‡i ~4&`_8BdZ6_˭:K0l oG0|&x[cFC~_QFPû_r/1W{B`td-:~?XmE#va|p:EEP7a&B!Q\'"L܁x,V]U+)jy>#GYJMI9#3&E l g/SG\^ >#ݤ7pҌeYi1g&7'ճXph߁ϨÏ!F cz0>q{y?#7ܑbDE]f?LN^' 3.ETm=Zт2/'R_ZR)dwQ@'vbqmj7F4 +Dr7n'$Yxh;8//0os\ҚE+*O'\'Y SiYl Ow͸,۱o(_Nd?h&b3rʢ%~Gd&/a;οY%=ZzSgUH%Ľo]i♈ѸCc0QTpWD:% ɪN{99wl'FJ?T yS'uOI!Fmt*SiJp})ecizo D2BἑrK~*²>nk#yC[c Fmv*nVM"ك֐\_K/2XPĕJ%髹v d)5s-$/ʼTc>-若28/4H@F7}S>hKm/YWDtT rs.;;Y8Xˠ_-$ o:p IRi R$}6JRsd˦wov q~e=&b(1#f^(}pbr0R||J ;n属0tVaFӠ0X#Y$r"od<YZRk0͚?~":2E7+puW̬Js^tytHop #%e ēLjq^^gBsN ,sWnD䈴!ʨ;/#F'E Dn03}MM/ d9HxjkJALޱ(d{S&ÿ]n ۛI*W]ٿJ'j 9q$<0A')Ϋ%5=d!xItak8L0lؔ8Ss mFwuHG/e8"'9[7`ˮrྶH]P㳚o=ȓU/2{z^T]^'KROH{/|Lj;T/76W}-EB'wB)G P6KJXcKrǜMTTۺʚ.H\B!?.0~S) 7W&|)^imΝD9__QB/€'jĿNS@2X@H+rc?jGk 9C.,bjAg=~?d:\S_ZG75lԝr-kncUd+E@S4I s 7 tsEj2{9pA-#7[H$b҂)YdBB"۲2Ҡ-̜o/ik1dz?I|SH  8QνB~!- ȸW&惶{ˌS cR#dXYX`[j>Q$ZbE*"A$0Pm* 4:i'+AG@ws)NBc-oڦ <7yf2 C7H+ HREGk*.g]άլ[$! Q ΚD6^jTzՏf0){)>bēiK!ug\`Xyw0DfJy.|&:hMU:B kjc=!\CE -hq--|W#Iv ZK??_w%y쮫/N} $gF20aJn=e u~!+V؇0硉gG_ٜ"_=-6ti^c|,j6W=6E/Ce]#(N gv;twYPyNZCV#`垯 ]ab|~N=Z:${yOD `z;κrW; $6蛩S˻C(hVA|$G=Q-/u0iEcUҳj2#CE#1IexJFduTה.XҰIy3ڭEM/oO>h')AWEk:i$'KgB!GF:{#G T:ěL cg#)zx|ꨒtbô'vڊ\*<;Waщ+Ip?`a)ƺ;xk#X۷œ$FON:>U&/|?5i$/{{-= w@K26}R,?K+yHjXT"jQ0#r% ؃+ Fl3%i0wk{u)$Ax-POD 񵮰.ې# #b4@5,tN̽$aMnT-{C3KoˌOU4/,We5Pp<.\%?"G\KGC$P-Ƅw0vt,)1~AڵvIGLxOq8NkĥZfj[ ui>- Q S[W2PsGQ't_T*XD^-\A̻p!Xump9khd]| GRAYyִ _P͐SIAyY(l"3aT>eGA[%YTs}ƍt[noOɝ%)qY)& iBkVeo̱IRSթ8+CO]5ewNgĤN42=-33&2oCN&puKT⾑"5ݟHH:5BW=jAܤj@GF@u1 >nJHDhTʟ}ĢI0M{m=8Xh9o7u*]U JR|>^L` 9;U޴=dFJwZcjv͵# Z=v>NL$]70b$Sj)~,ZE2 Xʻ#G4ݳV]k0/Z[D.U?RU;%E NZe+"GE7Wc9q擉+*YU:p KH+E^5ny~'7 K亼͂z)>v,pNTr~}/[8I%/tbJ Ai;,!T7e5$0.hՙ tr؃СG,!3\L4,Z{mfwO{T* ehܒG9?_pD(,\e(rpeyR[Pz²w#M~+&7Q_xrf֯_|6y_bxkI e?XmkcmΜ&B[x)%".G{( s-Y 'pA$fOٻ *e/…yW0s]ײT } j\Բc%&2 [m`=as}B5#5uハ7UJYf]nW %DgZ4 Rpj}@ٳ~C%Ǩ78(>Њy~!;N+6Mƭ{]f QYݿUUn%u(Ss`2`Wr}9"5 kk;n#[ /`lcC F0ot@7 "$C~#Ԅ*a7[i KxvE 8`7T>ewmsw82fp'f>.dUuu:?_ὑiVG^s=ew41L(?dsI2P`Ȝg!@D~sH .:HW+e <|8ɘ/'z eΙ32j6mL0}iyNp\ZyGp 2IaR?$a t1jpAU/KGD >1'#Pxk鑿M> W+i@H踕!Ƴ*&|r+ i1 v=)Y l^gS %&CkH^ 1Aa1 \9r}[濶$;j;=`4D{W{TF[)lUyHBcOAdN2y m*89߷L>łbe8^9[mIRoә{k*NCF/-S<ӺTq1z-vD>{^T#: 0Ι7%82?_jB #ҥv;}$wpl$>ᦌ_(Ҹu `o:I/-o%^k\?.ITճkѫl&3ۗq}^Y/t]( CT"*ԻVCxc aG4Ki篮mʂh"pn½ FR ߩS*M ?&EPsz+'zFͽ/^bU(dbȩ$ @Ng+SHMn 0 D@B VHqk yGDP'rVNM8h1@?G"+.tP߹$z\LVI9=^ZŬg0 4ĆeoEf ޷$ hlLT8j<eD]A.pt$QxFkzb=-u~| 3.JFÁTIߵKL#̙4|syyNTi,r.EЈvM;|{~Rü?p6{R*TBAыG>0 YZplm/data/Crime.rda0000644000176200001440000035707314124132276013523 0ustar liggesusersTU_7"؁JI H\Jw`(" H"(-J)eܽއ}zqg>{ŌϜkU EW[BKCKob]alMCCǀ]l)_?%(PVCYe ʦ?????????(PDPvHHʞ??C(Z(:(z((F(&(f((GPPPPP\PPӸ%W+CLRR)b>a~e4!xi8׹z ܹyliWڡ j"ܻfpUF~5:i7kwNA,[z˒m/F ҝC`3e-:7fqJ%,¹4ڞ{X8nfz n[ vF8[cX0\Y -Hw s!P]pi  awxu_m~a Ƿg,PqozpbPYuw ov< qn`_IjT+הKӳ}]Np@.γWaOoya 1g_ut7<! %;BL!l(!O1n aL [1l^pp$D o9&–?k}Os 6ܨzQoA7: זhZo`k)JRLka38=f7s{ Ioy^Ǧ'@CwpGHeyݘ;|չV#bH08a>Zfsb5.@z 4hm;vb[t"Ho{ j&!^>cH0\~(Aù|c ˣig.CpVH#mC($GIup?p:C^uq'۾7@Pj#&|E =5c%a9%R^D>.T]'^W㠑2"!1O "YH#;!tFe0oܲ.Dטk[=Tt ^WQut́0崤L#e^~?[z . ޼slUAҳ R>KQbDLݦ !jgnTÕ.[.O{@Zxoi"$,zUsLL$\>k tz )Ȟg7q9/5 ( AqzLOA+v݆RײaH!zKlNyCl޼$$|^q~+ ~{ Yk}ŐXYd>{<|woE؊*|xgŘr1d'X]VxY 7̟ʫcޘ",QO˸³J-xz|y<2Ǯг_C'gA7cg>{)Y𰏽F2c1M̶KVe£[ n:ãP]V?7c+- L5|N ;<]Q| kOl2yW^zf/UzkOO݂f~ԟ+b912x-Bsd+g}!#mxEs{<m?\:j; sၳqV[Vhۣ 駑$K[S @ҲEњCpo˿(M=&'$.s~H+׶=:~.G]aґS]?Fm[!dA~7CG7,P;ƿ2n;RmW0ӃNf ?/.틷gA"kcqy=kʒ15(k"[]cB l7\9:B\OHؖm-$T~Rs^ܡv2WeoN{et >pżyf9HGtpAmG7΅Օ@cw *7CjU!Xr BTiTYb H]˵d=H'XH@hMڏnqh10cpé+> 킧BT$@cWxg &FUκ@НK9!z7x{VX=6wvSٜGgP-\Nu7|S )tE&xmTs9sCL)0V3m4%ypu}F~%>iW ~rړ(c:WBMo^+c#z!NA*7lFCIWz!XǓp%Mcv?>*(#<5]z$ێ#珟D@L`VL釛)yt!d0ZwC&!*vй@ 0jےuk@Z)_AHZ HOmpl~6gxgApxsHc] "z87&gB&㝙w;l/lz9ھҷ{[,ac|71EB1dnb v!͸{v[$o>8 ]ި\ 5w?}qOMr !fv[9 ? Av> 1=y$L7 j- }]ym],$Hwz{Y ɽ+~$+$qey\Wa?V ;,yAHl!$ъ\4{Y# 3g3;!4Sx .g,!㺐z DbtGDl> oRv B"]C9Bƻ iԞ׿/̻g $+ zBT5?6 RE;4AxQSڝɸ`^M) fRwċ\D$^ꁔ5&zo }*z-bѩ&Íc':FBR~tx?K0ds.=\ډکJKi@v-RGZ4A@QtL_AAYSW"b~>uV{? "cMKpϯT&| ~ ng6%'Gn;*vfsBcrV͆Aw̮2c>1AHO԰X>Į[:^{>yc #g NqQ}4$p*S˿Es2ϝG {RᏯ{l QNǔ>+Ƀ 𰊏sڣLR?]{xw½8Ƶp.b`qe\N~g_0~=%B0j{< xY~fN|]%&"h; tA5D(-7/r44? :ڡwꐰlNAn $Ȝ3(oOvY# nn<)\q9u}/X 6a^a04XH|v $>;Q.+ R1䕪agЗ[p3ޮӖ"v_\e3m6\-D ïwvkA`G!V/ djb0<\k")eVf|]7Ld~V྄&$# \-}4k \5{@7g3ϊj:c @?C׽а;mG ֨^^9cgOA5h'k@>O ?>Koy?ԭZ7>Q&%qw<6Aֈ m)}zkANgډ9W*LZ?tShZ{*n:蹉ACqhnXi4[g+Ğgz.1<bHC/WOU3t} Iۤn|ft4|44 m1i_Ek3t{>MEQw^uSo;h;fôM^04=鋞Ղ]Jxu?z6ymw.EvYP-rqWq/ L_m;:7Ơ]sG̸Whvsִ:W7\ ZhMpp枪uРp_PhY"[\.>,wmNk%A]`sx.7Lw qP`]x+ЗՐxP aKԁBC >P'4*J6ZձbeP>TK d@ԆɷiP砷mJ(e—/5[CeIĵPe">@^kXhxDsTAmuP9\xX(ԸiLn dpdT9ΒRY-UPRm|2٥ty tePQy8 MV^zP _vBP ?U\o:*LGA%8UKC)@yU~PG@MjVPcSd Oi_k_[ޫ wB3'z2)7ۙw{C TOs?3knfWzUy8;ʼnv/ +<,:OmcסKeWk6ۗW>V]f3(a*M}xHG.DB9`?8]k z' )G-ˡp;1 P߷q3TZr燚4VBEyxE]Azb 0忤ݘ!^%] Cif8Zx>*ԍ. y[c}7"ݘ \}/.6l,㠌T ߌi*3PwiOPc{JT>yT >~" |:Բ XqMZI/sAf(}#׽<?C*A ?*ïA;TZZrj\M8wVȁRyX,(n(P6yHInQ;4"q:Nyp]2佮KJ%T | UzJV!ɚ5tIBatZs~l2/}h pu>՝FÞ ˵w-?F w%E2/+@w^w#ȵn5 5CQRcQ(bPi7(>r/WJE6$|>;|%Ejo=-spښN: TvCE 45(#^P;!P)E>>^+jWcd\(օ/Z{ƅ⤟PBQ7Pbq+/p}(kݼid.j b3Ǒ.k(9I0ď<:e9KP^?㟀z\== Oo} /;ڋSɼ3PwUtjTVTaz}Pޏ5ۡ룯^&T374Eli2Iڸ.}Vo?zA8)h=m;A>W+CYqaP.vx5[繱sA̎Y~e7Tݩ%y! ꃺBcJXaݘ: ]34h@{/5ɻ>-w׊|0n$ ` NZ׸?[Ym Z񏻂.]2#:(UL.{A$hܝ P}:FP8k1xX<5|{!tK לlX_7'oaH8P yٗ'TW__LܨBKƐo"+}  OEJM&Tr 6v臚ݔP%hbF;|@YYmz_Αw3:4`z&oc&6c^ӹJSG??RK_~.GlKuh 7Aޛߗ܇ m!Tb_?}Zҿ#(Z^gC W\ =gإI|*Pqa5|r5Ps衢.& /lO k6]䠫RpE{m{ov`rږLh9\Cb;EaAuc#ujszW{G76ߠJ+"t'w8D~jV.qUC !mc(5q<=7W[PÕ40 +,IaW4(>JsBlCPƚR(;Vw2asźN9I{&.k+U"a{s}пZUFKLsΜpҸsO09zΈt\Ƒ??X?; >„~|:~{_,-Y5C|:a袘hjM}o>dmJ>tjWDC3J?~R: VgϷkEa+%(X__,ߨ>3;TJHuO?n>שGCuPG ټLʠtؾtT_zj9||bqT_J/ԤKW@ ;Y"驷X:7P|Pbwӵ3澅3*x#7[hPnd:P8/P2L8b9Ǩ-wp?Gހ_>_hS1W0 ]>: syj_Slcdi1$p q)ZTJү΋ 2a!QTxC`i%0PgS8+nr[+k/tQu5+k] @ղUXCi"2X{^4(AYxo搿IwA*b/@Q^PTp_o&LϐKH9Ŭ bnCC Lu^Ԫ}aܨk9(|Zﳁ`5z1T:\>tv_Ig#V,-a̓?`QVƢ+x-0>ϓ Wu}tN}.h?,h"NAz&RziX)-_@.gھ`b݅= ahOQ˂ӣv0y{Vya{wpz {4VieP^`|da /iB㛷r1hre7Is5y`1De,.ם*|bPHoZ,mrj?3bU>4E /I+ғ3e:a~\tPtHȖ##X^ AR ) ~#• l j{#ѻ0Jnt}hRx)Trl1hws٘^rV} xضpjrm.g6n< H6T+F,zүj)RdӰkoTAi\Z wa~ZʈY>v2*^NjE`{:1v@#lwВe60 0Wy |8yYlV{5+=B*w4v9 :nm\x7{u4١א)T`(R:rM؇S2*K?k P̐UXƜmu 1m;{C6н|)Q0x}ڔF1A9VА_8tM^FBé]]|51BoXBXÌ??MpxXbפ="ծ "Ѵ|gxejYq+W27\Pa}cU~ITCZ 4~rRhy;;]z{ JG@SLR[Ub-emJA۫WК1t+pZ0g9:=]4x; v@ߛ-4Ы<) zVv-!>TaY/Z@$`x|dũ;3nx% ;H(mVAztd^Z=-po }5>sQ]" 4н"h'"仓*cr95#D|N B杉|`U0 j0aky.Uw5-bv ZJ&)څBgo?XѝQYFlJw |h;| е$:}2nӽ+dŖЧLl|nbN#~ԇ-ӗOnw't؞AiǞٰ:1(d Fr^d>σR.ġ$Κ#v;}c)Fq~ؽme'̐/';3΂SZasba4E)L:A+3P6 2_B,ނ=Z傣pJ|%^9dG:fYG9wkgPx%.{@>oP[3^m 1MStMinA^B 9ll[%iG `]'Et(~{=;7y@˖#Ι/zwk6{=ቚT}d~o:c[UG+@3Uy*@#KPu Ot6'CGfeA{ro0"'CA4$L\]"zH4}$3,8|ZPm?Rx@#ж`ꗀ]U0~)[(&Hx?ZE>p(۳3Y^8Gý T(fʹxza-͒/%:s t|_NC)$w?-dܰF@]q4yiE^ytбM+Ggh7+: -lE Iտ0@h>zmO)?iîmiU)sW,E^fØof<nScxrpz+t8<3c巟{޶@wxk.,ȧ "ڐ~h]ҕU}tYdCqae0G=L@gڽőEЛ" tTσ߄= W|KE]?^ƩWZ Ky,;Z\/]~ ]?~ ;q<ĿN 3 870}2 AO~51t}a.:3sД3 ]uėAx@7mqR:S,A2q[ v0iFl3Ll+ڳ`tEYlV.mIXf94e>ͪ^M ny(>Zz[m-j킶W-INq;ԏ3xX1g :qcw^Um. w ,tZXCE]6{IavjX|M0@96U0}w0L髷+j߭q7RjH9/%u]%HP;_XMTH+T=р~e8=b\Pef& k@•{W1J tgg<-}АU !*Nh7z{Fo=Ӳ/@{[l^u߹P7 P=6|T dbZ%'uX;@]ތm;yC{>Vh7(R:O>n͌DEDt!/ۂPzFW0nʲj2W}+jN-ɸnەiLh3OR ?, *ٶP#w¬}/ԑq:R6LK6[vAAo衆Yȯ\h%A-:hü7;P'_:,z^!lni@%ԚC5n}W\ܥO~Pw[H/.kSa[#CSaoK`lVV3E }Y3 S™[`8^{\%mbti% qvwd_S/ΔǼ2]{Z|aa0,hu h%W~m 6KDƷCOɄ+Gh66,ZhGƴn۱-؟r4Ri;S(& >ԭZh %V4e~✵%CVQ2CJx5~R\#y*R_QSEMcK֣MCG[B5Ps+fJ{z _(VGGڼ( O+M]W%{B~-ӡnhNO}Z0&`-ݯgYDC}EXƅ՗ϥwr,W[.{w,{„m+Dh߰wVO -^öjwc9sЎ)<v9`+)ƔTF0v׵e |E'/2a j/ûR*'4>:N ~YPLy) v~w]ɢ衅Sݝ"t_ge aZ8:6N 0,Գ\~ө ڌTkACP̒h|tcPOWQ0wfr~uLMhWH`+ &m"] 9+a^h->F}踶d@nÉN3hOx e/YdhxgB#% M/5@U> ~˃J|68/|j|;md^dԐ}ɒVAе\PK^&~֖~;4~=ۨ!PZʲuZ-k͞JCph ~Jk6^f>jZ@k7sI{9Cc'[fhR~jumd sޫBa>}N"x[hA2 xТAYMM-i˓l[>T,3o =OWڨx8J\^@;?>v T ; 윛r2na=VsSC~"~,OuYx~c)z A &̳TF[|e+4R6 BãGY .AU3fi\:pS;-{ER޼Nr]OwvL,}6G<2Nё[_fu:\tu +u) wGBAKD<h9$at+=r{4MSf4 uf|KhX-:.Q i_ޕL\N&< O;jӻ)cgBk.[%%Go U點Nhh۫ʰ+`aOM͆@^NLG}gF-3v;W+_Ŋoٳ?Cざ; pߖA(S%{hA7hڲ[ B+ ՝yб;A=9̵j)ː-!54?4} kC^Rf49#O\|2>(2|?y^ܒ^T|Q\lrH+tU'{zuͪ_ me"ǣCAS?uƴt;[1?ȵ7T#ӻi8h_rѷxbٕ.i;m1btd mLFRq|ay<V+w[/ܧ>v|pk{B?ӞoG#yƥ:/`Ƃ\QbSʃI[#찍uj5Dj|^qA.~k^sϩj[?GS]/zG}MQ4w a⛞ph8" PsDf8d؍CVB8+k+tkHJ.ƍ{.ѣC,˒QТ57 ?T5=~ƯR_ĕ?)_owK݇=aUzµc:_:Iu'@.bA tR:,[; K 1p2'fÓ\GoJO|& ma|[g> ؍p?B'Z'Ak^ԭ>)h wXk>?>}qoM@Bsjpb_ xq/+Wqhf { <JWk)oaZ^+ ;:k삎b/2O^Ff2.fQWZ.W ]wZ oxV~N2>4kΆN\Zhvyйaٰxzmv%^Pv%&&n{ІGsC >A}`~|[-Ʈs}B?H>XT/maGycxx>nV(@M"{S=km34MrݏVq˕յIZ] tuԷ/MB̅5Oܠ1CUJp7.'kLiO.l\ [QZhdkחhA^@¸Sq 9^ETBڇ<`uBb wzL|*~o&~5Ь? z<4Y#?45O:Ao>XC+{AZC5;BKj[ؠyh9,+ rI*/ 2ZF@æ]r;2^@e>ԑqzr$/Wtl?ȎYGjǪk5Z;{LovTDgf|l[hy0}<o1Ak`M&L 3 +G3`qȢ&-C<ɫ hXCC:/$ڞsн8v9>>jC6Umh3NSмI4+0eg0t!Gn}ctC)H:5^q8YZhG}\\C  .m[跊}c+0y`}sg},5n6CywٔxCLP~B,ĺ-I,Dk.K %u?k'"&%b&6<53̈́!^7"BD|1qp&}}~¾".9[o! B#; a'|Bz璿 h+Y?>߱* c&(=߈e'C!џ{pL~Nsr\zRC'N $///~nq:D|Gl3>2L[ϹIy"#Ho$?rC$?o%F֓##uI}'@ާNRQG dm!E}Y_>>}lE9Ur1,T'NճJD9zcA_zUl/yW?!N?^N~='T=F *?q#s+wq 7Iy&qP|;)7~&Ǔl-}.|y'LdB ɧbI$#Hjzn';\.Rq];T#9n dب"KS&jzPyH/ɧd{F>:lZͤ~1S0)Tg֓|3{rEEG7A=N*Q=E.vx_f|M?UrM=yT|B&CգT=M3),m"}H3e!`ǨA~_SMD;דKoRXrG%UJ6*"ǏW﷑vf>u?>&~c#'@QGs8Pjبv'7_T9.T{G}/ٞT<%ARבP=N=TB'T;Mw;9dliRKT>J{TJ\$PwpT|J~$AwNS,dpe's7I~$ !qev>3>*>&W3~Ϲq֗ v~=i~*%9~ xQI~Do6I_T)^8pS(HTW#oT9a&Nc#\=/վr#$Q} xNGT}KCPE'^*L_*d3UCUq|F'RTB>fܓ|#DMdmC6&EOvRT<@+w,RoTK֏}j\gA."P,d!AjR)?+X >jO |Eہe/]{0wNųg|s\`fy_%0b^<=VՈSCAy!XTb=ToawWnM4׉}2.7qTrkS?^Ř{Kp̀˻k@WzY3`ch~Pe IG!0n(&q[9 2LBh][l8`@,Jw? "׿|BS@#w5_dreE`!ʶ W::~ V&^~: V{3H-~PC,9=Hwt>[>t}?C5KN+NϪ&YݥtO78$ZӖ&KcnK}g+c`VكOAZ!?3B}7U{]"f$^7N}ѭOO5`u^,^l,߻5a!l`N5I1 #.:oCQUv`OQ,X~5Zڴtle1y00<2}GS쁾HU0X$Ӓ ,iT`L}GN0}ېCdZ$v10hxfC |E0fg+y`"wxЪ1:Wt֝%fZ-@ׯVntɼkMiz~vi@Ϻ_:zz1×AӾ9xǮ5`gY+ '#A_L}4Ui`:+2`L&;LS!%=f&1{V 1ΑaXe tyW`Ar6xHI$ mటNkB`q6kK)%dAt. w3 ul{9e|Ee0`xs- *z96Eq `xrj n\珫A`Pr/Y` hTB)c>4pw>ݦmpP@s8Z48xnϲ}aGp_h _GuX;;;``%p, JrTɼl$-臦V渂8,@m-'ެM@&yOa&Z%\6#_uDAQJ /b:G@k!15Љ&RO>zyKZSol}rIa`234P:#FJ`mj`-'W |lҺMp(M55T5\'SVͤF"ւ6rӯAKP?I `r~IT=z֮1{adՍKasg8~_{(yu1X_rVg ӹgAKD*(PMmYƁ Qm h]DtIUsZ<F[PC9}]_54o9M{H{g)X}7 G$W(G-܂i!`%-ð 3tgpī D.Њ}.X tmiZ: :_GK9@W?At?:5^ `0rru!v'`03xӦE[KٵxAo"z{Q>$|cG}._E00?u) \O }`dhN9 g]; Ft)+ aWVw0xʪ`|bX7) )XفWSoϩ>t#mǞ}x /X}u^[=3?v_ 7J,K`v?G[`)u)8T^{ b Fs+";+ؘ1foo %Ƴ#Cљ.oʹxFNк$s 93}}( cۦ5]!h=OOgPF{nM\sn }q.Cn*YK /`xs|L(W,wvήfU`XO؇ 51w/tU[n5k;_!CgNP<u \2gkas^7P;~uL y@v&%Wu,O(tM%`&.XF@*#%o0K+ 恭%Ȟ*Hujm+8s`KA0gZL{Ԁ ~lU0v\f*TVE `>mo ;şgaxђ=cσl`^M]u&}_[W/5s'w ^Q"e`}eWSO `gV]݅2A}kx3 ׽M`òiWG9tw4ݍWq ۍR`[q?L4 ȼF1>>,)}!Ϋ<;ǿUj\nx7ﱑ{?  2.d _9*@Y} {g(K6ژ &+n`^&6|`|,}yn3gm^(݄!KL_ڳ 7V Vu8+eR+$4.%ɠ[c){I&FE4@kPSpkh谒4E]A_}L(ذ-n ;̄M߱qmg`] #̘F#VdLfkb~n`^`2741R0* \oVn e?Ȫ_ T;#B[ͱw6 v*Qxub,Y69-0`} ꮯ\Cz߉4EY}z )F_>`f#&zc9]ç]U.0,M1s2?d_T\W'gzV>M?n\oY,t,=n[?,uz2x:۠?4ūЏ@ 78kXNlP7/\ =+&|`yu' l}GY{{p<jIbr*`նNۘ:*0z >q_OP#ܓbE+cZ]*֟"]<1`(d*'U0 JeË̼$z0bU7ŬsS}JP0g-dCڥ`F,Mw<we *OxOs;Wsf gC\[{iхN.MpݰF\3c]p3쫠O$~|+YK@S6Pae]:GR &pZ `yhõ `1scO>;Z8?v=^v2ckYt┼>`A'Y2eo pЀlf} :b'I9iU>sЩ;ivt4έYڬ q3@ʋ`qGspz?GҔ.iEUXh _m*)[?ebփU={'8z|xaZ|'MAiԈ&=wuD;r&D ߮+,W3g~S 7p^8Wp4穳\ڇJq.+DWS0ZM*Xn؂-Հin&Z0O0 ӯ?; ӔtK`+{LWn+)`wAS7QnNuܤNy|g3d} :>Fhu -NUQ-GGKhf\eV?MB;mst,0^9|0VueZ vE)KEoB>hf@GЪE@5zM!kC[u|)Ee2A{oZ Gt0 /"a.: O=RSwoN~ǗKR˧K|D`CLL=E^nQ'+_s*h"hA-DևCЊhCI;HI0q.a и6;Z)4͗rJ`+s6~WB!:+iDSЂhF<pE hѰ!6ەu_|q~]&Cw0Fݲc;^ cG.E_\M.1йrPtʰ t*.^Kv?OQl[Ɩ<ڴEc?6=E}tA<2pa>?`8s(mt3L;3G}&RgixV%;ii _OĤjx1b $| 1ƷBܔs≇sf񼦫\VAdKxkZ[ zoܤLbD9Ċcl )_wO cMv (@ 1^O-_}O@ܳ>\nOް޿Ra_/ZQ9Wvo1}mNQE qO'6L93{Ѯ faj.|[:N䫚-ӭ>`v,%}1)džôqtE0ssZoiaZfϷ`Ӆa\0lJı]5JFpxIYPkB2MrhvڼZofC_F;wE&ȁOly/|>g]NX݊GM{Wn ?Oؿ4pݽuCq켰rQAqw'j.v阄'@񧌇+݈+1Nhs^0 IFhds4z; Xh㿲`of|"t|3ZlY&uci C0Ů_'LhwpT@.~0Q^;-;*1NZ" CĨ\yG10.EEfiTKGT|wOlh3mBy4šNcYh_eMWitNG0r498,⋆]`U.u u&qob&SАEh!4zEz"ԵN3s 2~vy֪O;B̵oL֋MKS5+`ʱXǫPtCjkhwL]Mr&];/ASn\29ghmk`zI8N]8WI), `p b$0m߰?? eM( W_~x:q0Mן6L@Q<{3 kL)wz)[W$(hy{NUхA'aE~->kI !1V>c20n$ M1Z=`'g00rO[_ W޵i`CmI."-(*q;9.dG{eoa{zOǮI: o(|x }]}R}+.JYŇ `ɨ., /nNɝDd8{rrL](OBOΒ23azWtv%q"z׋ȠsQк(R̊PVиg˝hoؓfrY,4v9EѮ7/V>/E er&?sŹƆ.x!r;Cܩ0n]+D80X 7[s~h$a] #/C~pFS%"7`>500tF z|l͗zЪm^ CN 1xL'9N' *0F_QI~Z$s#y?_opsd^vF*"`d Xq|&gwBC q;'~ARM/oC2xH!ؐϨYMH %~YVB;8U}_)篡+Cu|摸5IB2(L/&ص\C( [OSI jl޽ɞ.pW݌g܅\@:+W_ҧ 55KcΡ=︆q!fǙqyHDgmV$2~$~!9^D{{?!9z=z%h!JHn$C45O"@c ~i$ri%$EFO O~GH^]RGU".Rxm,$xsfTIҗ&X O|?HbwbHOpB" F$놤Hj= IW>wz}ɍr(SD"KH Ry+[E&(|vD,0J$}?I]XҷɹQ =7Cj|aHe1~PگUUc`d c}*C{\oEbC>")MJp$r'[7I~Nqf*E2ޫ=AٮaFX;.Fx&k$ue(}G9I;(j񃬮"YmE ,&a$,3#9v e$dT7$sNꣲyo2* ;(߂d-) Q/9 tll葼hݩSRyB;GEN!uO?+ZlHaH]",,"E6ի8"޿3;U=qǐQbx({ZA$~@u8{4fd{2*!og=W(*όG*L+Iv e8:$}?3!o?#AwzB#5Hb/1NR.;#h ʻHTBB %(}W T//w?CU0IGRF2eTr+ ٵ{1@hW>.H9 @7D֏c4`d(ya$!i/CSb,eZ?:DTz% _B@=L17,y }kRf BH(%-C0卟pxTfBߋ]$Ҭˣit$>=S|[yD%%RबFsD)nvۂT(Ee}őα:HԆȨ yi7;#8D19ŏsAH1OVT~zUG  ُ1A2D?*Za܃PaOfBH"?7pBrqE [0+\Q8ɃTT(O!5Lkd xoa 6޲c7|rÂPHOj~eDM؀T7`&S{ ,L/A+~_S.17tRwQ Sdtj}R#HYAUH&k`wn$']d҆ʞAȾi۹@$؆+$+k2-9Hr͔ )!a8Q̵0f$UBPƗɧǹ#h6{kD$/Cbs lΒLOvH6͙ZE${ X$kAQC 94Dz H~ƉnERJedY-z#B]^PwiS3R.gIR{uL%?RhDHH(N֛[WT|$lO"EVʹHGa3!7Ӈ8%#ՄH]>w0,=8s M|}s%7d߾hJyLS!۽|El*ie$Nqݶ!$;G,*^!phnH NF^Hϫ-H8a\7߀#yPoDz:dr7Y։Y$P! biH] H2 WH?p6`@PNJ2H_zJIHUB\"xnFv\*m3Td(q$|h_W_Z)荴GV0g KGx%eEr 9#'t[FrǏd±7AD2nL=iqBkw/-P2%5u'hLrSo].?$+_+BҳH)$/ۏ}j`_1gPƏMSHXR0iDa|<#@nJ ̊- )t"4I9P ):PDJMC\|H$H\hԯۧƇDd|Y$s߽pďaVnQ2f 4B2_J7e!erH^r%R3ooB?ȮG@CcW-Z!+R$})_!593HT;pۉ%:LH*"H6 6RKF Z!qoI!@f]#e9ʁH}y ^n?4-clI|NqI}| $hEӔd(ySk$$7]ث)ane8|:RZ'zXQIk{$mu`?Fځ+O#C9?)*]vt)H\ 3R#+_b~,ERH&;<$H~9!ۣю玲/d!h[۽e`Z IF+!w-$=nّ$!u$9(H˲/Ybq Rhz6w/ݽ5h*f7"쁤Sȅ=d*j߭D{R*$TU 37DV$ b!AwĶ 7xSqBJѵ⾘$$/wJb$[G9&U#%Kq#<$\. I76q1Er_d"@9G),oAҖ R81vcBV*{VCjk QG wVc b?!¯QLm˨GQg!e) ۺpxAĎ~$^%ts$e$i0oD,~$E9 o3ÐRgEoŻHQNwa h%mg B H@5~B Rya^SA"h3释U $B5.lOo )qAH:_x#-f#n!Eϴaظ& H"w\۪@inגt`1o;RN!P OY}FI'@2kpn3>$iC' 1W_Kn. ]le_c-&~fF:YvZGicv֞ȿv9a_䨓'! ŷ).5Yzt\;c:5U<5[5K5kNJE}TU?_ӭDܿj/E =!r-龽4 tILVR̓Ĉ=!'D>?& 䴆_\')9ݑq$~G90r=8BpS/qrrs c=5yF?:%_慜H"f0Aup̳BHiy{Dnm6䞼IP7r'3S rL"c;Pr_ W<1rMdž3baq8:vE u6 ׋D_ecldc0T+$;_'-/?:{d(cm<܈9<\@v-G-&U15{;|nA*G !c 4$Wk&-؃Άo2D1l~A\-!Ab\9\{Trչr'£ؓVcW&>5U]#gs y@Gm/|+7:u+eo:wt>X}i>\b}գCkgk2IrI'Q.AxG2V'[tBߎ8?9y>Q侁ЇnȦXxSd+ dq@}(]lQΤGY~Y'7b>ʣ{ VDKw:vl‰q ' jeH={@慜 >u1I$ajf {gAY$3o ~v9%b(ƸP1r`a C7x亝g D54'NN>s2ſNFs_i%&a3dCWp~j\ckEnEw5 >O(:*ouE7(I9]5] YbKA<%N亜سJSY!GVt g:/nۯ%5 gV8Wnr_YEv3[oGt({Ӷ "4.H_FWZ/t'-Q\6B;Box&`.9g(}ENsC-D1v B҄~|?2:5#-!'Wq\S8[Q/1/0 ;?r~~{(9ؐKJ#8CUTFn DΒxߊFW|r1^K2$h#+2M!ޱ1Oi{>#f_mTD*Y50w9v%gUe#<.yb4!7DŽ"!Wf'/*䢇E zIߐr!F!fq5û~q'6t!1Grɟ'ud\CΈs҅!WW~N? w.G>p{ r|3ߩcH+LhDBDG0A5I> NR~rpD9F (8]<r>vr0"qw\$G(#ǬŞ1T>s&Iv/'kO<)2[G6bޅʿXrW!stfr$~4ȽO)~]{XJw7;.4.QTIűTB/Uno7 ȹ^K1e:<- ﹉."S.1Oyϻ]'{vl( *տ . T값[H_>rS#r~="k=F ,A!^gǻXwc0{9_psfSq1~}t QiC<1_bh4mO/:'& νvw'H^n%[`w`kwwJt{vg{^8|f3K"|NC_=ڏPޚ*HU _^+5lJw{Y7ç7~`p?xܕ`Gp+X3]\󓶣n\=)\ R5~sR v&"bxr<_44]R?C_f>kb,?v8H qص?70^Uu<{~usZtsa_{#kُEn0'uNƼ;mp^xMN3ASU}YyO7 5" d"O{d 0SRD 7leU;(J!NR/`ښj@ߥxK$9y2R7}[z%C8)}@=@ {Uy5vnf~G^AH; F; ~PƅcoP}tm :đD ж?O8G6tyo:2%"-Օ3rW;#qUo/@-\^tȓY|"2w%VC_<=єtG#oj|2 묻 g`hOqM5K[mςyiTk$C1E+8'Ab1נ4'x& {!1^Gn,>T>8?wCa8xZTc ??> COk@>V%Et "-ص__ȯ;'yώpf޺:Pa.&W`ENeg 7B^*[l'3? _Ϊ | QS&YA3:֙'txQW UʠQxpQ!nE^iyq_|D࿃~+:$8GG P.mu(^X\i"o"%ךSj-a&YqLb<plyu_| 4j$ GZ[EqDWqRߪh S/!k(OA[B^HIu~?x'0"u8?=?\Ϳޢz: gaA_Q Sc;x5_O׶{| GjnTZ[cYKԃ\5\邝kN1, /`~ȿ>|_R1j{V:~gx~g:ǽB=AG^s蟷=8UPwB:>i_Rl Z>#>_=/eD nI?{1y:#xA^'IaP%ޅ/|}c'}7I.o9 p(-p_ylԭάX=J. g"y X_OGzl x"/"<]Jp\s.#c!/|U{%ħѐI\!N~P_% FWB}÷-%>+/W,˓f";x<)O~П7V^z/{UF"<$ۀ hHd?H2 S3|_LXS- .ut (EG,g"C''ɿAqO>^X^*nΛ{.f<.tO'rgOO]/w47|N"@) 㑶[.:"|xDu_TȳiП" 0 dOOPaWG'5 )^ ~_ AMq k,oaƲq_uFe+,)=OQ~RRW逯5v<{/Y~艷]詯-K$:h_O i [>H'{>3^Gc]H >Hv 6֧yOB"󾗱~by><~_أ!w YP sG~| ų7'|ϮO;|ō~K' 0e=X{[܏B{%zN^/+c4}C^Mw)e\R$nw_;Dn;oZK@~ qد^nާ>'@w ?/|x  t6M?Qv=P1>nQ9Z6ey 0x4A/}9d3It%zb}߫kN= /'Oz{A= /_F0O#,ºy}z@=IRE .\ {ǹ~TbX/C¾.AO{ς~`؇!q?y7<:xZ?|[ h>:w#3 |vAN:toLC$@'ǰ >/o~!V@&Gqq_q<@u w C'k}^AW/5| ?T,Y#3B{{W=nz|Ro2أ{ gOt?\֍nx-yߞq qgއa p a]G v$9 l,D g-DpΌ*{kUQoWȳ%{Gj3['y{ fA߂J3?1Եa_9+O\c>Gσf= &B75U(U you ߥ3 G(Yyb *t{0^Mwp_27~OM>i3[+hN }Ddw5 V^=Ljݡ>*{ w5# u(! |Џ9I5دb7P|U>BAT Ux]x|Mzi( 'hdBEiӄzpuB}z߉ijdoz0a *? 1T2諬G(#mr;}}Јw}o e ]Yxhj{ov|R|MԞ }TU пa].ΪATn෪'Ss&AsgTGW/8RxqS؏q] v~Z\yG0 ~D3A}Q jM? E E'-P}8"[ Q!NLǾ6U3I/ںp~ a_#ijcb$"cim_|5 壠p T7r,kxn@3wqx 7P?w5ްM{]2ބVo/ `GU͆yRARV|/#7z-CXW -iGB4{P0o?:`*ML|gvXjͨ~hv@S$ ;i4l)3U?RK_/@v 8OY~>!x-XB'$Jb7OG%mOr|Lp⩀#MSǼ?2~G{A>CEFB~]AI Z |O_Wo?@hu#{}ھ_" | 5qHgCa=Cp_@5_U;GѶȆ"MR6xMB较_pO.J0Ϣ] _iܨ Uj4o'yEB;D `Gg gaߝp_Yws Ȃkd7=~vH@^*:g ?o*P<r B>Iw8{>7缀 M*GT^nu=gEz Ƃk`| yM<OqWUuN]5Dx5xN?!G^A-<&@CefC|}s_׍>8o @ǛNr,,Exz:hW`?&Uz#3ȕPϐ킾6ɧ?*g~ϫo ~H?a?`}5TJqv +Sub 3yHB }B_ !UP>=h^J ]{{|$a_2r}!1`. _ի~5GD'ַ{>PwCSMt #R/GКɀC9U6vI eh!nx]ϻX ?%B;/ ~B/Ϋy;I)`EMVnE5Y Y ,uIS=sd;_Swwy[J'(DMx~Ts{b<MwgS5yu>M$fh_}$P_vI ?]HA 쥃?8J(LI+2[RȠRy{|6yc__79x#x}-X+̓i43"Q欄?A~bb_ԑO5m֦# z)5x7z}'!,^ !R\|P:B9PmBi?u)PSF^9f 7WM(9||}$`w^۠+8FҮ+PՁzzWOW+l;l qzmyS~|s:B_, xea@|*}?If>= ax+/Ч*1~mi' q?jd8w]=Wots7niϛ:_eB~||7j~M%m aߜ h N-Kg~=ybϠD_샔^Qp.*!1B% nmΣP^Ї!|O%+$ (݊+! $HNC-8^|y_|W x#$x1@8/FuD8Wmveus X>o} _w> Ec؟}V|@}L<\jqpN=Y[ExDMɇ q#? nJ^3 l+o!>Pw^w/'9)IYoG} }J.# , ~NquG~ҷ>Gt#HxQy Ђiσ|dr<3/7}wOS~Aګݱus)O|A|O Bx((8RrRM>R Y}C5ڋ錸-S!.p8R$+<E *?B%kkq'T$c>yw%gX㾉/ÅgR!O}%b;I J2W_T<@k~ ~Z3 =WYO8}}C}Zq2)kC i~wCa_x,x5( A${bvz_JB\ I2Mɧ9c T~Aecȧx"};o> xvp_O_IpB?|$Պ[i~ 3xv-^ky\yocWLwy\:sU%+,ɛr4i>?n [j!؟!)q"߫#o Zk4AXG* v\3K4[o01Tg+ MDJ0SɎC#A\s Qy|7t4sQcq.?5<_~/>lI7% ")«ᾮpΟOF:* ơ tx{s^~/yNäW +2* .s5ꝂNAn^H]>t^ '>Oe!#~rti [?0܆u~ >`}W<4 `(O'~5|or0^9*7|}C: q=Ўk hw_'6jr>GaKsW~_8|^_A?|<{q8a|rS< }Ymgn:f;x8Wmq q\3#>.0.R}&iv`_rN8,WaҎ'1+G5&=E?*m qԯ}0OxT"Џw0 or?q`jw4= w:>Ks`~Pj)/i0H0nPy-.aNCŸo2\zz:~z!n "Ǽ+A* ,3#q<` d/wh/@n^a^1^RsTP 0M8 /._zXgQs~~n,|# pP7qVC\_1#W/u݈WjaX9ƫy `'o:+Pτb8N|&G<:bܢ> Bu̯ F?a2A"X{psgǠ?VH~gD}רq]b݀-o$|o1ze0&`< 棵Pnj0j`>,!.LxOq{7}xh瘗 q&пN+-~+WC}BT!N@c\,cZN-ڵb!#.k#"D}Ӣ?q\@Л̇Q_}"Op7T1^)E_ųYp?!d yNHq -Hyc.wޢ|3  {QǽD\ Aa|rEGk<ah80\q󪶘b˘"~b<32Dk>ϐvA?"7I( Mav[w|E}Cшq_,hoQ9Ac&DzGPO`:e}~ _ -C<>q;#?GAza :f;/6!d'|I Ga~B`>1:Cz.Ofb$~iϋa> '_0.4 _tqyho|-\=Qha_%Wv8`PNx9AQ_FF\=@?/vw8`7Ɉ/&7λ1>yF zX֛1C h7AW>~nø`.@ /W sD9#<Ј|y 9g@.Յú+1Gwp]B'_s<c+4XGnC^#ƽ:Axڑj_:q+s0OwwF0@~6'ya.68/:o @M:W x뎺;~<ԯ)/ m0oyC|ȫ,Gl9G'MuƸ:r =6EyODE@[Z\0ӬAޤ.|E<ڳsC`\!ǡu^C"mUV 14luxWrOhU係p}o1YyR Ljr6A?y6 0 #m1vdgơدB@<}0\輦 q"ZA{0"R'a6׀&q ?ΰ|9cA ĭ^('W8W ؊B (+BgxW`~Xx5cw=Z-00C^[0?qK#^ *1Nނ\X3A/@yFƣbpo1@ [ø1{C|+^0C_C_a=Wj5W vcQ4k =]0N4<A}&z=G W+>N4ڷ??U >AG=߀,^q}Ẁu(q]}P!2bZ]c/{QPOOɰ#2+`ƺ3 SW>:!x0~sD;*"AX' zoxu t(Ea#,A[まjN"/yR'osANW!}Zu^' QBG= V}^qT>k`_r T:#EhOC<P}Ko($7UK$y/ºG%=zС_#Q>JU(ojKZ b,E\z&G̿Ip߱sާֳПiMq BeľE#+=1ureva_]'W֜F\y-~_:PF\,u8/qUknx_K6`jĺ Y'0a~!b<+C: 7c'cKgxU|~;Tȃ+_Q! _gh.eE#Ӳ.D{Tu|n= ̏ACItq$:ca<_iӶ4 ;~_b5q y Oh۠cD=`;)' >:5ډ '/ g`V? &Fcߣj%յ/7Pzg t y|ĺk?5qi^?V++?h7"ڈycy|'>w |-?ԀF3 go+?a{O:o#0G@yaq?d!zú@'5yʐcRG! ʩ$^Cc5uocK_C}S"O=U[ 0:[0Sb?f/&u#$pϰ7R?!hr~y|^E #QN?8 ̓B?&)1մƸU](+6_/Fy K+.caW(9g^Vעb35\}(þ)3W~ơ>;u*# 3kQ+U^cE;T;FFkn[kx>佄:>P{&nļU Uȇba}U. zǍC>J};"b51=g=\gqLEB@y?ǰ_7 0.T#r8[uZCOQUXOU ]!/:ֳ-O}>JϦ}hjP b Swc~1 [SvjN"u1_qo[ar䭤^|)b-7uطǧ ^}G¸$3YE}ψXTyj4ǥZJqf~R}`2iejcȋ]J'X*1+P#_ꃸqʐWU!/> c]w ) 4j{joo \$~z5J~/x]D~ Z1^{k KРh¾az ?Za0ljy720/hY~L}~(A~cdJ['y+r̻Taȋ4PV_O>n%Wcߣa5WSbjC}eO)0UJQ/q\ :Xa/13S)Pi'u) !Ǿ^VoA\mqaM ܥOb#>*}~ʱ/jJx I(lDBQTrS\?-[Jq _s0x|##)ns¾SM;`e_0^F:/п_B~N׀k刓IO@@9 t;a^ |0ƽP__֍XW`_Ku[~8[hn1ǸX|õ(G乕߉u.hw(W?p߬ p-; NBy^ļoU ƽA\׆"/~Ru ) ע#`~yiIqy~\'uwb܆|?% C\|zx_ lBJ1b#/"ꀨj 7%c@EJ!^8O )ֿ0¾6?"Ok=` /PG#A;x>n*#5x?x_q%\/72KQ D8F}P G,ĭ0 MQB;ºZd@E1'3!ϵc/RGӈs/F~n9$*WW]Y.${ag x#*Z8}AB> Frӡ~ um:w_Tz>V 䃄LP*I8Oy(-2E$Be54ۨ'A g_{%HK*/Qoϥ =:.~)"媯KJYH?!`T8C(uB5Wkg+'| Cq<Ʃ\G"j=3$abgGuzQygsy7Ilb4wH\fbߑ5c;~F.\7prfh\Zw霒Ro#w=Mb6H G o=I;4'S~q@:eF$ӥ5yhٯ !\ȷƎs6wV't]!&.Y@\Mf3Y鈬_ȫU5?-yļ)O>B>UT{|ˋH\#L_ɕ5.e lCy+ђ!~kt$T;;_o-mHX"yu{ܯ>% }=;gjj.;c,O߸ȭcblɝm"/v\*QT|>۝< ;!'=V6~uy]/=v5;nq.|gܝ_yhyoA^d݋p$yl+c*06|tbVGɩz''7;MNݩW+ê˸ > Τ&Ł#䊱ÿ$2桾$*u$$j@ʄא+M8H*&1K'>J fw.%c7=w-UE79Msτ=$zw;8ڙD_MHDZſfH{Fy $GMMbNϝ;Inyc-eynh*bj5Wom͖- $7/"1M\J "?RVK%IB7+ͬ߾˭F4"傣ɝnLn?<8|.ksrڕAzPe43 z;[I˨|WA%dsц$WEQZ͹v,"~ '|p}NnZۥr3y/vv>\ro+.mɭZv#w{r\ 9юHf{Dvs l1[VDr\eroQ7Ƚ?2ev%ѓ&^#/ͼEvrkܑΐ+Wv"ͷǦ6nkg.#2Gv"W~E=k fM]tD&/M+C%g>^(Z|ЩDnxQǏ$4gsm$7?&9"74;o|\hJ);E&w74iBgu^29s41~1Aֶ:I7Rژ5n4UnH=k^;+mX\;MwWrc''ѿRQAË䞧.mxYF$fǏnL%51{N>.Ib&yPm F xØ\rg`꫅j{vE, ~۷Bs;&_Қ[ȭ}WO'7St6Xq׸+z5Y롺VbR ?w9r{w^rr3&ZnaW5ZVN'f693.b,=mQF$b]dk4GjmGۏٶ?ƐSyIg&% yIMNwoVOifU^rwX؅Yz3;y3$.O֑~]^D~?XS[-^j#SwףoˬI9EHID͋ Q?_ꟸ\tYL.zL]8\ij$T߈m}RHBf'EHĿG-eEȕ{g+,ޘD?Z,VIc?/c,mg_?ԲNt:{@Նw{)ƛ~N?yqOlcHr;cECs %qŗ$b Hg+&Wnv?191ZS.tHݯs^rg讁n^>n''gD2r',w_Zsr?YgBɫ>' 'Zt}Zʘ݇NmύfNc3OlƵ;'x="BW^:O:w^=׏'_ IjsjAۭ.'L[ǍJZPd{\+$?i=LO̼N"B~#vAo7sK&%~չA${]S2\nѭCq relV${iYSAɞjh;/"FӉp7%p 9/X rmHOW WoC !!Z6ʱ>Naq5|~IlzS5Sғ<4=zNj$2#"%۫,DnW[oEZxI(5"śiGĵ$Ԧ{;m\>ۯFKr}rL kN oo>+tD[YOh'w(HL[e$W/g&ц&^SurMHTh6 i9[_6,]{ys "ѿI㵳"*HPSڐvϲgœ~a-}"] WD|z$D {'6Ğ3A}`\$d3{ac#eFWL9k.ЌDyh-}A6$2wW_|%cרHE"rVp|{AV&CҾ%IHligͅ|?u7kwnMk}6yax5mgDM}YEH>̮|^Ktْ99ogVIlyGbܖO$[n˯KL'IT_ȵnL"k^F^qf,޻c6;It [ⷢYK^??ϗZeE"urrA_2y[$ȳH/M"QQ:Gm'$;d y3Di9$j/&QuaKsx)0}#ġ ӯ47pMb+Bb%uX@bUނljegTxqGڎpj}:sHt7%њCiznvܰD^7)D-ܭ|6YT충$r[^_S7x,v9> i-j؆$zI@A.y-}>\:CbϨWAbVSFͯ=<rm NĒXZN}S\Vs`fmILV;G;@s vET%#j.@bg:N>?; ?Hm \AnSuZRBDM8Fl~5uCZ֖}[~ă'5'5f[~#aݴ?$*>2:{|sޏ î?q+^/g\2!v|tD"fy1+WGB7tXL޵zk?e7+t&;N^ÄN|r| MVt"/=l^En%|jۢ>۵{82΍;ɭ=CB&[k*#j7.+pD)YֵHZ(NE"rzO"isv{_fS-%׶.<̔P'!$vB~ω9ĝ[iu i|[q|*6r0[9ljJ;KnD`9oWSfr Q ;B'!nw}&{烢摫]ߜޚ@WslYMJǵknC"ھ(h6DS#0V;G궆p_hlLn^̱*%7NUH^~`ezg_'7Mqz:s[d/>;<=^֖hHdS|<$L~G&Q9M'voHw^c)j;ai|^pէA 57a1˛cSY=KxѧfGY*%WnO~aw$Jn`o % ;}G&icu w$&2QU}H#~z\RFkݟ)$g0E$˽;/ +F D=c[|<[~geuյ]MrDh=-ƅ__!='}ӧJÜ$[ Nov*q߱y<5| u{3.(#fv.!="\I=*yz/Etxqyȭּ;D6厤&HܒmI}Cb7u=l8og1΂s>b6iu$/|bn1m"Ċ]-SHbT.׿m><~^(Ht†xwEU|٩g#g/ZuDfVj$Q-K㒆g]E^wo܆\uݡژ3K*:BH/O,̗UX@bGZȯ%&s/ցn]Ǎc-DNLzsq~\ gr5/>^46g*b1$ g1}_,U"M53a=mI#w[xWKR|Lwy Kۑ;3z" g/gQďvDʼnoӦ$qL?jH잟7&y۵."'c=tȾ$(g뾓h齉e>_.z]&XϏ.X.n?пGef!q,)V&INu`9^lm.5}xv2y58l LjۧvD}bUt."e=' L VUlHU?w"3Z&k*:i yR &GJo%&ۋMsNl}\59^[B{5N{U‹|Ό]a`8{5ffVٙ^g/ױiw&nt|tgz?{}-_M}f[\:Vl g;7CvRមaw6Nce^nlP8629EmmLkvYl|/3ָS"tLk۾g~ äyLN!{G]h{ݰٌaͼ$6XLtar{OB 'A'~Ƀuɡcl7I޲׳y4r[Fo-=ZvU'xBU֩Leuc W&/[E+{kfT^ZyMmJ7X[wqr^9z&w>7smlm*6yUmbY3zh,[mߛَ̏Z;nR:3<kF\9&g/Lbb}(ڌk]tW>>ezh8>i\&oG@\fCz~sۜhePu7(=xp'ֱV?N3;MF}1'Xc6=jRjùy|}l="N8aȮL3&q;6L.嘞ٷZ|#rONZǼ`c0\s4;(bvs [+=];]TLvS35Tai2I /ev72=vҜgU,K/CL>.ra Y:[.B[Mr3*_`uvE:P'g򴎺ߦæjS8f-M9.vMöpgv6ܘ}þc6.q{̎lγN"!l3b;%=볙vLPJ=ay w.?!o 0 /Ffv516?qrB%}̯~nlc-^֊LW5Y7Ȉ~ N:/zaJ!s;l:9Har񷤂ٻ!LN;?y_ٱѭLv` lbfsQњlLpV|*:Ukcbss3#,6ف\϶UyL0X&%8QfﶣV cvLf/擯_r$/ T˜]a1~äf vQwmsC`{}tbj'+uD2nuГx_&gLOd-'L/޹2p[RZUl=wfi?.c{C&7lZfv[<̉atf {#y:1|y]KE3z c{1ox{n,zX0wTt1\3y: acQ:p!ж 펂qEmK6; loR;2=fzYx Ï@k]}gJ6ոfTj/Vwu[-scnF칎_` 6aM͙$4ydvdw,ߍ>nicv_L,y|8CCڦ7;? h+/#Xx:>qcqxgW-3aG^otci=5#rAlU"V`rjVS$gӡ,_q;gqS&Z\&sNLk20Cގ+|/Sˏeq77Ԟ]M.);{WWf;_I,NtQq<Ł>>M~:U.DC}*le%~B0#].=?VK.3ʏK(e=F˞gNMqd%W>#7j?v7~8ڍƑ~.N])qY3D2%JK>ʙ=0q3K8BROh/+]4ɣL6ٍAagY\:t갸+vKq]$_\D;"ޯ3JƳ+ϟar qEsU}սm‚0\aM-sLN:3Fh K"W΄ s'y]d[W6F=peRWb~LNi=Z[y5JY WҌ(\gIDW+_3qvT܃+>s8O~cwE\uT> StE?RͤpGQla0z}Ƽ| q~&oDw^nLB3K?Dկ:_凯gzT#]Εo٨c.tܥt%>ejUy|s\_|*;qeTf\ņ'.C(nR}/J 6>λ艄R~H꿸39:)NNF8oN2} ~!!t<X{vͣ:WԈzR+sto[|={Q+lܚoUoh-:aX))_ϕKT6d7p^0;xUtr}qN'(Ns `_e0}/a-X!}4lJ?d*`ή#O~+Z6&.wӟ4^R3غ7e8.grdT庙}۪#ՎIϙ`6]3ʩ*/WpʌI_"p*KCmB~kY_qefvnӽ c{`bZ\xrf抝u+SF_{%1uJ]TX*qa_\z^?䵣_3&oӈ;4,/E{=r،q V1,)tSl"Ӄ۹2;;s(>ٛ/ -a랯B_h̃.T? ۹Ph2oLj~Z;{8x̼*[44˛+H3TT*71=;[AN?)x/w>dTa<4WܺN8W(]&}ǙTJ>J?Y1/Qh8Jgr_'oL4j|c)kv=gɽiݔ3ұ}+4F2$jg{fnj<9Pūpj#V/6=$5 )xh}zCϛ6K\xZFWzדZ y"gsCE,~9IF/̬f}C穕ԏZp' n( TQ?w-L!1]hB)Ɲ){οT~~8P6K`z_Zݙʥ4=ґ* ~JuzW^?,ח hV}uZ܇ KjBFXq&ߕ|iHdcŭxloU=&[Xb2dٯk8C˚>{o~>4crEY=+ƕ[Dv]rH3_jOf\H7::fLa|ʣt*Jt*\"Bv]y{&sk/dCci]ԇ >z) 6*fO%kP=F,:Û4/r{`~"[{k +9cF' Ӈ)f*j9sq좬  _A 0풳,Qf8WV҆ՋR3[}I=!,}MX0\fgCQc1/?`tB-~7y 7~tThAޫwn%L>0(Z&B &']so P_ֽ e)\IGkE &3ʫxc_|At=?td?ų \fvۧqp/Uq$..oo7.g|4W-Kb'Mf0_e;᨜>rx[*+f'&3e1?q޵ *ZԮT&o sR}$}< RX}ԧWrmnBX2=U o;pW\pFn4;HVV~w/cV+f Բڗ1YE.t*_c83?-*9:>%"w"})n0&K^pT/߿C׃\={ s: ( BOk7> 8fPt#IB|ʻHǑ!ˊM>&ah;Lʱb%ã1 =len5Ñ\q0CYݝLr[|#C|ry!Gql% \:myz;$#n;?*?~?F\9Sʑ`vi27:1_Lr:fzۖ\CT?_ ?B SYlVif/7339sN~yבcakO2-e&7>?1.ȸ!gr+W cqN}1G(󃏙>N'b|ķ~n68"y/o̹//|81si>p5gavQ\FWoN"z46!t^R}pR-8~Da~zG3Q|NsضDzݷ\V^>==,}f*Zdd5_AUC֛Ƞ';BĂ&okƌ[Lnh^^e?ޗj1}>cT|@;kv˳tTܭ:_wQ37zUĥ}  k0;0G+wtex⭂N?+Xߍ*fbb^DCs?F5"k0ڗYM~6'+>-I)p/xw >WtxyeVQ~/E:jv"[WI 닣r]Mbr\՗}oj͕Be+oF!佴/7ݴPH͆I1bg"^>QB$TϹN %_Urfezk57@VJALR2^h˿$y/83~&敲KJǑ6E ?6'0K {4޷j3՟?&c~7M5~<+rЕ?=~&x}ݷ^}5%.3Mؼ#V> ffB)L/JF~gz).9/njNǓ) ~vڐH_.#R*P"*7$Ka] qO/mCL5 >z-W_l%,߮Q➠ U,zU.B;0ϙv}3:bZ% aząn}Dm:1+3?B|b ӿz]ݧ_WF5o*'e8p ;~"Oq?9s.y_2ɼ1{6y grC82Ϋ _?y^>,B L>s]>fJ@ׅ}.'9f ǕG.Ǜl߆a8tGF_Hr7'/&?0|bg0˅é>?,^Յ`K%&ƻ'G,>M}~f8wC~GWsc82-wr̞ [>.'‡@EEL M8nszLN)5f͋Y/g~cNnPΠL #L@d2{Dy>KypߞҌՋ0 ?Nn㯯 c]}jU[k#x/.tޑQ$Fu;(5̾^rO gf&.?]Z |u;VgL3+ A^y)!t^E[nt}_&g)}NZz/)Var*ό O20cݬ:ٟS8JtX@j^1Ӄ\ cѩ&wlKGs:yNg<}l&`fI?K56aqC&NSux8ַ\^p'_RfLSuL;; |Z'7B|.<;SZo,ZoN(g]X]B?{Z7#'iXh矨E )4P~3˞9ǟ]4Ofk~ y`7L̏0u97+%rYk2+7 a( 9 ~~ւIZ":QyyGYDBFTs2;>,4PLVP|#I=YݒlϙTy:q r2\HMuGLS/u 6Y. _>mB7 kM3?%=~ S1JVꃭ+e]BKo\?mB$2-qxK F~N~nz{^bbz};?#nf?ʪ}$fr֎˴ /_ޤfr(u<{;ӧХ,nȡ 2; /} 3ЙQ.looGP=뛑OQ?D^vq&|u2﯆Tq|$t/2(g:^~͙D~8x~e$TϪq"zٳ>;.W^$ims2>G[=9g>Ӫz`_\Z"(oDuHfÙ@GEnkMn9W^F3IhUH~!Zl"_hkMO2}ug:7'Ltr0c*ӳ6Μ˴* [=9_70{[KgfEo\87weVGv i r-'.T[+k c~hu5g. 1(ǺlnQ X=.gDCWg6$~חn egOӳ7rxpm ?$ P؛ ]Ŋ*^88mE r֬D/^WlC5GobǞYBV&ԟ3AΎZ6$̾2,i[\9%};{׬>}vG~s̐yEٺg9~BEyy+mDLnN#ï=:iA:yNzD>%vNWf+I,8߭Vlt~)`r2n}K~BkqЍӧ(6uǽ8~D|;\cKX׌-[;93ӗ,W{r o)0=sK"[ڻm  @<|#sec{ $̢43ds(_DžFqf%31Ic)bz{~;yA3<{2f u+vӛ,w_ˎ e$%7͘qB&l^^3ςWu"gLǃԣebz{Od[tB9G"}?2<{7x ] }Z.yY . u?QĕB7aZ_έL_* җۆ2~'KuF|~ a|-kd,Ng4c<ѯ>L˂T@ܗے+5Ե¦2f:Ϲ0}2jutfv+\6b={'2C>JƟu<= D,fWx1yr=?a<pP p?;=3NNyd ]%>d77]7ߞ%cT̫?y#ޤo˜ҺA= % ? /'ȋr͙B,{s\gr _^iк:Z`?`. 2eG׆&KS&2 q@H~[ӟ?liuټR˻1}vs=]9֏ĥ=d51-+{!>c:_?1 ~Dا6%S{6_c(u#PJ]Ov%;%_U.=K_!#Bp gUx_0jFrcPJ3,+ߓN3;ߺŠoL,o%s=3 }B<{\W-3YU.&֟g״=puq*ODZ:Rυ ^9wֆ>Ɵ?.A[suta~XQeƛcƮK}f,a uVl!ϼG&ׂWdr9-6?1 b~ Vob5~߇:H~(x;~dp?o sB|W)l%9in~.r%EsnbȫsKkbxo~ȅ2+eOkfgEY:~Lt01G~- F+_epcB!+V˱9nF Kf9YݹtZL`癡dz)ԑ',6,7UrJ*Ǧ'{ͻkbyd=K$eiil-f2~+ıB/m6_,grxNBIl7ו&Xs.>/6AN*GE_:Gwe8?g6f_sL_@5}5M:!u,OO t=K ~w4Wʠ-B<+G(u紝!LB]"e,B)ϳ'׃ȯtsWXBXrCBS_!٭_1/ٖfN oyb̨䌪$;LdWNh/y b1wE鮴o+3{WMcYh~?hݻTڜHXϳ}So1˻ȿp̗>"K}|-HUuY,SP;!U!5\Y[dHu DfaKu#]5pכskQQ5Ufs?7ig|y5Y֙F'Dq>myly"v[}ڔ#*Jda"#2J׫b,?S=*.}(^̺ <Df,Y4寫=H:Pdq ky!GRՑⴭ0/YLTd®Kű}>)äre8y[ϊM9eWYD&Ǚ'2?օ&UP=d Ix"UIĴMu~+#ьW#jPC\#Dሃ fqkٕQ}l;'fy"JF=1g!W_gṲ's$H!3 UPt$"E)鈢 RDi(\ґ&ysg߹~[yL29gx"=$.dO術 /N Y rF|L$xoߣEm9%_Twg(%iO?{o'$*=D"<}^k N|>`:CKGLI'߃:Ʒ95=JA9\'(5\orb'eM} ןk]mEYKx8jH;{ow]=.G&Q?ʓ]3Ĭ},O=5Iv>\*Mx5CHC d<خ{xtײpUׅ~~ۉ}wLcebCȠ!g_" Q Yeg{}qm=%nd~vtxѾSoF}ٻVKw%8?E8ޓE{/}ш&}Oso>kL8::uǕ sk_엞;Gg }Kg}o Y~C/,ߓYݔw*йg W8ILHgz #3Ang]ʼnW]F|,vY/ߖ`;.mzׁ߳a_S}PX}-OsaOI.C"Zxk!J#Lpa9=kkٟ0$U Gh\WZ5=d6IBHBN|dXvYj#=J|gjBGW_zLxtZ {*x ߳AA-<7y9a:oVH-op߃)Utޤx}l ,?˓)4:MeMh}ֹE8eSP~{2;+OwE_aեp7cMq֏ gT}V͸ Tw1e]4ol#27N'kpS{]k7FROe$WAL@ M3HL@Q2}*x^ E+5Φ{p_/tB!)Oj5#p+SύZf|a;3~MqFo6;vFBϲkrM<0ӿdO-<Sծċ`$䝡yHƄbh>==f$,NF~'> ]nHKۀ=}F{ D-QSSv{ /FZw.PArE6$?~}nEX2>.3_3K7S{ (OHLy(D'Fb6(Ӌ61p5%f 3w{$+C>.ӽ['Q51| N_e^oe- }T(О5!9u&>&i‚ﵽ~kh> <=y%& f^h{3OΤyIxaֽ,WW!_a!O1h}ϓ<i$[KT$7Jq_b~_ye5S ɷ^ŐYߖA.ۀ8a@ iHz[6G?}I'.Hn\yM| I"H &OH2tBݖKZ/')r+ᖺ2ɹ/~2WXGH1F⸎K3ߞ)o(tk_CˎINzeiWV3dWE$7WLJG1NlHF+!6Ӽ&6$zK'j`cn9I1!ohhMrM51xrfh)K%\ׄ!Nh^H&}ba[DŽ7HqhVf;Iϵ6H}{|CۏpĽ~꠮SBs'400O(I+K_P(cB_ᴲؗד&qD_>j '2o\9H{ʺh-0Cw.ZI#!&~H{+_Yމ/ЋH܏)44йς۝mHr~hwJfNs);/P%yÓ4N~ȱDŽW2Wpp,ɟ󟰹er3>* 넖0EorUZ'whk|AqTJi ^95/'QW߉ag$Voyrt<[?M;_?!}I:j=̓!Ű.F¾r_B =ԑrpC3I}uvHE"Ql;ԓVCԗ}`$ ^_ɿ$ԷJ)p8m4bcvG>z 箄O`pt&I|ƟnоTv{R= } wGiL~ s{y2crǴpҲ4 $ڨhs=̽JCo}.#DDJ|}Y8kyeτEh'a'eb\>M> w"r˒Џ h}~F?/CK<}Bryz6mr_$euMZBRIJcVz=Bwź6жֿ6j7pνué]l¹D<$_1Pg✣}?>2"*B?6Lq&P*ɅY3z Wіxϟ8u4O'ۆ}o!oIqH mu5jG;SԏznESC32؇p3) .GIZ;1OҫDuK=zlWikb$m\2pb̃pAx?oٌS|3K45Wa%o}/~>#Wkr.'d?(iP ACw<(v̡u-M@x \b3i[OK|[mތDe;s|WuB}Wj>Owe?_^7f;̺!QYK-kef?5EUZ)?ͳ(.Io}^he_(~57B^^??g#?K4ܴp;`s:(o+\ϑ;2"Wspneݹ?~^)_4]{ߋ.\=ˌ~[߿\_뿱|ߞכwg S뻺nR>]{ߵy&30_]onC}礚8;|ڔpߑf#-5LWXN_}~3ǘ*|W<ډBrvm0mߵKċ;n̘By_pf$k}>};sgW#y{߾ٟ~(b%ZLϾHr&ϻB>w1yJsS܀:TB>üg u[ϳkv6<7QHM"H>7IS/{ dw퇼bg,V>+sגx/u?b|ٹnZ7̼p TdϜmi?2s[} mY4!g|M/g,Cds|y6ہ;~u9Ͼ;v}l_~?]GU&|>er3gy9\'z?|S:_QnyN߬_;G|| }>v|1X"mHf=wL)^\}]wIg`MM&8hS)N;mcσչħR}GRM޺Gǖ6َK >nXM"?b9}2w|ףowPCzfd_ڑiHۋ]=}>|4w}d=fݿXftG1v|3zh}:nԕo0/9pi;CυSGohGh|~P~o=O]KrpZS ?y#^1`^ }nGq8LqzHWYQz6%l^v,ɤ} R?;,/.f~7 ȼh)]8(sݬ7Rȷwuu|z}oߪf\E¾'I=̴cT7f]mޝyVF]QI_2h3NT:ad$Qf;_! :[s^s7w0 ^/B|s^"Oq[+g|vHx~+r?z?Ӝ?+7|{ju}5e_f|#k ޿Iu;w+~̝wfSݣ>\w2xo2y~OH ? "r!ƕ:};gW GDv_Tk&?#'K;.aDϦeI58xȌ /7g{3ΉR<ėa{=7ҼwvΗs_Y2 3^b)RobʏoYvƒ^%=>~̇z3}u9~_/mڕ ^&YfvmD$B[bo>fK1s !wOEΞ}߯_L[aEf6>eڡzɄWiۜ2(|9Eufȧ[}dK:+Io f =÷W`6JfCok9m&rrӷ?lmCxriɪf;cķ|ǧ,iN;q]wfΙ1fߩ_&Vq;SkN+u MM;tr}t,җ<^ꄻ 5:ݬ{aλbUԿFq}Wϲ٦ف"mJ"ߩV;5>w>Mx|pa˖i~sup6ݯiwlo78?5e@?-ʏEt1wu ōIَ.ΘTSЕ{皿W@E*!-rL{D" ]V{`= M'f}_yב_%H1*WTS(J=gUL!5{]Xvs4BW{wsmGTW"oKet<]{.K}+0(ܬ+L>Ǻ'[Dqкyu̢uDuuMuYGw˝XEɗo|jWJu~.~{]]FdQ? ;ZhneK$9տ #ݭT\W>]Fb]rb]>jOٔC8T(RN^De\{A]0kGqN<:=B$$ާN+|0"p0'ڗﷆc(?C=y5Sz:t_( ]\D 4Чϓ<*6`]=%hރۛI$8}'y)I#:X8m*]{6Z f~E@ޱ }.2{w%u}Q?, ؑue(e֕+/_jN^g9E;bݼloDޔOy)r#!Y}':Vnt}>+G;c* )!W*h] < a*k/!G>.F򥼴둅(/Ky}|uite}yWҧXOþ˼ /t6}!rG>BZ4VM8]Nd3#p[ ٧1k^ZO'W%jWZ~o/$b}J"_iN'.째x]FQ]@OOɬO+}'cu`??dbN;Hީ.](1'b;='C1yG'*;qǚ0$c>?2`G=ql?\y= r Οe[>ϡ]eum+ˍhooɘƳH>c@Ϊ}_9V.F-%<IO97veXzzchck?Y~gcvڗ>z6 '5L!y٬-fWFnȍe"H΂k4A,!?( o (žnG+[ ^H 飆xOUCW2{31.f;[T{9 f ďOAWdC3>YXG5H\Y-{-\ϛc~ub+bj?6 ;Y`|OJa֋U(_D8ƩTEjr1bcX!_ <7&b!|Α#G/na=^U`|+ac>v_1́v~LSimq~VGR\v\-x;Fߝ|JqJB/<)>\WRx@ǯxiJ>xDF$+bJ4O܌uxn%.,-zy>̼Ӏ}9IΣgo?gl|eOk>'_a}`_|N=V_Gz.YHTO) BwJV J$p[櫰Yg-^0e2A<§%E0=|ɦ=/ Bx!*SP`~)ON>;c|:N< ^%yScn̡7'=OG!y]dw"R.$~F]N>Rx+MY%? K>;,RTgQO\SS~WUkCzr=o-FO/8{؏8y,y|/\kGpnUoI-'gxةW8W7xT=<ޗ ,փz/.U~=i~ɡ/`{XuNOzgS5Mԯ)[WT.X{6w֑|~t?)?<<].Jo ?(W{ߗKv[] {!<@ {2Qeij])O$ /:kR۴b||Z9%ׁjSI1W,ʿCԇeXnqQ@t؟_L#u!pTQ>Nݤ.KXג+h/A`DZdj8ed:i7S~><ѵ8hè}H^prϼ 2H޴O)Do㜫&>=%:pLuWo*r WGV SqS K'.1$-lo ӞK!8XH͇Pz$_! yÐMȟ([O=pGkbÏ/;ew`ؾk{ ^u3ա5IiAu/z =r! 5qϥ?'/>)#:иO~8zm_qRS;B^yW{4tY;>[R:b4_/B&f'&_&ɧ\X] qc1e=#pjOKżiݸv8V'ȋ ,nK4_ ģo~H<{gdM_|h_$|vϗuվ:>/E]ߙV #kڶrs'8o_A[}~Qd1^wkm%} :dɗ5>rs_5-!Gp.Uߣk%/ڸhP{)Cyo)@W/N5R]sz6ၬYpuy $'Z8O -W}}}BCl3 Wa[pR;xrKk!OZ.﷓{ 9QB8'i<ګZa;;JOMA4>ħT?i}]KRQ=G)T?yQ79"i`?*eUVA=V.C^Hqn|r#8X!S.7#Xq1V1bg?-k%Y% Iۡ-a~ >ǷZUscxeoƎĸ3o)yLGheI;B?`]qF } $7U^B?ܻ~_,vr:'%)x.⌿#H=Fe_uOhɣ1/6R]Y8/t!ɟrɳ(N.$&msR/=$j#9͑">+]y%C<2teY'0#8)7+d~ {T@/WߚvY8Юَxtߗ$7‰xGE)oCES4obB$9i]{?ă)pNTv<+P/@L- E]4v?Gz'zPy]OM|sr &!'X/73ku܊\/=Cb#>Qy><>$֮\s[eԮRe<ۅ@~㼢]lùZL|.DžIc~Ͼ}"v.9\T y^1^xNj&9Q/L7q!ҕo7N!IyWc+/$=/|~wx ~Bqjʿ7ѯ:X8WuN@2pr6SoYC'$GTk@ۤ@OVقQ9zncsh#wFWFɬW/#B?yy]я'_5?!G !^P]EZ'r 'y~^@2.鵲%xyJ$Ɂ^Sj#"1-v:(w#~ s >F؏xJ$ ;|x}3i<`>ɵ,ډxwd)Dgq~8>Q#~83Ƀw!' ד,$אkGjJy.K=ܕ$'ƒs2|ZƯ=m(4c(fX9OՃ_[i8e6{/#Ɉ9NCUfïlϺyԡqt;!ŐWXs#81ԟoA/yJ$7R|JWOaпYЛR'r1 ɛAZJoD \㉇5߈;P>#yR༢g;a%ڇtQ~qB 1~+1sb<30_l 8XyГHzWGrnŤm0g/g|jL asKGg kֿ,Jk286 <:4qAz/Z<e NJewø.=k.)ɻ6uqxq*eJoֿBn4<_ϢD(E߯iT>dFe.-;[3.{p/+F`^eǓK.N^Q*&}"B 28>|Y_MjGji5q>!Nx-N|wCJU>:^/)y(]w.}D&dzo r`"w+[J)+^)8OF`8 P_? Z_+=[a7+n8!Uyu2X9~tCC~ 2]EW_ ~Q]T:- J#9=qZ/49n1QDG05ae'@.`^'P6"CF<Ǻ(r\xuы&#OCI+Y/ϫ,Ln#/)׸V?W%B|>J8(Ĝ%dQq~Թ =.Y8Ű0|gBϥKrEϱ_x''ai}ċ+D ʤf lq]IP.cݔSER+1ly ʵYg#^T΋qngF^]| ;@)n堯?<?۔[07?GC>nTA E%^P=~?S^|C%c CՕH?a_j?g5+SH^T+#J~/Q"˵S D:@U&b\)9eɿ<*~3遬 {F8 Q8p~hukz E?^1ݩbeϐkEfK_^8q℧\8,Ar" >Y*{TįR]+RUR!obsl_J XV"xV>؊K`ao ?؞Bv=\qQa{huȬ6X/ǣVtu/"n ɭA_Ɋ/1:ǣ|ruxBڂxuuLۜϹ7mp_'7H*+ʳ~Jޕy'op\D]?KD z7(21dHȩ%/g<[y K jyz;jop޵XSbwew7w/>ew>%;!y4Ǭ8*UEܴB;4q y0*E3_˽q#Nil8M9z??_ F֫`k1%`XG0o*%Չ5(?bj9qk".LC=9vN<}@|qXo,忋ND?V%%2b# :?n&OyGf.FS%jCեȣtބ' oH<{ z=w{_q(|;ȷZ\ĉd~`=Pﻮux|pA}~P jX y2Ar^c(˩ײB#X?c=[rmպW ?]ՓՍki *"CLfnhCs&חM>3.:KV }늸-1q+c{w9W+?&h-Ϳkj|G_I'|~Dr%~~؃@ O-'FlFޙ+`^&˟y <58|y~5!֯q }w}:[G3gq^pnE6Op^]Bܜ'_xcs˸wR! G| s]NyQ {j_h}:5JgG6$|Z ͇$փm[eҽ,jߚˮSprqhJJ<C+{^+. ĥ77s|Y+=hg})ɡX+ꯥ`T㐆⼠WKFަ)p]?xu{F!~J~볓:o`_9ٿ"o^|B6b̲#g,j<+V rzI8eoKqvcߢuQ)zp,}USgGbݭ}ꇕsGnTm;UH`Ms,1ɼvW}H ̌CȿSUx_(2QOW#8<f^6 Xp)+o^3+?awQLÃc?ׅGw<̀\{3>srqkȺ$_nx|Oۥ>jgQj%鋶M)1W8'0_2%2P;K< 87ț'%U 9r=WP[Tw #C| jZg#'g!q#=Iutv%?<(a(_"W|{~} UxR hݮW 86q,;Nm܁,=_i}> rxP䥋+#nHteooq<_>S)#[.܊'y02s};3x+C<\ԆF|^C~jxgcA5յCLa<˞h |߫F"MYu+oivW؀<jUO}/[͡ 7S>SXeW߅\Ž>CJs*a+7ao$ē*rf/+Aͺ3ɼeX{;iԒTTWnX q}H|nSWP _^/ҕKוq?7(o EqȋC|M=ysP>diJc%v%h%} !.KCut1f~Ƽ ⦋_ّCYƼA%,"-p[?,}]Յ߂N d6ELA$l)r/3y> Gܲ,uA>NY?V|DG]q }m 6@'!nJyr0glw\n <2'T,q/:z~\CySİRgO#|]DޑX xL<ׁs)7D0cb% Z f&MTlB< ={ua^%T;`;c>5?3T[kP3Nmm)K(㇑!w%CGL?N9ӢI)ƣDkUuwn|Ϙ%|j(j6/Cq<̱<sY| q~(uZ?qqQI3<WA!QVzɞ/gc"͢yXt8;+e(ea7ɒTV?#I) ~~ D~W/a(_ao8ޔ 8b͢7З-TYo:٧ɵS-xgY~-릸ؼq?87U!9"#?`}uVoʋTgR?PK%'-ٿP_l.B3?_8rj(Fo,>O.]霷7#H8 CYx,]T5p.GkD> oEd /Bt ܝ㧿|8qi.B1? aeqSGvwJA8o3xc!8;+Owwb'.;2o}!>I0}!"텝ߐȣ,qʤߓ*Һ)|V1ɹq? 翋$WS.e}4:*[̋x xd7(JίJ>@n.1n [ea*Mi8ɓ%hn7Uuؼ_Jd02"$hWmB~p\B]dQכ& v|. 5kJs/0}Џi̛s#[eѼ{q7|rjؿ!Ce"YKnR?HNˡ~0Om t605eoIOMҸUqcO@8YVϕ| Sr&jWZ#QCp#?ND#^y=ͼ#q+C/%ܒ1_Ұ9ӀD"|ϣ-?Ge%Fk|~FoH%Z}VC_|U |D1 -:ߡ+QJۗ&KWVĽVZmaj;#.]yi|A{WGԗ޽Iu..Cn29}yG U+~zbs$ggcE^fP>G!Oܐ{IKx$N¾2_~nفy7#/HM<' sf]V#AIe\-84m&#cw5""X >N9q=xnO!^η`}i? {Hvg![ 2kV}3D7.=\ͬXAEWqP~ QT:}u/?ck|{yA=n]  Ե1è_8Rn>W-ؓZƭG +6| V~E~ryW'z+9 Oe5% _oM}Z g?.~WNg|X}~'q Y>ztΫj/$c܇|^_uK kZ4inΓs븧pӼ(Uy˄6VcʑFyoANMS=nP\xʸϒ I݌sV~0=4^m}%Xx <2qgp>W#PWFmX'!#NP8qd' ?ɣQ{ȏW"W*7k䛊OKB~. X=<:(o7I޵Vau  뼗E"hP?E'"n\B܌,: s1?_>\bx ~.:K864b Yo<8;Nx +9)sP"Z-Smqx8Gj&ﵽoPM;!^jdٕx#_T| >jy p^u1/9@\x|}(mE|o?Zqj"'<%3ͧz<`ڨwii{Qq"BD:;k U7&s]*"9n*]o FԝNz&yD<y:y/ɉ΋=0W8jAssj^QCq^S1X)I=lμ3)ZZWGHUWGD?vas~D,n/ף\ߓG8RWd;S;pjfȻP¾QW'HO78]EX+*糨9nf3K]2oL}<ߎMD>y~"Zz!r~b2"NZY\Vq}B쏍<8SZ/D;t1]MZwo{@L#yol8g.[~@Y >l_| kj8 ==-Z:UiQ'\9> n/u9o]#-x7^uGqs8%p7 x' x\+˱7^ x2~a༡O>S| gԅ8?9Z ̓PRVSZ8PGV~=m}j0s4ӕF®֦M ܈G}9WA+mc4-AG^";΋Q4h8?meC'(QF W3>ɭuq]4Hm !.V vz''́zDVǼ. 7eVmW[PSXO-GXP/C :W=VBZ3nSCkTm2OUaP?N ďWpsK Ujqoo%0| wjߪM9JVİ<'q g^4֖L]^7AOeCn; PHu͒E^yː_i\FiMXΓ_}HFS'\KAܐ@>; yZPU-îOKR J li{-@]mg$zO^^I ErD8xj5g\8Eܣ[`PgF?r>~K$"Thl7c/Ԏ#Y{#meQP:s9 `.B}Ni2p/&SNx%>6 < .iv<<OsFC~U+#9RՎ\m-N+| ݸK?Oρ6(pobkgsB|/]|/~#kt-7>Wut 9aqsPD< AZ_j=$_."ݨWo\WpdP;߯!Wkv_N#}J"Xk zϦ?zuX/;uK ķj[Q_Lu~DܹG5E'-<8Y3x1?'E|%,c5TW L ~MOG>VW:/)AԊqj:5q])b>3x>[~#\Gjwص!ԧqvs dT;)Js|dE#|1lɛ\vrAU_9^m47#nN5i'|~%MZkvYWhR oZKF|VZg֓7bCrm+cquyݯB~3-US`<]+ՒNxӫK?&M"j.ϓ_v|YNԧI{q#!5xOmݧXnPf^{Onh5C6rq>?R+8}s6LjhGv1ߧS۝?HL >f9u7XruVc7Usq9O fd 55|j3qyt"4aڰ<{}&.c˸'iiyҜ'8NٛOX~(yT!G>BxqԵwZ~uu d!b! $w#κ7?4O=9m΃<2—ECZ|g}j,Q'F㼄ΐ_|kP3G/}Bd?8PC;\\q7sq4Տ_zǁǹKv<ʍl#_H]u'ce{Ey7.!.OeM9C4GXaؗd*ƭ>|Ř#y d>߸P,\=E_#ۜ^*r#w"i~;O\7d=:|/'IN KFY }U}j,՞)LMaw`? E}Mگ<#GdqeWr~(P xU ˕UPw^G_S!J Sy>Dzq'{髱] Vy^-02j;ȗDq~[к&#je𸫓~*CϜT9w_^|ȼ7 ƼtY?}rZ [flXq1G jxu˩Sp!%ȗn2YwbыU]In'TEǠ񋕘g6b'Ʋϟy?PR|O!mpސ+X_. F8YEQ?E#ӄZ]3kpq-p^"'/ Lﺜ0Y`G cu~Z|]J!1hf^U\=q/r[>B^ຆ˰iKYs=F;"A|E7%9o_wVH>>p1Y+c~xm$Ѧqr W<}|# 85ư=?.ʊzr' d*G3[¼.քN<}2p6=5Nc䅩ش]2{y/"|SͼS&kڇᯗSÀ34qIu'c Y~ՎpE,VL:pW&.B~u xZ?Q{GX~t+lNF<'?e;D犩gSz:EmY~ouVF CܸXMW1Ѹ?ný׹i!KpWIə?+* 7E:{]S>Ymb7e2Wq ,51y4 moq|O6yXpiܱ,>qprޗOpE}EMuo*X0ܯNWSri=H俈'2esّ,k1K)>q2GYWsϴQX|.\q~3+gR_)doC\<(5):H#8 ] q'{"F/(⹮{UDOEwGYy\,Rt?[+!Y-~ՉYHY4>Y0AıˋQ349'㸥L=wWRaӼzZ}߰?/v#^Pc3|71|Cb >ź޹y y }>߼Aџ1-W<1! v " w[.=GMf^s>2W|O2~Je?̄Q5ƼN鿁-7OȻ3cN.r\uu{mltyܘO&Op(x> ٔqkwE5WzBԙgy/QyA{Z/$䋈̇r%q%w|,p/mj=1vvv9\7_)o@od+z>_Ux83Ads}_MݧjXpο~\IùxJ 5p1b ױg LٮW6\w){p>]U)Gy}Ocs7lՋ\ ״q+_3:T0aADaU~\b/4Sd3Bk0},Gh漅v^%ANkjN[M~fuЌ01ªeY 稷; wS}ձ7N_Wh~8B WBR6K1V3-7Kqϝ J4xb]0?.~>4ׁS{ /6\e ?OQ|$ gՍ N_&:Wi=70?Yonz1363 o'.M}6BI.'y?AqFژ_{Z?LZo+.O{g炜,s~\t9MnA#U>C{B+q:泖4hې?]'e / acP>&d +E4#zDw|9/nWײZۓhjS6jU{|fc 琊0ZgӺbNI! '?Z3m!OW(xb8e7/IN~m?#_@zxsdJ|=c+\?^oSac!!s?=^g3 |ŧ&ul8+NWh&< .߀CQZﶌS_CO?/!fڨӽ. W!up畋hT"qUxO9c }t%yx㒔f8ݣr偛5)p6;c9]L^(m[く7> :V# DF6~!Sf,>_j 9Mq?}z';)K:[G }V&ᏛÌ0D&y ^..31hf#t32BAM71ŗ1ؗCoh?>W躯OߣKq.'53 '2i|a\%zjpumBv?>wN_ҟ;7X"驣&ᐏJA#=Wy3\~?8kNU2/S\] W'd||vAr]迫,` ˵Q]ήh}{+lLzt WO[ٕ:, 5\vGo1ž<#u0P]z#tMg?hYHzeN۟E+A?K`Nr*O/\#A7>J|E`?~8 tu8i+ \Zd;ɯXqb`!_=wg'sx/ٳȾ޴zWg]O'r'fMaݐ'L=쒉9_gO40eOv ~{3/֟?9;+43b8K%=wXMs1y;=k6.^;,}rc`Mb#! 2i]9B:žQ\*U+3B 6Ls~¾Z _Cu#sIc58h>Vq;~"Qy3b:r<;~p~jHow)pss?Β5 "vJ8^F؀}K 쿽}c9 {,8Z|~\E?wn#~wypENΠ}RWpp,Mr~ 3^~#>]{}E\j_\]g䐾O|iPL5}عi_#=q{8MZٻ9hO#9tx\3ak)Q{FZ/a)?_0z1/u9ݕ\ zW 0b8P;7?'Z`ߣxE5y4o'-3Bb?E~éloΙلۡ(7}1U_*p>fu睃0^ 9v|~`9ƿHyԀ}r_:ֿ0אCPr3AZFhߌ7~M3uz#W(ړc- {&o8 Z~9UI&. ɅǙ{@ 3\n?͍ <guzEP y ]E~{#Vi^sѼ6_Y?uRz(ZA|q> sJlrٛ~g]ҫ j| 8ѩ?ɋkD}z7 Y`uA ?/jIAz6Ydh |~FAA^ЧczZ6Aa?/6絀O#L+S/TL~#Q~F>}wȍRЧ^( y}F.fAEץXg̋Mr]g\s sv =Q/;+OI~?coGAqӾWgik}FݭJzXg=GZK~? M??As(oK}̂>#["޼ϨWXg\3gZ}x? 7=z&_^hPg({[gш/3r\s_*3w}??D]?k9Ϙ*3sĥ | /S޽0ě> _dA7Wg ߂>]MXg]QЧlg t4B=>}W<`O=*a'O=Ys!igU< ,|\}j|>}.3qO=) =G+\Ч =.n]oep#j=1n:ѫY³u/zSOQW!b9u¢nG^0%vs|_bQDE^h![vg> q#޺kYtN(z]t/ǽ^<|O!}/|OHB>x>G} &;qZ|^|>~ؑ점-]yya/00_ULE/NE%|C Ѿ1Fӹ:QK)~QЅ'"ŵkP7;c11/ 9?|_Ph^ȣ,2H%/P+$wWo?WZȻhMzĕ]E5+㑗}]^E8dR%D~^L ~c>oYcى71nEAӼGF]B;>z3~W̿..;3֢ˠq,M2iW?/1߀6f_|SG}~OlCzwȏn>ޘ׋!r`Qf?"Yj}èjs=zнi`o ƴBȎ?Gm^e'r<Ģ!o9->z>_1}7xm#/*u^}l[L;ۘ3KawtF}6 ŋѝ`Cj\h9C{?Fxc&Rsy|Gk ғO&zDIqvzLCOlYܺ'HÛa>rd7_8}<iLkË=M^Z%ﭥG=YVP^|ҳC^*G8G!7j$oѕ}L <Ӕ5f c_ WysSȏڈo4*>6ćV'Weox/[țo{zD1}=W]ø=3yg0?_{O׊c%Mn̊1gH; ""z/Q)nN'-ɿx~;$Gz<1וQFX><;bα|c?>*s,ը9 ZcJl2VW8o=ӑY<(n5WӾuX$ᯀ+<"z?023*Bͺ&UctdKØP-kd:EqCz\/kK!Cov# >37W=?Tbb*"/fؗQ72h}!YTk w䐟٣h4W^/NxUϰ<±шNwE}LqjztUsw=<1'v!9nR=G~E2EbQH#}?0Ex NxyqB\_2/c+|*"^(=A#/)nvsxb΢q.R#\tԿIki.O Įs@Hwy#׾Iϣ?]M8}+)OxާE =^Ȩy?F>MTqb.;X7c~~<=./(_^_%1'dNEztHԇ>(HIqssqN_`x)F|?MpDդxʀ}BzDU#fmqE #}] ;b^L : s@TV/*zR&KC璾MBd.}r/}'cv4quGL yLFCS(!NS՝oQgu'ॉX7)E=ͿY%2r&Ӗ=ČNTїyZgUM8O8}"*2/byk͸{zzvOհ[~fׁ1 71IڟǎEiqU;i_+F\I7CQُ0@b!㈹ q[KFsђgaKBq)e)~\q? ~ȏVGՂ?&j$aG]xS=phb3[KxTWpAM7^3 + =N{F31{:漞^?sd@> \GٍWpDܮc4W gҍbfdZO 穰܆,4R^Y-/V`y>]j֋,X[~νǃ}IGrm #ys 9yƝH ?FY'Ye'Cw~?8gH򍭦^!p dA">8#ٍFěG*ɮ5??p 2(>Y{9O/S\(_9FX@_Vꔗٓfߓ\nO8l%>&#p s!UKIH#o_6 y)J1Qh.oGM[/Uy= W? l1þ&=7\C%p~/Z"? m=z|x OC_I0/.#tgsL~;c&z;ɵ̟=HMxoEɥ'.GqF|SnC~=ն&{-ksZxw]n:~s?# =;9m ɧVY_#:6\߀i"͛ ܅rYxe…]D|GL;FL'1">hj3 G~eOȑ${.p~Ca$g!o|HCk_yFf#tpC_v_R2 @̡T b7<38/^{/#-*BSBǧ/1i,z@;"p~GV9$W~GŤd}:K=1x"4}(|Xl OFh5:! p.:kkg UH+M8?ƹ./qQ·dO܈|F HdîS#h,K ?2\5b] ́i֏Er+ؐm#o9;#kp5T]Nv' +} Au Ԟ.G<oɤ?#b1珇gʓlH8"k":!0S<]d'%5?z i8"H^&4ϒL^-q'ca: ,/Ўw2B?JGupG?/WWw7fgfKE*|Z"u{L>~y#9󲩿' HxT2 A:O|^ K}y5\/q\?ճYoFls#O!+FH6sǹ1]~LK~Y=Z')q <!^1/OMiwp9LwH>{wPt/BZHf#G5խVWR +-࿪U=`6RmH l#5Fj`6RmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmxmH l#-FZ`i6҂mH l#=Fz`6҃mHl#=F`ՂmT Q-F`ՂmT Q-F`ՂmTQ=F`ՃmTQ=F`ՃmTQ=F`5mQ#F`5mQ#F`56UTYgOO4?nnZUvkU֪ڭU[jVnZUTTTTTTTTTT5ݚnc[حyug>cݎj_^:[ҵu]{5;#!o ~gݭǀvݻ[w;]1^}w:{dAz&$OD^;C?S(')^q=dCṕQ>6?c<ygt^<9Y,qP/\8ڌZplm/data/Snmesp.rda0000644000176200001440000050032014124132276013712 0ustar liggesusers7zXZi"6!XN])TW"nRʟXH#&'ƯNuYt]teEyVjlpv8!tT7M9ĸI35f>Rx\#_ ʌxǔW@m3kXj#+(P#.l\P@Cyx_$W[apA ceb,_}Mo[Q(eڴۏ:5Xbô@t%([&䁋պ 1|Z`+r,V]4eUr2ݲqprpC3٧;o䥙D3%PKeTgf_|vo3> =5#_}ukog>nOprj2&JɆ|vR |"Qp7C-ee 2<l*~4QԌ7}` zMnKW뼗 (*f]<`@S1FgLL<=t"f5Sˀl1Lx}@N! B_j\QPN[SuNfƔC$L C_%W!&]Nڏ[pSĖc7P0d2u{~|w!iXwp`^FM`#K箆ٵCΤ9'1p|U"&;8Hr$_̢$krQ7l*=>#=u c &y"kOJ=8 $ %h=}WB B?vxgi$D=zDmC_Y䥭 ;I/q> Éa!Jlq9Gط?r-bD(c7Xx7 XTI~-c-S?H6fTkYXd?zځN:AI3F~5;7T|h*i=_>gNeD}bYVVBqN, 1*`I06o4cҚ#g=NM`og,;ACokvv+âo df!&?0irúE!t3FSz!B'|OYz>zJ_C$`SВP=73gw;勨)?Udsno㩾R F֞A(Ā#v&wכ8|L'aRV90|B Vx O0`5]sq ,LPܢ0勷5(!ʷo`\tWU_2>;xy*Yܱ(o;K9oJ?"Y Gy qÜ+NoE\}zi=\c,̄b#͊oN :(dښUyvy}N`Oš+P{ J)O [%@S+t9M-1vQ /f2NZm9%Dؤ. d>8\@g'o_)w_U֯njhz}w0Dh|`iˈS {cZU;t9. 6ɼWņcv8@TY@)7[R*R{: vwl{ ۉ4';|_v2})w.K{VɃڠ'0һy#HAS 2Gstugփ#M?0毤肨X\%6GcSbVBhy!`8e : ]5pEapqM?WLZVġ%a_WHx mt-*_b;V /Ko<4lx>Vl+kuܒg(Eq bW߃F*bnVI-w`U tt%TlA=?m8cmP-TA._u6])0uӭOX[}2k;VYOݳo/(:ts_pb̙9mWbF1j;t4 8M.ly:KBh8FoH,poiYԚ b0^e4zG^Xsu޴-nf9V{Z_'# +y;e[]˕'":0 =n.`^_B6ʺf=~(4k`>UIYTOcC# 6ۥe%+:"WyQ2PI4]D0AyS65>mu,P{5U ]5v1j7r OĂij? yϐVCkh9tia5ص)jxnT^9iGz Xd`+ؒ ~Flq j0{~mEnQV[2{,~a2ߩf+k83GD,qG\ï>񶊯lTnI]h|46y cx-8P>^lrx@'@F㘐_o-]9O`!Xz2TSv%v 05 $&՗ƚ:#b3}_^sAo>{k!>0>BőkBK0)?OAM70@;Ln8{8;>JM&2۳|D^29]gp=kO-% AucˬRлOwCwךHs5dѹ>N=2BNe>nڥֹCWm6eK]?q] 'Dֈ&-";,+SĮ Tr$aU~z8UWHdd i4pX؜Խwl3ě unl`KCt|`Pk|8(7t~GxAfѫzr{h`c4Bs(8;왞2{^%CB v)THq@1;k. @DdgJr?TVaƏ@?YJ#@wTq ԮFO2Q, 4GuP>KCv6,loѡGt)_>oƤ+%(116*\=w&\ص2`x'f$ 2ch{Fkd Z=4dnUSPtjM>zbkG8{Yg`YM|g]iV̊t]rf]ϳ$?Gx;W\0YE{2x^λbE)n̋>`w葎UPak.苑tNvdm%Md%ʺ^C DZp𥍗PbNtB6$^AisYU\vnB .*zЮ#V/*,3 1u㰳ƅB]NoK_ N_ )>=^Os+ "!)u{屭̦9j=fKLEkY]U3^|} s+zӔI[ G գz1#b*ώOhxLChQpҾpL.EOLҦuۆ 5cs)̅#$fbS?y%Q_2x5s^i(aD:ʥP=q$ GG :l_ G]EjD|upcۦtýr@͒ӣZ`Rt/-5R8]J8z,/7*U :]ve>VMO$=h0ސr* }E/&0.z +{5پY985<@/]V+]2b  Z2N"]pN=C}T⩳H{԰I$a[kJ\c Znzw֬x u/MRJ8|xel/R,{a!$QuJPɑ;V.t?0 SLD+[@ؒz ?ěi՝nXŊ0e0X?N} ׫ {f:Lx:3(l3껽.t/E$fQӂmm"q7巠w̶f' k|g2>L6P~m zF qEw(z}2QG}.b]P{; ,4.Y"`,NJIL "vkI B< 5+C ݜb`@ 24 g_4}uKaHq&/} (t!#R& N,] C]++>*ÆU<jfj Uk#"TeEVi$L[E3c,/$uyiPbkB !c@(2xA#2 ZSFn ݫGv|I &nZ-$)ZwRlQ~x)՟hPx׈y{*;Y9Kvc:"'$*XЪ~`Bqq . V}GwްfH>HJn0PjdzK%v_B5n',F 0t`3O!z$MvmҤ+\>^ RZbY$&p]Q!5hqz(\J [NƊd ]|?FMAG}A")3C\f>'%q,FN{ ,O0=c[ 0jq[n>Rc3Z8^ϭ rʿUOu@)ߪ@ K+@)1O ^# .I`o )2@o @Sc$zG B?)) ¢uC\NEgHcr8]-x/Lnf@Jy7o)񤶀M:}:0% 2jcl Hޭ>TR=́ ,IQ_.h)Tnk\Е<F}7vKr=LIwx4XV NNpTEr^-k^4Nqo?= _?ʬlZqb$1t{-T =Gw+#PlHQo"8ȍH%zN-'ZyI~EZmn+a@.BxM 융 }$Wt^4LO P`_be8woAa<@po[Ң{갶<כV80Ec;gQY }N$@87Q=klyW]‹S?֧+y{"-jlf5Gt%b#<ߡ <SDzftJq(hzc5^Y<\0Bt3Vcm.2r:GWVw4H9ƍU'ًqd$8Kls=YmOCn:& *FzH6OdWC_ 5LLCWb~5&0*a6 JUYUvF2MgSd`mxai2qB `]ܷC4aievW'\X$&r%nbp*?dBYׄz9_i}2R)`XDB("u)ln!:؂s1`^#3CJHv\zsa#U?KbDis9,{t@/;I7x?g3v0N"KHTF G;/6A)`1VVfVu򶱳u+کEljeB+/j,ٷE[#G]juuG'Smz?\/bՋzham?r*ۺxH>G^ WAzGWiOq%bAs6Zg\vSz  YnФ k}®APBG,P-U >L`w]aSRj䌺`XԚ31ѵS嶅B T)Z2rCU1}|CTkd#C 97obHRC18f^ x XmNҪ{`+ n,d'~=U/4Z c{mʳm܏1Z#σF<5r-C3gmb% ULC:7Zm7 %h+Ǡe cDi筧} m5;~>F=*5D9ddlɪJi%UdvxFz {r)? χ9zg&f8r`p47<Ϋrͳ=sP[TdX8JGJed\$}El9EFm#ݘ,N`L-0Lݛl,u&}S8;[ֺ9|i6S#LUOL{NA:}8xYCa~-'!Q 0\ް@$\zTmM Fދn & %,Ƒ܂EGWQ|VVN &j~gQP*Ka5)?刎\rE\n[hfao4^wEjQ1t!4s AQ*as{\WxdHF.ͺ}D:i3u+ "C\z h"'l$,vUYϲzmQP짋3:Y yRr6.u6Gr^uHD'jgIFeH@GL.8$ֆHl6=K)Ls !/[:{HM j.ol2L$%f2ر^aѮWؼBʧXn :? )'2[j{ݜ t{ 컧x#B RF0JثnWɘR!t5~,Z6ߒI HGC;U2m:Ѱ8$Uhgg@m)MlVzYtIkF&UHoKÈD4H!e*Lӎ#} d*篗(?7UzҁJx ʗjV>8ϙ k%J!t}e>7t\a~c씾rL;{+1#+\BZB<HMdzM%pč+ڼH˘M"͸ 7 =@8'jNy)IDâfΝMJnnloe'$)=BK@F,'@Qʹ,]Wg*tm-__&PM&O#? ,8 V_#kȭP[aHLGnTx ̾K̗Z Zϼl!űsCZ{8gweS/KhD;t,Jh@bS"wEfk.Tٲ̔[A G5FKgZJ XBJ"KeIJ7e5~MͮΎ % 翠ʦWT?<+}oXiF 'w[ EeoG/tZ˝+Y.ݡuvuU#mV(1hGwl9X|~ܼo ɸے[6x*r&TMF@E>)f p/h,~,x؍kBX&ɚu d]cs TQˤ\ ]*fij;!Ejiic-LAN `id7pmCh֯;y}ke P`mev*{_͒X%WITSOXk_53X%b Ϋ@c;T月gk/D+PaLEQjA?K"*%¥d_@Yк>{%[sGyi `doږYGhC~F(y84+I9ȣ1mI Yl#3z m RD=t Eo3*H,v͵w5#k{kG d0m0\a\Fv?h9JEHtXI~6~IApSr$=-1`0gYL̤UX+eAvIU>AߵŮ@,gb" a /W^g86,@"%"=!( msXgj~ם\- dx YXo7^s3mΧ y^ P.MipJ5$7҄}{_m\ ;GkQRgI& viY!"ݵujiP7bUn i\u^dhu/}!8I3!J s~i i]\ܩuf%t岝+.0ZQfa֋%;ԥ:Pl4;+ޜN_ɪPCC`l'_4H ?j9tv9G"׭S^f긃\zp#oJfHxGXOGh;2mR&+!)rN;Вs^FG~Z#pAI#G57oG?S:uj!0-al LX>zqӢ5] 90LhSAQY>O/fwc+ĬFAJ_Y);a` X4FhphD47-L'װS@`|\MYC's jb13-T*Z,_"&vߴ+)g%Q)4V{zCvu9mEw^UNg!q0 $bZ-+COBn;l0m*WH9k])3C^S7>fG(7!f餉c>+-~K.,XjB1㳃 )Z,$XJ0e'mmjU䏰x%dAYn8}uRCX(g"8woIhp[mCE/|RE_Va:"7'aw82UG#B*g6 R=Ë]mKB-W i2f+cF2! \[aOGDVj 9=d@''n`ޥB#z[s9Ҁm>{蠗 X'*|,nv M!o>/{1q7LfGnw'9u./&wcʏ)+#6t^kۯ^ ۵ِJA(p@%u9AeLQZ;qWCB׷ƫk)k,EF BkR;7D[8‚~,%^"kb#Q4~kA-[y\dBsbKgw:`x$e; %,vۗY.QF_E8nM0zl1W*XѪ-$o{BMXr:6⵶6(w9-χ1XR3{fE 0"_鎾='徻dܚV|[%DHG;{&FKC^گ;׵a)МEkWQ'χ{oͲe{i1B}vʊ6$QžP@V4뫦upȜ Y}F7œk6AōeEQƬL= X`6-QI7 D0ʮuC Nڶ%SK&.(ƒ4g+"7)-}ݓƙ 5]Uk~DYZbc^|P *.3 ,{s%M0S|8sMop b GN@ތL0›KtNE @mK\+"-ڮ[^7v#ŸbX/^NkV+ɾITpq]$k(oȯY̯gZMVQ'!.p2JT!3h>ϼu'8zkCnTݙ6l;?ECxLrfdJ45o8Y$zI9Ѧ`wNUBJaw, :HUrwณLcm 9;DLn` ym7 T$UvK*ʿ^ by-e] z4ֱ^rQRU9'<-r[FH3q](Nr'>Y.8[vfA%MZ)#sIFLTnRY*Os,'8H%61cLoHd1Po{CNhn]M/cbXV{Nmos"n xxW"c mMpsPbY?!Р6- czΥX)*֧#'( 5L=S%Tk5w no4"#TZ?`Wd:Eu<u~ri>mQ[z=+N:*^tC JOQ%xc)%3#ƈy_Qz G#*?+F6hf5q%s2>8Y7V^؊{~]l tDx+w#7g(LT@9Y eia4̖qr)s^[=^ew-i(hO\ꞰV;H%`lJًo!^X*rnΣfWp?{p#1Hua7H-g^5IӋ]P~aj6\%iF8 _GmN^*8G53LBb1h!6%Sտ3NCA03p/,f1|V.*[l7kQB1m{&3 Vo}5E7؎%oR0t8.޻Ōg.]{f6:,ADa;`lL#EׅۨM7%|#5Q(*> % ;tymw|@_ ;z hFB~ 'ݗZVz*խsJm_]Lx=29T!-/c`^V7h] !Š ~hc拍7`jNAWl6էш tG&^tz՞Q|ۡkjVL&w6hiWqa}dssX>5L1ݺVq7AJ57 8Jq2 "5`dO3gi)0ʧ>B˧&pڪ8P>CtǕ^< QY`ؐ5aY)6/'92EE#@{+l?1%x0%uf#4IَmM`,xdS'&Բ :DA\77ߜg|d>`ÒYOaaѳ|TFh/('e;G2\5 aR3C]a}ceo+ĐN=3rb<%8OZeQ-ݥҨFK4"Dכ`OS+Ј9B@֫; R˵x6jN='Gm׌qE*`Un(حn/&FW59h+KlzuC ҭG%H0Rp C=>x/9,3eQ1Auտ!UK"GAKFjF^2\~ȾM\[_}GQl~SɾbQudہ<㠐~uY4џ7H "F:h#5rgw/;( ǂvUdIݻegs 1c=RZd &Vu^tpi%?o\P2b੟Mp* ^~;8j8ǂ,4Rtn&R 4~Хv%>͛e@12^"TSmQ(\Ů;qVr!S %s̿7|w@EǙ'7M_1Ǯ&PkV{ ?+##7k.ڪ$`:]&,h.Fޕ.i&Q]"ٯOKU!/6I|q &l -uTLϕv@]p((A gR햑aU6160vSYgF=M*Py-О@  x3Ϲ-Fu- T:Uk^9E2"M}JDZ<>vk=wwLEvZz9FwMB&E_@l #|XNQ#6i~^ <3<l1y}Г) /ÇRme[ʹ0*Vqd!'T+@*-HAaNl0}aV-@jhHMʅ3hE[vR&UP>eZ ×&a2J"Vx!]_‡M78Tw:ݺ;iTc"%} bi/N;USV-74CwyQür;qzgn5rm8 Lu(Y.aj-3&lqEd7!0ް3ed~+ƻl'O\٥m?#uʷj0NDqRW Pt=E/$ noT%lSE/f;!ۂ8W|I?h ~|!ܪz$HY%!FH5Cy91ixW5ym>\Yĕ<3 @Yj(dШlQy&>>]ȩ Gm#9f2'|W.CiX%]ڗǕ9ڳ/)tg#'Hwza25rKv|HCv=E"`8\lYKߖ?4d/<\ʻ@4 w2M]e8-2]h_BJ0Eg(_7C(hu 訲}8Wܛ&$SΖwXp|NfLA$JvљC~ngb^iCXp>c?uxx/+*b&/1=։&%o^Џ^Μ&GL{4'AYQp N/r)Mх{@sUA%x/Jiq yp E[ 7vAx U)&sͧpOQ.7<\WU~wPD̑@ y#nخFhc8'FfF{THO';{Lu@p+Nk̹_; NYLuϺX.C& \'<`&*_MIcVsBm hm 43IŇbuGuu*!%T}h:eDrEkA&^ץqg5+XTlIap9ӱv|NBDV`_I`?)ǓޒI=bnp/;[45ˑX̓~Φry($TՠȾd9I Pqpꑽg &]oVi~EdUƍ9;r d>593Io?e͐GVѳaGAOWgJDlli(!KB`?[أq\T(l9@BgLq%_n,>$4ٍs&J+X|Ti5IS7HVO *_yP "w @ snOنctD7GSpVM{G6o?[ecNB < C m.ZA! f-0b 8x_8VD'܊YnQz}F4DYۖFk2Mr˪2%`+i +D4{TZ}qz8J/%64`U|Jі4Evbx|C~w)"0ɐED|fG~)0ZqkN&ZlHE[p)vG&AKq<8A=ߣL\>MyM/)D}şW8n76K?Ng2ҡ}ޢ@&zqA979OȎw[Nb(}GC2$;CaNWg+bU0Q4G_=JYNPV-$P꿋R_qد`jrH߮vrwBLv "v?Q*2v 8¥ ['a{m%5-pPOV1wv#G/Rb)oQSzfT߰H^GYXg$ h^j6,8bq '¬nmAmIoQX ⬕ w%ъ䨓1py{D+=2lx2Liv ч=G {"}UMV1 L]+2k,+F/ {dpAA-4l.h\avS@@~ߜtK<9;䩧_ =u|{l|E0U!ix!y^OGk{H+$TVl'y@'crZ,cwm(-fhqTvy7r걽!ӿPo "?2'<7XÜF &b,ʀsO,7}f8U9>XL |iK g'ڝNc{aɑ'xŠp"뮳͟4lwΟ26?O &Ѥew.C4)}ӂWsa6q e}ZU:VWd嶈&!D^Z̧$VZ۪Ou|.EbIto)7Ht\6*ƙ0Ϝ ;z<|KMaÚWWȯif܈'j6$xKTt#̳$s|Y7D?q"sTeԢPi] mLCN(iZ.㟀Cg h,mx/u 6Xc+b5/|eRB?RpElr;r=ilHe^R;^}s:Z@>>wr^h-Bu zz/ny>^ ic-4 ?m(PZ4 e&/HkB"< 5cG}[t3>E.E!!ϒ"GWw!CVOݛv{<~AV>MIl9߀ nI>AH]gUC2apIhuZn+RK,,*-W!Bc*~;T $Fj2~ɒL($:'Bedx$M_'RrHG: ģElAdbĆ29$aPg9'*|K<:|VcQ-^˱,` @,lR|R8n૫C,@"-xV$Gk(UF!I6@CYN݆rtJs8XPʧn]DhMcD2g(i^;?Քųd w]'4F #Z46Dfgm3![TרCےf(6LA_ƍ"OBl yF7ațtۻ;| ;4=Nf#5P.0bX&S8+)Zv 7 G6*t:Iaaf}X~y,A8y}('ĺ-B)i`p$!ݳJ%oT|Uw,Dj쟮3(^?RUᩁڑ,Ý=<+~쀋=T%V9]98˟Q0ыŗ |jp<7OSb)/3M*c1p̌>M3hGcژe:geıP&6 Sv} Najh8錓 g4r%̚71co3L`k&?lqyV#iSlr9k/ ?\88h!T*"?{Vk`Ѫ$0&wjl3+Gfd lB?=.Fkt M]R=k *F%Մfe9y <\ة꧓U05\TPoD9\lQUߚ .И2hƠ"R eB^ ԻۻIXsUX}6uh1UuG"ci%"B̲/Y-{>}ųB5A8ڿ3bB ׀(eykqG̹̖6lgpy!<^JWeת<nI(Pgv lJQLCڼ|pe!{ʎus^JKn!7GB0:& 2!I=^\Dν`TvLJtRIn2z}9uaKq0K8[u:RplOؼ?1xQ'‹Ӧp$7xiY+<;hϙt)GmrZTg?dm m.΢s[4zx,/iuF_L@h i|+}M0CMxaJR*Qx~CFy˞ (fa"?A>H :hW4;rIڂɀשtT_,q4ỉ JpTdxӻœ.?pRٌx ?R~jH˻7$6_VX@pĉ-E5<#TѕFs5z:\+\B4\]}h;~Aty-']|H (mL=ic4k((n@IG  /32`tHͦ~&R;wL1n!%[H~G ,0xuߑɏQ%V=4N-?׏OkbU9}x CJĢ}j=tUT[SC=.f4N o IIZXqhQ9ZΖ+O0O!3t8[!`8H$|WlkWє 3x9 RV+q~nvP Z+/~v*1hϏߥHbXGJX&LYlX? @MCy t06qM&=Rgs PaJ>,# BqhP%όu{*!:ʉ\ļ_4{ (FBѬk OM6=TмPI-gY&ʄ)T5gSKs;ឺCQ;g^1>m `{: /nPQ,e_ {U =4j P' Xr~KfANI㞓rS8tE}[գkuܬ;q1s^?In:D-j[x}nʱ,jpW-8 &k9ƥTw'۰Ҩx򿩕塎[$yI1dX$j 鞨*=+;݆auSnR*dիM ,/4U{ 4nAE%DYX[e0Yjc`D 2=a.=Z$bΨͬpyK3!)F/iwA'0 spaIٷw5'ԀVPCp\:]-e]|1xېICI"`{'o>RD' +dGIQ.% M,R h [02^5S1Q,Zk`Dhoc bg;Ա6ԾWc NQI\4;-9H MY>LM c<puMuV/bE[ %镄6o܁<޴iu AⒿ)KޛۍqV?N:a4UZ>i(ȶ}N]}Ǻ>$ye Njƅɿ("Y;kW@3l/AKIGt4{Aj^ia\ދC@yO%T|^qhOP= ,mwoe`[#7/Qg?JF%`7NPczgq;{j[p#ƣ:ՠSrzFęKי8TpT ]0]&aFX?6+ RE h3l43HiK;Vr1IcF ߨsԹb>Hm17vzrjݮ#OiqK<K^8jOۖ?{itԺPwRF(<1 s$:Q74&ЄӖL؜, ]&fi1cskfu cdM^S<7gQ&/ i@%o?8|A` M*l!n>>͕]6qV 52ȖUsF?kDIJ58J0#v/ :NU0H6H`͜eg0>\+}PQ>0BJ 4Mf" gVs~x /тdH=EP#Ŵ/삘3QO\hB˽US>Yf mNbxyYOxsVD ?m 2-e60[PJ"!#6MVԇ;sd0BDO H {+ 9+ &_@wT8p:{N.,[̓ҟKa^曩3յ&,^ޅ El?[Po؛x{T'B1eƦ́)f7 JnZqAI˜.Û$Ώb {z[k=GHiq?iaor$JbJSJ[P̞̪(J oE0B"y O&^qs;2 ٻΰ%l5v69拏q;3W'eG`)H_jj*D)":!lJξOuHCzP.%f}s7gwLq06"%%m2HFS;;mZl7c䄣_iJToZ V\G,62?aH"~߱) <1ׯQpk *=4n˳Y:UTLMYd_т\{FmڕL,to*ybsb҃XSa5.6(cq扲FQ/MU c/.Ǘ9 u (ǘٴ:H!f!̖楏TŪaF5igõZ^aDT0qnnyVυٴF{j[̪|ÆŊnm8Dnwۗ%l'T 9!eJǕn1OT/9;qJ+λ"]̲ke#&,',F@n1c+K?9tM] 3gs -Kɦ;AJ+H0D,ǘbDśn8-V6m C>8B]e0-}(&VsصtŧA^}"/S=Os;U@*V)\d!49?7;3oGoI9/Q; Z8C!i1J~!̚Dl g_/DjN^ٿ\YO5(RyMӿ% ͡czxe5=B"x 80juQ׷3-ftWh`g]>ʾgf -_UfL/876jl L=f5hZgb:fMl @:6z)04(&Liz1g|&kaĿh_v.Ms9ꖲ+k`Q bYmY)dEE8 E|XܤTH!\‡u yO<3{[FrcbZ5s/}auWQ7R|-.}_[y#Px2t(iCZ )KЪ睔D>~͗FNl3^1]M}5q't<D>"Ե|x 0.| 7(l ـFv/ W=8MK_i0\eIy?,]seKzf(ސ|C_5:5x=ښgܹT:i "DZ,覦͓ )Pj]򒌀SHFTIf*V@b#n9JYuNuffB.IcvBȊI nM2dlb\kE,;?AZ'vZD+͙/]R\JNW@Ώ#ӍN0~*ػocDQ}"Sqk+.Q~Og}GKX}W=rc r9ػ nP0 9'1uf"S'ַhz+Y%<l١7V~q|faэ/GJf7l6 qjY4eCMrZ(wȯQR!H-Z]8s3)UZyڠ\>7 Ι=KyFDYXωu9dtHd izX=ŠtQAzŽe 5 h73(u#2+. .f&֙q'ͺ! + %!зoebB +E&*h|s!\(Ofjai~P0: ŠXz9fڴ7eHZDlwWcN.ܧ|2{n*RcCj(8+tJwӪ3\m:|tlUU f` u?WȺ8_0UM$,Qm^tD׷N6NW*@%i 3/Đ M~tzkЗC󕻮k/iA>AS=|_:t'g=#CjvuA"aOd=/P58亏-A 7Ꭷ!ahW3ys $M^P=t.hSzy^ iLdro*%+&qo>QbYCP0GS,jtN +yNa*~§lʛȽ uUV0E0)B',ڷ Ĩ]%2niR*1~@ hgyhDXWTIѷ\4KΰtdN0ΣVF^}7@ihʼ8 3Y 0O7"h3WR~I#4- \8A㺟^-tiR{IEW{_$q2L9(@ /TCyfԞ ~j׍2s+Uv}e|wqIN;ŘRWPMܻ$ư s)$V24AS<[S''5kmVS,'pHtp!N/1W6p:+|?hT+%f{۹i֝vm C_E3ώ7BvSԮ㘍(C8&څh|KY>JBBxJ^3jH~w!7°f#j矁^ZO*.?aL%KWī܉h].*mH*A|=XB,Z2Z{ q_ ujYY5ҞEA*DfguOwmlVA^ 1u#wYΎK_Wnc~O%<ڡ`9l[C39JD 7acۨ U,uCތo:IYֿzF_ԭ qJhm:~4.~u>\8GBdI3! qਹo!T``n@ B[^0*jw})rojlXϔ,_0{伐.#KJ ztE_S<@1]*l; :{*h_f&u@0i8cA+E^JN\x, W'/0k4 Z<7!^#4*նu*piBuOpB@r'OIQRqߧg&N7SA=~l8m'A?贿;,hp%.y6/ו_9-w\xWoYEOX(:'#5ls\B|viNoJ_=((vB cZoj5e_S`: zc ;eFe'o\GsVN9a94/*$b8Eޤa*e+ 8o6#M:ĄA#3g;[ĉ<&"c&?z$X~K 40ʀX!h,QS&Vm$lf+AP& 㺍1^HMP v̲Yʰ o`',C|8叞1&\8%U~>*xw:ֈFp&QmϝTMk !'L?V.:ߋS#zSı҈)9@?5 c7!Jv]"){91[٤Pu&v0'ncD% c{ȹ(qg[k(i}{bvSe8 9]:M ׵^,ԶaC;p&Hb䪤!uٮT'ޘE -f߀_h9yHa`R %2goz#9vp]8wDž3d+MxXt9mPR>W=MX2'YzD>>n#}SSȤS8ob.@ꏒ9Jv#EMEu>FpА垃!tC!E \j-qBd'ǛN$\C 4Pb7zR2/,nR{ղ噿b$ZG9Bn'[V C$q1J)R *qetSyFVq&.k0oh ]y%Qo(OTYC e,z +_0 컌*,24^l&Y+L%=^e7`Yb˃M:E J* -͢^CK'L8oGQ [yOOԓ^ -BW9#7Dhe{5PÛZk.lIÞ?P?o&$QjZrLi7nF(6]Ab8˔|U_ᇉ9U^{=kQÚ> h]U^M`(:PGQ9Ǒ,KXG0VZy~Qx+ .ISwM;%&Aq%Q}m?g7V3.( u2:!mXܼ4D=s@\X&n|\x_:[@V5A1c\.{F8Q5B Gq= @> WJO^Cѫܝ3hqF/8"YE$u q ~ߛGF؎(}D@ܴ%I>g^N^غcg^ ajR.JWֲ*e|BXU;"{RFR1^Hfr1To lBAvޢ/<9k2kUJ9UxpФ廉OAC> "ð@ZS_lx !Q-(d!BJd)nEԠIXPj~ħ  nbeem/\[V]Gt=YU&cr 02X+P, rϥGݛ pҔ$yJl>F.WI鄇H=~;-a O*!6/3+* N>ƢF~ۯM=wd.@" )(4m /NEz٬RZT5Rw7烆b<#4ݣu9"ǴLx Eiawèsi9e@#d!y#`/aoo϶dگWՑS~ .f&Cx4F~L)Wgێe6pд珗c`T ˜Qضx`WQPD=a~J_#W|]t+xژ$qLYv>Ol)(RY4َK kp8"b>hF2B7wdb]˩{pLJ8hn맮~XЎ;$i{t)BF в5W4`3W;qjd||>1((m {cCDH>n&F6mv B;^èʂ=Th?u>Mլ "qE VYXQ1/ }$Xƕ ^Y-^+kR,= KD3IG퇻RH{p!t|~5PM#>w 5d8m:h5jE)k@mӮ}H9Y`MoWhH1"pc%P U.hrW9yϞ ܤ T}sl޵"xp:Xݢ%e/XY@"1؏KE3_S9MY^eNnD =qZU1EE`|N _.C[{ 妃g:B KkIW;$5 4QYZ^{Bw= EΗt=,AszZ0v3ٚДK m5qHZnR)ǯf>a`6FjnVf/ٷ;YwӲ+QGWV~0^A-KXZ)9g|<-K:VK#TA>Hlf?i Ib-:E+mSRʑ|=ϼ2G]&MN(i3@w-uhp6N#hP􄵇E0Kj(#N99uK5zyT7-{1ra}XdIQ"~ Jշŗ|DKffʔgM53p$+묣ȧYeS_VWzV3jDOJ 03/ݬS5I]FNnqN(yR۳@֢|ҘaɒkO$hRfW)0a xkQ]!B5c\2dE!_%oY }{P&I^n9A$;VϠ*4EAd4VپGk >(7t0G>2ČN/?To |Z٠ 61Bsj| ;(8glWfkVqϞ h]}lyr^w RpN:=@ slFxTK&_(JQS-׉ѦbkH5$b}ss.nɹNvFϭ7d@暠/3@$!NpB k!D# 1 y-&3ToAA4>B^c>): JEJK$%,v9me/q,ؖ"u qJgpG8INfhè&/otʖg!Q0֠ޕz$va 05"мzM2)ޫh&\6ZT:U 5t6+侁My #U%'gi!W_4+Tk<S/6 |l޵,1BGF~s 0L(\lg(;nl WM1]`6+z$d~C^\9>0Bg( FbqFQZF~is ?6ediJ %}V|w5|)iKnq_BccS+uޔ9na=I <)5==H6l5ί$8Y2(]aDr Vs-n c:rbV¢.75wJ=@)Hh*+S|=Mw.u0ҭ0ŕ7$N66pb5q CWv‚-"$o'ie|M{]1m&m Y(}u^^dWظfdyT?A%%gt.n2[MQKf GyynoVe^!Mn&K(/-qw/lפN3:tk`(7Bș:]1,N{,j'(C]4ǚS;XCE ۍi*Rl,!4tYJD~ bP"\!Q_߂_4V@%e0!s.֧Ahڭɒݐ\#dl62xc$bdMĬ/]v{0p~ z bHLPTxm#FfB8/3{0Nu . twI[5<V$2&L`P`0Lx^q+.Ȁ(`4V MIO,E i,p_kIB^,0, a9Lw}T*j %]WP[c#ýܔR}Ц pLz[<*t}QV0w:]HH+%>TћPwhLNBe8H#L3I{_R!<6έ35@v_,#}~ϨX䟜-QC/eoNGqf\,2[*,QPܻJHK ͶM kaȺzP&+[è9`)--K$+Ax%C)ACU]|Z=Oҏӎݟ.SlG 䲸*IetzVgv xr(_Bf:W ̌рA4sԊD "_A5lmZMs:_WuPhew 3 rO9Llwk> \6DoIY9_ 1??'{OCkq1+>cEQk3Ԇ"frwß\Ѹv]6ݷК'5 bV1ˠX>M*+x6hJq*1(|Ր?|M,sqfeAݜ1vk4 !Ϸxpv&]h=3Y(xcC25+VsdN&H_rw 8ln켋 %s1 Q:{O`a} L·y)a[ٵΏ(Z!hGTb͆/Rw,1=48F5΂^I'p(;bOOSl}Ӂ~lF'MOfe<:@I 89zSצ^ỳZ9|X|X[S5V(62Ktd#H$^tQP=GmJ,R՛ߌyMg9Wuk*uuF Ym0WF^Ȅ lbMtPj ޘ*i=7A$T v^ZH,M,YC9p-7 [ 0",ݯB,}8aXS$Tmw]-n EXzW`tfVLK@a:Xl$E.q5T"v}/d"!,?A#&}DX0>C^Ĩ BqI4)NEi2#JΘlBIȫώa?n.dMoϗh 5uZӳg˚դ=tA1x}j΃D㓕')7Lv_hCw3i}]%[z6!91獍*vNUD4Þ"kv1Hx7зuWi'0+'w-fc.tיlInFMqG7N&r_9} 'SVF&Gy2%ꚃr]J$Ѱ]WpSY#%7( YQ F3Jy~zl7Q<.e2!UjS;R53A15>(KkI=U̞'2L ӹg^w)'έ@!nɂB-^<;[~#2Um)،*"h{J&>mkB~X]Ki8ۇ,,ŒG&h^o`5So%_gZv¤]vIQ;6AOvRċe喷zAEpϲs`fNu{|%y{\/;!NJv B|e`̏+tF̬(N~>!9~'|K!>i0#ӣCRÜI(+g?ΠmI~`vspVWW2Rijj`!D]ŕw5VjoE' P+Lch{FAL4xؽ5Z9z3Tݬ qBUE˲i͑_[̵2Lyr#D4+BlRO+GsH"/Sx^$3 ߂WV@DmZ>gbVq>otZ$T;|+io /(ۃdHig8&%סy2w%KGDIS.&IBn, DǞqEJ6KɯmEiXF0ueI Z1"@([x}HF#$O_+_XjLgŀovgVӉMA@!X]+ ʱn|a)ʍ ^BK;+vW߮AIwmyBΏH Y(U貫EG٨/seMve1D=cu'y-+p l='=mƏi]h-~0< &ܘ$VY៤\ P:2(Qh^?УFǼU΍(c늄{CGe  MQo<ml!u %D.F{MB}/V~KsAӘЎaC%Uh5Hn)/ @">,ʩcYuSp$AM,[~!`oݮ g>QkDi%QX@%ەϒ05W^bj wC\7^[ҢE4n.H!GAid^;'T ۜf $>>6%4$׵żR5jD0j 틿u(i%A_S$jI/Wp}?.v@Yr08 C.-hOA%k˖ j+s殠-+AP/LѥӾ]q ps8!H1qMg2PNJ|B<~k1Z0RH0ZV81?u쒛e7|2-ڜPS}Cj(~lO"뽤1]w0{t J*N'5b풮/"Յ8h9[/N[LU}]ɜRKR,lZਣP3mo OI 0̲}ʴF%/TF\C(o/W9J}̷yr-’ WVi Sg^u`"VZVdC"\ֱ 9{߽VSb<~t]b0& |*ewauq3ΜO"~Nx`( v^\ :Hå:&]g^k|phDNbNuo~-ԋ֜'[Qw}AP6ijr]άk:=ؕRkBB;?-rR_Џ㑅NI/E3]{"X` xAnne1Yeg&Ab 0kv Hx~-脨YjADqϑ3!y/H'yB(ݼ?py% {ͧ@уxn~s4y:05nv*dՏQ7n~r~"UT0"UjmdCV{?(-j@3Y J@VGS`9,bamh?iKTv 97JUv᣸R".)C YByv \Y3>nlm`b}/aE #ܚ u}>AMwT6^J?EQyeGLT706-pDDNw7h\yG OjUV߅kRX?a=aV:ǒJSli:z,W$>ZA;T{Pxj%lPE6.uMCޤ%$_$g Dl,ۯz/{)&ϭC<3-DcwIbsϢŧ&^6=PI@DtNѿ?o~%U{@b9@g:=paGyL  U#d.o nJ>Q+Ѵ=Vy7RJ.d' 8 _oHch8(تC7}x!ko80FrVD kciI!1k[j\ؾ.Ⱦ9EH mѥA}e"Wk9q[ݶϥhȮ=Y hIPe9#$ %؄E @*)jUhYuK&1i! ٰ2:y! J A 0Ґpa>T:@+,!5mJրIY;7gA5JDxD?ʒ3D; PSw0 G=̍=/Gv6` M`3IeO3Sy/d%?Ag B0?VC78-F}"dw>fJrJRG: Eyڌ<.x77PWZ,Z6?7j\׶{Nc6*]I&tb9+DZ`Z#lfX]rwayy`fā:6&nи\!wn[xRә1cHr$c?5 U8`ArQ7B^Se?dy$VcM7<&]p.i@UXX ˆIT%`;jkpܟ܄ksi_O؄z Wk><99Z_Cr E7f \OZk !u+= `9uq@c|?TQ9KNv〃5%Vg ̲1G)˸phK:tgwa!4uKqkJ N2x6jIb9RN&mVB׀N|aj;aWoƉuq!6× U1z1'Lf]y'\,U0A<"E^AW3~F[JbPOk؆Gv<1~BG6WwK=a;B q#KX$8.))R!ȼĦ^! 3f(XiF+-TӺ;1A 6)ᕕUKr|st^=۴5\ڲ*6C[-AU|5O~Rs1f?IAb݊q +w7J:@jᦝOj 7Y!rBø"RYT@Dh(\l02Q/^㷍2Z^z0~owU&"l\)@Rկ䐍w/h4 (^b gpE# n] D\~ϕ߷1Hxa[%6wȻ*C#sV]+ ע>ky2onMP:7`rv; ȬN #BQ X'"-[xv}a{f׻KZ}J%zc&HpPlzAO؂;G^2"|FV2u H^kD'@7q8ji\  i W,Cˡs>* 3Sm<U#ٕ)'g j4J@ z7 : ^=m=Xz"@BrB˿5 VtpybsYNf1ѣGGwzt(7Of BΞ?wnc} ]L1:"qxH' ,aP>4lPxNٸuH4:߇}S|+ U!d"R]ܦ6"K!a*qF N0 !6Eӷ;bxb;wbq}7P7fkT*ѥgt\T;)Xr6b0_Bb(nZiMA)a#) GFz*7Qd/NrϺ$*V~a2%UHXNJ l4r@ϸy+9b'#v|IWnԽ~'ֲK Su)K'G7y!cPA1FP"Rl({: ,[>B3`rRMw>dct҄aB~彂 ~fdIn3~Nw E9Y^o~A1n隚!Oڌ @UaM蝺_~lo-Vk|Kz#p`/P f:ޏēGJRIzZMֆcMr}ܗ /UHxI z&? `Njw醤8dOܙ/SCR6!B95+.(vlňZ *s  LNiY􂜯Ac^rvob7wؒq7!3ED_ ȓF)G+Ou9+rmo`괿ll Ie 89ߟ&i(:/d"$kԟ08z GZI *y =m`k!d84#{6Q</D`~Ġ۞kZ0F4W67790`]CKKu=SZJx(>4Mї^L!!^,4u%ŽRPMa{~FgUH}0B*w܊/t8 !'**jfqZq@~~K1nHP#Z9IEaaߝ iBA)YO-@+bLyzQ4ElpU1 hPQ=߉l1&CyɫFӯ8$o z@|vBAYdNk &3'QYc^)Q? .2.M`O KJiuvIAY.دBVtэ/Л;%e_7`4p'1gCIzOz䯡#7*J)L'L?ׇ~[x39'Kn(>ya 73OQ~]˴PeOR  :=(@!X"&ބj{[/˭/C~5c)4㴦>k?f +Rh/}gg݇;'.M9=T-ʁ].~II:?Wk%O 5t$CZn/UPޤO# z2E˱i 0ؕWemE I;+dK$=*!>Gͺ2 yZ:n0#swb6Jw['驾g"U$B"w)Dt;1Mp6󡀮NnA̦HKzi74(n)M|̎3aj|=xpn\+<_'VŠPgzy|{4m39ZB x_Qw"6UQ[ܹ'W@$ڪؐC;.[vf6\@&E/XboqH{ĭp %5~2)%,0.4q¥\Oӝ-OutLeEn1A4kUe4h4ApXW05Yy:$GWaIs?th8Ƨ^lc::Q5-OOb U=_W 2Z$9>E|tH*1z*st3_kkI"U4h `}LxKaW֩ ۊC/YkE X=;ImDJ~`7n`n?Q~2mlJhtv7 aWʎ$6}O56 Hunjn}&ӵk:+`C(zEժ !i6 n?RgՑ׍aW dYӲVTK:Op 6Im7/:Ǥ< Dh|#lcpr=_,Bb:B$TպwD΅RѶrB7HxkgGm>CgI&v&ڱd̛ޫЛ TfE)"3=$cKT6 ḧ+ Z) Ψm\|V/ЉqFTGРh_~vGFԑiX_ٻn(ܟʮVX/1 C_ ebk;Yܑ ]dCD|R~PoX*!9 8sPVY-23 2K]5ݦ -cžZ/L/Jwנ*={ W#Z%+; F&e;>:B?F<UL3i=Q 4oFSmꠢ(L~kRXǝ'Fؤ4=GE<@L3Sβ\c9NMj-7ZOnr>zӎ-6 aSPH%\0-/ThKmRf]WM |9̿+ӲFVA8[!!" 5VF{ Mb^v#rH}H-Kv,M`ݹ/5珨+O^EP4yڗ8=RۛKpIujuzUϑԅ]P{01>,k%6iEr(cXN?P)@c!y<ٽٕa-SF#坎BYo?GI[h¦5 [wס>smMW!26[砊jV%0,#E>!$'zfCe*^ (b!rUL䲍˯޵e57[uUN =ReۖZKy@; y{C$GQ.>Z !; O{9d ,YzQ`ydD&U/9^]zeKKC9 ރr# Vݣ~Wx\I~EHQEdĊ^p6!S{ZpnPc& 9tхHb+T#"Fe24b R*f͎bU0l`.[~^5J.@w$Y؁M z3vWwelZe`x"ڊ3:"ΝGs_oO1aHNhˎ8s-c1Oja\ G`]1GϠekm-,SPr$F_cV0{nq=dc&fbnXw@&ޥcB+dKԹr9w"a=gazX04(1 #̜2bnHXDB͚ K26Y~\\ъ.N5?Ft]A֏ L)t͡D?0o4I6>@|C[2`&--_ޘ.4ve`5>]4-I-xѵzR%~dkU{ݫ~2DVHH?YL]Z}n0liC\bSF>60? c+]#Hi\,U8>> ЃM\"/ M%mqGqVp-;nUnJù ׷S#)]hk5f5{H- Y8E:dݸ ;s.Nn%Nj6WHnl&g yYH(W9LyxXܦnM_rFAJ!4FJu;aN )^OY :E_dJ.$'F;0wsJU!Ӌ dDϕ|9IF.!q (64ӣpUJ e .ClYeKK OFB'?ZbM7rMƈ[yr^hww0 Fb!'hW3a t`uY& W5P]釫e.R,fB^/ċkAIjf|p߯TB@;DRB C;%zhx(I..ų~o #yvW~.͓ڡv)O"}aX 5#nKWwS?TvBf럃0$zU\'8{ݰ 8ɮN#+BjۚhU:f*Ym:$P -H'Fb_JԢ\VESulbjOY`x֥A- _!.1[Р2r !/VٿߐyX@ےKh.P>^/N{<]F$D+\װ06ɯuD :b{B/yvxvM2 ZgjvlIa#Ң| kSOܲRANQ<@.2;_/b>~t<owd9X dfoPBGB8C,f_M~sԂsmE$WHzT*:eJ &:LPMb{j<"s̴5vj0<<^[!p'`7U/[U4LEn-"{$Y>0{OdF"maGF4I~4/ XK-34< X'Qy:6rs~'IfE[ض!E[?SIAzO\gQo+ HN2Na[D~ljy^4<˹Ru3RHCQl> v9k),J2+&DwH35` j#3Xm9fppmQӭFe9<}5枇0@4$gwEzz~HJ#"`O5l?~Sk%u AΞ$ ]StB[7(B2s^I|D5nEv4JfV*eO:tWϘmMIY~ɪ0f:Kq}/ @C@~jn`UJ?pt^QƋs~yϡ]og%<@vP/W82XJ:e}d`b&QYQ6(TluBoQq9(_rdv˗sdpi9(-ޥj-1Y&_/KP.6*5a+zcYFeYpȱ#y*Le Gg+6.Sԩ\] {VkL:B3هunxGVlT o+%zQ 4y% zHe3/zI/KC;f|" OxkM5ϫK.@ά{uق@L 0Cwȣa9Ē-&{=vb & H5e o4({vgz<\ytg Ҏ-R ާ DBiyD?m3vbҮ*ce+nIzz&*]zj?j| 0j1":p2[BvJ(Yqe91J»P&'7aå}j&~ah<[ofyCr8no(dҞskէU5|IB~cO/k:Ϣk} ̭-o玠"". Ǿ1QHJ4ъZ'hΩdw Ul<tw1qET͠]NF,h+I)X cz-]u=;mt8@?=m;VutB+=tenIF z^Lʪ*c+ y< IpBݸe`oVklL^yj̸Gݙڤ d)`Z1NvQYfo[8/*T0`(YO9 !I0E~^AE3c.!V38U:ʴD+j%YN%9U3^)nJ3[\~`T8ȏʫϝ!t :!1ݒz{ij>> Dh>vk<6ud F#&F#4ẹ+pTF& ^XcDEƹoUol!]]S4ϯ-P:'jxmΤ=. >`l4^ޡ;hbpǻ:6z;R XA1{](pLkve}ɲ x 4rc"pOj,Uhǽf9kubsa"s;+;^ %P3a2ͪb<|g-v1f#Rӽ*Od@\D /9ߟi J?!(Κw1Q="аqyD, \t]>VzTTW[]"*W Eu j,z(4uK!X."F v#1n9*̩U2\~]=Y:jxu80ʝGU;3 愇pjU`qxA![7ߟE2+swTR}h7aDp C}=W2uiq?*`]C(ESpOwu;z]{_@ T&dMrpz@d]eWe 3b\([KuWadr:~8U<t~1,C \NE+.LH cdhχJ;SCb6mۜ%.b]ۚP!y1b>x7Ra_nzh@zKDU,bWofks_(,9:2aebJK0gY?D@qTT^Vcķ $:Bn} Y␰8;. peyh1w*Ձ>6(pt-(?׎Ƒo;!$ع֫,Lg~Uz|gN\'4B_7ѹNfj':ϴEz\kK{, %?X&3n2km0O; mNP\ȫcW$=\jỷcG'-ԟ\kV?zQ'E'33L&;Gb|@0M3t<4唂0fvpX/+d&& AC[vwwO8hАw7t' [K\4=[|Ā_Mx1ڙ9i:f[vU;TWu<ΙNޮV&.Q[c),N<֕$̠<L;R2XvB2"p^ݸ]:t*&O~x˜::.4V83jh5!BLpo4UZ㦱geXN-˶BhW"/EtYvgxqs_E4܉h*cζSiI:T] M"w!ZcHtzVy!3C>HYn8Ip] )pjs]֐CGr $mFmýQڃc}xb[(67`RoD9 Z C+ϏJb7U&esR4:!o![P M?I$P\OV51MlSv .#뤋0G9gb\ⱀ`/>csU9426 q6zAVTUg욳nF@ zYQAY:i넂bպ=Rwoe0Bܕ*7݊Wp[&nfz6~fc}4Bl,2_=Dɿ`řunDRbU6j[{tUnJzbl-*E [ȇbQ:ˆS&#y\bxLQ]J;Qx?߬S;F/pǹBYF%M__p4kt@d#{C'tΌ2x~e ;xMҵKyV YJF.6ڨX`'1/ȼ~@s3fL- ?6(lY@U8NspRCZ-((K4'{J; :ϬK{vyb5j$Xܧ, AaEd- =TsA8n}|(] >ц;(۲c]"I*;5`Pӕ*lդVz?M88#k,. hG7EOhØPM8S&O|NcPbe)^V1uO1zm4^`H>(1|cIB$tJ"O{׌};;Ĺv.a#LH,wh∌pGdM?^{TM\,3-,v&z2i3k@LT׻D^f~˿8Q*2X6zb,i*тggU#p0(*8c1Һ76*?aR5;01ggCe#TY5=пi&Ҋt)$͇s$M T+@qy&*Kإ2Q@W۠&}S2;?߼P겞V@d)}+0tv&V 1Z\/Al4\ד[=Op+~tv+w2WVm8Yl5-46wuP= {gmJU#bHHj(AȳoFt:3ddƕ}P O[rH]Lٴs^@΄~jMCh #_)d*M/ս.`<zw[{u:a}[vvcD+z,qMEn+1ehlWuEG$' ")z_Pk1Rsrي-Kxd5!V;H>E w"%NSV1bƱh} !%f1_d{ ^Dq{=zǩ p-^I)˟9]` 9)&{1 NNƧ"ӱm)2k< Ţm :>}ǥnP_fra$͘T Oy+Ac,+ i=I-*HaXIA9; 3ly=Nn< 'Wi̞hq<kzȜMWOS9=5e3m`@}04 e+$'{-/!}ldV:eL QjjLn/}Gٮ) |)ҥšG rֈF۠|-j| OJ,Dǯ@KY(>Lo !8ٵiL&4nDk2IpX$n FuwrqKn.Ȗ؇lG?ZnO$S e/W k <؏r^NlWKJ؏qUYYKk jsp.́W rc ttFz&)yK*pBQ+O~E.3 nz*iCBBaW)PK8Jb0T@uf\5c3ؼ$|)x蹊|qW3<|:S8bKU8Uo-J~Cݐ/Mc qlL&@_c4JWI8|֨V`NimHBoaU҅,xӮG.S84MbFo@R2+/lcKZLh&J8I.Dר;-ҏ#8hN'ѮO~~?~Pˋ8Àb)0,GU_J-O-ro@T$;aR2D@Xχ4FD& :x{*qlHBK"lz=M]0`8[} q̆G)Gػ2tM),&yJG/l "h6-}+PA_>+CQVT1d76^EJ| `)Y3RIL}sSs rZy4`u =d5YdNPo^dE}yV!5v"<6 yAp1 1k%Ս@~.tGkIL*P+Iu׍Lb}r~0@P;]id)bC\F67}R4KpXY;-46E‹ҡňW=B\N8_%>ÝDL5CJJ}y^ |KY-,ᜎ+mbT X‘UVnF7u>?( .meN`zIOe&6;UgFn Ȁ$$EUEKB=w=#U,Y)&Ex[{@d*ۓvX]( EuZ8>X5' oJ^9:xb$zdS6!{Ņ(3g1{3iy2F%Lbι}0UWHms J~1rJo7d) r|D/8Hv+vkgw֣Q{-c׷`MID%%Gݦ"a&cgK!7  DdJ5|}# Cih3GMgC\!R ОN0.yl=5E+6\4Od%% gV~zS (W@aA^jtx -t-`$k'Ӄ/M{iHJQK"ϏGNS` 簅If:qO.LoZ_̂ƌoQm#-t^ށy!j d ,`M.F21!,l襡"!Sޢ gS|}~[*-rOokpțey QZ|RȔ LprEܲ\Sˆ3<b$dA ub4^I2j?kZ2g*& gVa3G]13[m^Ek a$):L4huRȽ}d0Rі9iurN&K\1njI>*/_1Z?qqwq~L-o-ğg5s *C۝ j PU_uf'؟[$D 3ْ߱>EL4 z5YqdNM =OR֠M'ɟRVF3.O4{{U-n+ 9*y= YBwԏ}!ZWke$3u|<= ]g:$}\.F)!F>GPPwE͕|xa Rt6)f:Y dZ=AݮGW';yx{1GFh9J-T5a)e0Hfl<_amml抰շǍ3ѷ/ƬķFZu _yrէ8`uu+q]'mQOp1!?d:)K\+ҙm"~zsN ) m-J7iP~XIfz/- */>4 N Mj|Ve j8[N#b-dȦG0Rmev-X; T#~"ƽ,U!a>g%73 ~T9Yb&9%OuU3A0hd2Jb± rbj)t4`Lm- hʩnCvew!vǜl6rt& Iw ^%c Mx)α 3v098rPF#PeNA]8!]QΡWO"mN52l[vT /}ݙ.2n:ڂ^n 5KjoRͽ2P@0o/WgMa*'/<NueB?%HICpݒ*7x + !J. eYTom/U۳y^GtTܚg}ωԶU=sP \LCUk.ǏgȜѶ Ma-X2=;u{@c:| ;R]׫T`~oF>WtH;ia5Uz֪wL-M(m]u j;WN353t,yUUϗ`Y9^l$]q:xc$_99Ժ0$%V`H{grba7.H/cI>|4;Hk*Jm{w5"NV߼CVVOlhLdQj(q-@yi^Lb`R-[ 7:E2kreY:[!UKpX mւ+Ž'(ע=,3NW/Qj*4:Y7קI]0Z(Cﻉ8gE/^P~\tFv6M 1>UJ2 HDcjA.ڨ~5>' ZP6 Q~$ &aA8hdFf; " 0r-o^9N iT,385-\-JuhIY;_vK$7as;0lط, -q|TA ɒTT= AV"_.d%8rS?J Jǂ\7Nj_|V}oÑSS E-!b~5%3L+"6xN$/ϒۛP /;\tA*TcJ43(PZ\WE]3Y|.jN|ܮ>Qtc'!_]!goeO `OY+YpκUЙnrf2^)?fti9V& Z..0aΝUjK^[m~:M%n[Vw츷q_E2S6`k "#UQ?GnD/K5.۽Ojsi(0焆R`k t-ږm*{7h]ƝyЉD Af9C7Hxy\^Xu @낾`kskՇK5Dn 2MEЅ &8G33gePztX*YSY6E\RH_@+\9mg{ޞ|bۯPkw}E(18"ΤFj':'kVHNLm3&l; {Uca$W}:2vØS P"WN{w+DkVs&`iI~_LmЫ7&_'qtn{?r!z|:!Hd]+[zv(fd!C [3I*I%~1QX3 XI1Q;L`W$u0l3|p^6^!Gg4Y[ 5RϠzLج*(Dι˅w&癣%_3,*!_4Ga;F\*֯W7"%rl4j&bOhxե{8e+ vBY$>W'JrdZBٗsCvJ`sZ%9 ޺G4/cDF$xaԼӜpexz0^%:hU_6eqc&fo5qRM ݤA ]QQޑ˂sTV%meeSLye?h;ἛS:;^HGI{mJܴ]c_cҥl|WݱQzq%mmOFr?񅟨|!wmJXT(: ހ8W͑9` \2L a{J/dޅ4jG뚱DVӅ\Όz cn누;o=a'|ޜECjlZzhT3Wa;K%hMPgm1)n 7tB:DDA'v~DAh-7Wܖ[5n }*Eȋ JvFp=u.sħwvP-c`Lj. ڻټ$뵏Vʯ.{ֺ0hLK\(^q$\C˝[\{Nq`hyX:v;Q9<@y{x߬GcA۷mEL[-!M*JQ3vj=%h|Oj!!G$Hj2ley3OX\x~)aʝꚾ̜2J @1CoQ7LNTiw+ãkU9,e#g汯k]i~yY".œM[ @Y ܍?IA3))$Ҡ2NU-%> |YBXg&h3 B!0Org݈:\;U6+(WW@U  Ť2}Ci imܟUkPaMXne55 ?HV^V_q'qƄ_Dz&(1N3uMkӊI@iR]F8agߌk"1N<.|6ͦ]QWhF-ey&h3TdijEEx>?fޕ,ER_$ozO4tbQ@D57hjN d76yԺxmm)Hzn^UyTҲBr:ۘ~SMIr_GJEZ]tRߞuXlWzB Sǰ'cuhm' *I9h!X}4r~7NAGlEI_\,R>t: oEl&fUp(H,LMr!0V˷=xXs5'ODDLhȧ%R!ƳeW8u9Æ:~L}x (@Ldt Ctn@mI_|d$ 8Jjg^a,拝O a#ȏL 4tr?aZ+U+Lu*au!d%<9#^$&)XT(%oih jz$A@i;t@f _&E7 ϑʘ1ݍvET@S3K^ x|3F e㱪 !<*pd~uDIY=o-OA0'~fONLA-r6!z;k^nҚ>ߠZ|mX8/ waؠi6ƕoHʣpRlh[,U>ɿ@7@d,VPYs$:J (EBӅkVi] {o ;VzBJs&O ܄Z"/!fnĨ ; 0,BN_bOب;Nmn.#8n=Vs҇H\$ɐjbBD '0r3$-"e9aY>/z8r>"{>ʣA\M#c)C$&򧎓B̯:X.Q,L)G<0p7+.Wsp/a-y:Õ4wZ7roXGCjb|g}G~Xiȏ-$[_~K&Bj&*λ4D*3vUehJ " EoTErFKyP(i l˿| Ivk`\w=z"~EM_=/!5k?ܟgs^`- @@ȉB*ɻR-8Ȇem̦ mi 'Z X c Sz{7LɆ KV%Y贈:Ld,)حc:&W!c±S𮨐/%'X}zswQWa⚃[l[;CZMMhYY ndžpNƙJIe{Ff:]YVlf M񑾩G:I9.jUٷb@Ơ% QiKLfji2 pv_97gf?.j>2jѼ֏|f ^#H' PAE)I@ 7$a `uW\A3B79"B*%(WuJ Vۯlj#qWc#I}spì5\VJ V[XF72-qUPac引er)mxcēvf*nSI"7dhcrsu>rT!Bp<e/y˪75Ҥ^gA;-ԕA[>7sʏzվq^E&ͽ~g%/a{8&lB/X`ۈ}7L.Mq/kYtZƉd/M!≈s4:j ͭ;MV泡0 0ꁳhL꽍8x\F╿BB!8frEd%(}[InW8?J`"^ grEPvsdn"l =J#C0t[$ArR]q0JFҬ'a˶wM/ubvuNmZA)vPC RFDCMS%)n~-喤2>}>7qh@'}lӐ(Uj̻cCAL=EÇ"d`=}}cggIa W:߇O A_&?]ha?a5\Yf▸"I bӖ?vVc,[5Pɗ]N9f|V QWD8@<& )KXx˙#NuOki{ tH/~]{¥Ԁ|Eصoe3վ:Nܧ#'z4{3|G FktS78!}&} ՚;/i&UijN˳  ep'^&;r˟)r!W5}Kt uPV|ORuJa r OxZf%Ä ȤCq4VXowdȱ#*Vc"/B=XHx#L J`߄Zyhvޅ;V-OI6alnO2C %x5wwclN%Nc!5ߡZ݀5_}Ylo,zzW xIDAyUbu.0l ٱ6$gLo1ac(ǟG&bu gyhfS5<Wl޺:¯2!9?"'!{颰G)y荹"h!}jymBHRu\?>blK.hmW_#O ?3}r%OUe6Xѓ)\Ul^gp^bj=2ǎoJئkj,avû{JtR i#, Y!avuee%±f].'lq.9m<]XQ>z^ ,'(wj慞,ez1>?j+1nud%FLetY MXֳNzT@Yp`& WF=rAZk4JoRIɖTa@2,* ϗ;0j5~u55c(O`H 9' i1=d#~3)P4|&8 ej׃eljk|_ɔjKN,mN#8%n- ) fd]I2~%ҝ\R?H& ޮZCٛ%tص-_|r&Al9[`$&q Q[Sq/ĭnk t;(*9wA16cXB*x-|`뫳>\R< M;_Ȳ\z[v+Yo8u^ԁW@74gc2-@tư5=d:JC/.:U,ſ)_L77hYפNA]]󴿻x<'_E'xQ?ԺQ!RbHuը.>0h,VR ϣI{4JFx`ǿGOBmVB: (wBcIq]R\: @}yhS49hFz5 z<<}:iu(={ o1}Q=0re~noa8IEB$ϢP8Śk)Ȑksw: tr`ySCŐpG"w(+N.BPOu2r}J۝@LQF+թ W =J%-1͈u#5mPx+VC@ߞȄ $T:cs?bCT;JID!qKkjAuA@1 n#iKÇumѝ7qL x }"J; >t`1$y^dY~ޝ3ha z4b&#EW;bc2=z=K/yAF Yt(D|m:$h[]eE!eѸla:Σ}IeM#NiP V1cDܳ?A>"cף%XI;_\-Mv.g`e Zۉ!҈)FdZi/LfO› O&,-ȖGs[k25"t%&n&D{аݯ+HP@qW`sH6k%ԙ*}|P.r|}'d;j߷`j%'OE+%>gp6?t3~̆۹$&Vv9%I̮Q|>}fg2MRLSLlX0Ls{%^ퟯi2z mEV &p0y%mKr@9mC"M1OHl#E{>Bw+rJoSo ?'Jiq)݆he Npݾ Eb3C1W<3/e,G3_p:2MKS8!$}b)ҡ~0?O HmZ௳p'Ac 57 ,?TM^1Pdj[rfiR.,ZD8*qUKJcɰӌI爑DgBv4\0TnYnɅASʮ Y8*2] 8ڎk]I^BI a Rx)N'i|L%I q^νJX[[\#6.Hϟ\ӈ8apN2GiTSrkM)%X}klOFQ7r#{dMhQp2k3NZ𼐲PWmz_0ú"-Q+Lm;o7!5Ϋ#B+a1OcaǾUʃҩtҥwlC9R'#䇹'Z-+BHzP=2.ZnR>f|0RҔ'<@lM"iL0Q L9n;$"t &[N2qxEWEx<ËJbW-bVoqo Gh1HhM+ HpSwGvP$0᜾|:6٢Tw0t`۵r\}AҫEp[|l"zQfS#$A%-:A@T#G$wxѶ6ָ^W9'9*QH< 3nFWKD%FC _:6#Mdv$dIsÎtFBC84 S 'Kt*հMTݏ}µO1M0ZN6Kr|3췮N~}ᅚh,4g\\ž:;5, meHg6TWOdalG y0@ @>s( n&7ۈ/3+}DB9EđGrn9@r^gN EKEFB½U:\4F* g_f!28uF D B@9'/8˽ZP.[zbJuO5+(_opIl. 2Ď$><Ϳ5cz<`pcwD!aF5?Qe4q7,5-d >Si/_)ѿ-ݰ鱻x)feG1 Q}^%aZ\sZ(i>pes"pb[ ?_ۂ-/)<DVS/Eq6CK?J^Z~~ѱDK>qF!xXyar x.#f,kiB0;b3*pZl_d*f_5/j2< qmʀ[OMwI-!˰cti6u~W<ʜNcZ\Hc(fQWLuNO=@tEyֆuBS9~wI$,!Se6l#[9^3ĉR,gfrv.ђU-0K7 EvY3O*C TNֻZLgr+x N+/d6q.bx\Ӕ>nLj:߻̋1Y?Z7~M/ Eʭp걤a>^ c`qry} nK3森 !^ǯYN R!I!@n] )m6Rޑ:ޛ-q+KrLw BB\bzNfejȖׄLxOF^ m],4g@" 3[Vq/6LP1'uVґw?%/ lO>eȯ+UCp/j3'ё$mp}KJ̘˷!3uO۾B=1얦 6~g 8WӒI)A5"uj0[k\eFH]I5Iy=A. 4@Čei 6X7:RלE6\xWC_O셶qf j-qIs PzY@;pEFx9QКnvq2޻HGĘl2\Wz,OkAA|Cv7]MePiB\~cY 3"tDT7dtg>NH0\,Ie0C5pzvjqc6!Y*F7,LySmYUna@\8+-#K12l"-N p\(o4| 9 JQ:KjQR8`nqR!GGz^q" t,=F`X*)h&;A]R4GUe='I /IY# oo<}p;HMI\챊vs*Al]K }QveP̛+IWrlͺ_XS|+vG^74%͛ٴuG,{4 ЊÕ}/q!Qu.f.8~`2jGo"\&’mzG*QcKRǶvRvX_VZ;F`e̵wv<_"bh84ہ6Z\BÉ2y1Bx8)ѹxDvEWK3 aJZnߵ C~<#Us?|*(dxS`D 0Q:wzE2&xK){*УhkBS5"SUOw"Xעvv5g3jE^Hh eW15|=$5lZCak-&R|T1%iY8ym 4yо)9eg[:Āl86R98F0v6T''/_#beMeZYC*W6}|P*9{0[/ edaM(l$$P G1inINuKSOr tE.f_hʫVF~@| tC;)f+gb5/!{<u#N3{=Æj&CkQ?r6U)h9ijݩcOQ*R`Y]b *걏:o@u3x>6~_̨I>!@\Do爿Q 䚫8]!yT-3Xɼ+ҽޘXG\h˄BގVceAT5 ([Мj+ S'/IcJ>w%u]LrL1;(Խ3Oha922Qo0䚣ix}CAFFAMdO Rzʜp p%tcɑg23#P pv]`WTQp([DRҁSÜ|DfL:E `ΎA5Jȹp yœ,\j?0j݅3E]%Ek VLG\IMwدH?\ؠu[c"i(9rŞA݁THGa'7ކ8Qp df`N؍vˈ|@  v`!8ljL;x   ~/@C"{ ['lbSpCwn*,ٗ1ՐiS`b =!nhJ_S2@s5U9-W H >8S'Q~PE.nf(8JXr>䎢}{C^Ւf»YY Am3cCC zvp)K"YA@s2I<[-97;wws"jp@\"=Y- 뚡 ̉@v"VwEX5a;7~az4A~I ʹ<ݏ$~| `q?E㶥9%<}M\ ^?֟ۜtdͩY{;:|b!: jJr *N)fx,l B E ) pN'uw,4V5I'CZ 'ХdA=أЅ7dՊV3Yj},@UKivQ.PiUfb;D1*Y l n@k ѽ68p\odI!sx%qԧ{wӷ 4#եBQzﴄVs߾ӆ4$w U,[֟4BBԋW/VnSP,AS[E0ވe0b1QJXZ ;|@e,9~Nׯ\A"~>}fc_VeZWna}$:tk\#$RE:>Ja ̡Dƕ}υ̘#Ik z֞;]}XPCwu'PI^sWpXe-`@.򂳈)TNAժjxE3J(R`buC_|glZD_Nۥp6^/SRۋq6&WIjdL k`ZE8OXq`CӢdyBV{Jk̖5SbQT9hC Ӳ/.UtQPaѴF*c]xE9Ayqh]Q;5MƮKv)j܍U}NQ!K<ܚPnrhCFbHh={ 2y%'ˏKԃX.MNzu|OEƅb$œАn:Bo}0{Y~.{xӡ/˦k߽s͈rn#]8ϤpaNADV GxUX?Y⋱ꨮ:3:42!#}璨9Ugk q̎Ԯn1&qǢrò3>dL"R}\}_}k·S{z+ 1`$G0 Ĕ`M nU {=W؂+rءiF]?H?&֪$ c!K?bS()x JD!'<>r3 `kZg Q|p=fXI:-x$y \sQ%yɢވFM+>lBo<= ]36C1Y@V&b ,ӎ 7Ȕq.:O$Қt/U&﯏'mYis B2F\{wAKiEݟsoVyq ?1A:oaBDyWny2vxӇ'\d*+h%(tI K;-UQA,e&tXЈ5OuVSzw1Mp-=Z29֮zrZb|pw*X؉}DK@;J1X(PLq IiZ(:Z*p41ƎQ|gp6=sqfo#NmZvo uLbW(0zPk6s xd úQ%RG)^-hpr ?쀡v5E!"ik)/'G\@7[/z*?'VI<:,փoӬ3 %HGe7BM=[T6woRLTJᨘ `s=cO7k!@p(G;1iNQ1,bz]1GZSȢӥ zJM?Nj)fKHU;ϠSH~m|2:IWix4 nNO#&u ͂OțO##2V]5㩚}lalKR|ҏPéZ,?o7;f"k3dK1aWTWF>Z3H7uVa>atQqIb,gl1t1k GcS_9VEMه jU# 𚛮L}ߝ" " >Dxe'fj+, (7j,_TVk "d4Id>=@Wߦ 1]J@⏺"[sNCi@\h:]2 ;5AxzȽ$]ߞnC^DZv]!yR*z,␢% gU oKzGѬuBB"OŎ& )".K-w=H\mV-P%J"[s7eŌ!R_jk$zޗk_# uCYA>}ÁNYX,;ʩs&n%,:[-vWU.籝B\Tuq#%&;!-ש$,41Jݦ*tÞT轐sy^ñiŏÙ@`,#"l2>-%rK7ojySl%џ3Ln#)NOx ep:T̷ GgkTRDHRFٯ#$/*-߼8wێ)tl:.8d{4$`ŲA|Cio*bXDZϑcW]@>4 $ܯXNV8@SQ2zXY|n=EoVlGuGen(4 <ݡ0^\nY !"qv`‹+GK,}NawǫzNJb1*E]?CpcB f>gNrʒ4XD:0c;2l]s~,{H9sŮ82[L#W*_x安m35 m`YgÈ˹7qd=-^aW'(”Yiw#!8f AWv&\e+ u@;bt)6_[]m!.,(D6l4Lom,y:dURHl ܌2@\HA*O߫40+} uSyoaFFOʼnƸb$oԁ{fJ=i1\n]P OyOv)vY\1b>!^ľED ILcHN=*6X}hc:CKN$F[P r 9ǫ2gލʶxI)e6zUyQ.4cQ1@A47pꕃŀ. %p@æ#ZpmZ+x/P8{,9gu(?Kb|O᛭9=5[X3M0͕RcqEXnfӫ5 MMLWW\ExO7Δߐx7%e-cCj'fKOs6f=1R/oohA-jLBMwMPܡݙd(IF{=l9[QFmxs7uT!RC*R`wAS:(G ';䖒"d@4C=i #,8ѳYju ٰ9ġ]SfTɰ:> mr$xW8/6„$Xs:nģZ)V8dLИ.KѪu.9/`[f㧠 :pa޼ BJRb!JzO&Phev*%xƹ)ڊnBwz'1(_ByaV exЮJf3c{op"^U/L܎xm܈v2v_Аީ@P 'M"[Aq|PW*z; z, 6/tfBHީO@$xgδwx]#˕Zђ*mm2nf>]h) MٟArFVo>f|բe^q )eo^j '"BcsȔ7Bu\lN\><(oEůZ@u#*Lg7pT5ŵ-ĆVsDfQ 0uVd8F@QB2}G8zQF CkW\2XΙReŧYT]&Ҡi^N^  G Wj5)E0VKҞl`&k˕x$B-D@K\ m%{iu$ǴeDTP4Y=D>:GnT!w#uRW1-4vWPH0W_tpZmW-dBn2Մz׼{nlט?¿[t m2O 7Egb_r>1NjeJPXS&kfIyKqAFC8o\g+Uz061v~ҍViD23b %SE R1v1Ϡ "a~=F:Fb, +$ڤ*TiHu,Vؐk'LYBFv WPmិ~[h,PLדP.Oq6 hf;=gԧ*K<U9i"=rVl%Mp`r+%{t-5>:g`r IU=Ex9.NdeD(1'Hɋ9j'{[2ԪI:1ՀVq-돲24*Ka8P5JK:m@ՠ$1F|6-SΈ:Ae @߂at.(2YP<29;b2QfN>خ)~Ydކ)*(L1Y鄰iMW $|imM|PP"6u> l 4+$mD{?"EbWb!'P%9?]4n7]N0vHNNn^On/<ڦҷE#E@Z!;_:HhH9nWF*vCўW71B> }PṖG{hA!XPYl壹@gBrʠ]]Wҩ8VN'Oh( :uTfkzgQ4AV"LXd&KET %4#u)>fLoEb h… O V{[$z;P/<ݱතq6or)b g. StHQI€?YnڋY\n68:˸?كF AubQy,( fO+C{c~MNw]ܹcȑayL ihg3T%E Cˀ+'Zt<%E jG}ta -Jv,A_q0Bb)}_3ok>^3-0e) Fp③ՌBY@^NYLjע* 9-ĭWR^|3Vf;'Gx~VN!bZo_zYՀ;W.{z5E2lG^Ԙ|4cɊ ~>h!.J(KT/If y|F{?^A_k"7A@ym'ZX.5_9u?w8 }M@wvC<6#ZIiݱ܋H8#S8ۍgJ#-<wL^/Sk'Og+ɵeEI!I~.folM&j[ӑM5 a]Č:͖w\&T'$x}Sf*(= h,*J4-AO4en"ۉR:fB``~9 ߮B}& }PG#GxܲC@Tʔ2 YݟV0_xEe5O35yy T ݬƜbK 1W.1^5̓_]:YÑSĎf1xjR.vf0XK`l޾x?Ϫ_v'o0% (&}mBUXt,TxoG:hVΛk݌ IY%{ h^hNmh&[RŌųq]͕ݎNvY']z\[jϽ ^cC_ &:T˰\Bob C )J)D:~([`k84߾ :OWRv5DNe }&MZu1 i"m4ngD@,ȖZ|q6D\yz;0 e9*~1=YVR)kWZr s܄eϡol/& 8&ҕZͧIEq6BlFAfGݯSŎ2aln +]f_]55QeŻ  WB[ZKعO,P9`@F^7Eۍ= OQ,ZH>wAQL3rm zr_*S7wBL%rԁv<=emjT:O Oʜfɱ;HЊ UV(9_p{l ]W D'N#Z6lE0$z+(g=Ŷ$ _21-e?^R DO/I.1.b-vMf4[u8Xfk"ZTGZ†cU“S1Ʊ͍ 2^c[OLq|go?.jN;e2`/+~#@PR8mb+"1UC8<1kWoW׼tPԁe] }I /ݜ|q\=&R]1w;7 (<S<"v~;jI w ZEn!YdFWWz'&QB'\~xxDɻprk ZX7&s^CI{ u#sΠOoq"OގXG J>-ݟ<_d/x>,gH~5K5d:zl#MwzL_%_ N)W{(|E]k^ 8Ϡl%Hˑ~4qJ[BI;~QGg"qˁ\p$G). 1SEƻz +[HIxzW/R2e|o߬',|ZX /ט\QvGsrڌb)ƂÛ^轏<6,V07W;o_UQF=1uMdw[#96!juUqv.x@FĢXq@*!] S $:'%Th3ۋ(/}FmWJRw ~wHX 㘒Z^/g6Ga/vGR&=w!Zt̝ j[N4.(&lp[ 3/h;`VP:[tt]푗!}r\IwZN ,UA5ҿ<Hux*drǧ:+ 5ll_$=ٍfv][܅ɛQ]miΪ[z]8Zڙ_1myb%G*PA^X Jxfr4)y o;y[] #ě|IMrQMcл&eq۠H/5o.gh63_<$J@V,by<31sBYlhي9N7 L+E8& *O"?>^}-G3~YWHo%d 5llᛟ#U-"M^=[*v#R5"j$C@!$-%uS! P,tl`zEsø[D%+Ŋƃ|& ,0wַR6ja 3з5݁P$amėnܕWr, gDZӺԚaI ByfY_m6 Oi}}8K÷h;}}<0hʉ~*8y ؿHdh N "|)R@DX@\>8JvukWw2oÂg)Sfm)^j#Pڸ+r'E]q-hjVݏK4ނhv&lVɞDwpP'T- ՔUiqw7a*Фcyk_sWZWu-Sb>G_H Ar+qK^L[!R. >iEG[a&&)[BRqAam'R--dU58+=ړ|Ȼt5'K"ke 8K/mlKsM쉖|YMb]+ (czбѹ'd&`N:#D'Vb޸F]4KO8%A7\ɈtvdV¤|)Wx ~?X0 8c;؞U͗va B[ňvrk#mw iCo%ZWr ,4N~jq6nŠN>CUH%'ЈnNj3O2 84Y3b\=W s[D썵GtnȸKf*O/yšopE g/ul3qW I 63R _ U1z/%Eٛ30,I3ߡ'wocOCq"LIvx\4@PױL7|YP66he<a=R09o))_6/*țNDRP8'~ۡK8(}Q.%1khiY>+s!Qr@%p)iEdχ$~#,F@=4P'@{X e&gIіyZ2¯Liz3;NFCE """ٹ/~]']dwm=͸XO0հNBc矿^6wKXmBU mȇ w IՈR^m!ƌ;i6ל8v*= 8V4z>Vw 6jșER4YqU@2/_V.T$A,idc }9tsP4r$Wfo(Ju4㴛W)jN ıL p *DШrnHY]ژT ^X>58[v ]/\К# w1 h}DmP^}bs#5ˇתt|NaVૺuZ o͜g9zaPкqp@(^'ӡWi 60UםF]a8yk*Ԩ{tv:aSa*Mqx{55ct8͎<'"qG?'+QmIZBY$$lzb2MIhcϯSwte+FM13d?jrDn.Mĥv u8,# irB9d\ΕLjc t4%yu0 )dT13&n 8e2QݙE^>1US ;kW6??`HȇgLř}(Շ1.=BِILD~/B[:1h}p9^T%N|fق絖36 (qeȧ 5b+' YK3hbVxAsS{A ͘ӡso{]4oWzBoS+n4W^zp"Ibť*SXm46gHNoGPCU[:R7YԶdVܥ>ouiXA5=1qOHDo Eci4%hOc-ąmH=5B¨ kЀrV_z{)ajY d-FP. T[-hgL jrXI-  ׂ;DW K+#r ! ү16V T X8w,6$[g}l'w^MZs DG:{V#'=cw~r,e>Ow~!BRDHTDh]Q?3[ N)Ȭǧ'\ໝOќv䴊ayڠS" k89(*v PCC !y4+>A7gEks9߫"y:"g1ſ<9Dȋ*6Q|~qzҭcϤ20+Vt /a!|Nr g4gڏ&#V$r^#Ѐ>G08 '|3`5$G `H3qZp)*k^n uZ.{ F"/07_$d/: fNfadPC2nrzmV`|Tݞ'nőK |Rc_֙\|B܄u8hO'XDm?p.&L~f_iR^&:1c>h1p^+\.j  .@$;- ]S[ע.A_>U@L.v E2M l.r7m|d[Ӓǻ?0MỰ O(Ft, nַJyaMυ0nQP@hBqJX&]r' ̯/蜏8xދ^BeCb_xCSO{,; $O TP*pBT's= G nb-U~;$Ck.M`"u9u&Uz.ǷPƍ#hԲ)xCQxR=~฽Ҵm'j.T՟xOw蝕^0MS"UOhr| Ro/_ 'XnE"y='~/U޺k7yNGd?y . {;u"wgIz9Ki]{1Km G;F"׮g *J#j*ƒv'9WލmIC=.k GɶQDL}u-P`vmL;kXx+ 2}XϽqY}#L^퍋uy pqgLImTϿP/9Ǽ];ZׄoPDT惴:|݈3+8C(4EwDEydaz.)"#6Dgtj]o%.+/dc%c02+<&("\9ȸL1=EI¦ܩ6ݰI9M]-!H;9s\^뾻r}M"IЂBB>nV7I`J>GYX0*çŘ1"qYrXJVߖLJ })̾)]@ &~_BDcs}fz+ei#("C ce$*Wׂs|!{Ϛ {kx)i/jV$gxF/+9oYwEU䇾 є$;9!We@!A` qM AW'i3Av>L@Eգ@ҩCW_x j9?5Tx44k c_B/ÞnAU;H߅Rul @}F是+j/_睷5rJ9֔42q{xQF=#710A#rMHY˧ϛȬ/l/ =vՃ_q%hA)zS.%c[m̆=PMVx47Y-5vF棱#MUr|;2U"/iz~IP<.(Lr]=j{-a証Ei 4Ӎ7nm.dV!_hqJfƕ0>lu"4OŒ>e{GÕ9e6TQg㶨gs)GnH'>W%_օQ)pFn|vY W^y DC;^G )CT ;3܎Nj @֩5tY 4zYxJOf[~[:yz eؤaA\O.Nziƈ×)vigf($Kї'w|ɷ?n㼌pY]V-'#^=>` Axo_ďdI*Lt;^MjGq'ⴰ`[VT0O;?uҌL(WhN8jX? =2jfk4%ml"jPnmJRjI-bx#dcu”lI(ZLA[)2ŋcah4x`ecAU&bmwwM@VQAV@gmǗџMKl0%Ս ,3G^pL`Jmk;2$hṕIH3Hz zK*Jz-i빒~;l8dozqAђ`(/WUl]a~~__ďX4. jL}=T$WC)DN4pZP3.shVpC-&ёk3)ʟ\le5ֶzʡԱ:#҇Z(ntsIM+uu6Wty#F7٪ +=5rr(=RRe#Ր_ӡPPQ9$CV2s$rHH]PAuzOcc4!6 Z+hF?hGkii)pӂnx[ߠ6M) .M%W!ub6)!ԋRqFl9^19pUR ,hK,vR ?9GL!32 o<{H6+]PؘO&#EW@GFҵ#ZN0|U]fR"Kx%2oDmD|i~y~q\=C)10߬v0ޟ9ar*%vfU&B}=N$qCP>+m ;`Rd&#GrU4)1.GU r>#ܖdl痾Nh)g'*'K&TT-Pt`k@Vu9oBa P-ǪT^OCPiQ.XIⷖ]XgC%76 *NZs/@blH0j*R0K0f:w)gڊ[dW!qJ3--(6twܗD!K.Z :VƯJIO xUU Mq P(hj 6Oft-H<#ڻ- bF~$hqjY(hKS}, ZeHq o*FQ"ۭ{}Yu~Mû>ɜQUmӐ%{G =71t@>dem'R4sy

)B]*};ʦ+FN5'\>Ldd=z]f a*-WRY*YG;tr9g&V'jtYkWP> 6@pw=n8.ebft"̼۫ݲ]L4lKu&uyI\&??IfgpS^JI2t PjH)ރ* 0BG#[ eDB ݸ M|f0n4Sz+9rWM=B H+<]["z\zarq7?:yZkJ{ 3lhuY"'h4 ; Z?TyS!fSjGEV4E_L9<+`צ%>ʬg[TUĬQץ-\9 j[H^M#( ݺA;UsS(ܐ"y4'؉TRccifI7rx431!( /LAo^=f2 DM g5 !W UǷb&ᵘNq0f3BYņ$۶ qn_,|G`n[㛜\ڨP&f]MrT9i਀UHnN[n:[-Ub!:3z(f/0)JC9 Ka6"}k(8DD n ,Հz#&X}c\ Z4ZОa{Q}OORL!QEl$hLh0iuVZ`wYǔƎֻ7@XSCLrDg&$!<*nnu,UqrꀋchUn gyRYÍlӍ$})wRsz=yIݔ1Ea] ZX]5 |/3}P?92ݭ!V7}#>IF{L̛ \:)W$|#@ŋj|/=@61**ּN8Ò/y&s]|)3Zo-~ilxbʙ8nġ<i=XV47%0Ulq4βʛS_n)!=~C $ \YVqHv}DQڒJ>Ă wPD zhOuChQ%<9k'CV%XMMg^? :rYgah}YSgWvTyz\rԱ֥OZ06.4.#0 H:6;d|!8bq{sdSi>WJsZr3d71EUS)J6/[Čڂ \saGZ2~4 {?muLœ>>|&;VC"%Tueh(b&t$1 <$749޷lD[_U#ԸZ!8)Jd 3 ~ /s *'g0L>jv ްX:<Y G%zLLFh6' ZZ2kiB0ye$lwO͊l$m$[hk{"fBsۡТ9bs4%jnU2`Y]ش_Qa)\h{^aR^ͭ`yvl@:o*Y]AUlJ`!>^(/rf#VE>r_Y N8-oe³'$>>BB4W|W+j`rBi ~ >bF`aX_OA4&"ͮILV&>__I{`x2Mا1HPͽZ^[пXAf&8v#4eA;$;mLAg4U1f ql/ᢰL59aHCk lPETRƹl_"2OII+5@t)shb*_uۉԑjx]v$kv|R 3|ϸ @Y%X3 >ax!VU)c"}a*R2ۣK뀺E${>.s|싵AvM颴?<>_%OhWDoc־YD,ŊV'&<66~2D1/DdٶH_*(Tr&)? fb.jT!$o1.wֿ\M;1?ɢYJǓ% .!5Fs˧݉ajb.>Qy2@c޻>(3uvhޗfG3E3e,?&$CT(<"s;UCW@]tTA5kL=[4 ua e(DwyxˍI6*BQ8/ur'X~-fh|ନ?W(*rv;@PO{Fʀa8> &wZF B`zl=SEqkάV4=uvWY6fO>s~ww]ǜ*-5O,7B>(~R d$뷻dd~] U֓&V$ HR^ 6}ѦлX|E\ɐaU9ܪ Js&@p~zG+chO+Ju*W=$ZM,7K٠bJg=:+8M}#_jWRxzkD6a,ݴd6y\G"Yb7-eN--*"OEˍ=Gqb%0-8kݞZ8B,VۮUw=&JQ5LEuC&-BcM8ybe} H}%ݩo|$a/6D(SUnĵ1ݔꍲnl^[:f%L3"qn+Gca2=rrb'TD*|[AQ:/yxUd@PU5lgѝtﴤs\'6_קO0GɖgcI6E7b]*'&zi1E[@㏊v)!yаp{ТǓ) ?+ ,EiQEt RVNc|"4@+8 *t+ Pd^][O`pnI@wd`LነRjb=~ŴP]P[ $0%/oeW6Ş{Aw6焁VɕoPh̗> 1/0 G!h,6.{j~ɖV g~Kѩ("`,5?Zs[3 SR=e.cM5e z(%!̸I!6Jq?l)iY)/$_g_y\ IǫHrK?,-Lm7ym9(Թ82,9 2̦bF\*N4B@/W))xgp~v*Z&`.w//Hbd$Mc nE#L.}SdtuW'yjh!sC/؄4g ,oMO.R*(Yz.Zw)`䬖yNEKfl"Ҟ'-"bʓhWTڝ $Wўf3^&{iZh@Ed"k>+}_l:|O)~~Jmf;gjw"Wy (s[\`J.ۄhz}HghrFD "(cDWk:uԟ}YD= rc-́\ؕ @j ZÍEkiD֣<|Ћ3ƑBgq҉뭬w?Z# MZO ̗_,Mݝٮ/}95Ҥg- 9m%풥fqE/Tt5(ǎ^e:՟ pc[)7J{͝=iXG]H~ 2R/E+hs.ð\~fΕiWְHQP;VtuWDxv!EK9KN|ajtaOXV$hΕ"Sk74s\Mvb'O[֩xʁܘB'QYrU3OR;4 IU^e|cV%^rNUIT%\qxY QioPZ`m]Jɥ-|8{%6J?;J0JS(⃿9'WK{%j e* (G$VI=]y,0dgR5b5:ӏɪZ[q!յ1 46H@MUdHsQSOjw%+ذi\a{aLq*x7)L@'!2~Oނށ:4w\}EBN~)0Sq}5Zg^+Oŀ|5 (hMqWFC0[gUb8+;!:k6-;*y+26̞bA|i^v~-jB众;xu%ҟ\ ӘQѰmik;nף B!!PPuthOhݺ_5bpΛ|h@‡68y~gIE| z|sOF-{WʩI&jtN7?s1. d_'L7Ʋo sxلG'n~]\ bO{/==x+M \v7z防dsiA\#Jzq3 ߫1I4 V4ciaIŪp` 1ε(R ¿.yg8˦[Qiqh);Y*Y6[06LŒƅCݑ=n*+-Zz pVVdVgYJ)N&s=;ȭKBҏr33o芄wJbzd1sw(^<.& ( lo}y9sm2I|$ÖJ&Mgq!`{~עKakE5h.R}'&߀ |7xl'p(neD 0Z3&t>s\k=Kj4i3NfPݏy3}~#r+5KlM'e(48*r~cK  V1?#$s[ IHD3#!f&b2ЀK̜:n.WfȿGl" !JT>vqƒ@.~9P/um%}gF3?-LW!;jq&CwR:Pm:,8 Fr]a%#~3:m>6vq&^,>.;XWm8z֐7k1;A0mmt+: gs*gbS⡞ ̐Ck>]1`5H qT>~u`=V|žq*$xA(JB o>3h 8!MFD6T|3QS/ HY?'uGd+f:ϔ?dd_ ^APMߒx6}l$dҲy\!O# Hb#cMh́]QAlˬY bcAZKx51:(/jMzWD>q'D fLyw?Xz7'd"xC¥%nwr 1۾~xzW]LW \/.8Dr_CtN;NIeZ@;g IL$h/e >`R蹰*YfB,`ޡUqFNST7- bKl{Ck@ 2QmN|y:gf v<R+[7}C#48h3+{Xm^.4A[#hUbwJTSw{Y+oW⍍"k z3Ow&2x_-<sӚ/%j[0;|&ص(@pylH4-s}|15"t.-"bRV) įϱ4ԑߖ%!C*lzwJEK.fI Fu< 2Eů~Mn:#L>~tD?iRt7* 8D8􇰠~U8Be%_ oæѲj3'ld6qغcc5 7D(zssh/Ň[3_eŒOzl}F؆)3y @V d*/^эt{>?fxvbVJ$:WKu4pxG4A@l!,,iPX2!0㚕*PB"  -"5Cv9)}َż7g[x"xf٨jß:""awE ã ^C7f2|s0 cA#4x:/_3N:(/lk1݋dEA~85uz='1tkY:Gpmn_#Y\πU\2܏G| H017Y ) ږ(LQDg="?揦eLMŚ7" 4GM0_h.y6WӍmqgqP; 3ួTa V"Qc 浠Y81{&Caw&wYSA] C i]IٯwO0-4W$`8b\&֡=8yDs4H&ͮp3+N& "=ͮ$𢮬_P_8Jke9}\oK5Nמh0L8;j몬wxTI6fݍE|& %^v%L#gpSEŘsdY/a+IpxaY~Z9f#؆M;kpP+Rbg|ki4庪OVq&։wb]^Smjx/"@'s*46[ge[%2Qxtճv,;Zҫ⇐Ӑ ׈G/b!y}oG-X'C]&Vo<%3K(^g:iԓ&u/[QlD%!8i2ʷh8qz`3#rX"A }c v,%¾&\f#Ԫz-4iA2fcŌeDfieδDJgPQ*DI L R$d΄N*ɘzjގE%G\ebUR}֎ +6+3y,A"'gDk=;tLHafwg382[}0܇Ui+PjƬ}ݴf]l_|ȩa˭PoV3F@O}i /~ @vKBn lY#q6/#Wq:::;*i a29t˜R|4\w Rk+pzC,,6Z9}b0)fn uQ[z>˩2nr+-(_b׋MCAM|Pn"4Gv( ~{?_>[zWċ f'y% Is~5ǎ$P8 ,Ql x.LX;g V \^L|YI1y C*-hRrefAKr>.r HqOb,[ZSþ?籰#ȽY k]6 <3}"h#9Ǎ4BG[n$㛯oiʵluv̪\#P`!ҥ9i+?{yH+P 1AL A΍{ь+4I܊q]drI:_%ҩ3-!hhF`eFŒkn$ N9laL0gtgL&Ua`VW^_~3=;"6Bb^oV@Qxaː;!Þvo}i{ڕseVCXÄFf3d`8"739lQ2ՅW׽!uu] mP,\V&^Uv:QH]Hl[M,hlf?6jfh<^SWnzh-.lP2m0\ v> +9p0Cc.8FgF fKf)CT3~:^@u.l<ι&Uy| S9/WFb` :C#6P-ՆoWK Q (zr3PU(Ԝ?RF9uӛ r#UH {RhYd9z 7Y։n8{r(3|q7N޻u2krTw7ٱ[;iAҐePSJLȃ Z[-{P">1VHǑݥ7VS3|}V\Zf.=Zu&`ޛ˒m3TXypZ`Jr{ەfi 5f>bk؝n4!<5@RȨ lϔehG9D~ϿSA 'ppd%mcBI{ԑ2! [7 X}ZRVDOÀcs6aEu:݋.D5Ac.:ɠ }ˠ@n̪츁]zQlR&b*: lfs]0{ @ j QXkI^Ԍ Գt|degKwGSP!&nZwX׶hTA֏;o^`} ^ﳩ1Wsb= XU"oT 胈/iiPfc{_,&R5:Di1CRD4?|϶eٽ ;<[zT'rz}-8j1eDk3Wa5:3Ao 3̿GNgW<J7㎰#,"a#ؔd,̯p~ 8N. :>BU * )78NSy(0׽ X]G3t9%{ޜ$iJ[Y;2#~'f+!݈ `'GAx^Iu% C@s_(NUM9EuU'!*s2|#Q]`D+&{ z$G ܜnXG4vA%GctTg|PnltF'ܴYs8m+oj pܟ,xTZș#ÝaJiڜ֧?lj]fܫFz0<SF镼FjlX;`4l#˸60[kKFE2)~)PBUT]l±\.^,Dq2iA`-OYPaV]r1(cp{ʴXw2I Z^Z'@.0%BH.:0h{ /X _C^ J-Yi!8hBh19QA \ڙd˿ԽJtF<@fq?/4AW &,^.7o25'V1˴ϙ=j([.<ҭ0Vȕ o6)j#-Zm5:*0|P2A)E#lpJX7DͥꄩZśtAșѵ 81rؽ}Y3Q7YS+w;4Έ.A$qTϜ6 P(X;G'Cd㪝:V& "wNBmAS ώdvCʎgs$К{C\ g%Zܽ܆UUV%n}$\GrSt Q+ה1t;.F/Φ9 Lu)&yag"K  M 8r3hwLb7-2jr'n߱ *J2Rqу3PO}h]v)bva (I0iBrqc?-s4;Y|lʩՆ+heUoߧ(.}B'bk֯@ցo"R./flq.}=$8{vٍS)2'#;w0 `5*~," y1)ucTeEmj 6@rp9 sד!|O:=@1zE兖`Ț \.9{h, mti -n U0I)Pf c4570yW}Y88r dQpp~D6эz0- r}Q*PmC3ױ|2/N 3w*ӛmb[mRxY̫ذ4X L Tq#R -uLa)A $¦ Yt O~U-v=0ҧ򃕕lbc_}6" [Y(n#W2|;km’"F_8seF~ݹi;7W@bFڭqb&CR)F>2!@ |\5,b^c[ָjaѪ㞸8 DL P]oC;UԥeJk2P,nJZ3L{e~n2tCҩJG(AvBNt{Ρ/:4fyn;J*X-K,y>@`mdH$ ^5 c%^2kByVf@=*5yC%}AN{%Ӏz*t!J˾7}a͋MI͵ϑ `uЉTs #b$7.뛂m MDw/{I6AѶec Zb[ؖm mX`aک[tGE *.gy[ !խOm-mᷧ.>>vVCG *UO,1GU؅IFZ4\B`y "~^>@[ݳ}{t[ K%,=UdiZY)P5foǤ/Hy?n6iƓ~7ǯ! ȱ&Y'{_UQܻ->@Laur:~f+#TC4ݙr89"⼒o&xdd7lej.2e{."%tEooJu=eƾOw{\J3;}X$#ʬh!~4\VF@s8jI4m{X\]AM` V/: ƣH~nǨ%8e޿?ksvi\~ ?4AX*7upr =_m+/*k`2Tx/Z%3PͶ:EFO_z꽲? `"E\bAJhջ5MJwd|EaoE36W4F\7.YB2?%!#Nz[Ӌ(ufl̙uX=xG///JC-[vCg:1Mo8cSqW74M~"C8Hsg5G?oQh" XDcesic={OS X$ ]-v@}0s c8X]~#pl˳Ɠך7ڈnnp,)5-KH]&Tcc䗶ͬʾXx ǐ࢚Êt,'~҆$on ?B1 Pg{bqǥyar: GfuR-8.~PJlpςIe+DÄ91Y\fkEs OEټFqgRэOt@ j"N撷,޻Ipni@cs|/{+gM?|2.^Tjn 5 DsDO(xF?W@2 XQ.X<ٱ̎b% zHB?}Q,2A7=^];<VLGz nA3&h 6%(:WpA)R4Gϸ#؎{?1vK.Aqqv]~z7yvy,uUighzeNUż%&'A\IQD Pl36&VR39wjӛ{Ye.rՌj[$*\g1i\cC|V ]iP%+NxjhX~y9Xˎzo4j }D J6a8nƯolcIh2,`m(IV>ފ堖ݐt͍PoۼX.(A3D0( S1p"ì&ӹXk .))N0?a?-0&wt_¥#3IZ \V҃Z'A~_&$?XU2}{BWRE# X)L~8D*W|,.8cVh\ϳJ)xOߧ;rK7A5qMy˅/ӂm:M8ʰ}U;@g\Nk#1NY O9nIڍy 1JwF[=C}\u,ӉwtEOH]Ah/(! ud:VC]Q(|'LCG[nJpMJ"E/7&݅N'9_x]Q(H^UXYN w̒K֯ 1j`1T~b­bM,TWNECF{N2pph_T]MYM2/5+N3kUD0"kT4K/?AmtPϧ ! ྏ*|#37_V"ykd^V.T (4Yt|NP2&qLʃ("W UCI7Pod0PS _-4￶zu6BhLt}ao\x/؏+{Sn[4l\v ?-Y9TJ4M 2:0咰Y;'7\BBSgQ^`w`Xt_ҹL9};"_ќGS5l4'~?0[Cкͧw+`*BOkHrv: ztP7l%X %ѥOv*(a%4Gzts-<02>Xu;L$߆AKCSpߩ[5yd 3:q룼)@/ 1"jS& |y{豼..>\ϰ_ T"+ AwOzD_XV l= `X{\y6O]Ėe9ڟ4 9rfD rn éuOYSENz8I"L"nFXQ`ίX-$,DLiPݛMLߏ:x)w#914]N"mD3+9f͝T`ġyōY7$4)h8wy/arA>䁺Q78vqGY2*T,r ggh>WtBl9Ja !)3v)Y5ڏ!V ؟eC[Ź&MoK/,J Wr4о~""rp!$F|ITeH/r9L|X'mGRb}HPX-+=y4ETxp%;uT;@IjpÎ-kF Bd~F!];B_~Yw_ R7O#|77{K~5Fn-?mC-8Uer\<'Ch60 a^p?;+)oE8OIB]Kģ-s&*à/W/=jVeuR+P1g@ X?g1 bh5uu `w.bXȱ DF/5-i͏C5d'VsI͗I m+]v|PM1tBWbh5~w"8gEYs (I=(sܦc|*BkDY2(`뛅i֙R712 giuͳߌԁ}ĶtWaose̛R<!{AKe9)5GHի~'z"4 O_c.K<44xa0(Poch q@ڷdOfu5ei}RZ 2܀1Hlkxy;!hTY5@c03p ƩD2'LU][T '%mÑxͼxt I҇g?=ZGgd]4qJJ>غѭet50z&[8GUJJǀL^Pᡠ: ^է*-Lcv(w:\YÛ(w {OT3 4$(Ag^o/[AA׫$TG)_b9hcJar$P9TYal4mG2J_WĴjF?|0 CjD RVdObʦu}2&_vkjBHLto &+2~=QX](K0zܾF}!ߗ5" 2cƶؕk^kck=]uYlf6 GQMIn#HV8%m>{%ɇ\/[B.ՉL[.̏h2Ç֚Gy%0~GI%й첍paXWqx4LmC6!Czׯ MAe&7Y}t+\s ]2 OJJ3QI&Qu W‘?آOȥYdWCOHZ/3!kWv'#t[,]CwGׇ?r6+ ZiK ilZJ%2 ^+({2LI`+?OD N1BoEjFaPG^F7G`ć qVg1d2a_GN!BbW]od%%CI 0dR`ajldbc1=NVu\Eobhq (ǡ ;6oNzP3󷂂HʲEBj a60~HvJ*r.Ad1hpHנȐۨCah !v§4:FQyhՖu\ZPٲ<3kON#tۊ1#U6'Ny筯{û)l=Ҡ2*:otU9l+O 8(8 DkʂF`~`|3?]ot 05:7YPE.Jh.`""frҖf߾3sy O"&Z^qǔ񑖳Q _ݭ4>Kzaf4ra%7oL)<TRZĢhThO0*J9J\naCa +SP沈JR#:)&jPߠR򿐅0sJpZUKA?;Aޡ97pB@F=Mb+uwUǙkh YBW~C Y#i;aICf:k2ч<~2y۸w^u͟õNϮgF~؍ilݮ|lZ”)\,U% OC4X'8K^Mmy/UQ: qki~ϼ]^ЋGCЯJB޷}C%RD1 i@/꿎,숺'"Rݩ<G; Vui Ldlg-cQ qvJ4X%꧀V5KYB ^v) ⢉[uB9>>ۂqR ǣpZk()zBV ,p=Jf`,R2sEbهrp{W RdbVM1^lu:\^)%#K[6;&<5*QRI2#AyHhT^V!_5loՇ.0nKZ"MRn/@<,SVX{pXTͦacklw ;K as[=$ q{Rtlw;cKͿ@; |~Wmv~z5"wBб[{dTUKQ2R}kH AuL6OQVݒ]4ܔYy?RtvYgOjҬlg)綕S|]f`IQ1?G[lrfT{˕ Y&6E܏`_ cǚe^3Gt\Y6lU`A9?0>yC\Mŕx{w#V:i@89-O^r;/r{ X&\mvX3,.e@IYuݒdOYfݨb4ɦD!?eAth;UZqΈb3ss.pjf9Z/g_>6ڧ}F%X3˹H_S4vB}Δ!Xc<Ωfk8K :"bvR3YGBp^-f.Zz?;"4,lڛ D_z ,SZo ЌC`YWxCB_A74aHOl03Tq)ic zN[E7`fKN^J*Xc5_k;%ž]EyVk^!3oB \zt$ƞ@P:U@YE׫&(#*8kEN2ZҞCA'/69Cܿ7{/9G<L"a9;#h:ET=0wdXp{=T}HrBMU|09tOoqPƚ*wG>݈t/Ee?ٜG Z6^Y36[_50囘{BAS&i ?iᶇ(Bs܉6B3`%DAjܶB+3ym{ XVwÏ/L#nl4y*PK_ōܘ,O# U֐!;Ԥ1 F[sx%X X'9m\+G@`Y4ǭ4%E!ZꢹrAZslw_c>OCi]Z3V~ML1 g?AaPnC͡QSA H_CO 2cbVTv6W298ypo\a(U!E2&CAm9bxތ$m$[^n q5wE ͰQ_NOCMob#Аl{5^tmke/qFB*pCSz,ViqnJ$mt `1(ThawyLѸrCMYd&|)WS!< JVy)~!랧CTt\3MBߕ d8PD Qf VB̚c(9lk<Ƚ?]0&x庣?~gA W7+ pu;E>"gk,'~ WߴX 4ߥXaGIGx 3)BZ_z= hہ<)1zIVpBvM$o9, 0*yP+H}Ogʎ)A^qF(P -Sƪ9,Z `F rgK FX4KL1pTY afUnP&zCJ.;ڼLJlF EeUSCQʹ,~xBu1c(\M5/E(7\ELr[u};^-#)ٽ%>#WS`B;DW~aϣӍSh|tU%_)/y:8NBs20Vӈհ&)%FWcp~3zLrGȺ ]@pףm4_#)?Wk]:̬dVDU4}-5b|"9pf5! O Ώ$bۚb;l!npD-]Kkj0m-mhi@\0Nyw\@nSF!. dnXj)tӑpx" +%=wzj=)P\K|.fk2[C- aAPwaG"&`+CVU cFu{ wa0<IDYL_ Kn)|o!vYN^o]19uc:07q &يm"e>%{8,((Lw RjyN]t$?Gw+\w9m&{We+tޓΧ('dmվV%| 1T`W,zw-%>as wuF^ON E&> ى) HccCQWqajuuw>\5Dv OA-%飻QNI W4gYV^`+0"7YW9>{ jR^6K p(ׄb_SLdә]z0\Gw. Xr:H\l]OYЦO|\zxC kҥ|iijX}61B-qyE8E-Pmw4?נ(ϒU8^FbXcհˋ^8p:Y\o^i.>uٮCYsBv`z 8\ѯa\%b<As]@ыSTl mZhJfˁCE'jra;¡ev${Z@d" \ tl&=#aWП)\P_rXdqЙg*6Ti>5Nj4fh(h)s1F"/zB" w,BTshĞnqoc!O瀪rvL]=i#72+6&;Em[ɐ[ݻW 0 㺬^lnЬyMt&O땏` al~ kA &ĖR?6`NM:#̧d\l(v+R>dw눌e ʫoeɔ%*lr^wEL6.@}zإVR~>G9 dY΋ی\.U]efM @k%i9q%zM:Bs 1@AXێ1!WBH2"{*X\Y`أoF!y ESȨCPI'/1h[> 7g;y k9xT9=#{Ye{+U^+5Z/xgsZufmLEzQNKF9) K&h|?=\n 98hJh2 IG&}-=.x6ڵCW5~&8C#l*"ֻOjZ,M-LF9LJ!TcV/1pb0 ´WeʽuFhɘQuB|C xXmv#ˀ{o~,3%pPMߗ0f`PNր}$hۉ8nTFAՁW<6@\:k玥 };+[tSz#)X'b>yvXx`8(Cʘ2gxS^c4wrVCy \gh_Iw~h&q#9y14u(2՗M|aP& Hn?xY"CE5)jAzV}\IB܍K1GH@HܙYM~{屷yJPxȮw0{.Rb4^_5rd^^]7 z%r1m Br<[++l~U,':\DI^!5> n'Љ;Eٮ2(QxfD:=GVo|v+ݵa&#VH!)p5k6D-u:?aCI: GXK&$,f9[yBZkh TñzoŖpѬkoRЯKP9ba+nJENM5E9Zxso&zgLV}Td' 3)041;6-6 h.bZLN UkHow>G0INTTřNw!+o<-oP.)ߜ̾0j}2(b h9ߚ `nj a͌I."q\]Nwٟ6&wIR VF߯Y ̾ MƊ *|PW{"t .癹gF*\ m3Y԰%|'mĨ'A6:x<'o MH~`rQ=RA.ƛv)Ő >8 [{3uQ@RČ6M>F!ߋMY22#PJb+j)^c"&)=[{815Ő%E1j (^洄Hl~3Z^:}Dž V[$;*޷<.<<}M.suZ_5B3S t2[ )oDyqR5BlޏE ~%sހ!A':c}-1O|ڍn6x^>؈+duUk# M .ux ߡel \t}X|)&/Ӑ~{anJj&AJ[*)&J5/ʟiM"[9y,`rp:JP쑏ɑ,s6#nvNY&\0䱓r#Y #)?O13(Ƨ-0 X!>>c"u`;f mp^UZý10vk ;f *WAᲶ:_?_ z$zMFAB6>QX֣Dxܞ٪3ER%cS4_OE] eA13dɎ #,:4h L`&7BGo|m4?=pUZhw xǔ¼jW0 Kμej5`X}? d,hB'λU&YOtؤ,Ihl M  lMR-a'?n]c.De|\ ǤR G$uj}I]c6|RQļ*cxFESF[(~!*ϱ5&r9Ҹ3 9> cz+kD =O8Sl6uɃ!MxM04XpZ:FE3n.6mH~) :';+7}i\ZK ؄c?u-<}Q>b]_e>/n IDPph365տ˝3EE4Sz:ja:V'Fko'*XJ]c=\fKUR"Y?w6SaUIrFG >/TA:&p&K-ʡQoW|OFncM[^+«[%yGq580$[̢RC$=w7OHMO56%- vhBI"=U6B['%+M  fh2}͹qx2ZE;NÔv;c!g!%$Wt+* ppEZa&Ÿ Z}Cd=MﱘaM權&̻4Vbw$*t2Ol])b8!2*f1jy7$р!uzg@b>Gr﵍,gyXvP ʼP5/&&%PTz1YmNC~Ӻ1ì\,7=vFe7 w9G[p&$Sğoֽnbra=&2C3?[z]4Y0o=$;ߓäl'g0ۂHP+ {Y8<2qm.! OMEG5?=F63z7~~ >%ᳱG$zvX``۠{p;I/l'4]X/eXÑkIZ585 +=ҽΦ)!ՠ> /j?~@stNz|gʀ“2w@͟g> -˗4QZJhu3Ñ9˔Gć039nu=y#C`,B&t7җIpYEn?AMԷ΍ tf ih(',Z.2EaYm 2s*_H w=d;uWyB*em]Qt7}L3;j=Vsu-e]c=m7$ pR}+`h,jCS!w8l[u<5_NJ3N6Gݡ,%}"4d +A&˛?É,dtu,(;u2H>ԁq-|$38^8߫s>-#*De|L£Ufe%C -A;G?PW'@vL3!O5+a\$աC C_H.2#}FlTRgx٤fTdʆ5nu f43X.O뉯oέ_;0R3^ c)I ڱe$Yq/:1K@Fr 1&N: #/ziLO_og /R³_;g0Q*6+ Uy` *Fc ;h/Ȭ0 q-Y1}QlʫN#䝽I%7w@+&6koG@=A6ICaɯ6>nubtrJK0BS2ej͡ԶRq̪؃Z?RIS1xPkGQ;ptu?a1WsjiO8t@ /P>l/3^ue/$ 7"`},h;eVANpHG½4vY_ ym֗̂lf"t{Gm'eĢl_AIc]gmNtEtmG `JV9&^9iAEf퇓XQpKpts/^IשjF^΍lEsz9w,q.uc-df;-`uOx.W@d0U-nD:hP -:x*ّ0{ IN11,5,s' ԫHhu6D ~7Dr([NA >TfB8L*X bP{-lzS]jeLA]w M>c:1e0G'/]^$$e܆GX (fK*`;~':87Ȭѕ: \?w͘?>{@H 9 ,3 xUȩ1OA6>9)ڪsG~sTie͜1.2ԔCO*x FK݈Tc*.:,K=~Lik5@1o~QsiO0"?y/R@xehT:"[/%#Mrjѓh-U]t/M~X)&} =g S`k^]EзɤYEʔކ#;WT&_% $%s<]% @eoS?_'HnE)2{뻏(]NB[h:3J/Q0büHYhžӕ꼜 bCd>¥ c'maD@3y֎Y[ "C!,BuZD1︐+wK t ='F9 $4k#ѲC+/ZKz=gY SL2B0UMsM"l$6(~9%-wf0jU,\zqO _]'M~k,yRP.#ڐSL3bv_J;&v=ѩ48 !!Z~wRM$ ď3?{72A>33b]Qj@\ F!*ݷ1Ic_t*ohqbU=S%]R?X- }#շ{'\o~Hw z1f0;uYwݭ~H+C7n#m8 :^-}KIvPLS. E _DL]P/E76טnUOb(UQE?}*^4kGΊr,sڼ*[ I3veUطlg6iqu]M~Q(mȚ7o5_שj}:|gN#nA J1/M<4RT땩H\06'vp-XqeM/0ߚzRF \P/o Vo(G-Hkxh(xԚd́1zDXKN}S $t%yYGc#XXRy^SE9Eq )Spk%[/4 )F~pFkAy,W?+a#X-+$1u͚>o98b g=Njؾ΅(&AAmk 5%! TtJ\*Ƶ2ZInƛ.۰;h-_7vƀD4BD/ڃ;K)zuEVYs3uu%!na`W6#6=롟fA>@]P*EmL! (vDVLW:h+-RA䱳!أ32-Km"k{񛄙ê`bJ^L"ōT MQbu{M&)44 VMG'8?hD>8EmHia=j\3лfR`lݑd:)5n23Lo_ū7_@wp BMS=&_!g]{.|kǤ /,sKV%&jw U\].pfF@ù)~#q?lR \D14 y0& ((F=wU|"J|\ssv<tXHu73.5ip+ZP ׬),EvޖD+*#%~,iyQҞVn#ȕZR-}uLFtwWyL /P1 i#С/f,>Z8/c gAMmML*~ :~[>ӄ:hj/:T  qu07- D‰ D3țAmavhUɦԱfF!ms@ s*d2_rB Xm.9||T1/LSE~ya(H֥?H{}ahjLQnPso˻4: &EtFSp1-%< xCeH~@<1|)fWAULF (_s}1;9ݳz8H61[`U~ I4>uNNaA{Y zݠĥYdٲj֣I«3k'"60 y։!.Q$ zmܼ'BӅ5 zocTȓ9w$@<@xHRJ[2T!fE{A 9K4qHW~9Ng6''ej9whpkq/ TX :rx]JF; *xo1}%\DSeV_&6&[<79vUf4&ӇI52zB G)Y:QקPz!ꖫgvw72~$'Ff#Sm U߷n;.zź$wN'|{Zd+.zLQh:Fz',K.Cj1O:FkfkC_zsb3)RsQVcor\_\X0'jJRv1QXK;5C tP R6؎S8Iί@:9&zS(nRT\C@k*<f qǓ:ߡb)NӥE90-/> xH֭G:E@>I ƗR:`g|,R8 #)SD =2BȫLh%s q30PdѭIz9`x\E,.0[ɺ# &8(o_Iubj9cxs9hN*pŬ #jy8>\jTm&1WnrQb$^bv,.;?ќbC.|+U#`!U,>uw\AB`_T&X;44fqP۲_r*H srTJ*OT 7+Hu{ԏ5v=Mz5@a ;)/6 j$y?! xXcMOU1?:BI m& ZVEHH?oƒ~8|+aVY [_ԞLXE8rG7MЗὊIf^/6)kϙ_tg cӒwa4f{T ]9&lI[NG^?s%YG̵m:TJ2R+lH:eX eqzc'W ݴ{'kW;04tkgB$sUXmAr=*qdZk҃+ mKM"|s 8\'Ұ\[}N#Z6A+U1! l˻sq M)C<%C_Au,:uB>ၚbanL`GV爛FX;-FTaxO&Cgʉo!TsUˋњ@8tGL!uE7#33Ȇe -WEօ0W)Ի$N]@XjW$;}uĊXVt ޶VO-$eP V^mצ!SǬ12g$[i"r$zQg87( aNEۺY$jN4a!P^0UͺM%[bC@Ҫa=s1DžBXE˹yѵ}#G<7f|Sɝn5L'nB3ZtHWyIu@ejOvpCjnnUj{af*w1#`Jp"͛lʁj_]~kyhZ29h(! h332F&a!Kcx8fJe,|:^^0yeE^3Ci~rNKfD4_ rEmA|+^ t_QU/wF<5*UoJEc#"Er'R 2$!~pp7YUd^%QfM:vnd[TPZ' =y[|ʥ|B^*՟zT$)D~8Z$?a'ڀ'vviTWM/ҋ]6#*ț#zʰA b=7i"E0NUr9=P泡pNkFX2W)}hi WPxܙ@Ls'+T򚘫)ʠ@?W/ĥlѐUѷ/6 Xw9h;I y9[n3޵+u>vZjjWV3n7pN.jkXGR p<'=N02)KؿiI'q݆mE5! ߙ}[dOmwNwtsHz!ԋY#ŰAe$q pZIXq/i}DǤ+ _G ˭Hb@%21-##kYt#(1ɓ/[pMFP U;ݺLHrl\g 27AАo voG/+~T@8?1Ea7#QEn4L3d$- {{KDTiVJzV4:߁.Fd=(%K{!/_MD鵮ؙ ~jRw1I!/wzҽ"ze+;_5KTJ)u\VRzsZ0eΡ#$xţA*yDT0PوIj]Ѣ?_P 乇eKfE5t*es ̹!(18`8;OReRVrǐW|>-N-oqeUoZT9V$>Œ'C3FeŸt6dRź[$>0!G" (^HSM"K6D)ԭf")ԣB/k_00FU OIh%S22KFQ~gsYNޱh,Kś/1vJKkf >otbKݰR)xAĽLұC,|j_UlaM/˸fFSt~ҐEX4Z` 9jAO!F%l*z8|YCC$z"Y5P Jy8gY.FSfdK:It/-P| /#LPVSbو,?mɃse1 so;3b7`'@s/!?<ʧ3*3hTciUn/6֡PJu`t[,3Rճ07줣 i[qJ ,žCk2mWfG0w~ z:oBQB[/t%2eU(. :&$3d1J{:*bb %쵟Ϋt<4C,;fpdݳK*% qV'=|PUTCf qH 3N?mrW C3LYiD ܫJ&<Clvze,1$; ,zY+3꥓tqq(odڗxGN^Alv1̼C\ھΉK u)YIT{t3hSfେ>M`KW'YwvǨ=SUv<É;6nMGѓ6 Fyk8}O(v(=L^,&Yy?v"旊r&3IpM[Jҋ}M -[?ޱP/GXY6py=v^&HN x&NFЗPP9H ĀNm@bՠ"?ErUaX\B`^p`yOaPx(ٶ{rEe13'Ed8NV6 ڍ-UfdntrVN(`Q5 P*3S8eэ\z>҂^Mm%sjd'nV= [-Q$WģgmY} 0cymN6H}$(\7I2pSt6q]&[+'$.qR w-q؛Td 7T״>,5ݱO" >7b݋1)g[,C0h^|A6 )!خ~YKl@miK-k%+NF׊>i2]@,\ ˆ98TɘMNl^_#sp](oMCQ14_~YMFV>2G>t}ǟ ZIovMk׀܋] ^Z*_- 0[GQ;˃e@Hӷԃ[mg" O׸G(фe&݄Rl٘aXFE4Cm܍Z9oWKY]ܘvQDI !¼3V7u4T.SrGn~%a;Պ%cb[lZ+B:?nٚf,a yh. oo lSUVOU'}iҭǜ1OB@P:k$zj?ɷ<(.nvXPSrkrRZDDb)񧴦?-Tp{".*R+I "znxd:~{h' hTْhZ!`wTz[QTFl99*$f9wL:8_URLX `w'}I h)~`oj>9~R,X^p]h$p6e8'lX{KALdYfRb,-)b՜\0^M"~eO.ZcjT` mFg(87.6)pWBV`dP%v53^G_)_j6ač( @ս8dʷys/5E 5@~ZqaL+5ݺ7Ota$x&G@(VdЮzfi* լtij&q=)kL҄lRU@V‘詽# ܽɍHBhү 6/ppR_mk)<[l3D9w:K.Qd4@\ SYM# gԤ|r6` L oQ%ɹ/?>^Sµ{yƆ7j⣤7!Ta<>KxCr?3T^emXdrTdd-<5b=j3d&qh_/`"P5j;>Xb|  UŠ]ϼ_4*K\ܣ7Ђr_5>ᓂ!EuPxoCs:.$mJŸ[†! &X1]u^򀂦!\H|#@s:ogBSLKCv3 kAJw}n6qt"[~Tj)wh,ﲊ1rxǂ#`@WŻbsq:Lska|"A!8<՜D?Z~RB_Z'J.R%~.Q?8RDĺƺ͢zT@ (y"ˋ,X]uN׊픻2Tʵ$$"V)toR^Mfb:>VNZ~mW;Vǯ̲+;mM)˛3}(0 Q5;[@Y+52, hzI[ҥ3 hƉn;R- Y$Lw`iSK޳Fop%"cOQU(Z#k@~Q"TLSJO8TBœpT@WH 0#5v@;>uͽʢSOu͛̽ZEθlAzsFX2md#Y1{nQA.D^#~\hf|ڻC!q:hgc{`8뎌QǦA OvEd6[@@c8ESyN_v>rη!aK׭x4GGU]&PaK)H<~HeIqAo*VX$ݸʘǙZ19.v܀/Q@CLbѦ9^i%? ,1Lx=;$lHO7Ǜ*:GZGoq5ܪ"øW<܇rb18t6fɇMEljL>bY`%bSvȃh(4:bB8L|go-Rڥ$# b{Gn$ '2O\24ͱ kUVD +qvG#aACv Ȗ)tfe\yl[IcaCJ#=IkDrb+-JIV54̈́ߜ$;N r,'.HJeL>1i=^,tiu\-gl:~`rC^ at=gxAh:Kя 7)N/ՏZ.gIrU"]h'u* V f#*31A2yYhf6cKWl<0|)1"$20 ''L GA_59K]&ڢVw[GߦJ? Ne+rTݣNCA@ ^ aU/c(;<LX8I$Cw9^Iij a`1$Sv#(f#eNE@ xhl sw"h\qlm ^X4K祲&hrqwZ/$r뿜Iy g'wygi$B6pb}n^'@ؖsEQXz^{Z)eK彟o@Au}ĨI:2v ;#g+S@EZ }}*t<_xX868[6` ~Dr'tM0૊2 l1B'-RPㅶPFM7aSYsNN }rw:*yǸ< mrxG~B5CSNeijqV;*Sw9>>NT}! }Ox׹Akݣ[W +WZݯ/&&.1餢1qmf|љ^~ jXbfgЏhV+aYNHcE6G>TKs?'T lEN57`wPI \=ME䳓95CJ!N-!=DO[tب*n  ?nh;SS´ v Xݹxg.h6PW2lP;'kGCQT ߸OK\Lځf,Uac*!{yjb(Dm'ɉa3JDz5x9 {wA 2-zr 3څp;(Zu2,F m%Ԟ-G[ϰYq)LLJOeR$k9Ñ]Ĥ솮,l }I%4).5rG,`*kH 'n27t2X' ] 숯9_e$ ETу U`^i2vĖD(B)P'Mh &9 Tf0&DMMŐRd @膖z dM|M=EUd zto' k r,Q|%.'*drGt[.GAUf)MW QغÚ| ,l_g v&k-)mb_Xl%]&3dDh8韮@^upLP$DEtӧ`6: }Us.GZbT?a_DF1zP#wu ^0Jur.Ѹ^ ыcCvu?&3V6)ƦI{ykuwt!>.ydX\3''hժ7ǞKzB\u{`ˠ:&uH<^_8h/q,~ 6${9`ȘXu}fSnL2Il7@w FA1> o0eB(VU{ 4X6%ŻńK"Tޤ-aa;%v pbj:Ѐ?<YR^u+)JA@.9Њ˭\or"p"_V5V@ퟛ@XA2s %:f70Nѷ4pT]g!$^u/W,臞B]4*~ vj)Ghi{6ݢ_^L7:frPxptq<\1G.I]Om`yR|4[̇y߮`S趷v!1X/īvOnFCM,f%s&3YK1V6q@Ie:tGb0!lwqȇp*&W<7ߐa,@Vo{}?4WQS/tpZa}Q*lu<1gu~uUP,M]5Q\g D )"ϨMޑ(m͆4 }|Kb8I7~]4Ӹ_n[4R#ӫ^2+ (JškusiN%e OVX4wRk:D-F{ XͶbH_Yӑbr"vL*( YQ\zY3kP`82!d|h::kTÂ5q#x˶D6^א1ķf`VD^H)ۙ"ȇ~m{h)0qv-eCVb0qY*`+V\fV|Lhu$cfF5-!g}=Rm=rT*n7J9(*2ĥat;~cwzjJXrR@4^6?kkiq-vުů ź3E{9o1>`!Mg~ՐlNX &֘q5PA꠴q\Nh;D=%lOX㎉ϙRJjLH_`xR_w02Cm^ c]}45GHDP~p`$ +_f~ZD*)VV~nhRvGZOW}nRTuЛhE'U{Ҁ j`wL*˂\yɶB+-b)zM}޵6$cwA>]!VXwmȝ08T*>J>੄4N23 CۿAODFmNykϗa,x,Q/ta&'05{֪") D{K*zeT3CW>! pY43%ۛY] ?l(c#Ji*XQڠuaeFcG ƮWP"w u|7C[[ש2O^dF `t Nl~4kۘ6lrW璀EokdxP.Zf1xb! (ϣdzBD9 jr-j`|@êSl{3_/W;O@]afpjSzJPһ|)R0B<x[YPࢫӤv_ʢXr!/I!:bi$v5)k0ph[SgBN$LЮ4 w ,=P "΁6&Pn0L/49kx_{e"FϥL(+@E= &bڛw?9O!1*xR9hH^c\a6w%E)6Nn֌ۢM}Tqjŝ ]l I?d*DӞR"HsUl smBKJPѥ)v⭠gHL pSɯg$٭r6[`(cKR]I+ ݸU3-޴3z)h}Ϻj|w.m-y䪆A~G8L-U"N- 0xY)FI\5*X`CDO'mi$\ K|B"7mR>ݥ>߻»8r$hUXM4x9l&z\MǃI})LLÉcLJԁ΋.k Wi[ɜGZZGz;1vN,~bBù@ΤY[{3Y w\ k!Ei2 :qg@ױhEd 4a:s+6?d *ÈqhIu7^寘ɩnOH߇Dlrfk54M>fedQ Pڍ_#dG%dƎI{5a#@0Vț=,?ENoMD.+ٟz=9pCg>گNeo^+:u̴Uu$z j&'v%G):q}b0#S={8d2RΚͬ*Ӕ>8)٬*CX׾^ۢD'NLxv=1;;h |1Ϗpj5P(l_'iA` @ҿ߼]y11$T凅*CnN˩sa}.(;gk L(7bW.'b;(Dng'/3[LpSJh+YmeV K%0Otc,!ODp2!h%\*ى8Qs6mqBR=NdpJ$7ul YTk#{%4uǤ0:! ~9E`dE? |>o]P@62P>L{0ȳ'ډ*A9!$1hŌFRV7=Ud 8 (Ճ:wERoA["d"#S-ݲ%У/rXqHmQ@)c=pEab Q"(,ѥ vL f7kZjN_>Fױ#ݪ3^qus/yL_R@-‰!; @&#TDԀWzrW*F#)⨢D+RղtW:#o^&u{5kN^@g'&?}B6h+joXX@t$F.~^Jf( Ag]OQ"fJ%VB Wta3>VC]6bڹXs@yݴawr?QԚjAe(y X5sl~:wym.& BtwH.K{,Jh)ah7MQËEI4Aq# ]|]k9枧`E͢H3MLX<NeI9 +VTA(=!q$J7|Cy)MĺRJg02xz)D| kE(H 4WH߅KmEijM[5DB>L ߂GuQ:"K )ML х Gb!_g`sDb6~E5?u2#rSEH_y->N~Eh?uVuU}2ɋZ v3( 9Z 5SRQfGqVVA|b ɦSdy1<^~<-/(PPk@rS9~A?飷AFK(pg750o^Fzw`-͢I´ZcFB+I+XgQym`-`#Ʉ_>c3t_xw r5PQqj󣷑%ztރ9OXNy$VF֘ 5*mӤ-J(AaDfiJÍHo'blG/Ny teMڇxG6@vo4g^zdz/.j(rG`C'>#e;\G CS*tlʤz!!Zf-i\oa-ٜ sD+1~F")m{87dheRh^G4Ԉ }XpZfm]7MJ,zɌiZ [ه͆-|ˣvoq}01(}:Ű2Z^sY?{*F$C?\No" <\Lʄ0_V|́ۖF;bx}ד"-OgZHË:ؓAu\_n[lrj u,>2B!a%I$g~J2cVa~gRpb))RV֌^72PGUɬ4YFlAqHmf#)A /)ųG.I8;؉T{Vگb;8`4ŌA2m$DKv (- HaT 2M6D!$YVpjEq9f4GoE`/3rxpUi^MWĕ08Rx}(5> R$CW1)5"]78`Ҵ Ţٴ=i1S9cPz.ehnQt]sPvxB]i>a(qu/ 0CKd'L(Uv= ݽWWEiCaG-ޫ.5Qc$WUsKj)^^/ƪȃ冦`]tC|F)Y%DRP ORB@p쉔oG7A~< C;:WOW (<ٿ1BD6B,$MA2]t= a%X1wGGZ=zCp]YC-MCqJ[\);N( KeNtD`Du2jbf)5D`d,3GFK̳,d0j=bΦd>pr*M5OZQACˏw6C=>;c2Y6:JG@Coe,b ;??in#ߴp< qq'VFSkBKvhpzj.L -%$&Z\uweJ&Xr/Q~bSLf˯, 0 l)# 1^4:#YryW$ǠEKg C6Bs Ob9vbó)U32u,EDɔ2Q'_q1K(Y? ۟1 Iӄ,ea^Uwgdg]ڠ|5jkoC^2"abAy k -'ґ |p=>iu5(ۤ+CZȸ$t\&cC擲D!ۘ,~uu13ڻk22"o偏ۀۺKIf67m\A *$s +i(Ll\:BSfor">ք K<6A7i@WXǚAD3F4ZR= vG7=Z(U#|D"E檷p< VVw!qykO*e ~WX$AcIjd+V_UP w2ҨP{5)G^qP2Oq+gVtnӊ#n&vuA:;L1>f/g-ŇӦFL=3DO۠5n^ݣ?4EeSlsBZ>?r ^{^UghJݴsL{V!A<RG,@B7T'JUSɺ `x?!P\4qr~a?~@KJ]0;lH4b9V8 D禰? ks@룰tq?276V1YX2rSU/8G0CW49nn, H.!91L{Xg$~Z.JOA \gTf H3$գW^YȦ)4RPWxBP?.xKJm!x{~ƧDx#:F4q[a7ZKE7.u\u6BC4VG뎫ͨ oɎV)`rϹ_~z)C!QXP`IsvW~8n$H+7Q: [CH0l]({aTeOnؔd(Š4I6C| JzGB%s,4b֔iz 3YŤUx. {\y2A2>?P7qi:f&7;m ;LWGVǭ b8l\7 K'uGgr%G&}*_^њrI LWd,\tDVgJ͠:' _"&`*rںߗ:~gR(ƴ%d>Ÿ ?%UF|USA:pMN$` |2D5N3/\Dg/Bс;eraĄ7q/mt%%^:{lHH6y m.vt^@wfUd0?i*p0&Fo!vcG~ J-BTAE1qRrB{!W 讲XD-9"Yid>{\҄{{2D:H}'Bt>~ڻUvҴP&ΠGυT"Ko<#3.(y&`k^Tn;ތw'Y#a/a7 gɀfYX9ZTCψ@+]Ab%9+ 2s*ņI`r ݛaDi$$Ϗ"%7HbЮznpCP{}ty!/7C9D"Pj+9<}VAPL7dCяC:XhNџiN o֔~ Cɱ{RzkK P(& R Ň>0 YZplm/data/Parity.rda0000644000176200001440000016334014124132276013724 0ustar liggesuserswT6* 9 EtKE1+*`FDf s"g,Y`Be{ƪv;{=G/==]u{hlW.9`Br̟"B `fGϚ ,10o >~ {OD__^/ĿK%?~{Od_ܿ?_~V?~+l?uWXsՖeO[?W^aٵ6?7`~mNkVs sUyA띡>agO3 Jm9@ RH D!rD%r<L"9șD"RHu"g9ȹD#r> \H""ȥD+2r/' rkc r$ǫ*rI5jr!kZr#zro Fro"ǛfrIO#y-r^"緐[-r^&ymr^!uyr~+9Jo%uy]r^%緑m6r~;9No'w;r~~L#?#"G"?!g??#?#~$~C$9~G"G?I?Hr+?!2g?Dg?fr~$~$Hrg?Dg??!g??#?#~$~utE.Xr~VR[+`!]{:,7=tĽn1dA%nPL6 7,,v4Y*Y&i\{q娧 މ^Jy]7J̈́p''i]Vظ5&D!\uMI;-\=&v\)gZ<~>\!yXv[qk_͞|"ם{l0m\S6x>6Ֆ𗸼kⲅsMCK9+M*^8-MR<\&'=¯U\c$ 3:PhN㎴A8iơ7qbyA}/t~ßjq2”" dw8|S1~%_wO2g+ؿ{1ȽrR&ل_xns*tK8lIطBʅe+ٗWb'pď_ϴaSob/w߷J%f o/H!p%wXպqO4c{ͅ$㯪8Ar9^u`|1Xl!{$Z0'qNpER9~Ҳ\?X|aY=jy .a!{SVn!Y*#lÍC+L?@L5g m[ATߎːQ|g]†=Tw#hL8yJlV0hu _(v gz7C"rz6NBgok64+nMM MJG"?hhʱ1@òTAÓސ7ݯPkwCEwaB}R)X|:z٥(-^ IWbZCT֮ͩPeϨ_Z>ςrDqf(0rhkfu 2*g YIkYBƼ?_f1逰tium15Mi*od@ǚ"CH"#DLYW 4d˓_U@rB?&vR&4Y'9;/ nS4#Bt 1̦H?v}m-z 1$<|fl< >"N j*Xmaޜth^uބߐ[<)*F., w҂pbӮ@FąFx(x\ubݛj|y!3Ae\54 PxGw۩ mi3wWy-{P'kF^WN:[v@rش?!eBHjdoGS!LدZi;w"d4V$Tz$@̌ oY)Jps׍6^] ݟJ-1VeD|[\ A㢝[dG.ڲEF^=l EEþ?āsw:-!Sy࡮9]~9\8)"jhKrKXUB.yZl .ԁLanM\[cqIo ָx\Qfu)(\2Ftal=֪|vҭv7\V؇3qS\B\xiC8㼬9Geq/ZppJE8岖b"c 8͔3tꂿ'=isqrSϏ &͞7p`+8~;8`kKqRM8Iן┫ Fb[3pܳg,lV}X^5Ɩc+K#ww鵋8/Y'{VݺvN>3tvus4C58^M)P1+}r2=l e]Z{XpTLP׏Qݼbevo \5;pv6q;*Nܽl̩89=fjQ89׊i rqvRFNNdiyV73 pzT8}t#I8sfq֕z8hfk8pO|Nr{QoFx) eJVH/!6jT'c%u8hu]\j~OfM?jloz`uQb^x2sR*80|ʚxVzlTGǒ܉chOUN/}Ѳ{^yg`82#P{<./Zv ǝĻ?zOwc^ɘYkO_i;d6y{<8wxɷ-τ5#G Gq ږ'Jr<R2 {n,{ &>VtOYۍ^ 2KoC†aCȾuRQFgwg~x 3^i.Y 6[ٞ#秀UË׭1gAl8Sv<.*;˞''U/ڌ+4ń!ZiAƖ|~ﯷﶄl rSd a#(+i?k|sX 1N5|ԃޒhIiؤ 5 \z%'@ߒsXt4Dx7ҡy]v#Ojέ"jGΞ.C똽/7BIdzoA>A[ g(9mb߯-eAn}uz07(Txq\Q?;R[eƧ<ۗv |EVFԿp_0quoСLcs9 e/'AH_!̘/A_y{ѧrr,  T*/j U}5.k`%̯ze++d/L.0W> gp❍˷,S{2d=9Y ɣӧqէXy5> 㦵TbS<>:7B-T~n6*UX ١ ϊK@~,S!gOǡZ_ N9A!NA &y?\~ΰh TCISxU`W29*]N 갫ôO-qbQ8IĬ.8jr-ʶ©1ֺqҊw.Iq;gnU8+m}8O8#`8U}n,wu5xx*_H[ Y^ݐc^ߔ͖7A啼 shZo zvJK/o{P Duft;KWjg҂f1F1ryIe%ﰸw 4%'W_5'L7b-Bɽ1gCQ{8Ec*ff6A^%%ՐPD _9Zv3EZ}#fNE/hӱ%re PS sAz9W_ZlH}) Cl~1hG}aR [2 R'j~LX n;ARsΦy.>ssŖ=BB3/eABcC R8ǝ:!M`ɺZkvsU?6݋_:_s{FéKe;ȡ~> Mrր*]&R\䧟dCY-[U0KrM^>=lؗRG.Ui* >Nh2^Sexo'daۉZӷhW~rh 4i 2BN)|]ߎWmL_Ymh;C__]w&bbwAsW:(ѱz#)k a@aEoP<_M-=q-;GAC 'su>JGfy g2[~cV([Uy Tf+a%#Cn@bQ@ݪV "n^h̕#ŊKK꓎+zjCe_׆@Mr4mw/~F| veoq)kôP/2N㸕6u8J:'B]CV}P4wݵ1k|H_sN(|dTF=} u7:C /` e⥪ k@Mc!G{}ed,+Sm8ӔCuBѩ @v}pu*q^n5p> [N"tnҝ< ^7G"$' ,+́k91UU Hˇc&΀UiݐjA9]O _* mF],ϼRl2ǎkQMW_"uH{CLX щXCg_RX`&HEW+S" vZh^y|ߪ"ZͷcK,-_"j8 On ֋<_Ӥ=Eq"_oK}< g|VTs9LyƯ\.oS3TbQ6;'TOJ-L{SSNs!q)!j|KrcP~,|%bÆfiCќCx!2c%< cFV&H9O/}WC~z}mb˗k9Q$=%])Jl^3|7\Vs᭷~5y?lN\ytF36-^}D"%$L]9Ke > &fVx u,G ) ;.L1,w"|\[]{(^:ydOs; .c faןų7Ldvƪg֞ \jArP={ee:r3 BCDMLjyӼTyiY]KJ;kh*};T3t9[w+Cr̛ pw6'7ͯSN\;:n!njW'n^R^f)xKqDXŝap=oYK.n L0x[37e 0*pL7oF/7+؞-?\r~/-!S[ qˎ"qr ZdMVܚ}znR/W[7 7[jopFn[L\sK6|n961\8rw)ՙkN5~ShGH42 !}5.lr0$:$|߸q}o0c?Ajf/K{1~^G: >dӭTG FXH<ְ8vɝO?rQ8ȂzfێLpA+^B8ɓUq·L_pUՃex[ᬋz)E%p0Z26jn qJwx_W9dpO⢵ڝ-ppbCˤ0˧6G|*y"U{p %v\T4ZF.TY.V^`]8ncVCg8~NסT]d]pںh}y虇m OSƫďϧ?ހ ڙ3f{`9_O%Cjo ݇C&%Iۛw#3oA!,Vކa~nOo΂%_.Jڴ򢕩P):F(Dž@וvAw-+ aĄ 9_^4nE7ΟB}=k\xtfj} _y9='k}˧guh=zxj%>UZ;t] ާ~ٵu|`{ >mk~A?3ލʅ_lEwB)}o@bҸUS ǎ!tSӒkoBgśgC-8{f(:=~:DƨyWgIБ Ti $OVS3oOђzwء3h94֫rQq[ xe\8E/, 7ǯP!5uԘ'` E΃7DxzAE]\AmƌzHD.(.0BثJ^ωj mPsgN TϱP#Ûz5CKvZ̢:kN;ɼ$5Q(_x+Ë(}ϷL2Q ^S׻CAox+k!e%5Tm_^*$l :qUN;=8 &CflO;X@#ahwMp]N ޓxCԋ"]$ 59rYH+ϿWEm/=\gGZb v.F CS%Z_x}j / 'GCan7PwƮF8$4(Z%)26uC94lj jS'~ UeJۡF7&484Zf_w@Ѓ[wCC- F›-UW 1Qj;Z58Ωf7\;έe'4ysUS(v<(QU<CK\ yIۡpŇ߾IBΔZ_<:.d̼`yõ@{ۢנR|hj=,oX5Y#rϽ_-7C嶇Cg{AОRwOAΑ"4x~YY ܰV'H Z6t02>{% wM{F;ыSϲSr: ,]>$.lB@w'-%r7n2՚urwP4mKۣ C3uXٛX`\ub^V\v"~Rl+WW\QsX\)xQ)75irWJ}uӏẬxƞOcb}nM"kq/pU֗Jv7Myzku*Ukʻc߫7㊳ mJ'T^ˆ;W>9CaM.%WhS_?;LsƁG/o"MfZizߟZW-/CEo}_i+ '^UEy="Pn;$$~{0dVs;pmaqȉ4d=r1ڼқNﻗ@WGW^ }ß  `ߏ-:X=r{53@pp tֻ*M ~o&_LOV"!z4 K iAŮͻ!ulQxqԛߧvkvs$U]T)kY,/@N)l{d\8^ ^~!>`7158</L8!do=.Aj_s`ȀݡQW>Ktֹ)i>f=ӖἑO'Jy*N8gvҝ;BpMᬣ~ .4śPjB.jßpeNMJ/=BpL2?ݽj$ϯ8tW8$,Sޗ}oGBN HT2scl{.zc^2/o,ЂM<Nr PV0? &"bd9 R?$2MtGb׏TVQj3 Rɏ!t%+!KFc=p^iqaϬ\1_k}ھ|db-@c;!~-..y#2 Ն }{<٨"B;帎ߝ~w( t/ xo %GlEG[1?~zBT:D!EH412U/YAY[!5erC!i~B>BXcW1q0c6mqg+>zQyX?SH]߾|i795Y0'78KrS`RիIAg yp9/<+Z<җ5zUAǾEn>aQ~(Wo;k/ s~#'. \<:8qZP\h;b>.]0I7  \%9v;9g:8Nwy@S12 8DD.Q4yͯ9!qz1qBȮq~psCWZc+.q72RBq"_t_ ݆9-{ŻkwEsCp}o~sq}͆ب85\g[M\}i \$;sc4.<)N :8j0_DrRp"iJ Ꭿ]tb.,y6T |DgךA*M!{A5J)e,-3񆼣F* !y擻[WCXd[MS\0iLJ$~*nF2vRdǀ8.r'=ZL}#:pfء6̵盓 qb 'D{4:[x8%|a8gu}ӯ8 ?E)B?EYlˣpvL)8w}7NILqhA*&Iy~q)~g+\4>oZq'}k.. bTkԳ:|Alʵu[%!rv]՗ 0or.&5Wo>,Y p6۸/~bffU6)kX=|4Vqv-͹о˳~.6)JxձQޝ[  6j ӡmOG?mÏgү;I=Mvn $hYzZ4(yoV>hG@mt͇l8(P7KPs!N]aa8ZT JoP'R`3_ ʕ̆zG&C@ןC&WjаI|N)7&qMȼf8ʀC9@Csa4t.teTrn$h~:]Ь|o;>> xa/Ĥ_w' =~߫Nl2(D|BA}}&XS"(i=,~#]9PsCuBi5;B\ǟwk@Fa}(r޿P[:bWV s61*\r^e(QU5xi;[nbHHܣ^5PSݨ9Jnf rǍCEϠZP4nQȼ3w5;nz \7yBZmcwA΍mgJ 3XsM$lZl ˶XRM>Y>n'2<|{KlC6 g/Mʇci3SrjViB!AAò3M`d]P`st˦B(ם$2 \lN_4w'ӆ5w7VOo;ɲqw}WC\-,GoE\Zp:fc*2h~f \@Pl:~κ879a45G/y#v}tfbozmzx8񓩗< GA 2p`.\:L:bo}!.aڨ\]6RG D{WڪqَV\vWr3dA6._;t_xG>gX&G_,?Gڷ[@{l$HV&5ؖ9`<T Fd N)4Cԇk3F:CZ1PpsPcsm=x%*9z# iO$:y쐈b9>z{be||9k(qz"*>a@#q1]5a8.o;qؕ R8$3cGK / 'vⳇX;օߵߍ_tc3eڳ/El~ڎap3ylt6N0Nյ%8sRܗO7D 1GxWxmxw[Qj x/Rmo!*(__r ~k@tުp!t6l*:q"6 ivSDS4Om<~Rz1po8`' 1#R HtZ^mR~Şç)d3T_z8U+d&Wc=utH,N댨\$8-Ii-"9>ޫݒl$} A6$.ޙ$pUK#Ivys'$Y?I-8F#"Y߽T uШj X$Z7јO iמcjH}"Y @2d猸dyaHd^"G.=[d_+d9Hi#~HNs}ss$gift](S Cri'ݿجu@w3WM8cŭ6!(#q6iy!nueG_.>b:\mrd\i28Kٳ8Y1cuQsN; NCy}Tsy(:qtMQD\ʵ",I.qiGuG"׻7͠%zL4O*?V"nƟ/v]o[ qWC &5xXxC=? u7ߍx#u'AIzW"97{ V|o24>I.8Zx [R4[Y7Q4~ތx[-*Axr ;֦THw+O-EjC_G!axq"zT;tc'!=^b4>Y]q3e/FٛݍN"B!UI޹3wo25kWICݣV؅^[Bbȿسa~{b嫈k|xI5Ϻ|jmK}wyyg*V KOV}y׸p_ 0}_Q qSnz%YsKS%V vmvrp#G,ZOagmf:>4DT0lhc 4F< Q DĻph>ݙw| wwsJiyxp~]#T7ۓ:+-#y;~/2I_[Үd.fjڳ& 茳̋qi&\$Yx$ߜ7 ܻ]kl U!وO-$dleoEZU܈9Z đܼÓ"u§*xӑ&<$wd 9KnHOlH?jV$\jh>]ArsՔ0v3ط6t f=dq%﹨8cVʧ寈|UƂ=iFyΈ swZ#8V~f칿@%SĕS?FqU^JĝYbqWmSyq߶qgk1zwxwBxK/ĵ``+۩\6Cqyx'} ti>ub!}t-}4c_^PM0u捳Gkxu['򕹎G~ov7fK|!ndJM~2r~2⾞b]< q\MYwDxdpFTlԌ׼GDI!iw}۟#Cm۾ޜe.VDiGn8E!ѽ }4)Zs NՁgQ<Z:N"NgaG%}=JqmH1)ĕYq)fpٕc9;M1zq+λ9&å)}L؄w ՛{7Q>&.ʩ>*GS.0viQoa&V݃vHA\ܾ_ny7:ህl~b'BR_Ϛ{r`VǼt!um#֯" ՞N@g,08Lmh_#s<-rT0c&FR-b[?'k"T 2ݗ{6 >lk;i=k`9:cO236i# xݛi^Rs&ʛrY$ coVm\x?z1vӄBĻwO X&bVuBL>m \G2Ia}mHB ݡuH"cP_$96'I$: IV@Rn}WӍVK}Y]rةI\f!$Z>kG$=vD$};7q]o?IGK$"ϷP-F2*F#k{ ^!s-L{Mm7AM )瑬jڧEˑA\HxY;$۫oi$OcL]ؓH. ]P\xq$^}ė޵ F"pqv5޾/-F >S'<⸫ 0CP"75Ks:BΔ"N}SL;1> qd.5 f\эu;ȡ0ĝwc .+<q5K˪kOdں^E6=T޵QoD| M+)w錝S$9I盘=5.,fŵ0vE"ty}:XbHv%B\.V[>se"f' [Q܆mBAN([-ocq7֞:{5+cL_;{;1^x׾7hsƎ6I,A!%{5HR cGcfz-NgZK3(1-xo!]|VvnE[JfpB<o[Q>v|aw-c?yZ]G63\8-$XO9opc4/(%Y3vf1y Ëe*~x NJN1qֻ{g ߡ!#ņB ^|?]4v ۦ< Mklqd0wGx}#ibpш ?zjęx}ę%-nv FJAggᲱs#2W.{q,3X~XqlМS8nw|4swEdVKODJ׶]mH+.5;)gf&N ^qd?rYC^M\ǭm ` 5Iq՟h8132l'M8ß!M3f},S?ww_:m'{Ӧ Q :'5n̂{;^[V>9~r|^W>?q}-'lc`72.m;/ӏh<N[E .,2vNG'nJ-2dpZqiQx  "yT~!%~ C|oY@Tco/0N5ܼ 3oR聊 uc'Wb N+C yAg3A4G~27c^#mmGL|243I1<ɍұ h\q4(穑4MY}$6t $ Q${Qp$N|xI$Y P_^jUVAZs~ٴ!v)O I;Itڃ$9}-SFd#<\ Izd^8$%I AR:N4 <:4IEeQ BR%׻3|$}D*$O0ӽZs""+숩֝A;:9l"R eIHnj'H|Q[]6,DK4* NjctHGĹx(}Rıy xChSz1p7 =8_+`YBGKlo1cs:/"/}l~鈻嶆s8H1=<o5OZ:'w1x+O D'O xɗF}Z},7~_u(˦d7D;ENl܈xP#0 ={4y1}lѬr~ecidha⡞#ci<.k':Z1Ԝ+/E0'pqjn'?mNapŊf5 ~^8|^l̵s}OU#~\L 87J*ޑjs'z2 KGǑP4|$|UhSc$\y"mS24Ip>vڥw kpFQ <|nyl}L$5 }DCLf,y$q+d$[9hRD|6[$~iMUHRєdkz3'keug![|lmz$wLed?>q*:DoM!ѺQQqvϙ13_^N0Dksj!]IC/ ڏ<\ؓxq ̅.ĉVLXo4"NaZLܭOݛr7q ^{(Ś`kw?M=to çf+l֟I5G]ڦן32"x+Lnc@;u^幉 ~T;̙q0pȶLc2uFm',fe!!s"ƌ]=:M'k2vt3: |qçܛsn{yn 5r!wE,XI^*$Na:WUB͐Lu"ٕőlوIU0}yܹ+,b\*gHM1 ^[K qZCq=S8k6O_9q+}y+e< q<MI[5qsrT'szjwWݐG;b<=8M/犮_8=K,FG1J8#nݞ,A\pT3)⎿_}И]vsG bκ*Ҁ쯌_[rlb0<|۔Ă͡|d;4TqgJ`xx[F*MĶY#z1|?ޞ}ڌ SJfNx/hbÌ~e]؀}Fܶk'T~XSD+!S- /j~!|G7ϙ|OF{TJYigMՋ,1M`∼ 8"13bAv!ޜRϘxa+N=VkF?ċ,{ON5-徍[W:Ys~=qY| [GVu{|lZW'Oil`p2:󎱟sb=6V:[}ޓ(<%}w9殸ɺ{[,9۲EK!99Xr$gT|+xףٹ%  Bf'=%ę^Sc#6ݸԫw2EG3FSZ@SU5 Ϲ>ćJMKbfwmÏ$Vh3xBeh`12;c~/4O\s og>;1ċ] N-5gn#eD#1ew3f}}釢 ?8Tj)=6;r1~EY;U?7k^%ѿPwē?6&#һ1Wj<'n,fpzޏ:&>L63ԃKW/c\®'V Y0c!U^;<`c'B {g!-m'18e]wY<{f\kR|}]z&Ï}?w<"ދ6#NL\:5cpfDϮԙPa$bD+p v4J2gxi84΁WР*~)],Njz/mzv<+go֟PĶ=+E#Fsd!+-Rf#[Mm|o\#s;2D\E|0$Q4`[y$ھx \,.^ I6/$o da]# 3(ꢷHzaOEfD/C?\܆df9}C2V!jHJoHvFuOs{#ĠՕ9H{uߏ }A 9F+~p k$?9{_Y}w_ HqTu%2~^Ucetk .1VTF3`8,z_Zd!q{(3iԃ=z7]ΗymV1o7yNo yQ`W:PO߃$KD+FF$(cw!RuQHr]n|C$6Y>(?lM$ͽ{X3d/ۂ6'RHʡ}BR.sI|s\a{5*_(I5In杤S?l @_f!\lJ3HFeU$񁑛"=85H&IB$q0l}d.P\ɾѪ25FrJ'/:fbH.uHSY|b*|Ļ9Mþ!L! ~\.""nAjcxnk'ēOVSf⌑;W/X?3V3~^uBh co\6L9` ix%\j Z}Y7SܬgpnumEș;~w ,NO;;O;{pwCxǸ*;{wicxYbeCdm)w"t1R$%3SMK5[h~/٤L~V;cAF_=4`k_׮)рeiCw7H v*t \Z- t^bm6,P 4 ZxKlN$t}-$䛩35TMg9 -n_rJ,쁄'*NG"s]ԕAmϑH^11 i ~{ѠٗĢA,gD D\NKX93_}mĸm/GbxhY'dtF$  6^o~tCi"v;$[,Ilt ?9IR['N,yF&OI*5@R^ ۍmD#iN-f$m4n~$Zy]a [e&}t1tl}x|,?Jj,36*ݰgZzLEQ?ܽ)90{6X/chL̉hunCџB܅*32E{./ڔ×>GܧE385>BI&.+ bx|z/K"ޠj~L|l=ÅJGX0l~FN4=gpۛ!ל,yTش;*z_|_ĝσ.HLBeM@<`KC*J{xH~N̵-+aA $o<IJ=*H,h2u-{}@==$2eʟH|\D~>ֹ8 _:Y};u# Y*7>C#&ޙ;ؠP$qZA($z:g*l5MINp|FWv2z3mUb V(7II/7hrI=IylܚERĢ>`=*SIcȍˆwHzss)k] ۃWnG2ގ@, _ H GO!ɦ^H!eH=($pL\'"fӹGҦ>3GHYqɣï e8GE3J} ;sUm6 [-0:5J;o1ʂg.+'kŞW٣q^ޖC:okw;ĕe5JV0sR{=1w6WE V꿙xpn|={$]sn׫g/#8իs<׸ Ouj2Rt75'3۲7F }v'~9߲ [ko~CU&.Lj'>mV<+欞Txp^L2_ZNKBw}{tű o:jk~,cY7f0 W'YU yd[/Md{*c Lu#Ɋ UKߤzP7B?_.{2]^ @gtsB FbZ+;"ҋ#Lg zޑH|~Fӄߺ{"‡2$c=gaqx~eHr.H8%e$sfT&O|432~ IWd󜏤" /<*dK&$2e0[+$==x'NK#QO#O\y-F2CCL!=kn=@?='9@vݗFIze*w$쯁~o6;\|3OGX 9\95H.}jG?ИWJKY-[;>ۏCnj3v=o8G qVM:6jo#a&3|q✘;*7Ӫ8~JJ%;:L\lfĉ1x){Ռ}H,8* Y筪tll1|Xc WiI01\lJUO1he#ރJ뻌=Wf!g~<~Ʈ/aUkJIF+,_z+ĝKNeLN(9o|̣d O,ۜW.xд(P 'vby@_M^wUɴ8]b!?ªg|wmϲaf]_n C?ijpUKSb08/h@T@p|DČTh/.DB;@>/ BuJQPԕe۲#%.kg sJ4BkbBT܌eqʿw!k!2e╗k@D{CmI/tFH 6 I7v鬀]I6T΁T[qĕɣM?DܼZS 3^2> xB" Nй ~x1HGݽ!uI?Bڊio@u3dH?e$_v{zH珦p0FtIi:VOUg!!| ? qzHZvH5BoH;| ]!g!ٵ ܗ_c!Up[c!uu͟1)jכ'A쳙L@tl&'WeD`d[ @Wx6<̿pWr%3YWO0l yxS#ƌ^X0[n3C~BPB̋H2&@d.?7<{>; /YϽ˓o[a ܗW]X̽8.wk }{ro[vp +]6.ʟ%ZthqU4/MoX}|wr;aDqVNshFf߶~s/rtIŁ(e~1["nOx\_;c8󽄂x2<,\ =q=q.3ZhoBZy52F$6"^;^ofXƩ2C c,"A7(^DGy%059!p Tlwỳ mW(oBy)3羊?']vlg"B 8/]^΂3c6|~3l3.Q71.˔:\k\ Ηd7g_Ǝ_=g̨ t3O2OS~DvZݴ}<}uȷZ7(j87)&~~ދo/IEg!CQj@" o`!z;_Bt`"!V`~K  ~#0'p\a8qk.'9N쁀|H# q}| QٙZ Qdnp2В=RI eL?N ={0?AObS{͐o!E`tZ6+ɏ`̞ ?aK-Wm!p(&K$AƓ4a?^hy4i-??^>=#cL+_&Ss+Gf>`2?.E|~e|by0_NC0suyll(.8^} ;!9o5W Qq/wkzZ<L(`[%"# b*I3!&&u8bqO)^/ ^_Kn<_.A:9RrHYYY)ī$, \+Ft ܦ@V1|3bL(_8Gg_%DSӻ"ӼC0IB Que!k{!Jp5,;=V8@H$83ʽa"X)Dc& KY;/ڬ=pe> )7ia7?=JȂo?2!H{'Iq;,sgP^xAƥkJE‹98HmC@A,Hz8=MxH"GiKY?I%} $< @& Y~oJBE*?&cѿ49WBSY$^g($ ~H#ϟIxEhd3s}?rDR8G$(ftu3<A"ky{!Ij1D? K# c N/@C7 |4_\',8kgBHY(p,<ƃ̓)ҸJU{MA`7=!w,;@#p %8 $L4$=zBn() {Md<'"GGg 2a|ojB(3ào0+C1fP!a)~&_H퍐}@?GBB EI&DpQ8}p'yqb80Ny7}_){Z!`XE6_C;O\0?"@j?( ,~ c#x9xa5H&?(YaoQ=//dq?}ʏa$Cဏ 2{ D>_GGR]&yDs"v͗ŷGx'•w^ S+y%ެ}Sw&zJ.Ip"R3O]@C"?f߀DD)Iz#@A|3? :,N?s6Ol"v)_置wqXIB糸&V8RQz4) 1-#8*\el`~8HG6J_~m`y/|X|$xq&Rd)|7eu'ħ_[XħXOlǂ }.i|Gu?I#1oM"i _,xfs1Do(#~H9'x k'ʛC}SE[$I})͐., vL"I$ߜJz&e"T~\=&Eii_ևȸqxӨs3ظE5x\@8ݽSpX>B4̧={ٓ#~)WO ൛%E97]QysO?p+d- 1!m0!eF!+4ؼ9^K'/;G⦷^.$QOS]C "ቭ MCX>ܜxB`6c| sX;E<7G 6wqƽ8>7b4Ny*Cz%kh}$Rg85/iMw;!-ubOiPBm p$n/d 4ohOM#Fd?\@EMA/'O#8, j,/Eaq42iABph dRO&Lpv ɤL )g%MCIROy5͓`r~OZ|$'HB4o=oG#b6$/'b!X7L?JF@xAQL+_Q}pFExNGUѤ_)|={$ף|?+Z7b{lw(0gH"|ףO"u[z<+d+SȸR戮|[2g9Hͧ=>/lɷS A,`ɛ~'_f~7oHbHy`\IRAܛ#tۂP;wO%jO3#~>A^G}l#K%Hh\M67sdOgDRǴWmǎ&q;gϒjn٬G<2{SJp*wܚG[|f 4&)zp_)$ς `!OE;ڇAl]RE u`#$[>G2K0l&_KE$xԃyZovB??Vpb(c  "uH@){H&x}=%}B}s1II>;ؒz>`_L\~,(Sa!c0ouOg:?}nki0Z8#|_lH^qysZAH+Ѻ }4u@zD)(l?'ۮ^װ"zLq<+>Za/ |H"GuנyGZgKC' yN7l~M.$`EƆ̷5Q=} Oݸ)(iyM9řA6EA 釡ucڇJ?O;q%K #}ͷi<"h?/'i W 47M!7 7O| C Ei=iY$.uy8EljOx>/z,!y2_?̮J!}=th>zGTOyϑA?mbd<[zLS?I "(΢}4qXh4ӢyJ׬e^13ף~;;f_F dI[#Jj$y4O%7RtvcEu3;4OLl{}<#'/$7A4_F%{=Y1{{(X&7H]گ@ l݀!gG%ߡ!yHh}SY;cI~GSIq=B]Β~z(A{F I|t~%hއW~?}VQ\C:?B}l2Ti|}}4߾Th]G[}l5_q(ta?f#헣u0VI YH~杣3.+'Ӿa2|X(2/Id7__QLKDnWE2<[``Hr:czfjt< }4BR?Ng؟B=z: WA;PIy` gI\!utT^R^Oᭂae斮e9vJOsi y:)*)`YWKi3ki}y$/NiSD S}\hA^ axD~ֽxC@֟Dt(ES2ߣyt2?,~#uT2HP;I FѾ1־]őuNcȼI'и#$$ Y@x ݯebWt=PR^O0$iZg%;ڧFTozAy!#o 'c֟Cu7$>AikWI!q) zLx }t] 9}ԟ=F'CsWEX8HN:ɋuwYDI\L?M& ҿS%\&+\RH94^Q^Aw)$BP?z>ݗ{7iGߧvƮ7%q'yehްq+>,4G= ?Ci< '|9ɟS^D=ߏs%ڿHl5/кSRkNR>lҟî%~͏<%!$Dy5۟@cwi>._:. 7d#e$AFp>t<8w\1[_y\2.uWcfq6Dz<>]l)!yʯãx+!`"~ʮ&#h_k?$.>eڿ̮#@4мͧ~'?lb)^BkI"L_#ǥiu*7'죖DDt I&q7RO:RO]w])4N旽'O#;=N%Od}wH=<ԋI]BpD s8O%uz3h? ?%zNWGy;Q)R[GqÌ#Gay!ΏOUO%AZo D0kO4G4@.˛I(}$It_6?G!Dؼhs~Mh>g{Z}!)?cɤC:#R?H&@ WQ^D2^K2ٿ"S |)]JV\/MpbG/ OYIpF^t4aq%yNv|"Ź/kZ?~Id=:zCLpRkI$C*kߔ璺>۟Mo3Id;_A^?2 ʹlcɾt_D}X_Z<_EغadDA"$E$=| &GV%[@H ? p`ח,77^eIXHB4WgP?m;2杋1_{o 2HN WBIC[1&Vg >oAwzRa5 kB e `榈5!̦ә$Ư5vKwn@$JJG'(uwu߈}Ӿ"o@D<幞?{< 7;W<#;DUG9vMfJ $WRb?5k3[XI`#wƚ V%RZy,eZ y.[;Hex Su.{;&gk^(x]z,xK^;g'J촪uǻGSs3'r"8{Whͅ}#}Zn_tRp0jkc׳V}c lH>7ZGrޝG'u0wa8Cu۔';h=,_"VtOv \Rg4Bp_^Ol]ODutwL,!>E[GuZעy?,%cHp]]b}SLq gI/2:>%ڿI:_Gf} &'6i'LJ]O >a$Gt=ݿJO%ߓ7 K$ C'F6Ga<0g1BHWG `86[ 1Jv>I6g"DI$o|ԍ<= H^zt\ I={J9Ft? 'nOᛳY'I5}>5 0wZ7#}iގͷQ;#:#ၔ~~~niYYD+a_~~!wX,(Xi ~ul#퓡~#u>gyIֿQI&=wG-}}Zw!xiO'zE$C`'~/ow@Z'e#"DK"zByz-ɤ/3~dڧF2_ A|B;dOtz8b258vwݝ{ִEQŠPTZ&؁``xw~.Gy漢][}V޿&k)뤔{N:]9j k뮓9}Gu~z]?{?~^ZүL׏LCצ^?~_}3tv]Rvx|ս/^ϧ;ݘPJ5I,QB_wNz.NծsN>?WIZϻSᒵSt%i'>@v݃P_9hk??+ ~E+geݍsg\>ZUZR{ݩ[wg>_ݗ)ڿer{ΤVU(뙵}GrRk(υt}>z1|W~ԾQ>zzQٟZ/][~±ZsFV)>i彛OA{ݬW֑zk*z归/Bw\_)]}܏i*#C#Pf+(s_Mٷ<֩.CYǡ RuNzBy׮SQj(9uϔ>TBoPח\;?G.i=(!7eLwT{iדwݾGYwW>U(Gwಶon|>*ᅰ+ϕ>{}W(#ݺz"^Uw*ρr־S(m~})@R׽PދjWܠ:]?sL^w־QSJ?@TOZ^/S+4>DsVϵ탑#>P/:}+Eo*2Ki<ߕyXнUϥ|ߕul+u}$e_sm^(eu!Sy&DHY_[ҏU|Wy~Ov>AqF[>:7:nܲv]ZĻ!34|X~xQ-_Ƽ`7܌ɘA͎KěO|q96%vn* /̯&9J1cy"463i˦D u/xuǫӡr0#x|T_xդug1=uL϶cjE^DcIQ1܆_q8ƥ%VZԂJo;`qǙbJqb">.?}OUg{> kUY۷ ”,舉OLjc }"0zG1Sߺؕ0ݬb`dFQ0[S~`Ę!0Mr0XK-~O׮K)lyU#=s>^H51z:՜S[1mVjnz-82U2r8+_guaSs+y7G#~Issب=oBZ@K!>ŭv~W}$=dg}s8U!ocq98i3yZ8yr6p4H3y6? N5+ dUy7 qL>MFAqKVٷK_Iv{ G?kXXpHs%:yE,`aΏ< mATxŀnvX߁4j3=vwx¡OCM7$c}f]tFT<)#b'e,!AޱptO l9d]cxs/)`ud0fk=o8p՗Fp9pӹ;8_Xr$[ԃgDk<y?unǖlrVՋɻOf@n]ΐܼ_nڱnw:5n>Bvc~%c <d.Vt5Ӽ(:$݄F-nvOTu,Į b?/ʆhuޗ,~<| (ӡ\`d2'܍Ȯr}`o |֮9Bцߪ7pLع D Qo #.aO]=m[?x"۲g7_nݡwֳiZϮCM1(l31BJ˾ !a욯 ] _C1͊>5QB~vn4x_捁9x O >n\su%CL8ig`g>8)͹۵=ZOOp9 enRWfE EVeI.?ɫrذVn`Քwancs ?agKnQe GOMæC;Ǭ.u^;j̟-۾#zNFK+̰ō5)J;޹sv0"'<`Őܛxn(:j<Ų*x|T-9tzxdkt9_tO|s7yit8?$/h0QR!M_za +l0H|$$^=}ZbsH/\R0hf"[AZ]coB;UߢS!cw{e=-mp+dv9FF#ȜdgF5iTƝ82T+N0?5{IHij&jzϩB #=~h= ;x L.-1 Ͷk Ԗ51)pvGҞRj:} 3 znװ6n\43w^"Z<DNwx kw=ShbȐ8V{W}'?7iCgmU&+-LJos l GϴN+KPONLu pH}wpy57o?o_ >=o_* * |:Ly djd>{ U[\|g]^[k`<|3SrLSgy j}u t(ڌI5;FBK\LJ[:^HߪKx.ݣ8WÙVZ_~zUmO`]6-A+:xٵNUsCꝿu{]T϶[ovsޱl7\>=]YI+?Rw+Z ׍ |5kpNy4HagЙNkyߙ`kuh^``gٵyB݃ Lf΢=`qDžVC~;\ۚEtacW-_ɷ=Z>_bK~qO~mMpA{zD*OYo,lۿE>k| wrq^!?E˟l@+%s1C1I^1µxݪ 6)Nkڞ=|iqʳ~=7aFMz]כ%Ǵ+Ŵm+Gô:'Uoɧ'br3e:8c1U;`B >o]2\u5O1;o_qU=a=6gٙeƜ|AF>Dn7,0ƩFN;TB>cޜd| Nz5اsZ|n񕭎;c}+|ϕO(y-;`DIO1G>'Nۡ{sU^x내xJ5YIvQ+T\8n}phMuuP/fgC@ȃ<:N@f>@:g!⢭oio!<ٲKGg˾m!jzѫݢR}Ue!鰯pkG_WzN ɕ h+@mg; pyC_;;exS\q(x?azW4Щ;yEp/j~N}8'wkX%톳> ?jס}3uipMhR̅>pϨWsֹ't[p}==C)F֪t80~pps[ ʓ %;v^:ŧ7g̷^>|HO/we.*rE.7ş}eZ9o< =Of %}^{qO.K{jVYW~R u® zvp~ngp+IzfpQf_.+Zx6xo^R}8p˨b|zgX|j{.v+[=' j;7uǩs.; 3㣁{Fu0YϹ7l4ban9K,‚+w <>XְH}gb5>ce,̻u˲gi9?ݲ]a>޲=|/yU۫5j_fO@es#0Ѽ6r}|,bA#CVMMmlo7^+.ZWO?s v執yzz>_0EtvzwP{|?7V 4?ax lsޮy\3-Gi3C⷗y{͇47x /h7`fc]k aRlxz=O<̿&Z/7poSYw!DZ; 8{/&{{&@ NĔ*[IRySYsWݎ|.NQ|~.=*pl^[~/x^ݹnTeX}W]'6u xi`~#S>#ht\{_3\hv\z<xWoZ!@C o.{s̩'SR -KOJcr?2>5KJ6 o]|.dyḅXܬwC8>{G-86j>gu)ؾ \P¢>g:MY\obS:A|`3R:a~ΩvgH/s}XrJ/٫ۼ3lƶ>u&b֘z…Sx=GԘ9b/KL;wi1aZ"]&>=DC̶/d+!&,,5[p&8yKQrVg;pjwʈVw\+l7\1Ϝ,xi3cFTIeadGZik&㱱!FO(9#%{a3 kn>CNLpf3^[B;ZX{ͬ{'6E~WO3=ֱ rɳ@ !V>+<~,Zg z]~h :]yHĽUYԓ/zLw,wNk¾v+fDu7>,ӎ?+;Ԧ`:ΰ73`7?!.86\;!ن `猺 yv5n] pРeYc+S6{5zgŐP<`<[SU`Ǚ$xPAn!_%Cav~ Z- Ei 5[#(;<}H<;*jż勆"BH߷K]w(𰬍m0|k&y7kf׉p/Q=[N\i=戗pg1HpGxpT-ímw:yKxUy k8 ndڲ%ܜ~cHrWk7 rN?~>b9g,}ibdsj=ƾY7V YƃoN*gmk߿Noyݙf3dXd7d6H\ߟ\ ZJ!cy>4KM}@˾ $JnO i5ck&@FK[2?DA6cJų:AǍ!6m idרcVы %aձB6EX^ A?U?%W_[ս5}1 7}h^ |-( z<6^veZEsu}.yw 6^,?;~]Y\nݞcgy+<1RxfFI&x.^otp:O|:zv\q[WVwɼtPGfGڭƟ>LZfYwUC1*y7nyj؉pٖΣ&SN;2zɻ&f+FA7,L!ֱum=YvFp`w&@A`u壡`:{Cp/dÔV^X#n=K½l?]=ͣ𚛬:rG޵fݻ{7 ot =_]딿 nizIU8Ԡ7pcz>,6Sau\.=+A;4kppmA/\:9OCJ'W󇌆cTݻM·>[3"8d\֩Ü!}ow]>@ڍ][m8i:ZRfTuY{%wf[dFaK׎~q.Sbʫ Vv 1>Qc ;:7*=!sOC+kW1pqf#iS={i]|ԃlTJsc,#w}zc3[XE%iN'u`yWn?g<;omV!&;O[J0ԍ)Sqg8gG9p|cdl+lLYKa{ͫ} mquJnnY6,6A3aEp^KAh]^Zj;YeD<,ʪ s}o!&f>pGjꞍJq:{^6|$U>hywչt85K#|qqIlW|~iwmL|Q 9uT_t>00[5uėՒ'Nzʉ*G3z>HۏM{C_o~{C^+x3s>5 U,\7\I L{W?E(܇+Ou^27k8Ç;.sU-fQo52|}KOaxےf1Cb ^ RGwH(i=•S!z؄9g rBrJwq|N5+49#x^+y& s79ׇmXkx=1ʽЇSKd%LU7Le4&8ԑ8;ON߱ں |햃ӛF8ՓѾJD/_84a8Z߻t\8ӳXܽvLGhoi8]:ؒCNt .MV/<t[?w:,q!?ׂj&#i15jR XA9f5<ܿx`uñ?f?O7X{5&^<۾x-p܏^0s2N${Q;e<->DLBs0oԖZaJTƺ(~2a8&L_;=SL,Iw90|JQLS:t8׆X:TlC?,M{ϑ~cVOU>Nڜn0fmOpq04_kfz3S./S_|8_RT3Jy.^C3pCf F~#-FnxC{z F5 }C( w4^obA ؠSOIx|wcG\:ۦ`Ue<NUU}NivѰ?iԠ K_22 Ǧ7\HoR55jp)!fWYxwZW޴nXgf^ח:7Z{yxT=za[ǓkQfljYP&8~xg#[.Bʞmyt3Xthle{æZ,U&my3@}lP,Xaf$buZghqKF}i'!VбJQUj)6.h`?%|·vbye[~.r[0OZgƫES O[mOjO&dm\.{;}K.TO-w?'Z"1?~5K=:a{㇭=k9mq|oۣP"|mЮ+pe?B~{eᷜoXcE:5ORzN^w~ޕ&_Nzhby|bJ7>}~6Z5Ⳏ[\j~^[ը8_T8#'D k [V]k5SwU1.+iW?vMk-k3Huð$<d# rnk't;OT;;+w?c]S/[7 A s[5{uԸ&G[ 8vܷ=+c^a^~G^'᭯W-߇h o)xmy Z&iۼ^>9}^&/-76# X _)0ު#>̽1߅vջ:sW-ސƬk/#ڜ遥`O%+0Xt.PdHWO7uSrx_cL[#&BtLV}&OitIeL.2h W 3~KLy>oALpp] 0׌![bBל^ 5]TN+ci c{+= 5Na$AS F=l"F$<֪ESgT焾׿8-</XlyjC'iþwov*|l+uen[]_pU={7w`;`;9٭=/W6UyÒ#3enn-?o4K7^;+yb\SKo0VumݓahԠ  ECƃQ[NEVEWq{q^M>qr5KuujK?!z*/߼;߿Uk!=ZA_nӦ;FCa.'Fùo:@ѱ!)}υ9|> V##aew2*t |-|ƒs:+tCN< Vo^,{k?nA&kGTn>iNρm>À7v ?9e?@޻5Gu5*ԣEk |Zv%!zzZCz=%߫򎾽Vޏ 1g @fvYL.H}=]f6} 7^g99w'k$u[ % I< ƅ0SN0ExgoNA^{!˨ǯ{\m\|Ez¨ i [x0)|\fin(58bp ޛy #}ϴ7C/# jO a*Êt=1\e^ +K[Nk-|>{dCߞ8J>NkY,[γ9焏l~E^iM '`S|6F a7Ļm1qz krvj$ᘽgf?R'$bNX>]o|r<^9>1e4?=,5]l].^q+Ldhz1R}L0Ԭ昒k{3}1s^OM¤?$0i1VootDc?gNm4wļ܃ΕR0!WH&XH ńɮn/J o1 5YW6?x=lN~`d_M1j1( t ؏-ȟQN,ch3ּi'Jv[w:;fdڶ}67˰-Aygl'ͧMqGmЪ큖 ͻ6^E]qNJo5ŭ`7EMcqߞu`gy?-c9XRm0_fӟ h>}1 pG6ǃ7|Yi,.kS/p㮶#JRZ#VÓme ,z}N} c3=ie=qW>\e7K[UN+g_e_MoǢP^Q]%HowbuP)t}ٕgJL%O}7^>OLORUקI_[;k'wV)}}>LUʾw/POm_ev2_Z{No\ǮwWr}s^wGO۷A@S>>\z_ݯk\ΕoGNcTts9w_ nͩWOգ lk*[9ˡoPcCvtv̧﫨\Qڹbͳ=V3+slc}E;WV3s?.BvfvN21@+Wvntt Ca-7>w9?T$?&BDٿ?_9E+~ HDž~G.WSin+שV\#7FXyz_VZ& aڹA0'g ǴwO8ߘfbǩΣ"o`1j3sп묨oGOje==JzUjںkZ=hZYc庍?qڥk,tGJݿ[FKGU,upȯls_kR TʁʁʁZ9(_H;tGH#Iw$Ժ#]t.ep N28]t.e ^2x]u.e A!2]t.Ce A!2D]u.Ce Q!2D]ːt.CeH I!2$]ːt.CeȺ Y!2d]ːu.Ceuj]Zeuj]Zeuj]Feht]Feht]FQ2Crtӡ@"Jt(ӡ)MEi*JSQT4(MEi*J(48J(48J(4xJ)4xJ)4xJ(M4J(M4J(M4DJ)M4DJ)M4DJ(M4$J(M4$J(M4dJ)M4dJ)M4dJSSԔ45)MMijJSS44 i(MCiJP4Fpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gpd Gd Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od Od@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@d@dHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHdHHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDHdDdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdLdL5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,Q%jDM5Y&Kd,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DCh Y!K4d,ѐ%DU1̱̱̱9frULU1*&W䪘\brUL\\\\\\\\\\\\\\\\\\\\ɕ\ɕ\ɕ\ɕ\ɕ\ɕ\ɕ\ɕ\ɕ\ɕ\U3j&W䪙\5frLU3j&Wj\ ar5L0&W2^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+㕊JxbR1^TW*+x1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx1^qWx3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W<x3^W MO| 5&4獾6^3̀1ʭ&s( G{WØHSa%?_۬v")k9Uܗ)łtG2SqAt]VQ(huY{jcLZ>Dv)N BRNrwo;]: YCóR2p AFiHX-6 }w5!gKZvQn( r183`Ą,WDX?GV#C8<'VX$J&X_[czBS'nĞ<,}6 WQ:WKxSN|No.B ^W6>WyO0P/8ؐڲ3V .{/`ƪn1LUw DUgj)1G^_*@Lufgz㤭잧ϡ\?O;Z]DwʆOOS ͎&'c3Ѳ/cn]g1K 8LsN9W枂%9 GFj9hDOB"ϓB糰?2Ͳ#ɃJ'Y&}y{OK"Zpbr/;O:/|Ϫ< ^mk(D箛{qS\,|mi"k㞱z,MW;c@b85><Xkx.$ t:7H PSF|I0r|{NJ #ʙ8ќvG O 5n1fC2x*So",R^A \H@{RwKNnw0"]>kZNJ`>!}wb~Q3Wjq$w" /^T+^ 8UߘiS007BY.Z9lD`x5 W8@5OIj|i׸iz71)Cnp<:Qx9YV"R)D@k]#'=c'&Ul)Ms2@$ ~e%t~:`mQe+jn"K1Ñ2@~|6Iyl!2<47+_YJ_kS$2F "l<֓''dEy ` 1H4A6̳|0\ŮГ)DաvكSZ5+@5s4N]mly=S8HPًH7 !nܠ5zHИ2/!l}{V:8hf6Q]B08 ̗' 4 /'e },'n4SU#k(18b5]Ւdc5;Awgkߎyc ' CV{ MޔQ܋u{N big2$xN@hZaV5YiH}}T{edԟ :ڊߩ@=1>yzidtywLT_X`cORWM8~䣶%'>`K7+kkRʀ_v+ÂY6 bOF}ocn_2:e땕]X lY*4#˥qc D0[B%6V0Z{k4ggr]+ច7O*&+ze z'![k[06oHJ-͉,V®ȿcX@0'ɮ LWtp"s@ Vq`u@z KDy]%(kcqhQǼ2(D+EJ\FpTc}[:!Ad./@${:3D]ݓ7$u{ ?B}^٬FTF}k(]v|FUsII &(*~Fwk 1[:Mv@A:7.ނ=a|9QqvƏ/ @¸>2!Wvutܖб43hqxUC~(`-uw72@xfiGqmLhȸ] 5{ݥQㅢ%{CKP(E%f'^ұ٧tYiC{1,)lvV3\h\մE R Di$! #nT*k+R* p6VT͈ "j8v-x _ xSVYe ;pXN7]MMr7|7$]O `k1W5[hzR^O: [*qŸxA)a]amyʉ,`X!>n/IEe%f7ld{<^37~,8ֽcCբz(d\](btSaME1 ?[<$DKF1HPǟwO^j zoo;oX#.z\QIcen`?H6ϝ BX^s1&jU"L1mL,E]FqSҏUA'ЬT NL7/VkB9_\ ~&M\&UhMV2;MvpvS"{d^x% ?9PȲ&{+B t0;vJ.qPYlӉ3EY"_# tֆq-+pdLYoZp#J [F~9S*Y\2yh9aRh  @f&0ɓE%1N5\0jAE1X_/Vh֊r$$>hjb0Ojr0W.,UC9F1']CѾE$k;D~qDŽ|$VHEŵsܓI˥`Ts:xJaGv(@ |2,M sԾI u=>x#_OiYHQVt70KG_cdulJULwX~3^n|@Xm)Y8;55`ed(Xk͙h5p1gCdeex"̫{̳CC\h&c.K^ FjC3qdȻ'&|DE?Pn1NR4qY!:nnPbO-nu(WQ`(BF5La_σ|F-CæPYDGiȿ@?~/El;$,eR֖D?$o)ej]_y:3$M ].96IYCÆAJT#y"tg$Uh#kl!S4CxGZ_Fލ+Vz$Ws(U% 80H\~HoRqbgb^/t ~C}yw S7Wƈ]͖0ʨV]Hyz^V->?U/[eyϮil̪N2gc3 :^Rdc~ehKV* h`]NG@RF4Z k3:j?g{B4SCtKhbh햾# ӷ%ľM֜!0x {M d 9GX[=8Add[:4{nqBXIZ[\ O+ӳ&aȄ |r.ϸT7JǴ&F?mk8>r/>k7, y_H|P }!}Y@gj1~8YԼp:rA8iJIx#Sm{FudB_gn-l|o%(#̃SA!]:Jp rAn X*DFT_wlFvlazb BEpXˬGRwʔ6 5}Al/6%[~3v)Pko64ZJo]࣒pӋ;l6ӕ8]92^O20kkͫl=ϻG CŸeKChk.-h~$z_s>9Zq9kOs֊,Mw7XLTo$"ʴflpnw0>ۨ]M _3* '<^rwiHV dKT8Շ Oz2(j_X}mǣ$*Σ E*C9Y?)|Fi]mWB+rÛBڋ\ي*@sՍu +*;㡉Y<2,$\uΚڭK8ײC[w&}S:0({ˇ8?H1`%F.DL9eW#TѠS4,EΆM񀅒+QMF(V}9_FFzp(/i`6~(%Ґ"gi\Zm>V坴&9M U̎D#f07 Tޟv6} V'R&bIupX?>a7㏩ٖRRL&mcᓭu-v/ivMZ8Dƥ+RZ달MSsVUpB\y 1|Ĥ2ee͉N:E}bzRڀZU񖖵i iv" Eu?w ngMUm`ԇQNOVI;"§@&w,FLxAAlݚl]:lVޔ#CD9zI-謪]gYDӯV QxayKsb4#^򳒜~_OlDLBfyNrU9-MFaCO.R}=XE;`pM=tV kO\&)X!ǵ;pxE~taQCk3BQרV lRi[i6O0ϛCT bZX0,^ϻC'5sKgo`s!7m$]COVU(q?>\2}چQjy gJ sBP%1,8_#ӌ"d"3yY)PYNv΀u\@/~fn@x2z?y\A^C* R-TߢgQu-!ޕ ؉ʡ$~dק5~;}MA+03\ڵbdg~n5p>"j-%Cj뫭 -#ǩ<4  AϹxEZE A~!ԍ>`x ;$'F2n;kΗnbgx2Mn3Kv,Te0 ' _Oѡ>p۔){m}.mlܘfbEeu7GNbSA:sД1OXjǔpV$q.+{wm}ar`:3s"3BZdHk7׬zx$+ V I?J\9˅UaY蝯Lj윒lՠ%IZt&Bq;%IH7띻'G4\Y'i7tQcĀxS8E F.uY8w C2kEn˼a.nb<79Cq'7\#"w:Gv2cwb`DuY^̒"Pmtx&~gV\CWZ^*|TXa\c&L `Jf?,}CSo=5䃉~U+)c'UZ}v.WeF_(V9iƓGǜѸR{5ͤ *}Y,_FK_S.K{QX7Xv:}9Ix;ԁK(숄ͣ@SMs%kIrڱ.E g !9ڍ剑7L}oȆSU"ih\KPi^^syZN]cXVh<_-,2e@=i6Y*V4k rG •poM.B!fc 9dp[=K)"*Ř#,y;%A;}YdOJe`YB֩ȣ>piJb'7 B}PR*fWnu%Zy#fX#Y0ww8v;4MUE+< 7~ԛOedwpEplHphEӗﭮ5T)(_P#6ߌ8*hѭTea‚bKQ/A4}ytYkaO:u}yԙn/*Ꮺtܫ9d' ȅf:ClzkapAk铢^D"DM|ͶiNEMQdpqFcky^g"Kí^;ZEsɘ>KEu+Lw)qKTmjhyGv8ᬦV:6}"cr, FZ@U?:gp,]@}s0}_7e_Ϥ|?m٧Zȍu|E>;^Ty?g7LH%}HKTBnb_4JTEX>YV'"J]㬇fLȏn)s1H$~iOHv[,;Fu趄U=n 7.M}WzqGrROyfH&'fYRsء)bu:Y6T:|lw jj'eiZX&_h6ej J. Hh#.63Y1J1Z}!)/SyΝj ݴ EJAbyfg fo C6:_VJl–\EA<;)|v@3A,ɄZK[4TJx1E}Yz/ MT)-Ja nM9x+$0{&@|L2]bQ'>{`L\>0 YZplm/data/Produc.rda0000644000176200001440000006567314124132276013722 0ustar liggesusersuxUG/>Zo@ŎhRShh[ &h( D s g3{<Yk|֚57QU{bmƘ%dV%fx[}E3W`̪!?z.zUpXUa]G*8WQ UpԪvu[G*8>*8WY hXG*8WѤ Up|^G*8WѢ Upum /h[G*8}XUptsTm]ZG*8*g/cLvC~fg:=x҈iMC솏C <`M=:b]t^;︱J~M_1?1#F4 XVsСЯ1xxv&|0ZsHc3:b1jW89nCzƌ;hܘcǚ6+Cg:fXe:Sȑ3cƌ7Z91l𱒉8nogL'Ld7lAM«]y^#pz;լ[ p[3XUc#JM-SKXh)UKeF0?BqG8?"ɏ(~D#%~#cw1;cw]ϪءݵUGU̥*vb? VŮzU);)^|GU* O*ò KUQ>W OB/)xcU TVUUˏ ;6vl,z(TA|*tF-O*RKvkzecsAJ>X_%v4_4lmCYGʊbx \Cڸ?<+T9+K Cq~5`Am3ug 5e)>Nυ]~Q|,gMO|e]*C=C^׳^o|e Nnz ?j|L|0Hg'^ { VyeW`!?`Sp>)8!`!|uCp!`o(vn͏vZx7r( G}#yk{v^B_^)ƿ۴]zℰ!ÍDC.m 9A%bmIBNyS׻BME)]Xx ~=e^;R@W}ϝY, \(t;a!@|?k]A?\w\п!GyOރg|s0~HGBR:]S`ˋ_WҮӽa/W_39d<3恟?px.#bߵQ̑Lp;8q{KH1^v7T+A:Vu\/o#hww*]N9͂~s+`y.~|w-?IAB7?-_)^̣ .U̳xW=q?1@ĝΐ[Pp0 AbB6:a!a_!tB^?s zy{`׮rw > D|+RK +)o+XS؝q7zt")u`)q=M?;Ocn S= y. H FKS9M ;= y]ׇ!_ `p-):=Y{5΂?f4!E; z [ž!r,|߅kϓ> vkɟSZ~?!F\O|,=t{+9򺌩3~d|aOCciTċ U3a Bpv!~[CA^a?0A? q7|}SG [+_E?Lc*!ڄ7 |{ gm |c ,-NC\)vO>/w1򚛞2Wr-sHȳl׸nOy_ \OB̵mJc+aGKlrDsM?5*; OcB2 :b?~y1~$!݄?j+iVNĎv" :pJ~؏cm`ִ:~e>vnM\ ;Z'}ۜr:!9 >\o'R|:u\C^ZK\/hy : b8 ~x ~ o }E~T { nA r!C!g|5"+v~)s }?2Q?l<͢nGun#GΈg <*wr|tɣy@h ߘ<ydrORZa8Z 3c$ċj\WgS>y^ZKIwRe5._si![PǮN^ID1vq5Wή^z(ƹ}_}y]k)Ʃp#Rq*X>z|xEc˞.tC]ĺۓ \"8O^G\ | ڇ% dnEw8OA&/SQ _xxxNT\? {YX! 䕠\O鋸 yg#x $Q.g`ua?^O׃à#Cpaz UHĉ#!0!] y_ly^lU;xץH>pgA^?랂O_XP(Fb_Ga֋ɈO^yD9=R虯xا<[^*1"7܋Eݗ-셝t(s1ޫ?9N}'r U]vFj 0&z] q:.5G@[5fH\ ?5}'ol޼v"z_>]g䝾M@Ƿs|źu>1O=C7A߻ysu?!)/q}?a+g`\8 _EQ<~( {.y/>O-y?GDIaȃ}ZaQ_%ˁ%WW Chư6ϲqbDض:bׄnWiEz$zo~B)?8 p:QRȯ Txf:q=Fro<Q9y=P(zy-GoDž}QO\ _ S!wG%u _o._ODȫR T2^._aD6ĜF3vq߸X]vxCNw!O;/B?ƺ7>܄:= +գCfC :vzMF`]8{ sQG<z~X\؉u;yK(jA A f#X~]-zm'1ݒ:NףּCw;i5߷N ¼m? x/w?* ixlO|zEMa_Gu1 <.=a~ ێ<%,]}Ik1,qy=c7bc=QD`3x9%FρA.Q1 Q7@߭7­'-E$ֳ`n`n"د[Wk1~]j 9>zڭ&.xr+M '`>W6ޓvrg|5O g >2nY}guzj+K?_kvy]Q ir)䔘uCRM]P>N|^INrXa '䟆XK$Vc?ppU'"/c!L(='<=1y{=IA'i!/N⹤xKmf=+.K"Lz34E0r IulShODp(r"awa|0eE?1cCn .|6iG[=clyVz2HY+e/p"ň9%yM(eR!k(bc2#,e67%/)qدLy<.u$_|p#{oǣ7s.{EAm D#<3柴$9AoIIORu!ppy+q3*=a J89%Du8]O:$$TNJ!$ԑPIsO!( {!ʹy uĬ/39_38*䛳ycG;Xԅ?gne/ M:o] c6jN_r0&%)?#D"R޹}{'VN C[B'jn6zEq?^H"Ag"t^h}tfLИwkNmӱd;KЏ*Sݭ{ _a]%c߹zaZ'a]aW@?gZ &NNҾAsp.ޟ ZA 9o{! 5XD@!/! ^J;pb僿o]o|s+!/ٽ# < >=a<{_!g}(x@;1򩑰 ]oq=u [~$ruiO>q?vq)uuz-L4gI|!-gNϵ]yCokGϷGv~2z~u~roӯBu=Ո?m ˏS^!+|N߭/?3O5(߁F81)bkFS'Q',žx_K3ޘ=$<$a"yIRmzOWrr7azЉދxp?Y9Xy3+o?o#g4}vP.}S%y}Jm =΃7C"?x,1o+hҬj}l#(a+_6ֽ^10;Wbᖘx{»cc_W88 kD4 =;|51/܈yG}FS =FքDT@w|];=ө' D>1؏LyIWWC\8nۨ.{CVȧ Z-ֽg{?yZ{ Ƚ:pà/?ru6λݹNx'Ӌq0ՑO(=t ?؅< )t|8|!y6}ߕЛAW߿ `gφ!= zg7!^udz=1og-&}_7$D>#LFIa0haφN\  `ԭ Q(zQ7zOŗ./D, }nI %W; >oh.n>o'ւnwq+]_Wg=okoEo> ]h{-_|ߊ8 \OE>=}4p":㸮߻$A&j_N"?8uT)¸?aL@d)XJ H @%}OByccԿKgo|0 [@IῆT_i}j0ԇ cH_ƚ>ȾX?vr;a >g<gC}6쩨g{"f{!~ܠtbyɨw\Fǁ~n~/?oZ7F֏an݋fqi yYZ >zu!糇|' 3gkص-A?s^TBy7k <έ]u ϹZ7[/ES T$]z]Q+ ݭ;ylQc܍F~`w>{3гocw/͍g)/q=ud;=z;Fǜw9Z =do%\OnyYͽ>ŝWN=B`/G^ĸ-͉qByrTOo];UBu]OPD,P? |niϸ~T[ xP=c6ɣeWw_ҁU+w|cm>|oj { :NЇ?ƳOQÞ7o _A0oD<;7yxΏŸG>^6CGwCG{w7X66|7%M<Þޯ\oy >6sO  OGC(_-}~?Z5.i-oߛ7C[7s98@~Wc/S+p - mjP \ N_G0G?"~{i_o3w5|v%]Inv > ygA{k7!s;B^N+ (o8Q痭?> WUA'Y >us#9ǰog%s>jc<؉g㩥vuf+yЏQQop /p.cc~z^92ec!?8qE]Eyj oP[B~7zG] /ͅ.A<. ܻ KEK!t{x"WR-P5?ZC!c>ձ0c(? {>F#r^98GP}9d ?<¹qm2}p'CCާI/Pq@ HyTw{\؟U^ĴE98 y̥8`_|#ak qozO7ꞛoA[67Sli: <ܼl[1m~Hg!CN;a;wUǸN-0AG?}9}?E8?ёj'T4o: C>M: _;]<?xK>-Y~K9Ņ_C>8_AUT/\Mu53yhb\=W?:$N@N~=/]z>Wp)p&(P? ¾Gف&!L؎xB^4KOz끼,eEԓSR}Q߻ ax?>yw%buʁpMnyy8Xs 6{ no/&Mqiy.zk@w%u1T/uzn>]DcK>{Kme5^8gRޗJ:OTO`g.q. KˁCA׬XvZ'@ J9Gu+0v؅/S~|U|2|`!!`ÄO< l 7O&<+_n.s[>>m &<=o[ pw <#!@?֯A5x?,wz3$mBO b#/ox>Q!]+䱸#Nm@<"a-maGѯpGWH)$bomcq7 7x:^Ѓ?34 q¸q) rH?Y>‘,_H_]LІG %z \E {B說_X]؋_*9hB_AT >Aq|򠋟TOx>tnX=l>9:A>ƀnX)w0?.p+/՗\d_Xd5%p!*8=~=HY!>E#7O#Gߢb,`q]ްⓝ>zLBWߣf ӂx0i̤4@ymGC? #{LGgG>͑?~\? yM?~A%+ Ga#E{\ہw^lJs#7uS;/mְ(]*1O \q }(14㵕5s$c3{6=g.C<⭘WB޷? 6o1nK;;wK4.3'q?'H;z6BONT_E\Z/n~Mn A? ˭ɥ.D]=6M:8gޏz9xg_ 4 J^~ ;y%D& : 7#;:w i{ !QwqޅBi( MuTw/ј Z{. oK_%vF>$P09^s3q~pEC({6G?wG t;#ph rZ uE uZЋrobfQnOx!~; zzk|B !ב$~~~5է>ǩL& JSn=/pNkw:?FaáP9= vw&:?A9N8z=r yw8b  |2Cޓ ߥc p2v[Go~zO$? .\Crrre#֑1?PF-8njEg5{Gш>9'H>w.pa^nJᕞ~B}:@6Gq˧˝bjr~O刻b^/t\ױ0mK:yN~ERC/7G|3lF}4b<g(|q'ȉxp,DA>}j뇦Cyh+P(]T?V>܃"Cgg#"bq %o p`f_ѯpz/(^-^u`Bʼnq~ 8W"-׊qu+ -ERqX5Nlߟ􁽜ESO6Nо _9Oj+}b39wO _{ATJyŽ~?B> EVC܌?| Gb>?Pw jlwU77NC 0>:wchݽv9K;[~IXD# ؙsѹT^_&`{F$e |+;v |\^V茺KB .uos%1ߛGʫ˽!x-}fk؇ <Qr~^0`;/0࿡Kދ8?ml {ދ w;.3tv#uJ.ێ":oBhc&Gc_ǕR;L^Bwl`}R2!WCg±O{LX 6Fאd4m)нu3xOkXgγG.fXWr)@(d%?/R𓟊xq*rs-<݌{7zA㝩k.{?C^=z@^T8L}/>gg?4q!ːWzNo!ilK~ 1!;CHl 3ah2B >9{PZ A]*zs5pjĥ\iʯq~:WN6tM0kQC=Veq~]XWyTl /ۊ"}@-mL~MB{Kϊqa%Jwf y^\:y?n\& 6 3żo}E(p[!۝CނϜ[vz%I^{ǯ7_;KA~V{1˨_GaVr A{q؇]+^R)'yDJ>>Q(2 ~z56xo3 k_k_I =|?!}l 5d/!spxO(1_ m|vaF@Oz?y̿v@xI}|UNVɏ֡(Zcqb^O"F>{"7UXXM׿}w PxiTO䛗.W`8.Ti`6}:p&}65}1ޏK0"/}_;Co%bc;ٶRv_WkgSrvcgvS|rVuݠJ9YuSɏrYՅUg >, zѶO{/c%NM!B?& {x,?c~7Mq^6r[n_<]Hmo;(SO,lC</!hRz 7"~D_悺u2VTp=;"~=)b^JrB?+~.XuiXw=~_x`?#z?yR'Lk}bOϏX7alދzO })\1 5>ƾq+#A>ˀ)CO~q"Iq_m/S'pd]ᯥM=ld X?/ŋȶmQ?/: S3䯷J =ގDqg!twXXޫqGЫr@~u{Vn7Ŀ{  {gU>.tEGo}z#ov:!?tkM?Eaf+17/yxAgl);%onB8z-֯j|ܻ3Uw~NKOb!:__=O~+xq>ڨ[`'轄3^ źz58~Y׸˴Xenӕ­bw#v}WFa>/}Ciy;mC^z(,F(ElľbM<_RuuId!ug`}mlb]\R^yYKw%{pj6a ?YQ:u uSoN#?+?swjgzDb5ot_⭡HīاuXb:ג Ny< ||ka|4S . ~cS(CWvQݒ"K텽1XX8Uw9:_;uXEgyi$ڋuUY%jD~gW۷bWQXU_&^@E ѯDE& b^!+ χ%~_i^Ǡב<Ͽh6Z!_#O}K>zNʗC)[OMS31\LQ]r嵿}|?p͛xAnwB>L>!b+}KE>Џwž>^vb͜t1Zۮׅ\n|a.n;ϻ/k*^uOGYB?O@zn zU~ukĻ2c}"kuei(p2qs4s, ,o}H,@\3~ S_[s(o?8롔-x$e!7wW_r#+Cl*z1iBxZ?pTP+1y+7ObI)`g=b}mݮvk""uVtVݳ'O}Q]}OgcOu{o+k+֙vf*Z ;nphrtTФ1/[%#H K=Hs-|3Ux"3efrGYrJ%uў 8:{ ÂTg~r2ts€FEHz ݍyRQ _nKIwSn;W9P~W ~*`]]qWplz(֝°NpB]Ak }>C= =m:=?] yQ|AyX. "G~zu3-u(!~Ǻ|twGٳN=ǰ?x `9Qp!=uuo{ sP_Z'ֳ_Ɗźyga&pjݰGiuk~'zgF|\+'g|u}FՓGit-sؗkq7A> /~H=OָUW"KƖ^bl@ƶe!s;Ւ1ow2U>[0ی!ǚ|]=s:c06+W[3q]~|]^Cz}=߁O<el)c3x{)goƦNewns5uu={f@fwfϗY{mgַXWjCXGV-7܏U zr0ф9g>,mۓ?yqcX1_]aby!8,1fY\m,,e3K}Cf9 \Ws52v.c}{3̂ۓUfѴ7Pg0՘Ťw|5ٺX|Xgun9|_so>0ֵ#c]eO{fٯ)܅Yn2Urv5<,SY,wc25FfW;1VN=q>x1Y-cg1ZEmNmg>D3?0ցknK״k¹MW綡gl;=\Ns];k/1<`lv cs /䶼+?~$Vq?\c؆ >.k{./X?md{{~۾;ӽ4덏{cptC vi;Ys_>_&/a͹=b^fo28fEfQv/?8__yu(?\u c9v2uݍcv,czƾ)漎`"Q-E6o_Ǥ+Oq{Kn>q?͘EfQo2#qhwfޏތ%YtY,~,bkŁh,X.'Wyq@)s):/(ZM>?99s8rَ>9? e2:2r\s9[ЈcIRγ93sǛ۹1q[LJk7?s(~kA\~ssvf.3#?\a}Й'g^?>8 nűP>wFq#ܦGrL}m5/ǺQTڭ-=9FZy(xq/|mxli1&c>g|.ֺԃ˱ŏAbf1,6Rn_3EӘznc{9 cy Er\},kq*jΟNysӋˇO\'C_0Kc쵛Yvů7wpp1;xU!oç:q{ۉmg޷?+p5ǞQZ\jc -Eǔp,jktOsyxtǢOӦ8~p_qyYsY^9,ocϕR>2Eq۱EB8s|ipY],q_83]^rs\w7a?Kry^8Tsm`SC.Ub1830&r_xWcmύj,O P>vg:4{>yqωcsxq WƧُ~~y˷hV}xno_yocts] q=~7 Ə:bmk|RtzoK,}zIx)I+@أ侄s>[$;!{I^w/$#G; #{ACb4~+>ƯEvW]|O1=>9~>ͣYou}Lm;OYpt⹅o.~ftq~?OuSўﵝ]Hn4Ws~]h~j\wK<!7\sHH J_~KS/-%@?y΃3%7x=g_PLY[0w~]]w]cq2\ 7ݶv5ɓܕ0kOqޣK6都tHN7&ྒྷ%wHMC?G Fz֕|·"aϮZgw+^>}oW:TV+N'|bGx;j}h ? M߃OF_v??Hl*7C :DA}C ?}.;2 8|4?gŸz,& t{X|%ŝAwǚAw_KsZK8Zƒu`uGQY~GhZcIOO\~D7j gOMĸ7ẋ=jCG8wOszZ 8?AxY@OW-?ޔ¹g6Z_Y_?K#Yo;wT7 EK~a#ŤH?ǒ$yB{}㜤߽8qZϧ4ő-Y跕mgq]1/WZ@ҝ<ûq3vN"ܭ'"$Nɿhw4.}Xh]]%98;n.Ρ/ױ+?R>G돃4CV/R:Ԣu"|Nuβ]v{>؅$gG7{`smv$ y&A~Aq= Ɛݨx^ N]MrCL ^Ka跂潂z%kV:ps“[jok)W WV4:#%?K߿?9mpxNw!E':z!ôΘEqm6;ϔs ͧv]H~_@2?|/x7|1vΧ1x?IyI'/NRv"<ޥ#ZQ/n`PM!B@/ad7_C]$ըH“*ZǬ&[CZ%_G8o܃^c;:KwxI?og&̟= E;dWsȮWBׯ[v>}ڙ9NNSTGLF*矒0Ӛ"6AKށ֬UI㵣QЯ4nj羠Sۈr%~8ͩmA)+  vOwsjst]TGmK:WiiӼ"/s)ϵ~m=uE~^ݺtWl)J_\W̳g3Sѻ&(_{C<*ۙlmΗ}Rgf)V^~y(v?W+WB sşqy)VQ*vM܌|ٟ>41k}(tMB?Q2Ffr]ѓ 72Wї]t0k{7L&;sW)z1L>Q?6CGbGAkm}OV[31(&5̾>3+vMxbҋ_G[)*vgf<|Q觭?s(|keOK~Jan'9(hƏb3So4c]*Sч[ Ŏ[?L|QWy}*vd'fV=S䑊ۗyUΛ_3+x(~؁"GOMMϊ\Wz-EJ3RN"OEhZ(M5만k":W@?Lv1S^JUC_"WSܡROBLn+xY*8؝O9WT_y^g0W}:ocOgE&>WVAGE  }K3>|6 8Ktߔ(ɵ㔢%NSS>Ljf_* +~\y(|)rRZ2](q8ߎ)xn)QBϛ㟢WӼ[?E>;6ŞLu3{WS؝y ǩߔxbn0C}3;4ٍ"E/ Sft˓tʹzMe&Wl aƬ+f/FV[8meCpu˖O[>N̚>W_:9*wϘ>[j*sg3޿/3=8kڊ'+.Z0i՝nXP>jFU>z働^O=LTOj'Ig7}1}2PhL4T&* DCe2PhL4&j DCm6PhM4&j DCc1ИhhL44& DCk5КhhM4&Z DCk5ЙhL4t&: DCg3ЙhL4&z DCo7ЛhM4&z          &=M4zh4iDFO&=V=w{ȏ*Q-?jG(zHj=$ZICR!zHj*IM%$5TJRSIj*IM%%5ԒZRSKjjIM-%54FRHjIM#i$54VRJjZIM+i%5ԴVRJj:IM'$5tNRIj:IM'%5^RKjzIM/%5f#Hj6f#Hj6f#Hj=%ZOISR)zJj=%5%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%*%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%j%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%Z%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%:%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%z%6Kl$H,Xb#Fb%6Kl$H,Xb#Fb%6KK,V^Q^f=si]g/`?C plm/data/Males.rda0000644000176200001440000014510314124132276013512 0ustar liggesusersw@hi #".[DVvHdeo2(ZHK{>ϻ_'Eu``AC c؈^`V;l0 0  1\{ 1|!60Xca &cpưcpC0P '1\pu w0cPQ;*m1t0 00X &c! q0pkGC{ 1b! ; _1P[;jz,1t0 0xc9a^\1,aa^`P];`a\1,a ;0pu j M L1t$ 1,a#00pvZ0c0E1l` o1a}*`a_ G1aC/J s 0 ncHCoz 0v 0jǰ-nCp .c֎I g1Վq[ V`'1֎H .c6 bT ^vEcp= صc:q A1D`80Վ0Lİ J 1\Ð>7Ԏ >FbaaXa`8EXa`/c؍a?P a`!g21dN;S 00 K1pE 0<[;b8b1<C!b eӡ-s [1\5 DQ 1; 0`؊a/@ !"1\CiX0;va!v:b0 cx{t6 c1pvja@c]P;ݬ18b j b! jzca&#a!C6fǰCC1$b*S9!-ԉԓ RR A=M9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+Ǖqr\9W+rsB(M1`Ж3ʧ7?N8phq򖏬h[8⓬+?G6dN>Ed폻 뗷}'50\|!%St֧ ?dW@~w!oydKA%+OB򓵯,}C7dc#kM>}&)o}>"Y[:'dO#L¡7y_yCc^/o!?w\E>'k_\~0Ȼ?Udƞߓ![w?wⷱק֏7W\|Y( Y/d'/_pb |[d!k˟N~\Gv~뗷ݟ'4h!\|l͏[W>!+]C?mEE?'{dgy_8M!+ ?_l~#k)w~%ky;?O'{>B|n~yWd/qC w|d".~- |NF _xigM:v&kp>^ۘ qד'~h$_dO˯?=[7A6~?N?M'kƞqǍ/.5gA>dKY'_E^#-w(>EdC坟q)~-g_y=Ut}-|iȞ/d}&7ocn#_ٵGyl}[#Cc?'y??>ߐl}@R~?˻%;[UtϏGm߰~y)zwPt|4ߒy?_ Y)|l؟{w~&dG=Dzyϐ}m_\#_!SdOv}֏StyȻ!;?lOYʻ~?ͿdAV>XoEdAS]_*?Wߒd嫭vi^*w(?d׏EMB497YUíw. ,W{S򴣼__(ZufQC;N Nֺ[92גy_z̺ɮWbO}Gv]V#k=S'#[~~6NVu[+,Jc/j.~5*G>:,BVmh\\]_C n8JdX?AFyxze~E~[_k}?{,5DOdt+Xպ*}ln]d=/Ξdeo5Jm;d,(sPlOT]iܼuY?d!c{Yٯ.27;Zkep6(^uуejQW#.RJQݟ*z~%J(i(~̏J4^Y}Qd>^S-cׯ痷/gE}'YU4?t"n?OG)Z?_듷5il~W4vG )"4 ߟ$/{Njx^춪e]Fe^s"!~6.;87"{ܲ)NWC9kwd]j &dd_ ̼]痥}e%?u?Y7Y adU1+m^;YJu}SWcdGCWW_}Ǐ\_> Շ,_]!GGCt\ke?[G]u+SWdڭsyO&g'~egUZ_Cu;!YO鳱WW]|~~w]!854o2bYy٘Ϛ?Y7Y,O//dkYqY۷:oȯh#Ud |_k# u]m-WW}.>SW~C;l_we^]KF~Yۏl_C>iH~iW21SwB򴿬'{m~T_ÿs;6|C's\+K;'+7n~o}?W]_7DCZ,tb _yY$_?~Q5TO]׏'g$ y֏Qg𻷧"P$r"KO͟,V|\MLJ^IU ʵ)Qs~uNCkPԫTSVů+Q3_ﱯο_FQgX;jkWƇ҇1nƈʔzWO@i%i7Wg[J(QQ]%-4_4tXu(2J}0:xc3|ExW֜Tռ =SޙY$j/0j>qb{E"sp *8՞72]@2*zM12. 2 xw6yx65ȬՂ{߂kby'Iq82z^nn*Ufam<9Rb}z9< ]9YeM{><*s7Q@sL[ ]7Q3U[7ƃmx[,9We4-]kD"*5Mkv{|=%D)~M5{;_Ug)%GenEYV GC@X2gD\9Sg${34QmJ@y{Bs0?4 QRs #?4`=: N0ߩ{  :6de U;U@UQYJv9Lw@nSI޾oC):h p x֯7H^jɖx!p^z ԏz3SwV Vǡ֞T5Vzw}3Owvǖ(r"[݌K4J鷤+p9?+Fm3gK|CA@O_ztV^FtiA9C4/'i"ZVr==n!m}gjCP>HΜN 둁YDϲ_+'  WATQ@C_2/ q(Uo(FNƘ ʃ sD6~݈ZqbmŸk- (Y樏(7h~y~W`Nv\|.F}eE歀35ym[=c9e ~$yK%H0}}v: 14Dwv~)&B4 O0@6B3" =Xl Ym<텨AD#j# W5wW`JgCx͋V~'y#QZ]*]?@2((_!|+NETb_2#]!}D/`"!7ȇ'.#=Nir1'-ؽGU675XѮҞ^l[zw >݉h/XmT‡~u*LS BFAb.B ¸̀ml-O«rR\<=. k~\?l˒ ly&C{_M-'oXn兏][x;sDEL6 ">! {\qo ӶIްՖ[Eߗw-AxҪ ˀꑷ'OR?ߍXw@zɫ~t_Pqi~ yrE[6\K3[a-p9!ާ[j_(]S{5;p ^n1QWt !u ^|Hюdz^m)O"1׺&I(oj߷e+)K5"AkEAԹP!vx`l?Y< ::< g! ϋr=|D^|]ڳyS8w+Ѷ#3+5QzzqOCtTdX7(6a1S83O;@EQW,@5mvP>x?ˏ3J߲D"^޾bѣ?j/oqqňtc}|>>ZRzG٧nW?/j@BLl(6w`Yl{xYHcKV[hi8p;s!'N~I}p&x? ^ǗTF"ʨcV jMɈ$s":ڥTfm\hV5Hg-_ {#sެrv%L _؃L!#̫Xj_n%a锅@`NKӮ}$6  ̽!xє}>I<87ݴ>HE8shσY'uvpbk4k_^mw a.U<N)B'z{`nY` .*[+]DUt}qk>qΏȻ.@a;6}513rmudydA {= f]h&+6]c?D9Dݪ?H^tkrM(q9^̕֏swz!zF4ba%neC]%1]ߵ[;19"o/|V*?;Ɋl__ݼƅ(0{6m^_nxJ *BD=?OIsNt–S{sU+eF:qS7njfYEPhr}fw]'`l m}XcˁneOz{zY睻A<QX䋪'?(̑Tm{@]*e T-D`9zXGlCK!PYF m:Cnf8p4M`]XB֤3EREPeri+`hQ,JrkU΋( ]>'**E]5wT_ c7 tqк#:jݜox?xqX{3=tYl2M<}A񆸄3@{WjzD+ Q9r#0FJy7}Sx/[CNK'@e!+nޘ{5ľ6Oz_֬YZ4 3h/!i7U3a{DJn]!x7((=D E7>46:u}r6sDj==mv!ƭہ֣OW%D2w1Z % P3|?y"S u%2luÈŇrc^ʝ-A`s_=XcO?:Ý̧j37\ {=ehmQ̓#Z.~F)-]΅ M4.]maeZ\9F)Cu!'JK"KAgBiAkv*'HeVT4Db_ۃ5^ؿg5p|MFřׇ'"nl0V. }'?bcfGnnW6QT]c. S|d{&?m$t)bJNt]}[ċ @mE@<nQ߁/1|VYwԳqSן{bǥ#>ّS>(k}JGauVkfŌ!OGAEgw#=N=ZāMny=%-pn&†k끩>ܵ&^?10#}C/0m ,#ӻ Jr[A7+N|QGjxsDM7g[PZp]XAȿ_찚|N^wMFE'4b4TUL£Cˁ Z"sFkZkT;FJ6\8NPi>Β;._%d[9v\ /CkD?sbyvc&3sn7|luF;SM2owTN*{ITYAu-`rPvŒz*wB0/Eߙ&1`.:!,|xa=af lø\ȈO1uO,60Vi*DQ?oLaxn9z *&{ rǾOAe@GU' .V7BWϫzOOŌ%E->MEĘ5wߺ6]lp{/7{"hwXu .W]AS9;mNr?٤hƒȗytӉsa}@c}^ X<$?SN_ڏX羓D?r Mr5 }/ %k<YCɲF2րh+cC1T}s0l0GpI@bpՓ j&||3 Qdws9L#ɎAko$#Jѣ&Diק#Jw!g!icA{Έ] yݱT#Xs7e0کOc\ei5EK؂({f& (NSR6e$ByOaN{[cD`g2RձXsMw}ȿ1f~˹i6bܾ v4'} ª˪kQ88Ls+Y6\SPЊ3rKL֏5_*"NX>f}䡧/D~oCMAt387*U |ݯH_^XljAEKXۇC}mz!X>y0q*ީ麺ӛ(Xs$ǁg{7.gN =B¼=P'g0WG?{BAV}NvdKǚHBh%5M@sz#+;][!nN}-[C8:H5x@1R:ja)(M|[ yU?fZ%Yn=QZ-ê$M7`HW/櫧CNmGquZܨB"^eA,@DVFk_U,0rx︴?gGֳn [`"r>c*_hG+f7{0!߱Dfj(s7tl9TuX[Nɇm5qWYSdO;!}~D9u[c$_@$PhDWV3 h *~`Dc;l~h7_&nKUn<hG٭&b]CAZTg9_CK~0'v#M j/xy "TLDe _A#,Di, g_ϞəkFEň9Zoscz#8Z\x&;;G(-u2xݵ MlET.}ݲQV(cJBSz\!OM&a ڗPߗmáhqlzD`v[W9ngo`KIR1|IK+|Rwۉwہe 55u"hjn5jrMx a߄?=(Xn98S^,VkT{{//h~EETwdrZ"ic *W+Q\o;5~-4/T JсZ#GW@ӓ֟UCA?0qގhC-C];^+9[3zli Ҝr?r 5Hl?̽7YzL?)O~50iN / ߿i5D=pvUcL|t#zg &'GmyK}99_1?d,Lo ^go}Ec۽΂k[7'@VI&+OU4|]'ʌ- 3wN7? z7qV7W/J[xmBnǝ_xcWʫOWΡ#Zg-K"j."jVu]S ѻg+N@7n3>:` ׶DQ)gpb4VN)o0|7oNIP)O+LNcqeaov_ p$ OmMz-_PYhy}'Is ǴYO֑5g(vn+?mJea+vQ۠sE}+_n^O<"`d:~7R7#[XlW翣8kG%DM_ىK?857 q]#zS'#ZHeر>䵡k{_oWiD;ckֱ1xh `>m}-tBSZP"9N꣊37K'Vw^?7?<0T^:$x]6w_qQ?V%D3@F[ꏚC))鈖ED C_ǧB%QF瀣vDdm(?6fmhD75w8X=|#GAՓ{&gBAUW$}$M^=˷/~&]bP HQ" %%˸D=yk ?_$_'{DщT wC>wb9gMSDyvA vG?QV@/wr ?fˠM)ns`xq|GP`F TjouWcpAD|,FA Xݎ ID.(]BF]|Axɝew/j=][N WsŸ6]ު6!3ie#@w}p:d'xYz<ϼ'KqO .QNs'?D }HVO_Xm=)}CtVBJnqQ2n#/ۚQXmF5nώ>wÄv߈>.+Մ;q7OGOeAp FAao$@UKnؑo w[%ÃKô#3%Cʸ8\Oym6pt̀Aj{Dy'xDȺwc DcYw{=w1:G=O^%;i"`Ʒ. 1 PFp}0x)}:oz(j|ύD4CZw9mԝӁ|Dz D[G͒?@lo\z~T`Q(Կ92p}_eƯ&X*P=O,k(Hz~TxXv-xqQ~ԣ?$gOOCm~ܓҙ%6b C 1N=֒U\: [2]f_ MtS:}ԉw9Up`U/^W\׀'C7_a'M2 OaܷUN@57eXCTE0${1w}L^u27swr@K?ۏ~߉MeCup@ l<0U#-YuJNK<ӵb/K&r~~Y^`-\5Xĸ[mSio@0E;be\$κGn{3߭Χ5 zG䕍9߀8v& ]wFv\I큽kl$/߆ ɦSZSA0[4t  G!#3 QO>ZG?W–TU2eD+ZzAmwiZRo{> ݔȣÎ︠ QC'9(]=pZ\BԻþG ZY؋x&^]1B 𾜿?D_)aه.n+@a0{3#Oy`mN~zBUS%ӇJK~ݴajOrb",}5>%̉t/'|F \5GOlsϞ_o_K۰^*#G[ aσY=fpqJ_Vg]:aƒpl)?m7 v]{3e!ʊ[MI뷚Wz~_#0tK!?%g򖃠m"d.J߿rIyhKV>[N=['}ٔ3iSᅧ.d H?[@=I6` S]謘6H\ߵv]&s#~ɡY||-ZqɳD ](tLdxov׬6Tߑ_NFJǿDjWI 2>kNHZޘ՚߿M}WU3=A)3&%(Hɡ!wOv(}~)xxQU )qϺKuM}oUu|63)>dsMWC4?#ꮅ)|m^2g ;=7/$:ސ&c7}'`W`~UӚ$AݟD9Ԝ?!\zX2C Q؝ykglkD3fĿ?u eːjnvi8 8O:jYRu빵v/{M!=?M~x=F_[v¤ tᱽP6͗~ijҶ pGj9Z7vƄ]{`~O J;m7Qk"=,ҒB™ԀqgV <LI"g7dc >7 ?{:3' c>s85a\_LC!Fg_7>= 7:X^o{ orzbûovV뜒RsxD8@(@Ft:QKdfNo#}@392N}{[C'dYFiç Qk!+eWsHbDᆬm/iϋ8\}_"~] 9c^󎃳S@ӥmuc۞"?VK?6儨ZwQT[nl+u^{ UV^gK$= Yl 6gnw};A#Гy}$yKιZvMI%}7^m6d!Sz^ƎUK Tݛi @ܤHeH[~#^HB504Jslj%}7p~#>yQ6/ؾw|ݖN i/oNBԞ+Ӄ?r{Emث_ f2ItZx%/vW Yqi;$U!uylO(7Gxފ+$sl[J?PnN7u `K*UZa)5"K˧݃#z-c52D:?p?RS~Dep3Kw==hB7񩲯T6~)(טX UvƎ~F;$MX(vaaus֨7W# ]KB >lNL}ҽc]jj98xJkDܻݕ+ɫ ʑ7of Z4۲5_Q+opDS4{z w߳jqV0i4Lm9p\EΞ=M(wϿ.9>9~|/YmxcLԓ+3켁kvx۹[IϤ_Gx \5! H{@ S%w} Z|;IraD]|sNoDZx D} Cs.Js&wG"n?33HB]wDg|v'.QW;SOgUK$K9}3-7dH A~聠 DvQNz;$ѫF9#,,7 @12ԁ= ";zp_(6W[' ՐZD]&pڗaIOǚ'@k*G{mfʶ/rzStD.8ǀoGGWu賳7s@upLP.VU̖a5p:SMeFS=5wP,`oqm i>zuV}|56~qwk!E^b)܈2,g ,.wAi1 _DÞ6C;Gs^X~b1 ?_$}فӀ{b[ofBjXQPw-?FzDq1- D&,Shx<\WWzȍu=g|IVoتx ?l\._g7rƂEhBjvF#YP_adN>[Q&$Fb?᭚5;:7>0 /ˌG̳@}w5|*?q/܃G.imA~-J%4xwsx |CyeNԏqDA7t\Gwa/dg L6[h>˹2se'yrǞs}!?BYx,'tRWc&+:ʹ= *c>ƍ[ ]77@:qkAFX $?~I>6sc#'-,ӫUnj7/'~E!i~YG8R.hM!OOLIjoEFem?6MgOLBPcq^45Oeߓ療 >c$|3kgkʋkkc2d eP̸a&+&k <{OR"'ǣBZv8":u8V⏯a_wz4<ĝ_գw7?z%j\>OAYgc@4X3;ips.vg gs49-pa/GN9Aq#Ysљ@E#f?BP2F4B-NНEu}_ɠ}k_@ߛ~'\[g˨ʾsJvW'Q7*(q?mZb\w_@ַږ| rn? _"/ Ѡo@-znߣ?߷{ jA7cQEQqto.nA}hxZ_ qΕzI?tv~EXv 3ݠՁWާ,sdEQ?N%,-M of^6?U]qq{.rneaDL`3FH9䔋uSQ}˶k'~̖N&}8@xk<~t%6:?Z@^  @up ~y]9y14LZ5~ l($p$6gTo8<[dahsiՆݟ?.j91kAvS&Z7cp'Jݞl[ 48^#8; K"BwG̼M6/aϩaʩxkal}3z\u5<C0\_a,=d-4T/灌QhF}S(%3"!cuϯP|E۵'ίB]\"&A /j:GxkNl~.}ytX\t[gDUjzOӏ[ҊnwG0O6I\~o ^fzTN!kWb*f#]?Q@釽GݮQ[ɸ7*#/@ٽK$,E TF͓\jޣQzy^bJ_ߞ \^2^InzO @ZIz'OOXfFQ\!s#pyMVm!a([a?#wﱳmOgaqn{Xg}$__s]!^|ll(|Go{d>n3\$6C>UFb9OQdϧďW][]wUk>&_}FeN3_:>e[hv=zAcb`\R&ߍ={Aa\駕ZȱIQQvYxY'[gXGCqq16mrˑ;G\K ]7ul6))ZS꼪nQP?iAvHvL2ߤT(^]?Z=ܘ}$3K_9#;'Îo߼'CkZ~r%_cӆYLiCqxY9duYWq0uu~,ύk8dt L 6ȏhnv`o Q{&v>uz5ѣHVy:Hj Cwω-T.ni޿.D:PLcQx7q]fftZ (GEw+p"_)4kO|s.RUAUϘ; tjԿmwe#t-^L_58H.`Utq/[v9?~OAJ ?u>ݞW\ykg3~z믝qLفkȑC@h_H$Cd'$F1YeC 9=ʫ.s% c|8 eCq0MgPBS @hz|M_ ]y8Om%y NjY&2S-"V1]ӔOF9m!g\vamQvNd|c\X6EXCQ>zFM/]u۪Cʸzgð=@k ]hz.*ƺA X@_-3L,IJ@0Hu%=e3wW[ J|^c Ú7BzƚnfϜ×TØ;뤃|f́tB4"ja}a tS̀n` wSv.j3si?MQ$_TPfЂ+؀4u\ڗ_GD'o_,Ŭ=w'WTT|wG!?%cC7 oԞ+A./s4ݯL rj-1 't*GPtZnP&1EP4A2aTsܠN_MW;(M4t{2O[v'_Z խGht . KK~ ؼԢ ߣ X ܟ {nu׈Tr;2bf i^7=xh$<Դ~ _Uc!]GuWB|cx>E}|6aM;-rޕ$XHYm%FO]"&ㇼkzy9qAyc6JIɿ^Ƴ>ol=uyGџ,_AzaS>tTLZ/@} ~yӉ 1U! —GUXm ggF[6K2yDXvmv-{0/cMX dQ@ IzO^?bç G}X[vY3<^ag[}WhSt>ޕ??0`&mu&_cgr4eoF9X;O_9ƨ˸Xd?T.?mz˟56VMEOiŴywDBF&.]A^su 2Bhlk,w0p34k3V]Of#GS; |8Eq}G2{б}c^T_!GEyCsZ#p ߖ)7i bUGfu} UY֎R=.- R:Un}Z]vx$[2?CFĂb8Vvb~~~_jvP\5s=aװߢf~8ctcH-A?|}s 'uMw+>^3'q6kIg*d[e eCGXwmPG}KLg qIqa(>=%+cǬ p[K2.zbM|oMǃܚW]k0d>-[".j熏|*x\xpt-~2oޥ>B_yWv]ϷA$&vPs36sn^+Af# _wf@hS3iä9bkjͰ[ Y9eU0BYk}*o^(|BKfi1ocBE~ewZbZ>!%"w$"C˷e# j{SP+;7 z\2}~| bճLY>=~lf)(]ys( !4U{xk߂k״G٠-=i[5 ۬`k_~hڿN\owQ Mם:f` L1l 5 xqw}%laP+݁=ˮ|5L_$|`gxDQ+5OyfbT/9)&@J "gޔвEuAR_i\г8uBB^`0vhOye68>-tAyI/x[} 6z _6U[NpVbUnOb?ù o,ᰵ "Ny@ѼmD@~*(a ?pQ;#0 a}z~d5szBuSG9,` KnJڼfY0UF%Q۵J[NL`'NJcr?CZ?_?FϨl?VB=ꭧM>'";f+N8'Ӹ[ϿX} wj;9&KSqTw^8s|89İaG'\~y߀'!n̹JN^9HMi#ZQRtI OBqXiM..$XnyKŇj AivUG7zeGrZPniPͣψ[E g1PG`q:9YPzAxLbix.^D%~}Aa%Q@7,zo:4ꍓ3~Ӹ /^p1xZ5s,6mYŢX︉ _sRF|a4K+[Oex#r2͗ra``Q VF~(gXdA'>Dǎ=ݜ?KSn%].!}< P[ogl-PW}sUP uV4<*ɃK 4v)cF ;N!q_s#n/!ܧ{.Fv܅ DTL{ 9Slħ~>*Ŵ6a^1 {q0O, ʿ [?Gh&ŝMgk_&< Mb:>H@0:aNlNj/ N!5;ǯF^DtH7 60e=H|ynD%mܠ/~J#4'6*ڌ^rTF!>1@.ZyG.|BX+<+ƨ?7y4g~vtOx{1 J_Y|'9U=o.u{ fb6Nг5o{ tb速o1=0w__0ҵAfK?`?'fOvC@xFԯH0p(g!)woh^?s+ti|=orrA靭 {tOWuzDÅ2r>E _?M$nߴd{;e?Ѩ?hZD髢׶!v!SP>{ d} =Yޢ 5 xJsn<.=-}ԩO sH;9bu-k^/qsz\(JyuӺJ B3Ÿ# b^A pRȚI=2x9orqSnK|^{";E4v/MTrdw}-8?6yҧ:Uxl$鷥,vr C764I<}ѹfu*7}uKwBco ]iz0 ~w5Ng8DqsMD+{t(8k u* B6]r"KNS6nA8p͑]ݴ_3&4tEdP} @V:Ȥ O<ߔϝBJfWШxtrB;ԍP.Av<Ƶ~Ѿ8w0c,CAZ!W%sSsjAXcqFy%K0i|HBq;##]2/&N;'2U8ˇKX W5/f'܍r@pwxU>,m ]InǯIeguȟlLI47&'M2'TtIC%i^UUR |֋t{O =NDǕ.%@qϩGTΟQ;ZzD;ԾDQ2q?o?^lqQ7X[ ՛sR ǿg{6A],Q oj5]~b% [LgTTrNIА0x_5;3 ^y;~~ oY{ء܇C͒shUz 5Nm'p;O`9hoi?}\ʴ=g%דCmNAv:"XӮ}g~tN{WǣKGS,-P>?|uF)o2hv%c? Aɀ .gq"|+eJKEG7҇BlZFsr% =ӓQ x 6ל|_uc+NxlmN{<$ o[Oكtsa淠qUs8W+6|_ Pd'-ۊ%! nS= bHlE|*b,w;o,"MϏcVBeS>'A}9ɳPne=4r}yj_5c{/[o̯ U[~_RECǗTwQ3^|>>H  !߇C'kgmn-=(,F;zA4w$|ѧ1+O` YSq3j< ?r]<'1V.Iɠg}9ܰKW. «F?A+~qKTk DϬsQ=}=*@f߹k|Q H'^*x%Hz:>}R/'wE=rۇ"39WGfjNF:VEn=_rggcw\!瀴:}Tnj_ |j [riԎ E9WuxU{7:=1<ȫvzҹ^xԨ8Z$8-PN\QX _э^P~j~wMK}_0:Fx Hu:F?ޭ=_k~7Ah<<wqu<6?$hpEOMڟ'E'q;Q~!q\ьd=6v~?B|[Y0j^0E C^!qArap֧yM62?T aU&]olA8~LOg9"$RoA$bNx}^e73;&޾{{ Ou GI73>ܐ٥!u]+)V{i60{VQ]/[cT[]Y,bvݧ7? ~v#}u #_GMEκd7]Nkހ;#Wѻm ${ @И.??'ʞ 4faҤ#I Xz1fDOB2+vrؿůhZܶg+vt^vO߉{zU{K߅p|N e s-%9 }Q@KЇ 6zz [{lUߌg%% A\uDe*w̯HAzs_$ǻoONgkЎލifDm*y(CX,$sk%ʵׁC?g ;<NjӶEvy$UL6\//ϸqqAm߲! cV&}K?q>q|fw RA `|!$7ʥ Z.݂̳\* D 3O_#w]>EX *B?pL)fl3(_ofazvj=Vkǩ0`2lo`7: ]#s-f~ezp/<>%8_|58=?3ܬoLbۚ$WWЁ ך#B{R>8pJs&qIWDKAʳ`ܘqV}EjR;o^{:ۃ\j*'WNzG zf! sSF;NEI: v TpDIJ @E]/p9H"XP'cyΠdQ\0k@mpq.j VμD/N,ݍꃃ~<,A⃁v]s4iBG`L:OG~6cӻ + ؀딉I p=(7$,B3ӳZB[oh6,7vyKG9N9~~"x]m<<~:S[L> „{%wɔ^[n]⯛mN$T^Zn[=󑐏Μtk9B+w 2Ss?}G׏iơY+ d6WX؆x…kzJM<3ш~u]O'&nӜc}N;89hǠx"wI϶;b:;5*8ι>C>APnw1SP:gOxd{P*N{zH4 *wW hdkײw)#"frDé[XxDsn~r1 :pC?uϼ*l.fGS!uvzɠY]Q8vW ]wC|d!3,0(<0vL.QpA=KX0֛7Aސk< |T顤-AČr?5WA暟θre?ѵ׋c jy \N0S y/1@2K/"I;xQߗ(-%0ױ^M<wo.'^vw 4{nt{V6B§Uڀ2Oxz{ignbDcb0D#=2|Qsg鑈V6o"QOxn.B_aX G&N|%Uؿ vȖж_',-E5C@qz Wbm%ګ=`U/LEqsLʼn]DXdžFXw>qa9Zx 2H=vĮ߼W}Dۀ/Pǒg.~Eǽ?9pNҢOl8m,gFA.95B)U0azuI<PCi(>ƮY0ܐxr"d*3<~) ?h=?wk<~. 2yW ;_28Ql GCW~y;Y*a/meѩaCQ{ڜ~ y n?; ӏr3A㑟Z.oK/9-WWPjW*PdƃRsX;?"m=1'3 Ӫ笉9?Pyq+4a?50%Gf뷲kL:ijiO˼6+SQSR̯˂zP^-eۦ q -{;EѢ=OM~=dpBr=d݇QZ| fן7߿ڧn4u6aPM٣^?qLs#SG$MVXl.m*DA'E~޹ݸ=T"c̘?}}tۻj:/0%ؗ hc-#ATfȲ.@io%8mqM[ULbTds86>\9ʷ!Ͽ|Y֥F| p~LwG21eJ+Vk V' BC7q=ˊs&L#͟Q{cXUwɷ Py?zD)gռ3?We휄yP&\eхLd`?LgZAI;>\5Ƨ-꒑?x'd#q=kl>i'kfO"A3@#G[70bS^. FW ?CrQ8qc?!ۼ~sI羧D=Zm}l|+Bwq@cN y=րL<2p\ Ƭ=/ X+'W58 'x>o&ߺǩgLW흽;h;kܟ/z|ቼ<o?4P f=4@3-k.~/6@+_Db,̐lF,0hDPi2e_ 7A9ja;] x!#@ܮN Q[w;l'4]h~~0Q;Hh[-)5g@}_ͯPҥUz{ wfA5ሹ e 1cx`7~>:0l^'%݅QQ^xZ#fkq>BwN5#,_#v0}V&~GpG6O6O_gAT~D9߭7,@P 䴬1Q;\m)JM'Nב~Wï?y+zcK]Ckd^Qt^?ԝEOςWւ谱-SGh=XxIgNRzN>6}v#s%ݠQ#Jጃ#j^&q`!~Ǿ/΁~W-{ܠþES@Wځ8|Pv?5P {xu?&$xgo,JlAVn.A&'ⷂ8O4W͓P\˘%'A2E|m㮻 >)h}Ic 7Z nw:0G{t6C0+?} q#7!kjnD\32f%\-,d|3oy9.snClrP Ȏgf 6:Go[P(-n6] ]PCSp?/+#Ft_ :\!#\ϨW4s}M'vK~ #A`&9tΩηj;_uA>~*T̫OoWܮ)wѮfƅP{kъ,W $~clGuԤhhEa vO[o՚vSh5C*ߨ7r}ZMWG,VSڄ,[XTĹ \Ϳ.EQSQ'&БX}&}",-Wk/'<{dxB/Vi_-`R<#uU*MR顶.-VG?^T)fc㤷m*КGdN矌Z{Zߚ$QoI`AzgUžkن-*֒i-uD\A5D>Ve;BEWU(k0hEn {8^]nUUb?F3ύՅ}'kb!ҜX.m%ۚ|`B-2Wt!|Weڢ19 {u,= ="6W2Ҧ#6ym|P0cڴӉJMT>:᪪8v,aFMdT"dy"~*_ E"Y?kOLX?<ҚW[T1"!cUQ%WX!Tk}UqA2~$ow[k6=LOh[Z[VtO?[n=*Kd]LU4 $ U!^d[- f1_+DHCm>پ`/z FkZ:tcINQTQB3|iؘ~q9Pq_8Ⱦ1Ⱦ:O-Ts[ַZ[k8{DAĉ;m}j0Zk-ȼIGeU -aSOQ)vOֲ^o?$jgϽ6*~NZEu*KKDנ=~b$r M;mYmL;m['*9QKc6~Fec[GCEVj[qukǬIL -ZX0G=&JZҝmm81߱SBNrZd>&HxTaVlk*ICLodZHGhƆa[eJ-UQxےN[qW[ԒܴEf}&GMzR Tu7"*TrCcT/غ'?<'IyvoGCLR<ZO?7d,~[e-*mn֠QXeBx7SG1~*1m}*>ljf>*|MSO]m?-m)2A@*?EgiC/k%%Ӷ-ȣw[_`~KG ỳImW|ROiT'!I%BB:b:r݈4`sHodhoGKT8`sGMQKxF_T)mY= QǫZO|lhpvv~kjB v.ٺx;zwA+wrnuputBUC[_W twq6wk=ݝ8{#EfO+>'rnq%?Vx(YɸGU&砊%#CSm tCKjlxMKZ~KT֦FhOF(ү5nT!Elש%<i@k +L}oWo[[ Xߑ?i;qq='>#o"g`G<k_S/TwLG0It$S#=#d|E7" ȱX*AkK礨!!kY,ڿQUľ%Ơxj=Ƕ_U">iIWex\.$z?TGMD%,ڟ$ҥ-:hI߉Rh-aK֝dTU쏴ĻTՁ)}k:1V7qM] Әn RdkĘ95K+yX9 |&TV21Ly g5 G?0J?P/f߶rBg{Tqs?-='!2&9ߚ|eh;1"|dlZ/~ny,3T %0&s" ~Ra2fT(cT}t,!7{d^R5GDC$Q[qYfH3D}hMq2LesK6'TNռ3h_|7#IB[<`b]y"~F?WyZ!dDc W*NƐDILk5[T+»m)U,U v񈸇Je^-qv8.r >{CUsAY^[/bY-S☘[X,OT4!Km0:'0{@ƣD}G\h mX~=˩D;C}'%eK/~h?-µ%\B57}ZD a['F{@  F*E"PKI[}|z*PA*YQ?w:2b]ƌ66ERab3FP+>~vk^k˭Zx=sǖu8v˽{㟾;osk8>s8;{حx?3yx:w}w3(]qocķy.<Kȥ\v{>us5)yw:xl\ns!)5-ӵ߹gYߤ9F8룇ω-8_[MsFyyxXǎ:;_/=_˭x|8m;ߝϹks5¹s ׯ5~vyRn^Z=9>9~yG'A;x>s]띞Ǧ9~&WZw~OKo?.}ߎ[U6}uKSKks'5x^w_ϣrw<]ZNޝ˵׎ w>t~[ֵggfإK=7qwp|ntpZ.g Nx8~>~p9yOK]玝ۥk{m>8~'v:Nŗ;w.6}/6ZWcs-~^}޵/Ny?Of]:6>}yѷ^s\]9#|Z{]3s;k4?ד/TO_>_n_=/_|~ߜC嗏_xM{W/^w}|y߽|^/~/^>~rV~E_o˳]_gywwng_ ׯK xE_k>^>[˭}ro.|y|HB˫Kˇ~n}/ﯧnߙMßYk>ou|zn-mMc_]zn=]>\ÙM_pa}oo];>~ ֟rx9M+~iq''?>.b7Y܎Ky}czb>{}?/zyu}Ͼ˻:G\s~#xx!rc}v޷mMzǶ; ?5)?g}o/?ȹ]>K3w\=nu,Xهo\;ܧO޾ٛ<3Nc_|oy]{n=6'-~-g_;[M}\wux^>~_Mm_>#_Mt[N,g-{޾OrǬoϱ~:>=}}/vKGw^߿z9ϼ|yy}mZ?z~~]yxÏ?9nwӟkZpmݽ{k3m[y~~o˷s{/] {<[{>9>߳b}+l7I^7 </~W毟Ǘ󯾾Ջ?|[?=z}/?~'٫ϿxbxѧxoM/N?ݳ/g_<>7[||o|?応?}W_珇/o4+ӊO+uZi~ZyZYr_5kj_kZƾ6}gh}gh}gx}gx}gx}F3jQg>Ϩ}F3jmmmmm}}}}}1c1c1c1c1c1s1s1s1s1skkkk4'/-ʪZYmYYYYʹ-ӶL2m˴-ӶL2m˴-ӶLS)Ӕi4e2MLS)Ӝi4g3͙Ls9Ӝiδʴʴʴʴʴʴʴʴʴʴi-ZLk2eZ˴i-zL3gZϴi=zL62mdȴi#FL62mf̴i3fL63mf̴i+VL[2meʴii%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK(-QZDi%JK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZi%NK8-qZiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiI%TZRiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%--iiIKKZZҒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iIOKzZӒ%=-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғd%#-iHKFZ2Ғ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iLKfZ2Ӓ̴d%3-iJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒd%+-YiJKVZҒ{LY߰.u0w s70w s70w\a0W+ s\a0טk5s\c1טk----------m0an܆ s6m0cn܎s;v1cn܁s;0w`܁s'N̝;1wb܉s'N]0wa܅ s.]^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^mՆ^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WB^ z%J+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^2ze+WF^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^zUUW^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUCzЫ^5W jUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^uWUG:zѫ^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jW@z5Ы^ jWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^MjWD&z5ѫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW ZBzЫ^-jW o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o|.v ]o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o7| nv÷o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/o/oo}'?<~?_?=~_qQĢCplm/data/Wages.rda0000644000176200001440000010316714124132276013523 0ustar liggesusersՆB`{wŦa9S! BPM COIB I ! iw~ ͹tmWZz0Hmʏiϝ + \ߠ\6f{rC)0o/[p,}x^<(sI]cdU<-ŋU>[ |ڵY\1c/ţxtZg* R:ţx*pZJQ#ܬiΛj猘jſc\_<*4Ϋ.)g WE%pj5J`.crU]ip9jie ߺ۸*],6oڴ+?]%WtqU'\r뚮u=YԬ}9Ќgvs{YϹs]ە\嗕tզ]s5c\ W\\uU\#{Ώ\ :7WϺRj(v1+tj+3a̋]iq;xkYǃsr+_*jqE]j\mUrpY=W[sCukbs姫l]:qվ]:k;ʺuM5gY-_ֽcaWyTK\#k\y*;W93k\\,Nd{W{p3Wp]W~s+ڷ+_\!95:qW\\sW\\+<\wOW;pAW\sՉZ9aȓ1U˜y Y۴o:^ʺ?ʺ*w_\\vuM8$xNڟ=kfݏs+Y];+˳U3W]Z~.&RV:ϕk꼫g]⋋>U6#Uw]ƴ4q.emG7u=-,<2[ ҎpO䔙‹Qolju9r^)|f,TnjNLZ:w!8wcR\GDz*l7ijVecϑƺL8-xY<=d8>Lծ!e#?K8@tbN絓Ҳ6>E~u+oOYCH%O.i;Y?{{2W) cBIp)}=&y^Mݏv6h3gaa>Ygt1u[E0^l8&uW K!㚉s2'sUj<4a}7u/x^wvۄ'vdZma#2Y(y!/a^G+z6\9z4{z,_-}+I [+_rcg}.UCKIgqByzlvݖcsZGKAJ Yٙz;7u8؞$c $=vZqR{UX;Wԝ#ku}T㕴k7΃97u;ôbe]:F*T׵ty1p=KW: mHo];7u9QqvOI/_ 댸e/WmLUm:=[ɏ!rm{˲m]ڌUd%9?tt-5>Gb9#T Jxߏ*e[HUrʣ1zsng|sVVv禮T[#n9]wC#$q۰oyKauJ<.W_m%6*itVkkcC,ұXnC- kMZqllmNJ2tJM%MϸVxA[.s3Iԣ9-S0;k\R=kڋp NJvJ}qXGjþ=>krS(֭Za?Y7T8YKa;wfiLijnScEsPmxNyGr(21v/ɇjsC{ ^'x_-Şo{p/U՘U%p$66!kTcK«&}g>Z//c^|N},uZlc^LC]gyUx۲-.~^-n*׫6\q,Zk>ykXtU/E;Lcg {eK(Z4 J8K%Jϑߏ>oI68r&{,ڝ-eTNZ|)! א05%ݮ.M^2QuZb/KdNs76;l1xn y#kl]da=ve-uQD6En7?Tvb{x޷fmgGkr;n-Ä>Lvĕ1?bd̄,\+'GOs߶/ٵrS-uLҌuҳ~זsp]U-C"n.loj{r= 3|mǻ\s:>_ VSOv/אz(eޝӽf;v񕾹tS|%߫vCUgxKc68}\NB%,>bGNcJ9e'b8[ijk_؇Z[+/(78dו{G;7u"!qu/bT3J\,7drj U!]gzSڶۢ^K%ߤ,]mB%ggl`8\%J]Y<$`DŽFRN_><7aT>:"vX{_SH=gn=S{ Ɓsml'rHwIc{˄PΛ7F^TϘ.šv ^ǓRwp ڜCFW)'t% `_vt*&s2W@t*НdQ רv*;%~Xws{~(|=a샎>+fì`[)7u<ՏQNy*kL ȸ\Bc1Ͷm`sgk|.zI`ۜ'g_QiY,nݶ#e-m]Q|ˬ>mUyO.cϬ7pI5 :<9K[LcZ|F\e[*^x,qV$aT뇐Kc^ɚ(޷%3222v¼ż vWy_a87u>T[w[j;#%¹RgdsQpo)o\v0쿷ARֹeyR뱜g6k!{Вֱ97 l`|L ̽0/rD':~ou>Sc|bpBn< Mƥ FuvSmKY9cxFivq>b+̗>a\c+S4S^4#C_My͔Lul=Yen=k6657tx=qoFezYv静Q˜f󚩾7?כ{F˜kNo8TrƆ%}=}Ŀ*7=qfMgOW_p\GrnsYR2ltJ[kvd7:.z]_9iȚʥf,fJ_ϳfJ{3u_ar3Y_9͉Yٌc(zЦϾ/cf=L6K6 C/X'ף~ֳ~7{C5:NC3qZmj^_;]fʳF73Y2hL mvT+MȗZq5z= ]^ӛ}vk|驼WKG(Fm|8vF}=jZy,ht_`z]4LŗVֺ%?jop=zYrɺ lDeeqOԳ3sMy,FYQ?)}}嚍.Sror츾+fJ{z'Cfze;3ih ]^aD}}Fj=F5^{FRR.ӓw͒ЎQ?{3?1ʳX3^8lx͐/3¬z5|3kWEY*FYz-\mfgc3WTz}ʗsì{=.«.k^qdg=xYYS3'˸%k\e[uzgֱ:w3FvLeTdu]krYu^VWyjا:.G{ȚzIegOE䊗߶y$_]=d}efGs~L::xտI9&w=ɪIV^IEZ//y^X{QIa_$8i'{ҏe\<띤S|ݒ=~t$ -[b= i7v;%-:KMPn~y]qޕ|f^; ;~Ͻ'ɿNbۤ׿[Oڟ:_|ivt~5ؠJ.٩5/HF|pW2jؼ%#O:;d]gͳĨ=ÿ(V\|-sofɈW_IZz”okjou`ǷIOi&o>~lډnT݆<ǍK:f_OI"^N:G?i]I׼wny/ϭ{ЍlfYei=˿si/{;?;V$]l]>麶7ϓ~y.>8X5iqʷ(v8#w_ OrO]> G:O\ɗ}⼗X_]t^?ot:esx4U;M>-ay _t׏G.:1<"`2Wo{J9棿=ICl&|KIS0jOⷮH ,vm| oyJ+wIS<=ȏ'gN>: ?P}'^\ߴzI uҹh ?9j8#>[^_1?O9m')ڗ0w?VLھ/}+wWv{!_g;3Ѥsʃ7trrg;eA괤WWzI\u6Iھ8$a_{F~7L']_Wg]o+*7yտUֳ6s_}g2O[5i+5l"$]}.#o5k;ߞ ?t',5&m].x%Y{'-'>俽b=׹cXdȵwEOjܩKydҕrs~_~}+睳0?&-?g_[38hc-~ro|%=lۿGtϘb7Ie~"8<ΖZwyiɫ v_gKZDžkWn7p]}wrfl~/ݞJ{5=ۮלjyrhy끵|d{ߊ׃'?nz͓Ŏ7I{^Jvq¿Zb˯yJ>x:L?zO}xZ=h{Vx})%#>n=~.VrCߟv}r=ht]s""K`Nmhy!u.|i/^u,G/iҶ'}w/:_Y% "i/%`MJjɔ+5[zASYieO'Ur~|\O͑)K%m_mO\\y}9,rɟ8۸c\NM{.x܃sVc^[<`ʻ-v|=t͹G~_z\ҾyM_>kˍx>+_w%- sv{#oE3ޕ|m7gu>#qO+8Em+CWˏix>qhu^Q]NzɰRkNt|,}-z7Ku#ᯟs'zD2YÒwt\dʦiq^{Q?77g ͼImbV\􊵊ε?ieCر8]i߆/vr:IO[K:VIZ2͊o$K9iF~y|z:q$btZ}~{;̸T4|[b7Ó5qyu,")8Z76۾Zfc泲uyH>'ycswHm<[Ϧn| ˼exmǭCV{a_\~s&KQj? ^ⓦmņvR7·ءN3=.3[iſ~~[g*?9v8I_V:Yj5h񻯰G.ʼwۥ|ub+|/^۟=#%͊[`wKPs\ 㛮bvWʺHuz3NyTZuvnlL:Ş(iyPib[I˶u'u|wחmù4ۥZi|M{W^IHO[b<_d;tK^1N0ut%慩/z?~tԟk׶0mC4{7uQ_t%[ܼ7ٟtĿ^˻J:YZs}m}pҾpi~y=٠Xgoҟv-q߃OuOƑүH;MQnK-8n[|ef$#v#5?MFw‚pLv#J5r=KK// ]Y/8sPqz:N45_\f^j֓:)xd:ΓF۞yVm_^Y'm\_uzn;3_Al,jtbG}[ҾAq:K;$sX&~ݧ^t+Y4~ oAi?og~_~%ŐT Ǩ},-H$#/*erq¢ 01Q}{:ƺxooc&_o/Nqk&\-Oeu=J ]/>}CE@ΌzKxI~ʙ'ZOï.xA^r:)WdIe~,|֦X9ەp׻_x:U1;iȸL8: g;:^o3ϬӦkS+2:s___HZ\)d!4`ҲzI.gk!]8']>=:?b?ֺ9"i?!O[7G Y͏-W) OM?{<8g^sz\݃zjլKz+lh3X}7{?'zO^94h~AٗvZ\2{(<|u7Y׽׾8nip+_31O!Lze)yGiIڝ{-\^ᠤ/哙Ygڑ+^۷qSNF|o>j:٥{帊oG:4ͷĺ>Z9u).uIkis%k&m~~L`m4=u_\w:.>Vx4\ǥ_94|ئ8jB\dXi45ڼ;{]yS}tYIۉpԆJNF_FUcOZPs:NqAfղ~qM9J?c%&b>o?L}/$:kRvǟÏd׮ߑr+*-7쓵n\(&Xć?[~ꯐ/]^i?\?ڿ.mC^K^d,~`YֲG묺+{|޴t=1t+i |ؓ̔Ky{t\1Ge__ee[Ie(vrQe֬ CR>%xWy_3Gꡬ[uOï.~xr2bvjafx}KF\F\TL~/܌_9l^ˊWگ[V_մk7똣<{ cJN9IǶ_>߽IVcuF>OT&'k͡>R{yݦsJVqϴt$'M|ev3~KƗ6m@yCI<^Ye:_n}',72ڜg3ے\?VlOץqzy? ]gHacW/:eup᳎Qf^7BK vrs/y}ϓ:%d}RUd ~Gd?o~?^gbԲuﲔ+~\K^f kVSzY'ÇEΛ/Nǁ?l)-?> {1i¿Kz}Di"kڳ.:wCng 732nHyjw/šy5H׊h)7YXau0RR?dOwO](zՠvxc٤b3kPGx3>C﹓Ϻ:p]څ!O]0|Ɍw}C)4di~q\Olמov]lǟ& ]GI Z>ȥxجUge*\Lځ)髌̸EIY/H/~'HTxrr]˛iن-z0+{f/ޣKQ}g]/=yc{9:]f̌;*|~GY㴔\/2nqk:4d[XC8cڇg7JٔG/ZڦHӲY9bGvͫWr}!S_띆nsl_S;Ϙ_k.m-[.4=kݧbƸ~mtV>y> 2l0^ݯ÷MP'|zɨq?df^l{r X#yuJ^f=Gc# o67/~9xkCwomoׯ? |}_:NMḔepz(1%MIu}yƠc#_ 7#S;{ sQ\Wą#%:K "ιp|ޣR2yhv'_×yv]Ec柰UGVb|#Xۤ}5&:/KNIK&Klҡ||VNZXTe|ی>՗TOSwU%諾 ?f_Wy.--GM631}])YwK]v'bY}dj5yC%d֔ߦaק~fæOP>/~=߳$>O,(rYzYKǯ4'~n9֭I|\'8B͝j{ 徰_ e,kk%];ON?x&ϲ^2oMoj*e̺o:>?<ǚwiu̺Uzh`~-}Z{~x7IfF3Y0 ;]{Ί[_rAicټv.}.Aqᶩϩh!/?M<:'2ߗ}nYgQ^k-㳎v,mWr+M=O=EO0^܎} S/wɾY_}|o}䛹D oƻKiV=^;5:vd䟷\ⷫ|fwV|1KY/Suu=Vhm+D-K=_U@_oY ?m]io ̟}yKg^rߥfsҾ?c蒯z&}UY ~*?7_>/sKVOw/3=I8Zeg u}y9wmr䋌_$_*2Kkgi='!2n'CwS>3rYJUH筆3ս:"i}]^0;HCti&?RӬs}Шʇzx}'kxQ|~VۃH?m}Ŏee&]2Oh^sw~/-I~{fRq޾qHmp;/XrvN:ږ{mo4]4]3!S_[go S蜩"qYM18G{Κ'hj)&|CݛqM8bb|#Y_VuH;V?>kOk=ȷ1~K>t}OiG'2~W­达(K:׊,kpOw}K~/ץ0ƻu2ʟE4O%}:5wt gY?(ゃ8LFIdE/j!)'~ ޵C?%r"oSF“LeLS}R~Ei2z?{7&qѿ^.i+Mȸ̌eH)BZ2yN/QPdbe.ԯK=ZרXLzm)ޙg}f/ktrm.2I륌S<_#ݧ5OI/>>dS3{oZuq]x^^|VD.uث#2?oTr_&}mI3}f\$3[뤿qYg8S_ں;:|/3sku>ewotCI\]ͮ{Ǭ g:_csh{J#a~ )ynMx 'd>Hiqc/t^醢dĭNi}=|o3=K_5ήד=Gt~t@mzY7MͲnySƫ<}O\>hyB.s+h%eFhiOOp~d}d_$^C:Xkh3yñ.6n[lsZU~Y7xHXݷ%6چK̾xiљz~}ߦyލy̧~cfbKyMT0_XyYIp#/T^e^/Jg"}>=|x[ZtV[V9#n:糿zG|}QGqz95~r[t-/#`{|o"p邏9-mII}bRv?&ZW/KmS0]lb>{2NL'}4*_Lzk<WϩY31R~<~='9Osѿ'Ͽ<3/KbWW̾bJ_Uk/}˵_uԋ} !h9״=4_ V<оY(լOH{H=b3>X)kk'L{p8x]o`tO=Ċ뇖f֕eGbyTcm?!|7|yPUg/KKo/~d Yg+^},+ :ݧ5~ڻH~S-wܷ~}v{Z e~~>f7Hףd|]g#|skRu"y~AYT~[{lR KzGw)?} n'W2ﴼy3?uHGK+Asj=_ZgxV*E} kx2lקRon9e47 e~:*{pf]VnWJ.՚'$dT_${4$u1¡d}E2?ܰʭ.z~~g_keqc$]_6ޔ_%qzR/x}?yԳt+wdM乓<yޗ[q_OS'y`mc|s9Rz^bʁuvdb<OY|.gӢI~''M2xw\no¸o]|4kb~Y*>eb$e,ޑ܇)>䏌W++a&Ws:_Eyqż5x׌/d<";r}[$Zǚ_ks/~xʞyM|7/J6@}z|6y~luvy?ɼWy^iYghyVIӍu_eޞlT|y2~[7Y?J?'ךϽqd6ߦs~+Y3Jo=ٞսGO>}30Tߗu &f^慲 ]} zYGȼ\F]Y0Lyt>VemK_XmrI#`y5ǻ}@slϧ_urr&!;wWT}Zz>^qߧpUqs~o}MϞ|GW|of/~eߗ"3˩g) ?M#5.3Wυ_3M= |_cH|OײzGn;T޷J{ˤW*} 4wOO\Oݑus*¥&?K={;~\#-^짎y)m7޷CWśƣ5y|Iޗmck=WQ8?Y>0Sud_n_u=M+OK40|{Km=}Zv?sj$] +Ai:0ou0 &幣}^K#[yb^Q;$n\l)E|N/s+f7.>S?Fs|֬ bS>\@}On?͜9o[::c92i|f ϻkM ď}?2o/qe}^IG8/oN>gE玠=L|u,۩Hc21*߷%Bޗb|]UHGPڿV4ٲMA[eYg=ǵ]}v]R8zd#,ߏq-`|Li?+X֫S^f^̶?zb_>+w>z:1"0L=ܽSź`}\'%>S~OFzB9>{棿za%'7yC)o \ U|m6M޻f1o!Cӷsl뾓}WS0tFNmy|nޓSSO̶l3aq}! aPAސay_&7%Vn`ޑyg]`ޅ]dޙ0ȄA& 2a Ld 0ȄA& 6a Ml`0؄& 6a 3ax& τ0<gL 3ax& ߄0|oM 7a& ߄0F`L #0a&0F`M #4a&Є0BFhM #2aD&Ȅ0"FdˆL #2aD&؄0bFlˆM #6a&؄KC oI߲o}Hjh 4V ZAC+hh FihFihFkhkhkhyyyyyZZZZZZZZZZEZEZEZEZEZZZZZ%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYV%,ae +KXYVSxOY)Kp n-@ [p n% \p % \p % \pe!\pe!\p \ \ \ \ \!\!\!\!\!\ ! ! ! ! !     !!!!!\UxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WUxU^WxE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bx+^1W bW^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^y+x<W^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|W>^+x|U W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xU W*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBU W!*^xBUW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^Ex"UW*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xbU W1*^xo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vo' vogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvogvooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooJ~{n\nwş,ҿͽ6l{mOߖ plm/data/Grunfeld.rda0000644000176200001440000000535114124132276014217 0ustar liggesuserskpU/"ҊJ[Qe(/r < /͓nn^$HK/A)$ lѱj+ӡSf:Z+e1RZj{nWs>u3;k^~ș%'ﯗC{FxrxZnCiIeq 0Ӈzv/]4xS!pmӰN88dn/^/~/=^:襧gtK?a/Rt'n;ޯݴx z=skϠ|om!ط uk}Xޚo.S3aWYo@6?Vb蕗YߍvO@L~y,裐Maה~o}4ogڧ}8] 0E)GA]-'ϢR<ʢ[hWH0)(.n.?psf{+qv2q4WΎz5nxF?/|u.9]g7]Mw%)}]pnwѯ?zn-ٍ)o]ƚl7ǫHnnRf>I,^ߒp6Ń_s`{/|햍?/Vy nV/.)7w8I;12\6#.'#gB\É4ywx^E\ ΆqkwMżr9W0sgB_0au7#s~X]v9<q.u:Һ㓴yov߼p" SC1nb!}/@}!cfx662ؿ$ r~܉};w.I8ub!)_ԗEs쭔]G:?$~AE򭛘Aw_SǔúI _nMDŽcu?,m'2N#'oGy!?ywx{>{T>sa=밻*؝< Ia?xy( _>3v_ v:z|,2B}=y v](ߗ ?GzQ{<ʧ3YM?wB?GP{h$s:wc6w ^'B^g;kxzེ=FgPtE݋h'/潹(/9[6}~9wI9SYjA;!W(_ZÏ/YL)e1>ew dk[!ێߟ|w1m ׮a\s \wv?ߗS)W 9S5ƙ먎z&Ƴ:8j}[f׷n> ~V-8Oy/BaK~X^>z ]  a{ϖ}V |/way%r8VģAush}˳\'|Uc!K1yQk]d#Rqq|u,g&fg؟kg_=w:x/w ܜu)L'2y~cUZB>d?*Ϫ7Qb#c|>׹K 7q_5g6sl-BM$qR~93)<'r+z.Wq}pE#XnA΀} \qz1Vy+}r }=˫h՜jѾ -筁 &7~3LXr;alN~_c}1(G]"G>{hw?W'r i'說? /3&pHiy7Db'oG*J +Dk#_="aĊAA?~3gB Pi*rY*gr)bh)bh)b芡+b芡+ba(ba(ba(ba*ba*ba)bXa)bXa)b؊a+b؊a+b؊(b8(b8(!)FH1BRb#! JV.YCd-ڒu$+ЂB -(ЂB -(ЂBӄ M&4Mh4iBӄ M.4]htBӅ M.4Ch B3f!4ChLB3f )4ShLBf %4Kh,YBf -4[hlBf -4Gh9Bs#4GhBB -$BB -$BBDΒ=T*#5C/L,FƼ7}O;"plm/data/Hedonic.rda0000644000176200001440000005033414124132276014023 0ustar liggesusers7zXZi"6!XP])TW"nRʟXH#&'ƯNdzWmX$t6EQSs菉k0̆4zZ<%0u6(@,|mQ?Jydn#֚)vjO[AV_c/db2`If12qCO,{]tmZ4YIoCEa H0Ga/`"p`N8DŽY|~cf'`Uo__Q:nM陥z[4p\^*rN/S,:p=6jۗ,p5s5kvGh|/dʩ<lnHPJ#5@2 ,.ys 5 TɹY0 S9WA ʦsce߽2/ /72x4dvFi=ݷ_ez,/<+}1/?LHC+ui y3%%S?WqYIЮUQWF8"?>&Wk+4rۿ='ݖpM <.(@h11KsCiYdtVI& $2o 5<˴S=kPfh%w)#.$Am$$]eKk#0$PBTw03<ॷsm5w)1i̽Ca/{:Z[ȶs#tCjSbu먶f@ ;.Dh.Ojӗ_ŸH9#eam$DM ;6Č*e]q];>f6,l%9,{R4s>qk/`rǯr]I,.)h5,{2Jnߺԟ F}ϩ/͎6>,eBG P8BhNo'F2s-6`$+T $xӣm_U`OU4>=Wk*gHh[MڋO8Y购hGo80y*RX j90*]XQh+ 9{ A[+c `vcҹgM(f~7\|rTėB8@cp f-y)QgW CF ݺ>h=֙]݀J>u!2 Vp5?(F,w_GTӹ[5H{"Tb켂ҹ|3)e :ؚM]cݡh&dݏA>"#ܦE 9nYmm=-\XE\qagȔCb'\H6D9Lf; 8G/ E&t1O,9ct4S!~* , az3bu>$)d {|}%h!'DmĞeZ5л6% vs _ZhokP խB,|XQ?Ez(^ ʽɩɓ+\~|ԅ*L (@MaP4d5S{ǒ= )KF#֯G5SrӐ*EU͍;{?#]ȳ3j<}LG]GzgH 줣7@Am hbnch"MJ4a\qe{ yC#0y< &2  )15\4yd Y^ Bu_#2L=_ Gu8h|.RA~j7$\5{vv7m}5so3&PF0"U ]>;({R)t%W]?Mi:Ӳ<5S"jW )k37kw*#ChYw xο }O)mka$P>,jnbw_l}tT"V+G9i ey]־ (e1gqN_krw!n>1o5~cY}M;7q_%+WXrA+ip@{X^q!J^|6P+`|~SxhιdMX Ee{b?mv! yN֊΅?ݤT],B'ma1j*?-w$S\J◆'ى7m!qpغaoݵH^Bxdɒ4j\ЋujH}0̨}{=jcL( dgwk~cH-PD>.LC8NE= C&P=ʨ<wQeá[Yfi48$ [Н=[+-\ݵyAu~G>44&;qu+lwԖrpRq'H3rvE4kbW99 >Q9"!]NRN|:@9dcri#rEJC@w~)r̕fm*Ac%;4Nvxʞ+ho!&RZ1e=X-#`@bA'kZr`N@j֮3e= LM^]&C2}O'^pE HOAqQ 8(ݮ<;Ó*9ڋ}vP<95e0Qy(Z bq^JCd_Qz4/<+}>J,o[<PeyR Ʃ{l@bY`Am? {;D>`5ثb$=b07oXMym $pNS)E ZX qV`-]=lry'.Xe7FM!ƣb)7l;T1mr] AcPLN%P!ZdO&qEV'y#7&z-b1p\5YJ<{ mȫv7GLCH5#sO-tN+pX'G XcY]@KN^R*Vb5ᕃH$$kRmcy5>?0A7có=.vH <{Ca@XKlW 呰B m'0D-֢D}uiIT>u\؅%~M#]L/ uBd g4w!ĘZUt+-[dP.f kJM2xFz`pVq)Iˊ6BHjػD̮DmS99Eb<P 40dm0CTeLuyQ_]2%5ykZf  _j|=d%Нr)Hr~^l& IE/]R*'#9ٱzuTz[˒C=D'Bq7͉o~"mJc,c H DY4 l?1%& 7 º4X#'Q蠹1}tE .`*Ç!So x3--=SWvy%Uk:n(,(dDun9ؑ@BqGaP9g:96yL#`uoR5%\!GXn1&s闪^Bzi¼뛜}LR&]ubаWX" J8C=e4(uo=鬋NH/Vk!E^ A|N:GAc*#`0%Dǽ%r$yY6~M-x@Bi.a"JUA:08/CQ1U Db^Ǖ7%6aMM4 %:2Pu;ݧk H|.ʭ.jME . Yߧ k9W1JxoʠccX<5%k<[0֓߃TlA< e P72ѽ8hk2 ķ?/iq t܇{q_?\Z ]lhKn ^šзL :Q7b#V2~~\çe{Vg23zL\J x*r=^*2OG#d+oFay^nDݍ/2KD2! ^?zR%!A4tZ76T~XSlv}2oA݊tGH{Agl(MOy/'^s80d)w07(|eAH"O_^X+_ǿT20a x$R]9Q` n=HC)]{;DLR)A"'~!8g^|xL@)GH}I&Tl rsd[W}y, i.PRjWc80vlv'!7}T$!r!?l6WbOぇ 3I4(P ,}&M>Ws{~2 %)`IZ_ aZ[B #ϖY4M Tn,J(W '#YVkFcpM]}?%4pԖsŜ?G d-iR,{C+eo0^ WBdIi!.V6_8D7"EM8<H{kn+ ,'(ٵTO2e;*!ƹF&<--=G)mJ[y Uto"mG'C,S x72@ y<=df:k,uɎ,:3*ӊBtIJ/E%+ E!MĄwrlf\ϙfkII.9R(nb{ a#}BMVx^mMSJVA$KE.S-uoi/l> ]aLS()\[Mg,aܷIK9^;T߁6<He zF -yd512TL4w[Z0TXqy[ڜ1Ʋd1ܔxPNd8NNHȁ{ҘRڑp)&w[!y Kfvu6n1V~+^S\?%$w1g\ܽ*3ji%N޵:Yxs^GeE=, 1% ʬI A#:s+O"r"=5T)Ls#{͚/=c v#.|aAM hC&ʙZ<[=Huw±|' !O^$X\)Wx?vk+'u$| c!f|\^AIZԓ wjڝ&`dˉ$[1D@jʰejmFԶK/cng7&&V8teArhRpw񡨰5LQ-YVAK*XAC{UtJJ8 .ȵ,N46k)G4:s.qOG4qU` &z[;;,R,]+q⠂:\RlMawLE;nM M](jӪ5.4hZJr9a`!}#/N7Vk2fN''gwk;pЅ_g>{Ou' "lPqߊWyǗ¨P2.h@xRd N$ ֥m=|ؽ C?oۖv,SKa[sdffML ydO7|xD cT ߨOՍ~jVT)?}lB-g\u4l xc"STP}X1a>ce5IEjSI: (E>S fX9|Us5{_cRE򫙊m/7&jYcCe!{DHnG1N3R.=n/Gc7QP˗zS !TTgYE4alw>6e7c񿷧۫$)̺k0Ζy@\n9SpEGs; v,v#ɔ #ETЫsCxH<0+QxG"@n( ]v2߉I-{^zD&aE?C#3 ;j*aKR Hڵ8gw5kO>T`\?8@5dk z^R5v[dLOG1vuVkF}l_ȵLSqb,m^G>}ov}7BuQ'18p,}|o3Js]}aո _f6ɫPGR+jH7v Rҵܖ\(kð F5|gϦ Μ{E/3Yui?M֑~M14  Nsw+lbG`-9&fA׮V ` 5يXP-Kn2=ȡK`5^yvM .T*", nxv:VT`9^PwC  3M`ۛ|Jƛ/ .$M^Em@\kc'{{ʊ8-'xod 2lѴYWqMQ8&Ff{<=S $i#(dUEb1z,"Zݼk'>X%0L=1 E8I{Vi9{T kt{U_k>Z m/ h Уw8r%85̆o><)ҤjLXSEް=H}ഉ#mܡopc&.%z'vWB?C3!䗡這:TZu]<җ5s Xgc܉5FYfy?KSbۋ6pW,-wAq8JQفq ^T"Rd½PЦ41aS+IL~ _^'])7 ڦ;e<%pEg_r}[ܭ_K=^1S^S#OL+gDIBjta8Rc*Y~bM8RnW,\4E4n EA\vE->|C]G}e⟯8-I8u3{ QM75t81upU-[* Cjp9X>AvqSq[ç t{| St' UXTfM\m=]" M02Ox_55Dki7̊@L[ |gAz9ߜv EE2d>*Ox(Pwg=ߐ Y&k-y_$nْr@#&( lst|2{XO߽ݴfSʿlqAJ8 imw TLv%}83Rʔ}܏p(M|ɣh; ({,]o]:/+Ni_ۢp;dgl۫q;P-Q?޽F$R20QW܁2o5D,w5A0lk-*Ynfg(o Aٰϔ`|m!~%o/%7sE%߳`ryCӁ0+y#5t{W8EcyI?}H||Tv[+(`ԫa0$˺; [O21x݅ɍ\<8қ|( V;U59\["9 Ę9 !?;ܾz3%1ȯ[LoMQp bjeLVۗƥz#`ߐt~oן L,披E>s$G] *VCg坛zX›K+A 7 oޝ9Ba~Q\ʹ'nrSMn1>hiDDG/z8N+}-49Sgj@"0aZgMw[Bhzās)'7 "G|yFݒ;یCd$(Lg!ͼ=UJwOre L+d6?E͙HrEݞ?⠵|#ʵĒj}RK3̈́yBTU?͞E6׶|V,`Mmz QݼשxO bvcG V |/rI>Gp9bB(vI8kahD N: wY+H"Jڳ92rPU7+Up(snH/})u)MKT>-YΖ >fzu3(˸C ,-ab" vuZdnHLfCԞ2F3@Vwˍx.PΟ$^p_8;FKx,Qzu#XF#ʇ GƍÑp+Bv6mh ` “GF@v#Ry^eb~r*]8'~6 듈r_VjARceuݲ o.\91wkLrNv DѩNlgNu@T$Pbj|ת?]-e&c^8&h CEZRh mW^$ʡ:\+7}觍i(WDq vZGqһ쮉GmlRR̻K&JA^ϬMl?={Я 攟D0dF:ŧeeB{'|}]7/T!mQ 6l$\ÅK% =;Ui3)>"0!t6?yTߺA"\9$f*ұ7 _k(<ՂhC`WUR#*Ӂ2vF ^"$[vQ׮I J=mqi),xť J :`8Zk|ݦ{3 +*̵ӤpmކԽ7Gqq]&ʡV#BY/LWNS"juC.NIkwIyxp]mjYs0ifE&$'s|UO~ }!tz+T8Ekɶ y:@bnŧ1gb EmYUn4vTEbUV|s?_i(LPpHGTTY^0Umޛт5 p1EZ:ѤE8MB%H;]MUw8r#O"xp]'L)$MU׎]7O4o8X6j7"o͑+.im3V$U>4_%jV,'pb!DM@:'Ve#Ecz*ޞCC0@.~_L, mA 1ʳDRP-o/"ms$UpoȹX\B曈9E*ĕ@suhY[S0:\Kw[WRILRJta1:)G܈Y_L#Kz8a:e+`_ g iv\.tLkD΍izD08 r2ZQrNiK%s^}wf z8=@?]+ˤ9('I;q+@ _ 2*?#zשj|Yq2tɤxN=#`7`%n5/[aj;G[c3,v~;7l\@Oww_AG.DW٭, ]=ABK|1ՓE9lH}e%H */_ZK4@K=<6#D\;ۙ[6b%Ӣu]GҋW:ZJT%P#zNJGJOcހFyq ko:gN?wrMQ7+9,>cz]jp@$JM&;ŧiI/0jthiTe26(C ʱaMS?)c1 N-+!8ĵ7װx{6)`F.<%ߞ}Awx̆DY-PVZBht]#?n$;{3E2<F`_1-&BB^A"Ξ]J6YqzSŹM\w`~W.RMeMpw.E̍5Qp$Uk0'_eu1Zuiduo;dlQ[⩝~xtr[. {Ү*RSl7iw%#ڜ<~`z@5cjøUxrY?m~ް2z&Bۯź(VuWeg:2\oQJKW; q]('v[F@?謜ss?9`ȭO`bѵb0 :X`SY m{#z:XZzQN 9BxJ7,܍j~[%W8$ȵ8|ٳF (yﱥQ&nB!Mu?-qx%"Mې/ɝC%͞MYpƤMl&Sm2,x{8aP0g5: @3KS֘mހ5\ Qu$F ~pJ`}ٰ, m`VQFKe [EhԱ t-cۅۀ~}ST؞Ge<_(6 >* % ~WcJ',}\= %?؋Z&iK֡YZjj^0o0 @N]i2b!F?[5; p2xD)CDyԳ0CsKHuK6/DxN{CC/Wܺs|UQuMͥg2q |í".? Ip׍dfD Lm}8^W_&k:G(':soAE"*z(hxQ <rʯ gFÓe šE L I%fޥ+?Բ,AuDv ~ TC/!$1`?]-<0"e{PJZEGn;;wP0d P͐}=>ι$U>ڒ;eUL .N)$ [X'g0Ve7JGt*ӦY|OKฯx W@"f'Cİ GqIG 9J]U"FU HU47E_D^Gڸ*{~r̊= uLfcteY>{DXIηӟ>Z1{ O&kkɝ#OwCkɬA tA03=C4D:rߘ-m^Јה~}n{ܕ񎹨YƸR qfr !2>RDzPqW!"}Hc`DKDV#0֯|aL(H ix\8CۭaO< 09+ti\"yLG%X+ZBͤSIpj&db^Zp༬!o@B lG.s|J5c2Yt5m hȃe.SDN t;>]݆`\~v긖yZjIXs`Z\‡`!ຠxƋTt0LkS҇d[ ⠖69ץ]y2eu󕎀>מ2B&1%3(ʨ]zo:L`<ɐCdŁ9AT[4r)px57B%*㍢Җ?;SC]&ҙDx\Oǘ <"ϫϜLvY{Z_^Jȑn DsS> t?=bK$1XYD &3ru}g?[4P ~$LH*r ٜ' N{{nQiLm懤mHw 2A1Q}[*WȿEЛZ C[kYeEsG\rXϳ;ʹt4ZB_ N395p欘n_WBޔ7wh;* M5vK:S)SXbѯ+x$d8}MTOa!a?#>2צ 3d6~jC_3Lb?.QI*Ԑa΀}1Q:-n)&$o5مxN ИȒfMVqc?ӽ4]v b9Tǣ1M{ѡV:iDVr8MI)b7nrQuŶqvRJ|6(̈qQ~W[EԔ>P;Q$'O@^;̓^ Er?<^wV ##q6PYl%N?Ҹl V| 4>"r}@@ ?~ͦST!6[hEͨwg T«SUq$oL^-(@EzF|nqqOv[4YL04->rr+'6u/[** Q):xq/;'mtѡ1?} HY7(MQ>I4++ 퓦1㧊t_Ćl[%pT,rP=7tJwu uvz8p@2yjo FOZ|^m@qH%]F7cq*DV=@.X_I;y4VnQiv'g!NX0::xqmwu{@}ǟdHS,y(%@%?SD\R/A|7h3,h轼dj=]zȺlѫo޲d$82NHu0"dc/2V LeȄnd oƬ<čU lp }GɜCTKM5|^ `L*XxCQq; vR?xM?ZUk m3mf=b̈7EL 4vF?"!KWN/9N(^OiH{1%C$I{o%v^j!۽âztY`94Lҩ -8:9[+w4D;q,"n[m{r͗`T-T S`Tsj0[؀[W֙j] ˮ9 |-iD t"w0CtB# vZ P綀R=܄7D 2z<HЌiˤY Wa2P wetEfKbkCbͮXf bފA|$( v&fqڎa|S9nlo%Xo LBd%: i{h|/0MXssv[ˣK' r [B߂)WN Lx&8v`՚¥ F&:"}2,s9M iV&WXtw,tWuQMT|J(%@9\EQqj~ (X]18iuG$gv.[lv{#eZ*>\(f@'n)6^f޵KRКۿ]<JNx*`]wiXt56}_ q#P %F_O[r4nPidˈ)Sglj}6Ⱥ>m#_>h̽+ϿCjgu_?=d T[g.+IجjìG Z#]AL_WAJio7>F2}?Lf <>Oß̀cH8_VbRsL0\:z,jB=øK뼄*FٓJQ18!&N4's1t'HD䇺L7HPw)} X~U?iɖ&HSyKUR#OBj/i 1e~+ɣub}M;N+h8,ϰP5O$Xæ@,fK9wS[+iUWެA^K_q!@)O_c_s2~Xےp jGiO{nSwqon]TBPBI+,#(+Ya xkF]<>}MzVvM.-tYΰՓч>f2ӈJk`ٶ57Czx8@uFÔ,CUdͅ67ڠ-~3 b[2+i(91g+=dr{ &}3) L >ZxG;aYͭ؜ w$tmKoXڏA}d@Q]8eL9]ϕ;%Pu5x{f=2 [ Ǫ,bWum[L}{D cKN֊N>0 YZplm/data/SumHes.rda0000644000176200001440000003744414124132276013665 0ustar liggesusers7zXZi"6!X3>])TW"nRʟXH#&'ƯNuue<w H"=`vFwH3IQpC/)2Vro"*%jιP_aHo.&6&@h_~#ߙA%0ds#t/Gr*h< !`BLHUR+zj]dQB&x^MﳔےXDcA5kIN-T-bͩ"rhrL_2V'.94Ip,4]sc|>Ph3Umi@F:S# ,G"S}Prlue|` 4a[ -1a2Jk ?cb(+ dI)y*{7[zW5mpq=5tN$ZCADbu ?>H /ӹ=MAЪN MkX'Un5ؿJD4SZ<+NCWj)^8F_-=Mh'{qN7N--&kr?+Wo-ytƟ8Eq!ξVO7vC"~с8nN<(-I< tf)As} ~xl ɺ$yk+Wtkt10X&ppGɡ+*r<QbuuUz,^-9ʕNU]R{(ѐNAjc5#kMV<5r#Əu@5M Bm]Cm̆p# Ih͟:Tp2bK8ȱROlsVT:QQg3{f'N">3$c>kr+){uChЗJmT$`,۱ h2gq~gOFwY4LyTJ2(G i Q|/H+%x3PWvvEUQ(%(&dzhɹ<6Qj}tBkauTpm`Mi%"7=3eZqJ9.h+@Nn+SL*zGOkwẂ!{Sd674*"o58rj[ZK,gJhd"[kôkȈ'}@q<7ol򧍔{2gDצ\O4x~ß\j%b6qi鴮BSNŤ44M#ٸ{N-&A>n(uuBt!Ik|4蹊TeSO|15 'z󸻬.{ s)q}d^oAJ5 .z~Lͮ=0$T9ތ\DpUZlhƁ|(cF2nwi:(gd Vk_]|mc(_ T.B y^@ڛJo`PM v8}l '-g$ŞU*<3Z!6X#RPu+FviT|)CE^:sR1N緯NG }+؎7/XW yLh;4g!QZQaYPznA1"KsRpBt"4jd;Q,rXc/Rc0D?O ;(yEBV*TC5,לEa1:Җ^߽+rlrD4eOFK=+7\C|v17۵g_܄f[[ˇLph.MaqEk ylC`yjOa沼0O[؜o 6GR%!C2xԦN;% .ReYW͙( ]x)fqjN91-Ѱ+beh%5??8dot8k/LovE@ʶ6̼W`D+.6\E ~5`7ޭ) XOq LO<ƹE[qmtz3`_#z\=_MZTVE IiMw]ɧnx! SJ̄r3 `ӲHSb+183^?2w視ezA 7”jhw6^g}4 \V)4@##`@$<$ti?Q=[( S: PXg{}eI =GXǰ^FwtV"54~(7_˘Yb XEb !fLR}ME`U)qiyq?ؼ`jHW6(D ]\l8k+(}ߌ` eoEwT'wQNwKߑHĻo.^ 9 $.I!)_`I}bALu{0jHJYKjK<2o-ڴpCƩD"+ŭrX_oDAK2zZ\ ^`ځb];,6N)wk^t%Tǔ**d)W~:ivlrϚQM4Ra lJopK!( v!FIrӡ~j EWPӠ) yL퇨ΐR !tS)†wX!e|XP|[hv86e8f4~Pt"6Kؼw1u#ХISPc_^ώ*RkͯULc0dzשzmq&L*r#2~j49VD-C]8 X'\ifpƍ4l5!k\'l2KRK.#PU"#.܈-{xϲZYA2t"4:Hp:M6QCM[^t*R+9^`/V9Ơ@qU[$֯ͱU&~~BpN$@"DI'ȡߝ` f0yBqDUټsm* Ge9.ڍ֧a{"X(׮ĕ6]̹F0Xf4X]_#&ך}%ָ%LEgG7|3K"}(7og0g b>3%[ >,9 Cv䡲q(01v7 ,n "0 {{m;4mDyR6%^{KБ9gA]ؽ3wz Z U?.'G8]$QA}8^t`~εroX$zP[=Gɘ5}Cpl,XP qjI5&]W7^/`*F 0b5[b <68?C$JT&aȑ'ݟˣ8O&I(q0RF I tgҤ=޹Ѧ=t_iFKǒJdA|A Z7_EmLj.^`)fzL&l˞oX% 1Q#ryt6RlDl|`pg |Ch46zV8;etG+R\ :Quq #/F q""ZF?SɖPh=cvm  @T8-) n`B/Qzoe$#L3F'&*'$]I'A 2dZ`*+_\ܿ[ȼ#7)=uɐh HZ qp)\^,+we/Un.U+iN6ֿ@Hw )*܉m7d\2z_ͲSO]H KZD'}ѢrŎ~/|/ng煥%;I[ d@VRkQ}%Xf+~2>["=[1~=|/[n(9^xNQO.0E`x".?Xj׬y e9Q^f~xW{ߕ  n *Uj;J&.X"2Y"%ԖFKAjS=CRA_qpcj.#~ 5jx|k6?5ÙLcDMI#KH.짧Gu#mNb 1(,3fP"U e07N'6`A[G! 9V]~9rtʛxZIU+\CG.Oh2NfٞU re;#D~슆v=J[zKŜrm^1|{_%1JM15Z9 v9?~t:4cq²MuEZT;yC~eHoUeZ9l\\ zJGF Y-2?( JnՕʉi}c]$a捪4~Vb1M m.^Q8Q{JB={gy@<-hnj#oI(.'Fy,1C`joS]^J%=H5tӶK%V W (,$WŁ('"ȥAY.d(p ͵]SU}c:wrQGYs?[Z--iƒKۦ鴝sE8X}.ј}LZM |P܉0-,ͧ /K`JP'ÂXjݤs KҮd~=K$-4RYDXhHG4tT ڮYч:z?DİM:gq> ZO c x|eo ޾Riz>54#]OЅuC҆ޚ`u( Mn_)PQA!k )ғfϾq0_?xEadUIclu'ubrD#|dJYdN\/&Y4}H^MRXhW-sPם yE'}bVѾyuJ˒H(TCU*>|<`UpYxnPK/Yv16MΨ{3o_b#u[t-Qq8`HoG}xp$i#RwkQJCrWm#fH;)I&G+VNPQ#-eی98/{DM Rm}=h9+o*ഛ// &cj*ie0Z 1 \sN7CI-ұ6q*tN6 Z8Vj1jzJ[@ =:Y%YgxFycӹI\W6|<ݐDهU{.9n||Ü.)K8 Ѥ4,ޫ,v+?8 Uy%i<}]& '!3]"]^W[T/sN}M[7U#{*1%y j N%*vQ+Hy`LPkIՐ"YdCVIj[tǣ+nDVfuu3"Bε7x ܴ0m.bא^&_G#;"8|j QG6J ; AG6*o9u %A 2U7 7WᐄJάLाJY:[c5R(i3~c1;,fboqq"ItJqJ*m (e%;1lD @_I?``nFɮFQS6 s@$8Xd` z(5vzؿP} t^8m@H]5zr LGZ爛B$ʗ~<酿J"xfTuVsB=׮pIυ >Q/_j!$Grs61|QT[tQ&R j0읠B/(<>..r21THjb<{ipz p]*HM{ج5=9G^Ԍj9Yaؚw!b41 s23AhdKD5I n{M s/D:6}]8hH0/̚ ;O- I0[T*8=`1+QH~KA))=O<:6xkh ]a5ԿcC%\T%8hɼPxbUE BsbO Qbspq㌸F,>8jpWl#LdtOeÚj UQƞ"xX%s >PA!RYVrk%Iv(W͋z9-; >̮PU/3r],\YX_a$:TGl-!:ym(p'r4,E_10ʅx-l]Pɓ'۞u`ʐ$)οC$~u9oɒw{TYGMr5{GԺe}+=;9?91ȸcB*QS/*|NO/$7>;yx g+'Ct yZڧڒ 2X> j9Jx:ldd|w $brWuïҫf |n\/}ܳCf6Tyo嗳[_K6Xb;5WkiNDTPR,F8}6_q!+ /uÀ8X؃ &Y%([ `⊯0X'CW5$Q{bν>Jn`=.)9,kgUr (iҌsÐ;%XвW=GkqBW U58;Ő9K>njA!beCISV%akrXxdKּmLd[wi=4%fYQ(#C @[ _p>XX;3g Dϯ9gNJW {}sbD<$qt~mfgYA o] oto<2'e@H=.Rxng!F%D*jdGIlT_R>lƧɼ.4V1+%n SEm\o,OXQhk.xPvIPI9')[j=R li^_QD3yaDr z Q7a.6[$GG':ϞsA mûӛ ߟ*+m;l^XcpgjdN-1n# 9D7ZcҺT+VeTc G*(SUGVFNV7gՋQbMk T(A%C瓧PЪybS0j V,9xcܾ8A/pE;M 'ܼF|ɟLǢ22M)qRavޱHLn_׷:UcÏ7m 5 E]~ܜQwvqhSsPHr"n;5RUnx3%Wӽ!IZ3} 궥hPBoQbpn@*h_/`"r؉m_mˢR26Ki{GyUK z4w[ E/K 9cvhtBC h=$:kw˧`9E2 YC@̱!8J%m omtuiNz!n0INw͊[9Mo*Mԑ`,n \^ش0k%괽4la^?R>`{FC@5ӓHXE0v HH\I^_K ujA֖-3|bw猏sO[#]Y+_s b6 5 B]ߜG^{G nPSm+%P[rܾ8]zirE3SJxE*I`?nՏ~'t!k:DT0l7<1RͿ\Oee:缎\ {TȖQ/NP&9eKjqUs Q S[Gfq㼐I6m9`f<㔋+'E&J!ɎmH1`f w;Mn)Wuؠ汉 ?)70Ys@!x޹591d)yf7*-TPk>ߤ@2A7lTc2X 9]'c++;"Opnxuѹ@,DO+3n!=l ,Q,nӯ/ͪ}6sIzF^NRTsv=z#<+;~>0#uzvt0U0б|yh҉ ubX]M[S-=?*P 7p>=iz+~4.9BBîl<\NGK( ƥB ;"ye@QQ+'#3q 6Oxf-!i&U T/~'^1TUXݎnVyx5WL`6 ^Okb=b@3-:%$:{mFRDaIjJ蠿s>*@fб4+8.$+J#&O'vQ\LDRlŭM3'-zx3Y| ډm ~ `98]]!@M 4 ES\ r sАbJ~n$JG`[r[tkMehjw0.S`7DK56\ ez >65g=G\4$j?gI0F5d!_y= y:BKEÄB~B'+j@@H91]\[,Q"7 E5PO˽V};R2576r^YAZ^Z "X&+ZR]h`1oreO2,@[Bҟ jf/eP.ɗ<`M?z.k53[ȯF>/`&=%7C:Q 6j}mfbu RF̗s=&Jq!/ Ea4 ilN%=1֭`o%p(ߌ _L+6ߩ>qH"t2RB`cuS`uu UMYT ]&rcJ?$C~; -n hؿ `HFL7a 퍰 4IY{vbx}Ǡ+z <*)@9jfJ)T0H >g'^ dr1CE%{+6W#y%5zbfں$>It,j O2x 81Ӗkğaq`A7}DuU%UJ7bONvz*|⏤m؊-Hݴ ,(A5[4]mܾXĺ%uinj0T=|wكlIeɃ¢7E#o0@@ Z&phF@2ۮr=W8_fЃP˼Fy?Ve[*eK2:)na!P[9~xLSXe=*e &_L!!'5 }fxqȧW)r<4,$Ǥ\O]1r_kQB#`w׎ IB1:ʞn4B@|YV d;9L+Bi Yp `mܽ]];1)23 @=gfjɩe#QedJ}QJ"H& 'dC:mK\33)` ?~C^v뇈Ubg=1NF8c6`$UbZh}Fd<(ky@>q`H$EƷg ޵lK̆4߫Dc$ m[@Sd/߯N C@cã/LXȔlBJ/WuS@^SNξs&Ra)Y@cEYּ`>LnO\+cZra{(X i5*וTr>3遐2BP{, 6`kFy]b`HʞcOL < WJO/"t:o|/Q L3]BSB "w[DuyV 3M¹Ʈ]4z'2 4jZ?9%K7ȍt|#>` bYt$&Cۈ:މ4(nCR׬v#`Ԥ10%M 6K6~҈0[jI@G}HX}tzPN(T2W=E jσ)||o}Xq>0 YZplm/data/EmplUK.rda0000644000176200001440000004261014124132276013605 0ustar liggesusers7zXZi"6!XEL])TW"nRʟXH#&'ƯNkX@Q*C|W8Ƕ֣ Oy_fEm xw{G=]!lFX-9椤6/AIXYC-1GDhQM`i},)_[ 0q ~@mnk|DC<D$:KmPPɫv̈*6ju' 6_}P*njPj}M-75U ,Er7apN> v57j3!NFN};OkOb<m'BI>e[7m>[7+",3ic3gmHIۄn@{̊#}`R!iw&aL<fQY^5>'Y-L˩V$"k=?.ʼn{uvN )|7}F[BőBƤ4U`1Bk` <$&.;y%E>r3 oq"NnGf16^gȎ>gy=jѽ{r!gwWc꒒(Er/m=JZ+A|q;rj@2X#>8Y=!I>e0Xph p]$t(YO;obʂd\ lYaǝtiSB\FaQd׫d%jLRs|cr'=+DŽ qM(@4QEv!88"8\(}rx;euo 5\ Tcq@/@:z?V_Oɦ70`GUqqey_8\,C2 G*\:n^+!{U2$ ew>VrPm5&7B_jǠM?ILUB3ytΠf& h &dհ5RیZ@hZ!dQ&;k>lgȰd͗t#P4 v#۬lZ'0W㕣 HY~ ף0ayNynK1w@Ќ!Ā|NnD(?P"82[[bNq*3Km9{'wqin _}c 7s*C` blJ?aO$Cq9t\6;y$`J-"s#I*o`~XdOc-UmZKMʝ&V *{>-̠0O\ف-$?Z5#~jɡ9m0:dĹ3E|ɶ^S`ڈN]##SгQ=G&1[ZST`|wܓ^ÔS& R3oEQQM?4_pYW: l^> [Wvn:{YXm' k[IĘ~g$3v@~tخ&KGX-s.û["ө7yO Q<ϖsMJ%*2X=lsKp|飃i},~OJ03:)xM4'wkˆ&&T*7)Qbha|Z?B5OdzS | |G:ZvfOƍ^u2]m^_,rb OhԚSÂ*TZn[ZA\پʊ|)Uk_nPؒ0%_53bf?*̍[ nWl GGMa"g m:`ZjAN"2qjj IoF/JI2@F@Rkj/c1TSj "A1Kz9Iu7k&z$oplջF-EO$w޷JZHW28MU"wS+n_|FD]MC-Jjb~XܺLPv>8 s`ƪ󉴿Q-ES\n /*[%PktLasC@^1+e7zB[ +JeU!=8M6.ҖVcf07ddGԡgy exo r{KeyKW;#Dڨj_GTmMJǚ'Ch=fʟ|`FtsT!1ܬ|lK X j,~)e*ϡra![Pȹg ާ3$V~#iɱW%| |ܠ^nXU"5p1zzM<t sa].*RwA@p~ 5n,Zݬ'kax?堨FKKVaT,}e@:v~B^ ԇbgdZe73巛~Ixma w@_$^{H1n^Xu W"tSsi_l!۴3< Ӭ*Bx٨8{lf?q>@h@W=W)E]0afs_`.v"HI2T *?7 te6 #{*?$fVB] 8T}nAuܑ u0XgP>56p`?.tdRV}T{X=1bpm @2\ v -6)?6yI7"5(~zem9 ͊f mWcWQbQ*gs1XIA޻gW"ܶ/1ϢzGlPkRdM 7lf"3NjR$fKB]6+X<*aAAzh@MlpH-r&$ٹ)B9к+So?AUv(%Y dYOFbzֳk AukZ@s9}d >[lNQ++s{p:R[Mq66W+2AF(-:*KhT٨4 LSy@og$ټ10!_yɓis#?CHY0GQG ?獞(jl //O#AId{&d86t3 %TkkR*<#酫]5I0%t}LA9 PkTH'?`k;6.8qOp٣W:8s5xlHnI-1@?I"[_83vܪV'ZSrim'=D&O pQA{xb[LMK&UP8R/{>|`VufQp~It^M]A‰_j bgbfCkhf ;y씛x'akiO/\ljfm*;0B8r\KVO9ju]ARwT"CFp+vX#z TCt1Z ]}]DUSWSe}nըx7|Lְv}\%D>F*;m1ހ=yNʰooN kӒ@Z(yKli*gP r$s'I:x[Ř/|3q$g-4P6g,cqTAcbxf F1I?!K*^3 [ e@3B,x VCq|YVsm sU^Jjq ԿWh*pp^6IàGLK&|8&8sX=/ד`M3.00>Lew@^`S>WhE7 YOO˱f~Usɫ>~:QYnB},@ tdjg}RT+'kU7۟f 8<12~ĭ8)'|BsٶJ#G9jS񇽟U>:.Y^^(cS*ձ\n]`i{M bH%l (Th Ǖ"8 /<˄L ~.j(|ɐ{%*^ZQє@B!]y#* JUZjɪļ ōc> !^φ*=,̱#lN}A݃Q-m] /e. 1AQkP "酓\2$d%*wϾ=z^s2*wƚm0P:{hoXHkۻ|'N,%/=$qC H=Uʹ\8|@Pg1CNvگON^ߙOܤJʼ @"ftFcn[D;ؔ_zeO-\Jٵ͏`U`xMO쌔)u4Z3Z;Yŋ(,Cݸ_ &glQH?˙8mS`VKr5B8`[WDaVtE~]q,KA vn0GAbzVM ¹+Li0,(G;1ʲc7|tr2p*CاY|Y%XCEպg}*kr!5 X74) X ˕A~5-m!l@ NCNSfi;OgpUσfvˊmBzm rFy+sNS#]0&.r^}<"0U5 *(ki`ܝfiCdҖse tcLG^;fvb:J$=B$=Z-??7qyϊ )ʟ)@8U] " \B?/-/ƽߞxZ ; Q#D"ͥÆ  eR\2z4*^$'p(1 .[V@Hٙʂ2!,:=]9F_"2ީiY)oZѓI ͡A߻l!Njab X4ux&ֽZ&SfsٓvfH͎n{Q<+L}:FOf"s~خ wr,9 GQUE~re 3َL("<ʚ ?@%p3(]?VK4/leQX4藙.4zI8%۾b'P2WOvm6^Dڞ^5QvZJM5ٝQwNږHMfO#1*ae4xErOQ=WۣI-v)G`?5*C<\ia%}X4k;O^A-d"XaiTl6x=+vuV&#ݵ̪STIʃ@t~P^(Ew$k_"ԁ$۱A쨔Ra 7b8!{XX| x! +!Cj4}O9_uc2rL_۵Ebq4\]shX`^_ .F'c% ^{Ñe0 7^šrs/菶AVT)ح=4,ڹhw0ڝR#aUIK"iv mVOcnlb|JeL<2cvg=8 tTSl9DYU/bR&%䄄a=JYa"i-hg;/8KUN /aVٛbW,qqgql[--R&ܝˠ%Y d cJcxzNA1O`rp9\5xWrO;+ h xx* / ~U7x&m$ \w0(]xtAY=}ݭ]I+c6x]tb&|->= 9z@JRUҮW ZAG\Wx,6dCE Bnfns6$nkxZ'xm͜C竍)^ B!1쑰)=ygª-'ߊ%]O(DNuY}#7P"}LHrzE*|T Ӳx  JTV)3Ps<^\ܬqEͦ/9DK6 UU=`\ijP0&o8 7|B6{8bF`MI[\0xoo MіUT[VOO;+ATbE@ܝY_w!h0ho/- dq?x\xXCo , {SGȳdoVu&^RrL罴Soȫ}¬RT>%Av Eܹv."r2`e40|>iIVbY _I;El$[`0m:,J.e%69/<=p"Z : ׅlKyI(S@Ϻc)3 DUTV`k mT"&bz"g؁76 5+b$56,Bg2\>[(m/*ۈ;A Ov/:o- zB /Z3?7$=o ~DoA4芥fEc( 8iu[̅)0`Aˊ;707<9K@r%Q\:, ,Y./ve(ɧS3FRG ;ww~>4csc脕P'Ձ^{z3:k+ |RrrjLt΋\GO(2|킠8BТh-g<:Z*R!y_;a8^Wr[ Vd sRК#3擆yMlh,z2{߭F1Lb$~ `ڢ숎̀a-X`Zy3Vߢlskm$kѢVWhN 5 'B&K*%t>EZ0-Y?&i93 Z\a 7:ܘ:LpfXO"k3RAvd̕U\5m3ؕ=m/|%RDdZ(a"+9+$ 1UhK-+$()V dv{Ʒ+R!.s5UO$lLŤa: 4&-\BQ4꿇OO{ĸ{́ !@GD j`6v'әbrtq MO|@$@pim½P'7R"0cëP4U :NWjvFk ] Yy0 7Tc Nd|z;^tUP6 p޹ AWnXPJ49T.v2*>>e;c$ɨ8 QʟkX>wg5}[Ձ?|ю1'^갅[#Ezñy[򳭯꥽<V9HZ(%(Xc"k1ɉlMj%Լ\G|%MϯE&=k.Ggώ]_xJfH_>D:C6"Ԫq!Lmo|]{IDcj_ŵD1˰]Z5ʷ炖Us~Di ;`~hE8&cOs:kZJ48UGlx,Amj<y<8#H=O!DW։KA$+'`q !O4)dM;1dWi:DM-{c9͂V4Wٖؑ24 I֣m0G0eXss+wIVM!V)4>>3mn>^]`qVuʆ0Dʱ]JrXpLd(VjrhsAXXcM:'Aӥk󃔃*zuQ9w0 O|@2]#|mxzx Y&*ﻞ!Q¼Q@zq2 ǔ܉IZQs~x+?׶*aUzCް}[,Hh1)eWuYP #ȨLiԓ>Ȫ&T+L譫.'n’\ƉtHjJ0t5Ģ,߱G(rqmy1@4dR{sg {a.a<[tQ8z⬖S X[ Ke I+ ǓeCԕN({3;Ǽ.\3t u̓7Wm^jF Cx0BPa=<<*'<Θut>4IPkCez? (^n\F4cV?z0AD9 Z=?g52"Byp]d=LG"2Q]ƕS+vdL1 κF hZY/UNfn,;Ct 5&N qջ֬)B/瀤:nD|!:[c+5F3^Ȕ ۉ\%Wζ?IB4'ܓ>, )|^^gv8yEpT"\I`5I<a鹩#Ѿ. ~F?)K>E(Lm|_}"J(J|ؗ%  ݪi#mdXy.;2f]ʮWeҐ|XW;ik ?IKylݠ)I&);P38Du',5cD5&<@4,{yzL`ia"$nң" +>:ANL4H"yIP͏Lcu[dʅ WOVp Ċ p'xDrO"Tc&v[7<׺=5tμZSV {8:#Y%`n[pҋQT#t^qлYW3C^!׬ʣ,e@Aj4vku$A˅p*gN|2^jCw'9|q !K5vBca2gk\&CײcyT`:0Ź5lj@tN9}T'ԙff5+{{>i)LR,wej[֚Y^HM˻B&mLj(hNIݴ;i8k+{Za{%jݷZA`L50ul*F`2d9&FjT@*OO7 W>G+|^C7xbۍǭ''jŴ0U ueOFw;gpR)H;-|9G=l8?bXeg̮+P`V -7đQ0(BegI*v_*AP)$$$zUGWW'3b@CӊA}NupYDVw G 5cŞw?l; Әm݇S:Mf@٭1 .qk&%iV1 (Śd%ZR$|;ijtAdmlH&M)Ehj*k3o-D)=ʵnQ=<@v`t<.@K^o[ ֓ȗ[Kۡ1%Yb5Չ=M F0' `mK}t3\a(> M:4_F#x=%^NV=8gĤ.] `0'u!YA3F[K =^I8,-\ 2 eZO 1*̞F&=sg3zdЁ _~bn_SoB1h;qgEqȮm)QYzUѲ> N!VRӠwHR)Hǣ8x[jb4ʕ2/k7/ŤB"5F5 'i VˡDIb>;UI4e@=|_՚+/@l騐 Qu jA/1jZy]8k]B}32)qtaP#%g|ێ|lpxWs&s8>8_Q &׃eAUcT:K e?҈K3 Ls̡HJSEHmp+ \1A `X{k2% `ްmSHpb-2G`wZ<#5/0L^-A {B>2<[U/NPAv.dv착!v*Jn&W9y;oBTlԜ8??K 5m_݅HGI:^&rPUcHr*q:I:J ;*HٱG3 qkGRf"Dēce+xTl2w{< q| Ws`iQ=Ki^cN7-=^}/^v!hT$ J&N5tE I,Ux}i(DpARG^ %3:A7=- (B%qr׷J!Xk]xfߏIZ+wܵuqsrG T赞S2.;je[zJpC$y[Vڪ^9~3VEՔ/t0X]jYVA[&NMW;|85|!=r!:^=y)5`KfW7o+Uvgq,Z\c!x I"o;l G;wes"E7ΏgY[\Fh P%?IʀBt3ɬrHT+l8;d ɶN~A2&)Φp~`butrTJ &X6K'gjYw&]ޟis ̃VczNCҴjm H;~'{x<. Xr>ݖurwXabh>Bqwo= ǨvX0DFUqxhْc!&Sz7iڅVTɈ"} ̃km$Ryvر%?s5O$V\((Aek펈p^nlz1w; u3,5%IFcmuN{A3BIW>VRn6ۂ/@oSg|kMX,SCk℀w"Y]ц6 *KNHuvک;5HkP= gѮl2MjsAC+2:X;.i\PuuY:q| 9G` u4*o ,s60a)A?&I١Oc'I L6Bktaҡ~Cg9ńA+O31'|I1~q_>}ȷ+#l@ӎ,=}bB0g/wŨj0WOȯmחԧ1VL_չP]P8cY}ƳoX(z%ʊY7eX{G@pZńlI({}f.F 5Zz=l<_TEMRj;cD3WS'0 YZplm/data/Cigar.rda0000644000176200001440000005010014124132276013466 0ustar liggesusers7zXZi"6!XᖷP])TW"nRʟXH#&'ƯNjEzs`ˆ,F: ~#I>Y@r;qtd wE;bR< 1wiLN4%|kMQxw/$PtW*j10Noz qē z5d~+{cX# ,yQ.5)rokK5&Fp?փP@j/Z(|Zoo";O*!.z9̾1EQcnF akAѐ=KaUKO}D6>mGQZ oAh#`PL&^MvۀWzRȖVև0/}-U496E>N[-(Tev} EIrC8T=c4;JlDlfp8BKyƻ{x[yJΦ OONhav$ Ѐx-D}p{T-8WQt'dU0߳˫75{F,XBeٹɘ*FvI7ƠDh+ b;UeFg1ZS;vv-**{2g 5/ *9ߛ׉řBa'=.z|$?'7ț S"߽+4},o_wk[xJ$|s+[]gYmx4{0#2Ʀu>'НRlQX.{pσC7xTŦ8r4ϥ3Ժ.Hg<;$2j _97ju؀AW8Vpq5eiXr_]%n>`;8}!W {H@ XXcUBsTMIY EB1G{$BfATۀ0JiZ*j.-BksW#mt0x+qLzЂ ʠtw ~R ot.5@NS?l2 SfBZEӑBb~p-v1Nk43K]O]@qgG?B9A;Ԧ`XǝPkuY*iµ0XS=-]猷AN^nw^ !q\(>wi_$5nԻLut^Avs&X@g5%a6z˷*܇✛cGmo0{kPZ>¢¤ ~S7-F|7,&-y~NXЁF#n2HVp,;8ij*eZ 0US㟖ILڄ/U'ʷSð힧*@AmׂΉݷB7GU5P`\KAQ*]S"6zAA@&#QS`dpwFޭDq=9k6Ϋ}-̬(M7֧rZ2sqFP&ĺ}ջ1OB {mڌ7? Ph0C0QqK+  O9Sw@1ʉXlT^?֖ij;/^&#E*2ql^ M^q*sR ^5KW tnhlK1||3/9"\$~nV+5= "GڳI>['OW*`PKl$)`zڐw*rRȑPpR5 >P¿RءoSe!7Kv)_O*P=F~huy}L[Ć;U54;g"!̝} EE=bp s c$YhkSJc^xS&wA)G4|W/=.xrZ'-g&Ìv"!G>>ݷh,u9EY.S̃d#V )e\Y%Ae)?< Öa_f'{hq ?l#hQANN(qrTk&DZ"'eR3ƟO]rv7{q$H@#5d/=Kc>Tigꊛ=.RD{kL Ì^FR/Utґ<"~(E2$J pyH[<- تv"|fX`Ob/$œ)^o^9)ٹQG22 Rh C]IhU%&XOjDX#pZ"=AɎ锍5} EIM{J߂4f~xEFxp6i}oOvk 5Ҿ'%ՇGduU5Sj @_FXR @S ~yZqm'@ڠ ͖@"~S(ɫ!Moh3aQOjdZi߇koBj1A Bnوjj@DlQ^/Vi!ñAz!R~!* ?NK yZ=#5 |ѝ(~(zIW +֜W׎ [O,ofi4$ɕ=ڂ+Ö8b= ;AsLX u AC e ܍8l_A;XѪ,ڻ~|{YRe*dQfxJ@w{kA(j( kGs"ta+a,{2 "\u'6eek F ͧlr}bCbA_Y }*j\ݾ0ipt3`"yYS&atŷ"r*tEJ }ݩPԶ`(JC, JE<|,ynuen#{lk )ik$Law]NP0TK007OeXz%@3Þpwꝵ9=RIPhe%CMICAgvD-d R=G^zI% ?>6޻JplS#Xƃ.Y.\R㺇1y;0Rؗw#}z- -RT2R&$ Ѝ8: [t&r+A0Qk ޡI˒I zDڏBz_ԷXJ)R  喊 lk%,@/GGX!-G3 6$I*c49cdPS"H/aPfXŒS\A$s9ED/e],?I"N6ߍh"oa_ƊzN|ņG3'5$m'y2afg[3!D|?b#l h%C8%rG}\$D9J*ѐM E`YLlp Hꐨ YRpZnzSf7 QuӐXf؋+%HSWkSWʿ.w2q*,#c<ڃ vT+`S>0i2k%hEZ&|J(Т%.dUE+A\8˄&a^i4ͨHۊUYݢ Md?IQM Lը GOЎAi'ٜ=Sd(DCA;W,w݁uSj@θkl4#d-lDO/>pDU!;qZyC,Н_Y yxL˘폭֗͂'A8$8L)yp%[z {(Y[D Aq:9.=6h)0VZH9_5 @N{3:po!}PxōF[$;OFQcG>c~ܝkZvzR ]eUQ~3=MMHg,ף} -m9G@2z8P+C;c0$Q bk[աzX|ٶzH9^Z^<as!t)=ӛoo^D#*>IByR,ԎwlEμ׊t )jo}r=%=_wHknh'MuUݖyJS_\n/Ċ| OQ'egv|Eq8؜Y|R/6oQWsw;~{U ]͔c&M UV(Ao4Xryep~|g`8y !Y|P]e!\rr¨>ly[ O)'y'ߠn?jTlON#S YX*-57΋c^ywVn@=9ֻvUπ=V>)cemnO|#ŠYp'#<CV4ΰ2wY1 Z(Kua])BHy2zbGKKˤ'%'S*GId{gŴ\CLXC. Eq(`vyHr|8L2u.F>+MS#O\)k3Œ?h mٯ7VIIGֆ*]4~] FU \,g+W )orV5"ȑ"[_:]}a 4bCsW{<8 t=O^Pb ^^1>jS}Mb42vdBjKd%np }|txcv5/4"z 2*(5m+G7uAc*E-^*g2-KwJ*WFd_AIEHo䭒O@8LpO?QȨM yrիU+CTNqB-/逆dˉXi".}J<ȅ&/R %"9#;%ж?;9u ͤ]A&}^&|6{q7zy~-oϼBUi4)Ё pCx8y]S Gf9PXi_b^JUڞZ)kEN꼇6J}\j.?N)sI.lmec>bKB]T[.[υ< *p:0}σ{ 4kȗߔ)(Z=ێƥv`9ƊD <QiMAy5>O /5[aJ#r|qp}\>z$\aAr ܰ'7ÈݮR~aPv1ɘ%UHɳwD6"Zs6LBt_QoVCQ׶͢\<[qpRTBJx?} +44zi1|VdVG $Wewk-ecKKZ&ɜ+уW82yL  eP#(Ktm\s4-o/>7pZYjŐ _ZV,.:K+ i'f |tSiXi*2pwtâCMQUS9t2SRԑ*կ<|]c\2zUAǰ˚<2xA7ky\bpg}:(Dj(UWx޷"O=𤟉+Ǚ({nZmBL5/e׭ԃR"5lKgS-J\$/S(Gaٷ$(~hA4~b<X]̦ X3qm,$fqhAXq'PXE]PHA&R)G3tN6mB VC+szNK\k[D646w6fw`9PlfYA{Ϥ=U97"+7!biWij|II3t&>q `WYSVhlv^S]dw߼Z`vr^N5vF֋*dr8ߦ2/߻6CGƔac9 V]AWGl..ݷG ٣ $]_ X_W@UA_kp\ay'@W+hL!Ruxt s;UMhx.(X۹=|1dDS/d}>f/<)}q |8X1" ߫ rȑ`vл>_㴼yx_RJ@Q'ЬOS7|ɭ];R,TY7hנi3i8b2ګCU 7RS–fsb*Hf!٩cUѣwmvGwʵ_x9M+3;-&_2#d:гڎV?rLĨ5t͚Q XZF?y bRÁlXIҰX22"g(ڇɉl MHT:X(xAS_=@B4]F ǠP';$1<5ICHs=C(@4=S*(؃X ~bф7VWl>EvZxKGɮFYq^Y;⑧NRnjff7҇a;< +S+\itoL6[]cfPWML[!XNe՞\yC SS ׼>AxfKشkٙҴ`鿳yj6 GӦ1AE(qVY@8eMLE" 5Sf9~ϠYp 0D?Hu{[%rܽ'ihSe^8oޠ "Oke9~Bv.K7ډ!MK~C/)@YZw ,Q-&@׹ , `sCif O_"0S9YUFՎeA}r0 7b&x_<\@qH VʇHc1 s7J9b1v{21Hʂ t41~nffnb˻Wűԛ;8~rܦYd3^ŝ~PhtwtF ^O%+T0=pt@j=2ے|{#@ eTg%hm^V7x+g#+!<=0R=-(s#YJ D_WUɷ. Z),!.h\vk؞ $"Ȅ^Oaj!-gbJz쨂$)l,4 Xe0ΒGWD:w{~2@a g2U$R:Wk.jea?ؚ%x 6H2)|4!C"YajҰFYDg5Y>1Cp:MݹM)M8Q6Dr vM|h;6vJP8OC|sR`uGJ#j3x21gf= g\Stb9ٴަ- @XX  ƴ :yv%~LPش.bD?*]UY-+>  Ht;a% N[PARtuMEe=1P*yEr ͍@߱{ke'CCèu45:Ó<3eA5:hPsLe ]V6kr_!1; '8HD)ܖ4P~#:F6YGf1~bo Z,oLCSsJ.1Bu{nX4Fj:4UwC/b:wT!(3%W7T8J}@Te˂k!UTf}Y u\KT!Zȭ"WD@"RbCDFl ^p-v–F3k({_c999U۪Ծ|ozi1yWDiYW٘zbΛ`zyt-fiaȇ˜Tulg9Pv/iMD?b9Hd\ʲV4oeW ]3w`X#L-N`3w<҄n%T-Xnb6%^kI]f6>+}DR7TB[#NҳI=Ax-PYӐLΥ"{emQqWo(6wg@\xWxPzX}M8H |)\MݣN+n6]'jmtZK"#L+x]pbkED±ź _)P hr@bډⱷ= ~ J 2tvkS,_d"cO{ݕ_#!^Ɔ!GF32E65ıI6o*8K[xKXG7tD0Õ2_S&7Vd UájBS\45຦)|S(ԡ`)Gj$1=R,'liޡtbpo2>ס'VS߻gj4`t7RT6.Q 2DGOrH-j7\2rc!MYxh!Z6AASۀs C*A!'i!ecY9+Tn^x%K\dHT($BpEt?pMC:v|ieO%G%]u} v 2 d-E7y#h`ki0#GЬ`2%yB0%_ԑ/P^q(Pb{!9|J0rS#ַz~ #ۆ{5׎L4@Vi"POp v+`yw1vqꯓ+X\KRPM5iI3*L3w5|U>%n}{ݖ|'l ,~ZxN0υ\}#)س!Bg#pgU=|&߾qc?q;*lb6 ;.3C|//C[C#c py' yޝ|:N?mMoc1`\0?A? Q>j1 z)&O?^WRZUZ*I9HQL!$٨q60RloÖnZe,vVs^@?Q[=0JRtqprpO=\%PwoM{硛*0lQﮢ@kI\G))S/\q'm?ޢT6ƙ&%8?#7Jbټ4YdXƕ#?] D##G?Gndvsߚ3s&v1Œ~`.Ew6Zm}FWÁ& CYŁhў&I/![莘8.C$YAQ{ΰRb7SKHuйnOTѻwB]ff]5Ӟz)7M:cF EX `!A0 4jrl.!1DDFo>dI)r.\aJ_Tm"K$Au-T7}S0ЉGܓG2jP~;c̀9=6SU٪Fc8J 0^!4kTVqIZ?;|*:)JXH5!B!(fW@)jN onuG"t538\ H Ե)Vt xbRfrytp~ =Rxwn,T>~@:h_kB?K=>Ve*Cd{RWXvAw@VMɕĽ:&# *g$)~﫹1hPs^Hx(!@^6a=؎~MOQP=?gP߽M"9 4" 2SYU6#I笈 =)PNy Af?9hPJh j{eΑZg\^\@i@/9ۺ҂'9Bi4f=ek9](/++S Iv#W=d8ϰ_#FЅi%TUp~ȅC?y]DLRBOlM+j՚I73aXn]8C] WÐ(bZyeo gH 6GfڭZh#~Z!db5?'Pv)=>' @͌뗢|}c^н{s[R4=wbӐN7zf|us*{|T^-l;§k ힷdaUn ֠Z)-jDoGĴ.Xɍj1[%@w nmvOƸ}pZWg,?Y!ߡB.vlg-;SwF@sY^'yUqPN1sP[qa@psQX:9uS^` @ 4dsGa|^)-y_ EJ'i]5% pNNyI,7/P|҂3ޣzċ67^5l vn#=dU 79q>f`Xܯ:V6Gp? {;R`[ԗCgÂ?x&F>WM _|4iހ fZmp~[n\#8 Qo`G1u?~u) תR6"1rvxRr*C#ƣ5CP2$ h>~gyp]*gE[mvaf *%=ȒAmW,A#BrFe 58^#")7*QWu kmfa|V37\s{3EPy'sGKp._yނĬT]n|jX@zsmĬ2tKv_[5@uOo%49/uŢ{r$Q|D6j|Jfx>CS@4nv^ f9P mږbE1jl<|>ĨhoDֆ3it!v ٥qGCis{UaTQdDtWOΡYru8鼷ϳ6]3#MKuR<hVحs q[h'CFjT XFil#(n#iF%j8vz/{.g*f\;$WbBRaTFH*84c`4*^'C68ьg8ؔ+DwCV^G Tc9_Dy_ }MFroNtOxn;Fa! -o*_EdMP/אQ&|(gUg(e3t:Bׂ_x:&JgF'&ŵ88_$,}BH`0`i۲2N!=X7`=Fɗ_07Xv}uv^]@kAP\z{y@ބ"#&~\<(ٴM#ZʿJ'p:1~]:%jt]0s6z߶UG@w֧"}Ъy ˓FI%ӵw-a^Fa Hu_sb48IK̐?gF9Li Ss`R0[s%h7s:"v_y`E"Aq{/i,>2ϣfg)*a2Ja3o1BMp&X4{.E##[B!Өг۔yIrzo+ *L=4#RB QΥ&2aUxhXBjg\ʳQc>G|m̂8 c&$>qBIoB_A7Lk1]>vnpb2l51Jb?430Y'1yRS >FbI/L=4_1u 6ˉT]xnpvq^)A%lj:˻8j* v=^(LC'Y++I2mv+`:lP_?CMY9OM¬w",i"ʸh+{9)U`3N8qr)?`k}&fz+U=o `sJ963c)?;dY* Loп|v/먞 znlh_.RЄK6Tя`W Z],,++D"RW,^5M!<8qIXbn'C 躿# Gc/1Z,NDZ!O2-%bq3GI)"X͐L zigm|H\t00-Ǎc}+)Z;Q0.>єHƱoՋ0h\PSmdZICyהfَh%B>:"6oW'opk/>$``/k%-et^V,Ɏp(6a[Mn4znf@Qm\}gl܈Yޭ;n7%STLSܹE7`"qεZb }TQRݴ A_YbhPKD•0FB8pwoy͜8 ALnSZ3f#?I',pr7(.g1Q%YffXhG-X4փ߯{ՙMB";yԈ.ձ٪#C\@q>*Vr;yN PLsΓz< -d P+XBx]e~ߓ]T4A"γt^1[ܔ=-5Ι_'`# +(#їZpHqLFSQƲ_ däV=U;>v f֜z0N, (UG AY?T!KzpT+Fڠ,uDILCUnF CCM_Xx"CpdvVϥ_.orf;A?KyNRҲny4~ΡJ4ak mi4>wKbBp袍:/&_7:/T PEujDV$**At(  g̀W/ L-2"ʣ s7#ŞG[`C"0@:̶59  msֽ'@\ƥlZ(E<%XËq~\b՚Xg.1bZk K9:kkX9NouAC`ϻXs&C@[bcotg}1  PPpgA-NxFrKo1XDQW( #K=`Ek[ZXAQgC8Um -UUf|w b^`5nH%fݞD#}R){l0BEޢkZ*~2d>{ӯ pgݟ{< zK m T,_J2I̥\w>wM{6ѿ<4%*3^}_QK?_#Guܲ0N)YçF,.VeY r֋&˦RPIw"uz@ًPL v,Da^*ϩt%e%ڣ ~i0_auz_Z' .Nnrڎh3W?V2?ZfS=+=zCSJ гx[ϛ0Y&ק/*Y_~aTΫ)9_;4,O{OU~W0į"r;Vod]B;sԯx2BFWRXwaD&q Tv~rgD;plp`,_-~ϕ%'J?K~ҡbA=Ng]R5Q](^ct9v0\f\Lar28Kk>/b䄤Eт xWVx"=M~WsMh2cR(ލ2 oCr(V:"eiu)[ W!% }]QmscfJXR@ T0dm"i1F;>X(ځm{3#0ȂA|jr"`Vf O(Dxbq8ȴUΉ㇅X2C͝ly3 "Y`ٌeuh3`C[@4CpyVc[wXUF0Z+Mm.r(Hiq,;#R>TeX:H JFY#YѥV9H *Xw^xה4Y/Vx.NsSw5a3z>v+m*l(\m$tT E o7T@L岓5ߩK oPѓw 3G+v?9UfV躕 P9۱ocJ?iKw:W@(. gsb3'-%iX-UskB魙[nZӽ8 ʎ=!xtOU8'z#aqL$r,"Q19;/k33p "x|r4[E=&u<\՞8X ⢤ʗl0/i۴r63yg> -aD=Ut8x@)<|^8ayhsX-tB)X9)h3}[y,y=y/jVVGuDZwH.?ދ'Յ=甶`F5Լi~ACR(-ˆƣ1w^!HGr[raЖtD0 YZplm/man/0000755000176200001440000000000014165357232011625 5ustar liggesusersplm/man/re-export_functions.Rd0000644000176200001440000000066114124132276016126 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \name{re-export_functions} \alias{re-export_functions} \alias{maxLik} \title{Functions exported from other packages} \description{ These functions are imported from other packages and re-exported by \pkg{plm} to enable smooth use within \pkg{plm}. Please follow the links to view the function's original documentation. } \keyword{internal} plm/man/Hedonic.Rd0000644000176200001440000000304014124132276013454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Hedonic} \alias{Hedonic} \title{Hedonic Prices of Census Tracts in the Boston Area} \format{ A dataframe containing: \describe{ \item{mv}{median value of owner--occupied homes} \item{crim}{crime rate} \item{zn}{proportion of 25,000 square feet residential lots} \item{indus}{proportion of no--retail business acres} \item{chas}{is the tract bounds the Charles River?} \item{nox}{annual average nitrogen oxide concentration in parts per hundred million} \item{rm}{average number of rooms} \item{age}{proportion of owner units built prior to 1940} \item{dis}{weighted distances to five employment centers in the Boston area} \item{rad}{index of accessibility to radial highways} \item{tax}{full value property tax rate ($/$10,000)} \item{ptratio}{pupil/teacher ratio} \item{blacks}{proportion of blacks in the population} \item{lstat}{proportion of population that is lower status} \item{townid}{town identifier} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ A cross-section } \details{ \emph{number of observations} : 506 \emph{observation} : regional \emph{country} : United States } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BESL:KUH:WELS:80}{plm} \insertRef{HARR:RUBI:78}{plm} } \keyword{datasets} plm/man/is.pconsecutive.Rd0000644000176200001440000001640714154734502015242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is.pconsecutive_pbalanced.R \name{is.pconsecutive} \alias{is.pconsecutive} \alias{is.pconsecutive.default} \alias{is.pconsecutive.data.frame} \alias{is.pconsecutive.pseries} \alias{is.pconsecutive.pdata.frame} \alias{is.pconsecutive.panelmodel} \title{Check if time periods are consecutive} \usage{ is.pconsecutive(x, ...) \method{is.pconsecutive}{default}(x, id, time, na.rm.tindex = FALSE, ...) \method{is.pconsecutive}{data.frame}(x, index = NULL, na.rm.tindex = FALSE, ...) \method{is.pconsecutive}{pseries}(x, na.rm.tindex = FALSE, ...) \method{is.pconsecutive}{pdata.frame}(x, na.rm.tindex = FALSE, ...) \method{is.pconsecutive}{panelmodel}(x, na.rm.tindex = FALSE, ...) } \arguments{ \item{x}{usually, an object of class \code{pdata.frame}, \code{data.frame}, \code{pseries}, or an estimated \code{panelmodel}; for the default method \code{x} can also be an arbitrary vector or \code{NULL}, see \strong{Details},} \item{\dots}{further arguments.} \item{id, time}{only relevant for default method: vectors specifying the id and time dimensions, i. e., a sequence of individual and time identifiers, each as stacked time series,} \item{na.rm.tindex}{logical indicating whether any \code{NA} values in the time index are removed before consecutiveness is evaluated (defaults to \code{FALSE}),} \item{index}{only relevant for \code{data.frame} interface; if \code{NULL}, the first two columns of the data.frame are assumed to be the index variables; if not \code{NULL}, both dimensions ('individual', 'time') need to be specified by \code{index} for \code{is.pconsecutive} on data frames, for further details see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ A named \code{logical} vector (names are those of the individuals). The i-th element of the returned vector corresponds to the i-th individual. The values of the i-th element can be: \item{TRUE}{if the i-th individual has consecutive time periods,} \item{FALSE}{if the i-th individual has non-consecutive time periods,} \item{"NA"}{if there are any NA values in time index of the i-th the individual; see also argument \code{na.rm.tindex} to remove those.} } \description{ This function checks for each individual if its associated time periods are consecutive (no "gaps" in time dimension per individual) } \details{ (p)data.frame, pseries and estimated panelmodel objects can be tested if their time periods are consecutive per individual. For evaluation of consecutiveness, the time dimension is interpreted to be numeric, and the data are tested for being a regularly spaced sequence with distance 1 between the time periods for each individual (for each individual the time dimension can be interpreted as sequence t, t+1, t+2, \ldots{} where t is an integer). As such, the "numerical content" of the time index variable is considered for consecutiveness, not the "physical position" of the various observations for an individuals in the (p)data.frame/pseries (it is not about "neighbouring" rows). If the object to be evaluated is a pseries or a pdata.frame, the time index is coerced from factor via as.character to numeric, i.e., the series \verb{as.numeric(as.character(index()[[2]]))]} is evaluated for gaps. The default method also works for argument \code{x} being an arbitrary vector (see \strong{Examples}), provided one can supply arguments \code{id} and \code{time}, which need to ordered as stacked time series. As only \code{id} and \code{time} are really necessary for the default method to evaluate the consecutiveness, \code{x = NULL} is also possible. However, if the vector \code{x} is also supplied, additional input checking for equality of the lengths of \code{x}, \code{id} and \code{time} is performed, which is safer. For the data.frame interface, the data is ordered in the appropriate way (stacked time series) before the consecutiveness is evaluated. For the pdata.frame and pseries interface, ordering is not performed because both data types are already ordered in the appropriate way when created. Note: Only the presence of the time period itself in the object is tested, not if there are any other variables. \code{NA} values in individual index are not examined but silently dropped - In this case, it is not clear which individual is meant by id value \code{NA}, thus no statement about consecutiveness of time periods for those "\code{NA}-individuals" is possible. } \examples{ data("Grunfeld", package = "plm") is.pconsecutive(Grunfeld) is.pconsecutive(Grunfeld, index=c("firm", "year")) # delete 2nd row (2nd time period for first individual) # -> non consecutive Grunfeld_missing_period <- Grunfeld[-2, ] is.pconsecutive(Grunfeld_missing_period) all(is.pconsecutive(Grunfeld_missing_period)) # FALSE # delete rows 1 and 2 (1st and 2nd time period for first individual) # -> consecutive Grunfeld_missing_period_other <- Grunfeld[-c(1,2), ] is.pconsecutive(Grunfeld_missing_period_other) # all TRUE # delete year 1937 (3rd period) for _all_ individuals Grunfeld_wo_1937 <- Grunfeld[Grunfeld$year != 1937, ] is.pconsecutive(Grunfeld_wo_1937) # all FALSE # pdata.frame interface pGrunfeld <- pdata.frame(Grunfeld) pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) is.pconsecutive(pGrunfeld) # all TRUE is.pconsecutive(pGrunfeld_missing_period) # first FALSE, others TRUE # panelmodel interface (first, estimate some models) mod_pGrunfeld <- plm(inv ~ value + capital, data = Grunfeld) mod_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = Grunfeld_missing_period) is.pconsecutive(mod_pGrunfeld) is.pconsecutive(mod_pGrunfeld_missing_period) nobs(mod_pGrunfeld) # 200 nobs(mod_pGrunfeld_missing_period) # 199 # pseries interface pinv <- pGrunfeld$inv pinv_missing_period <- pGrunfeld_missing_period$inv is.pconsecutive(pinv) is.pconsecutive(pinv_missing_period) # default method for arbitrary vectors or NULL inv <- Grunfeld$inv inv_missing_period <- Grunfeld_missing_period$inv is.pconsecutive(inv, id = Grunfeld$firm, time = Grunfeld$year) is.pconsecutive(inv_missing_period, id = Grunfeld_missing_period$firm, time = Grunfeld_missing_period$year) # (not run) demonstrate mismatch lengths of x, id, time # is.pconsecutive(x = inv_missing_period, id = Grunfeld$firm, time = Grunfeld$year) # only id and time are needed for evaluation is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) } \seealso{ \code{\link[=make.pconsecutive]{make.pconsecutive()}} to make data consecutive (and, as an option, balanced at the same time) and \code{\link[=make.pbalanced]{make.pbalanced()}} to make data balanced.\cr \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), \code{\link[=pvar]{pvar()}} to check for individual and time variation of a 'pdata.frame' (and other objects), \code{\link[=lag]{lag()}} for lagged (and leading) values of a 'pseries' object.\cr \code{\link[=pseries]{pseries()}}, \code{\link[=data.frame]{data.frame()}}, \code{\link[=pdata.frame]{pdata.frame()}}, for class 'panelmodel' see \code{\link[=plm]{plm()}} and \code{\link[=pgmm]{pgmm()}}. } \author{ Kevin Tappe } \keyword{attribute} plm/man/index.plm.Rd0000644000176200001440000000522114124132276014004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_pdata.frame.R \name{index.plm} \alias{index.plm} \alias{index} \alias{index.pindex} \alias{index.pdata.frame} \alias{index.pseries} \alias{index.panelmodel} \title{Extract the indexes of panel data} \usage{ \method{index}{pindex}(x, which = NULL, ...) \method{index}{pdata.frame}(x, which = NULL, ...) \method{index}{pseries}(x, which = NULL, ...) \method{index}{panelmodel}(x, which = NULL, ...) } \arguments{ \item{x}{an object of class \code{"pindex"}, \code{"pdata.frame"}, \code{"pseries"} or \code{"panelmodel"},} \item{which}{the index(es) to be extracted (see details),} \item{\dots}{further arguments.} } \value{ A vector or an object of class \code{c("pindex","data.frame")} containing either one index, individual and time index, or (any combination of) individual, time and group indexes. } \description{ This function extracts the information about the structure of the individual and time dimensions of panel data. Grouping information can also be extracted if the panel data were created with a grouping variable. } \details{ Panel data are stored in a \code{"pdata.frame"} which has an \code{"index"} attribute. Fitted models in \code{"plm"} have a \code{"model"} element which is also a \code{"pdata.frame"} and therefore also has an \code{"index"} attribute. Finally, each series, once extracted from a \code{"pdata.frame"}, becomes of class \code{"pseries"}, which also has this \code{"index"} attribute. \code{"index"} methods are available for all these objects. The argument \code{"which"} indicates which index should be extracted. If \code{which = NULL}, all indexes are extracted. \code{"which"} can also be a vector of length 1, 2, or 3 (3 only if the pdata frame was constructed with an additional group index) containing either characters (the names of the individual variable and/or of the time variable and/or the group variable or \code{"id"} and \code{"time"}) and \code{"group"} or integers (1 for the individual index, 2 for the time index, and 3 for the group index (the latter only if the pdata frame was constructed with such).) } \examples{ data("Grunfeld", package = "plm") Gr <- pdata.frame(Grunfeld, index = c("firm", "year")) m <- plm(inv ~ value + capital, data = Gr) index(Gr, "firm") index(Gr, "time") index(Gr$inv, c(2, 1)) index(m, "id") # with additional group index data("Produc", package = "plm") pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) index(pProduc, 3) index(pProduc, "region") index(pProduc, "group") } \seealso{ \code{\link[=pdata.frame]{pdata.frame()}}, \code{\link[=plm]{plm()}} } \author{ Yves Croissant } \keyword{attribute} plm/man/Gasoline.Rd0000644000176200001440000000202114124132276013642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Gasoline} \alias{Gasoline} \title{Gasoline Consumption} \format{ A data frame containing : \describe{ \item{country}{a factor with 18 levels} \item{year}{the year} \item{lgaspcar}{logarithm of motor gasoline consumption per car} \item{lincomep}{logarithm of real per-capita income} \item{lrpmg}{logarithm of real motor gasoline price} \item{lcarpcap}{logarithm of the stock of cars per capita} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ A panel of 18 observations from 1960 to 1978 } \details{ \emph{total number of observations} : 342 \emph{observation} : country \emph{country} : OECD } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BALT:GRIF:83}{plm} } \keyword{datasets} plm/man/Produc.Rd0000644000176200001440000000225314124132276013344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Produc} \alias{Produc} \title{US States Production} \format{ A data frame containing : \describe{ \item{state}{the state} \item{year}{the year} \item{region}{the region} \item{pcap}{public capital stock} \item{hwy}{highway and streets} \item{water}{water and sewer facilities} \item{util}{other public buildings and structures} \item{pc}{private capital stock} \item{gsp}{gross state product} \item{emp}{labor input measured by the employment in non--agricultural payrolls} \item{unemp}{state unemployment rate} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ A panel of 48 observations from 1970 to 1986 } \details{ \emph{total number of observations} : 816 \emph{observation} : regional \emph{country} : United States } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BALT:PINN:95}{plm} \insertRef{MUNN:90}{plm} } \keyword{datasets} plm/man/phtest.Rd0000644000176200001440000000710214154734502013420 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_general.R \name{phtest} \alias{phtest} \alias{phtest.formula} \alias{phtest.panelmodel} \title{Hausman Test for Panel Models} \usage{ phtest(x, ...) \method{phtest}{formula}( x, data, model = c("within", "random"), effect = c("individual", "time", "twoways"), method = c("chisq", "aux"), index = NULL, vcov = NULL, ... ) \method{phtest}{panelmodel}(x, x2, ...) } \arguments{ \item{x}{an object of class \code{"panelmodel"} or \code{"formula"},} \item{\dots}{further arguments to be passed on (currently none).} \item{data}{a \code{data.frame},} \item{model}{a character vector containing the names of two models (length(model) must be 2),} \item{effect}{a character specifying the effect to be introduced to both models, one of \code{"individual"}, \code{"time"}, or \code{"twoways"} (only for formula method),} \item{method}{one of \code{"chisq"} or \code{"aux"},} \item{index}{an optional vector of index variables,} \item{vcov}{an optional covariance function,} \item{x2}{an object of class \code{"panelmodel"} (only for panelmodel method/interface),} } \value{ An object of class \code{"htest"}. } \description{ Specification test for panel models. } \details{ The Hausman test (sometimes also called Durbin--Wu--Hausman test) is based on the difference of the vectors of coefficients of two different models. The \code{panelmodel} method computes the original version of the test based on a quadratic form \insertCite{HAUS:78}{plm}. The \code{formula} method, if \code{method = "chisq"} (default), computes the original version of the test based on a quadratic form; if \code{method ="aux"} then the auxiliary-regression-based version as in \insertCite{WOOL:10;textual}{plm}, Sec.10.7.3. Only the latter can be robustified by specifying a robust covariance estimator as a function through the argument \code{vcov} (see \strong{Examples}). The \code{effect} argument is only relevant for the formula method/interface and is then applied to both models. For the panelmodel method/interface, the test is run with the effects of the already estimated models. The equivalent tests in the \strong{one-way} case using a between model (either "within vs. between" or "random vs. between") \insertCite{@see @HAUS:TAYL:81 or @BALT:13 Sec.4.3}{plm} can also be performed by \code{phtest}, but only for \code{test = "chisq"}, not for the regression-based test. NB: These equivalent tests using the between model do not extend to the two-ways case. There are, however, some other equivalent tests, \insertCite{@see @KANG:85 or @BALT:13 Sec.4.3.7}{plm}, but those are unsupported by \code{phtest}. } \examples{ data("Gasoline", package = "plm") form <- lgaspcar ~ lincomep + lrpmg + lcarpcap wi <- plm(form, data = Gasoline, model = "within") re <- plm(form, data = Gasoline, model = "random") phtest(wi, re) phtest(form, data = Gasoline) phtest(form, data = Gasoline, effect = "time") # Regression-based Hausman test phtest(form, data = Gasoline, method = "aux") # robust Hausman test with vcov supplied as a function and # with additional parameters phtest(form, data = Gasoline, method = "aux", vcov = vcovHC) phtest(form, data = Gasoline, method = "aux", vcov = function(x) vcovHC(x, method="white2", type="HC3")) } \references{ \insertRef{HAUS:78}{plm} \insertRef{HAUS:TAYL:81}{plm} \insertRef{KANG:85}{plm} \insertRef{WOOL:10}{plm} \insertRef{BALT:13}{plm} } \author{ Yves Croissant, Giovanni Millo } \keyword{htest} plm/man/vcovNW.Rd0000644000176200001440000000737014124132276013337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovNW} \alias{vcovNW} \alias{vcovNW.plm} \alias{vcovNW.pcce} \title{Newey and West (1987) Robust Covariance Matrix Estimator} \usage{ vcovNW(x, ...) \method{vcovNW}{plm}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), maxlag = NULL, wj = function(j, maxlag) 1 - j/(maxlag + 1), ... ) \method{vcovNW}{pcce}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), maxlag = NULL, wj = function(j, maxlag) 1 - j/(maxlag + 1), ... ) } \arguments{ \item{x}{an object of class \code{"plm"} or \code{"pcce"}} \item{\dots}{further arguments} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"sss"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, see Details,} \item{maxlag}{either \code{NULL} or a positive integer specifying the maximum lag order before truncation} \item{wj}{weighting function to be applied to lagged terms,} } \value{ An object of class \code{"matrix"} containing the estimate of the covariance matrix of coefficients. } \description{ Nonparametric robust covariance matrix estimators \emph{a la Newey and West} for panel models with serial correlation. } \details{ \code{vcovNW} is a function for estimating a robust covariance matrix of parameters for a panel model according to the \insertCite{NEWE:WEST:87;textual}{plm} method. The function works as a restriction of the \insertCite{DRIS:KRAA:98;textual}{plm} covariance (see \code{\link[=vcovSCC]{vcovSCC()}}) to no cross--sectional correlation. Weighting schemes specified by \code{type} are analogous to those in \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} in package \CRANpkg{sandwich} and are justified theoretically (although in the context of the standard linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. The main use of \code{vcovNW} (and the other variance-covariance estimators provided in the package \code{vcovHC}, \code{vcovBK}, \code{vcovDC}, \code{vcovSCC}) is to pass it to plm's own functions like \code{summary}, \code{pwaldtest}, and \code{phtest} or together with testing functions from the \code{lmtest} and \code{car} packages. All of these typically allow passing the \code{vcov} or \code{vcov.} parameter either as a matrix or as a function, e.g., for Wald--type testing: argument \code{vcov.} to \code{coeftest()}, argument \code{vcov} to \code{waldtest()} and other methods in the \CRANpkg{lmtest} package; and argument \code{vcov.} to \code{linearHypothesis()} in the \CRANpkg{car} package (see the examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. } \examples{ data("Produc", package="plm") zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") ## as function input to plm's summary method (with and without additional arguments): summary(zz, vcov = vcovNW) summary(zz, vcov = function(x) vcovNW(x, method="arellano", type="HC1")) ## standard coefficient significance test library(lmtest) coeftest(zz) ## NW robust significance test, default coeftest(zz, vcov.=vcovNW) ## idem with parameters, pass vcov as a function argument coeftest(zz, vcov.=function(x) vcovNW(x, type="HC1", maxlag=4)) ## joint restriction test waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovNW) \dontrun{ ## test of hyp.: 2*log(pc)=log(emp) library(car) linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovNW) } } \references{ \insertRef{CRIB:04}{plm} \insertRef{DRIS:KRAA:98}{plm} \insertRef{MACK:WHIT:85}{plm} \insertRef{NEWE:WEST:87}{plm} \insertRef{ZEIL:04}{plm} } \seealso{ \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} from the \CRANpkg{sandwich} package for weighting schemes (\code{type} argument). } \author{ Giovanni Millo } \keyword{regression} plm/man/Crime.Rd0000644000176200001440000000717114124132276013153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Crime} \alias{Crime} \title{Crime in North Carolina} \format{ A data frame containing : \describe{ \item{county}{county identifier} \item{year}{year from 1981 to 1987} \item{crmrte}{crimes committed per person} \item{prbarr}{'probability' of arrest} \item{prbconv}{'probability' of conviction} \item{prbpris}{'probability' of prison sentence} \item{avgsen}{average sentence, days} \item{polpc}{police per capita} \item{density}{people per square mile} \item{taxpc}{tax revenue per capita} \item{region}{factor. One of 'other', 'west' or 'central'.} \item{smsa}{factor. (Also called "urban".) Does the individual reside in a SMSA (standard metropolitan statistical area)?} \item{pctmin}{percentage minority in 1980} \item{wcon}{weekly wage in construction} \item{wtuc}{weekly wage in transportation, utilities, communications} \item{wtrd}{weekly wage in wholesale and retail trade} \item{wfir}{weekly wage in finance, insurance and real estate} \item{wser}{weekly wage in service industry} \item{wmfg}{weekly wage in manufacturing} \item{wfed}{weekly wage in federal government} \item{wsta}{weekly wage in state government} \item{wloc}{weekly wage in local government} \item{mix}{offence mix: face-to-face/other} \item{pctymle}{percentage of young males (between ages 15 to 24)} \item{lcrmrte}{log of crimes committed per person} \item{lprbarr}{log of 'probability' of arrest} \item{lprbconv}{log of 'probability' of conviction} \item{lprbpris}{log of 'probability' of prison sentence} \item{lavgsen}{log of average sentence, days} \item{lpolpc}{log of police per capita} \item{ldensity}{log of people per square mile} \item{ltaxpc}{log of tax revenue per capita} \item{lpctmin}{log of percentage minority in 1980} \item{lwcon}{log of weekly wage in construction} \item{lwtuc}{log of weekly wage in transportation, utilities, communications} \item{lwtrd}{log of weekly wage in wholesale and retail trade} \item{lwfir}{log of weekly wage in finance, insurance and real estate} \item{lwser}{log of weekly wage in service industry} \item{lwmfg}{log of weekly wage in manufacturing} \item{lwfed}{log of weekly wage in federal government} \item{lwsta}{log of weekly wage in state government} \item{lwloc}{log of weekly wage in local government} \item{lmix}{log of offence mix: face-to-face/other} \item{lpctymle}{log of percentage of young males (between ages 15 to 24)}} } \source{ Journal of Applied Econometrics Data Archive (complements Baltagi (2006)): \url{http://qed.econ.queensu.ca/jae/2006-v21.4/baltagi/} Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} See also Journal of Applied Econometrics data archive entry for Baltagi (2006) at \url{http://qed.econ.queensu.ca/jae/2006-v21.4/baltagi/}. } \description{ a panel of 90 observational units (counties) from 1981 to 1987 } \details{ \emph{total number of observations} : 630 \emph{observation} : regional \emph{country} : United States The variables l* (lcrmrte, lprbarr, ...) contain the pre-computed logarithms of the base variables as found in the original data set. Note that these values slightly differ from what R's log() function yields for the base variables. In order to reproduce examples from the literature, the pre-computed logs need to be used, otherwise the results differ slightly. } \references{ \insertRef{CORN:TRUM:94}{plm} \insertRef{BALT:06}{plm} \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} } \keyword{datasets} plm/man/piest.Rd0000644000176200001440000000337114162425404013236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_pi.R \name{piest} \alias{piest} \alias{print.piest} \alias{summary.piest} \alias{print.summary.piest} \title{Chamberlain estimator and test for fixed effects} \usage{ piest(formula, data, subset, na.action, index = NULL, robust = TRUE, ...) \method{print}{piest}(x, ...) \method{summary}{piest}(object, ...) \method{print}{summary.piest}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ... ) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[=lm]{lm()}},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{index}{the indexes,} \item{robust}{logical, if \code{FALSE}, the error is assumed to be spherical, if \code{TRUE}, a robust estimation of the covariance matrix is computed,} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{"piest"} and of class \code{"summary.piest"} for the print method of summary for piest objects,} \item{digits}{number of digits for printed output,} \item{width}{the maximum length of the lines in the printed output,} } \value{ An object of class \code{"piest"}. } \description{ General estimator useful for testing the within specification } \details{ The Chamberlain method consists in using the covariates of all the periods as regressors. It allows to test the within specification. } \examples{ data("RiceFarms", package = "plm") pirice <- piest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") summary(pirice) } \references{ \insertRef{CHAM:82}{plm} } \seealso{ \code{\link[=aneweytest]{aneweytest()}} } \author{ Yves Croissant } \keyword{htest} plm/man/model.frame.pdata.frame.Rd0000644000176200001440000000732614154734502016473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_model.extract.R \name{model.frame.pdata.frame} \alias{model.frame.pdata.frame} \alias{formula.pdata.frame} \alias{model.matrix.plm} \alias{model.matrix.pdata.frame} \title{model.frame and model.matrix for panel data} \usage{ \method{model.frame}{pdata.frame}( formula, data = NULL, ..., lhs = NULL, rhs = NULL, dot = "previous" ) \method{formula}{pdata.frame}(x, ...) \method{model.matrix}{plm}(object, ...) \method{model.matrix}{pdata.frame}( object, model = c("pooling", "within", "Between", "Sum", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways", "nested"), rhs = 1, theta = NULL, cstcovar.rm = NULL, ... ) } \arguments{ \item{data}{a \code{formula}, see \strong{Details},} \item{\dots}{further arguments.} \item{lhs}{inherited from package \code{\link[Formula:Formula]{Formula::Formula()}} (see there),} \item{rhs}{inherited from package \code{\link[Formula:Formula]{Formula::Formula()}} (see there),} \item{dot}{inherited from package \code{\link[Formula:Formula]{Formula::Formula()}} (see there),} \item{x}{a \code{model.frame}} \item{object, formula}{an object of class \code{"pdata.frame"} or an estimated model object of class \code{"plm"},} \item{model}{one of \code{"pooling"}, \code{"within"}, \code{"Sum"}, \code{"Between"}, \code{"between"}, \verb{"random",} \code{"fd"} and \code{"ht"},} \item{effect}{the effects introduced in the model, one of \code{"individual"}, \code{"time"}, \code{"twoways"} or \code{"nested"},} \item{theta}{the parameter for the transformation if \code{model = "random"},} \item{cstcovar.rm}{remove the constant columns, one of \verb{"none", "intercept", "covariates", "all")},} } \value{ The \code{model.frame} methods return a \code{pdata.frame}.\cr The \code{model.matrix} methods return a \code{matrix}. } \description{ Methods to create model frame and model matrix for panel data. } \details{ The \code{lhs} and \code{rhs} arguments are inherited from \code{Formula}, see there for more details.\cr The \code{model.frame} methods return a \code{pdata.frame} object suitable as an input to plm's \code{model.matrix}.\cr The \code{model.matrix} methods builds a model matrix with transformations performed as specified by the \code{model} and \code{effect} arguments (and \code{theta} if \code{model = "random"} is requested), in this case the supplied \code{data} argument should be a model frame created by plm's \code{model.frame} method. If not, it is tried to construct the model frame from the data. Constructing the model frame first ensures proper \code{NA} handling, see \strong{Examples}. } \examples{ # First, make a pdata.frame data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) # then make a model frame from a formula and a pdata.frame form <- inv ~ value mf <- model.frame(pGrunfeld, form) # then construct the (transformed) model matrix (design matrix) # from model frame modmat <- model.matrix(mf, model = "within") ## retrieve model frame and model matrix from an estimated plm object fe_model <- plm(form, data = pGrunfeld, model = "within") model.frame(fe_model) model.matrix(fe_model) # same as constructed before all.equal(mf, model.frame(fe_model), check.attributes = FALSE) # TRUE all.equal(modmat, model.matrix(fe_model), check.attributes = FALSE) # TRUE } \seealso{ \code{\link[=pmodel.response]{pmodel.response()}} for (transformed) response variable.\cr \code{\link[Formula:Formula]{Formula::Formula()}} from package \code{Formula}, especially for the \code{lhs} and \code{rhs} arguments. } \author{ Yves Croissant } \keyword{classes} plm/man/pFtest.Rd0000644000176200001440000000314214124132276013353 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_general.R \name{pFtest} \alias{pFtest} \alias{pFtest.formula} \alias{pFtest.plm} \title{F Test for Individual and/or Time Effects} \usage{ pFtest(x, ...) \method{pFtest}{formula}(x, data, ...) \method{pFtest}{plm}(x, z, ...) } \arguments{ \item{x}{an object of class \code{"plm"} or of class \code{"formula"},} \item{\dots}{further arguments.} \item{data}{a \code{data.frame},} \item{z}{an object of class \code{"plm"},} } \value{ An object of class \code{"htest"}. } \description{ Test of individual and/or time effects based on the comparison of the \code{within} and the \code{pooling} model. } \details{ For the \code{plm} method, the argument of this function is two \code{plm} objects, the first being a within model, the second a pooling model. The effects tested are either individual, time or twoways, depending on the effects introduced in the within model. } \examples{ data("Grunfeld", package="plm") gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") gi <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual", model = "within") gt <- plm(inv ~ value + capital, data = Grunfeld, effect = "time", model = "within") gd <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "within") pFtest(gi, gp) pFtest(gt, gp) pFtest(gd, gp) pFtest(inv ~ value + capital, data = Grunfeld, effect = "twoways") } \seealso{ \code{\link[=plmtest]{plmtest()}} for Lagrange multiplier tests of individuals and/or time effects. } \author{ Yves Croissant } \keyword{htest} plm/man/nobs.plm.Rd0000644000176200001440000000355614154734502013652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_methods.R \name{nobs.plm} \alias{nobs.plm} \alias{nobs} \alias{nobs.panelmodel} \alias{nobs.pgmm} \title{Extract Total Number of Observations Used in Estimated Panelmodel} \usage{ \method{nobs}{panelmodel}(object, ...) \method{nobs}{pgmm}(object, ...) } \arguments{ \item{object}{a \code{panelmodel} object for which the number of total observations is to be extracted,} \item{\dots}{further arguments.} } \value{ A single number, normally an integer. } \description{ This function extracts the total number of 'observations' from a fitted panel model. } \details{ The number of observations is usually the length of the residuals vector. Thus, \code{nobs} gives the number of observations actually used by the estimation procedure. It is not necessarily the number of observations of the model frame (number of rows in the model frame), because sometimes the model frame is further reduced by the estimation procedure. This is, e.g., the case for first--difference models estimated by \code{plm(..., model = "fd")} where the model frame does not yet contain the differences (see also \strong{Examples}). } \examples{ # estimate a panelmodel data("Produc", package = "plm") z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, model="random", subset = gsp > 5000) nobs(z) # total observations used in estimation pdim(z)$nT$N # same information pdim(z) # more information about the dimensions (no. of individuals and time periods) # illustrate difference between nobs and pdim for first-difference model data("Grunfeld", package = "plm") fdmod <- plm(inv ~ value + capital, data = Grunfeld, model = "fd") nobs(fdmod) # 190 pdim(fdmod)$nT$N # 200 } \seealso{ \code{\link[=pdim]{pdim()}} } \keyword{attribute} plm/man/pggls.Rd0000644000176200001440000000763714154734502013242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_ggls.R \name{pggls} \alias{pggls} \alias{summary.pggls} \alias{print.summary.pggls} \alias{residuals.pggls} \title{General FGLS Estimators} \usage{ pggls( formula, data, subset, na.action, effect = c("individual", "time"), model = c("within", "pooling", "fd"), index = NULL, ... ) \method{summary}{pggls}(object, ...) \method{print}{summary.pggls}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{residuals}{pggls}(object, ...) } \arguments{ \item{formula}{a symbolic description of the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[=lm]{lm()}},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{effect}{the effects introduced in the model, one of \code{"individual"} or \code{"time"},} \item{model}{one of \code{"within"}, \code{"pooling"}, \code{"fd"},} \item{index}{the indexes, see \code{\link[=pdata.frame]{pdata.frame()}},} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{pggls},} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} } \value{ An object of class \code{c("pggls","panelmodel")} containing: \item{coefficients}{the vector of coefficients,} \item{residuals}{the vector of residuals,} \item{fitted.values}{the vector of fitted values,} \item{vcov}{the covariance matrix of the coefficients,} \item{df.residual}{degrees of freedom of the residuals,} \item{model}{a data.frame containing the variables used for the estimation,} \item{call}{the call,} \item{sigma}{the estimated intragroup (or cross-sectional, if \code{effect = "time"}) covariance of errors,} } \description{ General FGLS estimators for panel data (balanced or unbalanced) } \details{ \code{pggls} is a function for the estimation of linear panel models by general feasible generalized least squares, either with or without fixed effects. General FGLS is based on a two-step estimation process: first a model is estimated by OLS (\code{model = "pooling"}), fixed effects (\code{model = "within"}) or first differences (\code{model = "fd"}), then its residuals are used to estimate an error covariance matrix for use in a feasible-GLS analysis. This framework allows the error covariance structure inside every group (if \code{effect = "individual"}, else symmetric) of observations to be fully unrestricted and is therefore robust against any type of intragroup heteroskedasticity and serial correlation. Conversely, this structure is assumed identical across groups and thus general FGLS estimation is inefficient under groupwise heteroskedasticity. Note also that this method requires estimation of \eqn{T(T+1)/2} variance parameters, thus efficiency requires N >> T (if \code{effect = "individual"}, else the opposite). If \code{model = "within"} (the default) then a FEGLS (fixed effects GLS, see Wooldridge, Ch. 10.5) is estimated; if \code{model = "fd"} a FDGLS (first-difference GLS). Setting \code{model = "pooling"} produces an unrestricted FGLS model (see ibid.) (\code{model = "random"} does the same, but using this value is deprecated and included only for retro--compatibility reasons). } \examples{ data("Produc", package = "plm") zz_wi <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") summary(zz_wi) zz_pool <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "pooling") summary(zz_pool) zz_fd <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") summary(zz_fd) } \references{ \insertRef{IM:SEUN:SCHM:WOOL:99}{plm} \insertRef{KIEF:80}{plm} \insertRef{WOOL:02}{plm} \insertRef{WOOL:10}{plm} } \author{ Giovanni Millo } \keyword{regression} plm/man/pgmm.Rd0000644000176200001440000001564614124132276013062 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_gmm.R \name{pgmm} \alias{pgmm} \alias{coef.pgmm} \alias{summary.pgmm} \alias{print.summary.pgmm} \title{Generalized Method of Moments (GMM) Estimation for Panel Data} \usage{ pgmm( formula, data, subset, na.action, effect = c("twoways", "individual"), model = c("onestep", "twosteps"), collapse = FALSE, lost.ts = NULL, transformation = c("d", "ld"), fsm = NULL, index = NULL, ... ) \method{coef}{pgmm}(object, ...) \method{summary}{pgmm}(object, robust = TRUE, time.dummies = FALSE, ...) \method{print}{summary.pgmm}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) } \arguments{ \item{formula}{a symbolic description for the model to be estimated. The preferred interface is now to indicate a multi--part formula, the first two parts describing the covariates and the GMM instruments and, if any, the third part the 'normal' instruments,} \item{data}{a \code{data.frame} (neither factors nor character vectors will be accepted in \code{data.frame}),} \item{subset}{see \code{\link[=lm]{lm()}},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{effect}{the effects introduced in the model, one of \code{"twoways"} (the default) or \code{"individual"},} \item{model}{one of \code{"onestep"} (the default) or \code{"twosteps"},} \item{collapse}{if \code{TRUE}, the GMM instruments are collapsed (default is \code{FALSE}),} \item{lost.ts}{the number of lost time series: if \code{NULL}, this is automatically computed. Otherwise, it can be defined by the user as a numeric vector of length 1 or 2. The first element is the number of lost time series in the model in difference, the second one in the model in level. If the second element is missing, it is set to the first one minus one,} \item{transformation}{the kind of transformation to apply to the model: either \code{"d"} (the default value) for the "difference GMM" model or \code{"ld"} for the "system GMM" model,} \item{fsm}{the matrix for the one step estimator: one of \code{"I"} (identity matrix) or \code{"G"} (\eqn{=D'D} where \eqn{D} is the first--difference operator) if \code{transformation="d"}, one of \code{"GI"} or \code{"full"} if \code{transformation="ld"},} \item{index}{the indexes,} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{"pgmm"},} \item{robust}{for pgmm's summary method: if \code{TRUE} (default), robust inference is performed in the summary,} \item{time.dummies}{for pgmm's summary method: if \code{TRUE}, the estimated coefficients of time dummies are present in the table of coefficients; default is \code{FALSE}, thus time dummies are dropped in summary's coefficient table (argument is only meaningful if there are time dummies in the model, i.e., only for \code{effect = "twoways"}),} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output.} } \value{ An object of class \code{c("pgmm","panelmodel")}, which has the following elements: \item{coefficients}{the vector (or the list for fixed effects) of coefficients,} \item{residuals}{the list of residuals for each individual,} \item{vcov}{the covariance matrix of the coefficients,} \item{fitted.values}{the vector of fitted values,} \item{df.residual}{degrees of freedom of the residuals,} \item{model}{a list containing the variables used for the estimation for each individual,} \item{W}{a list containing the instruments for each individual (a matrix per list element) (two lists in case of system GMM,} \item{A1}{the weighting matrix for the one--step estimator,} \item{A2}{the weighting matrix for the two--steps estimator,} \item{call}{the call.} In addition, it has attribute \code{"pdim"} which contains the pdim object for model. It has \code{print}, \code{summary} and \code{print.summary} methods. } \description{ Generalized method of moments estimation for static or dynamic models with panel data. } \details{ \code{pgmm} estimates a model for panel data with a generalized method of moments (GMM) estimator. The description of the model to estimate is provided with a multi--part formula which is (or which is coerced to) a \code{Formula} object. The first right--hand side part describes the covariates. The second one, which is mandatory, describes the GMM instruments. The third one, which is optional, describes the 'normal' instruments. By default, all the variables of the model which are not used as GMM instruments are used as normal instruments with the same lag structure as the one specified in the model. \code{y~lag(y, 1:2)+lag(x1, 0:1)+lag(x2, 0:2) | lag(y, 2:99)} is similar to \code{y~lag(y, 1:2)+lag(x1, 0:1)+lag(x2, 0:2) | lag(y, 2:99) | lag(x1, 0:1)+lag(x2, 0:2)} and indicates that all lags from 2 of \code{y} are used as GMM instruments. \code{transformation} indicates how the model should be transformed for the estimation. \code{"d"} gives the "difference GMM" model \insertCite{@see @AREL:BOND:91}{plm}, \code{"ld"} the "system GMM" model \insertCite{@see @BLUN:BOND:98}{plm}. \code{pgmm} is an attempt to adapt GMM estimators available within the DPD library for GAUSS \insertCite{@see @AREL:BOND:98}{plm} and Ox \insertCite{@see @DOOR:AREL:BOND:12}{plm} and within the xtabond2 library for Stata \insertCite{@see @ROOD:09}{plm}. } \examples{ data("EmplUK", package = "plm") ## Arellano and Bond (1991), table 4 col. b z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(z1, robust = FALSE) ## Blundell and Bond (1998) table 4 (cf. DPD for OX p. 12 col. 4) z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) \dontrun{ ## Same with the old formula or dynformula interface ## Arellano and Bond (1991), table 4, col. b z1 <- pgmm(log(emp) ~ log(wage) + log(capital) + log(output), lag.form = list(2,1,0,1), data = EmplUK, effect = "twoways", model = "twosteps", gmm.inst = ~log(emp), lag.gmm = list(c(2,99))) summary(z1, robust = FALSE) ## Blundell and Bond (1998) table 4 (cf DPD for OX p. 12 col. 4) z2 <- pgmm(dynformula(log(emp) ~ log(wage) + log(capital), list(1,1,1)), data = EmplUK, effect = "twoways", model = "onestep", gmm.inst = ~log(emp) + log(wage) + log(capital), lag.gmm = c(2,99), transformation = "ld") summary(z2, robust = TRUE) } } \references{ \insertAllCited{} } \seealso{ \code{\link[=sargan]{sargan()}} for the Hansen--Sargan test and \code{\link[=mtest]{mtest()}} for Arellano--Bond's test of serial correlation. \code{\link[=dynformula]{dynformula()}} for dynamic formulas (deprecated). } \author{ Yves Croissant } \keyword{regression} plm/man/SumHes.Rd0000644000176200001440000000150314124132276013311 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{SumHes} \alias{SumHes} \title{The Penn World Table, v. 5} \format{ A data frame containing : \describe{ \item{year}{the year} \item{country}{the country name (factor)} \item{opec}{OPEC member?} \item{com}{communist regime? } \item{pop}{country's population (in thousands)} \item{gdp}{real GDP per capita (in 1985 US dollars)} \item{sr}{saving rate (in percent)}} } \source{ Online supplements to Hayashi (2000). \url{http://fhayashi.fc2web.com/datasets.htm} } \description{ A panel of 125 observations from 1960 to 1985 } \details{ \emph{total number of observations} : 3250 \emph{observation} : country \emph{country} : World } \references{ \insertRef{HAYA:00}{plm} \insertRef{SUMM:HEST:91}{plm} } \keyword{datasets} plm/man/pbltest.Rd0000644000176200001440000000431714124247623013573 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pbltest} \alias{pbltest} \alias{pbltest.formula} \alias{pbltest.plm} \title{Baltagi and Li Serial Dependence Test For Random Effects Models} \usage{ pbltest(x, ...) \method{pbltest}{formula}(x, data, alternative = c("twosided", "onesided"), index = NULL, ...) \method{pbltest}{plm}(x, alternative = c("twosided", "onesided"), ...) } \arguments{ \item{x}{a model formula or an estimated random--effects model of class \code{plm} ,} \item{\dots}{further arguments.} \item{data}{for the formula interface only: a \code{data.frame},} \item{alternative}{one of \code{"twosided"}, \code{"onesided"}. Selects either \eqn{H_A: \rho \neq 0} or \eqn{H_A: \rho = 0} (i.e., the Normal or the Chi-squared version of the test),} \item{index}{the index of the \code{data.frame},} } \value{ An object of class \code{"htest"}. } \description{ \insertCite{BALT:LI:95;textual}{plm}'s Lagrange multiplier test for AR(1) or MA(1) idiosyncratic errors in panel models with random effects. } \details{ This is a Lagrange multiplier test for the null of no serial correlation, against the alternative of either an AR(1) or a MA(1) process, in the idiosyncratic component of the error term in a random effects panel model (as the analytical expression of the test turns out to be the same under both alternatives, \insertCite{@see @BALT:LI:95 and @BALT:LI:97}{plm}. The \code{alternative} argument, defaulting to \code{twosided}, allows testing for positive serial correlation only, if set to \code{onesided}. } \examples{ data("Grunfeld", package = "plm") # formula interface pbltest(inv ~ value + capital, data = Grunfeld) # plm interface re_mod <- plm(inv ~ value + capital, data = Grunfeld, model = "random") pbltest(re_mod) pbltest(re_mod, alternative = "onesided") } \references{ \insertRef{BALT:LI:95}{plm} \insertRef{BALT:LI:97}{plm} } \seealso{ \code{\link[=pdwtest]{pdwtest()}}, \code{\link[=pbnftest]{pbnftest()}}, \code{\link[=pbgtest]{pbgtest()}}, \code{\link[=pbsytest]{pbsytest()}}, \code{\link[=pwartest]{pwartest()}} and \code{\link[=pwfdtest]{pwfdtest()}} for other serial correlation tests for panel models. } \author{ Giovanni Millo } \keyword{htest} plm/man/vcovSCC.Rd0000644000176200001440000001033614124132276013417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovSCC} \alias{vcovSCC} \alias{vcovSCC.plm} \alias{vcovSCC.pcce} \title{Driscoll and Kraay (1998) Robust Covariance Matrix Estimator} \usage{ vcovSCC(x, ...) \method{vcovSCC}{plm}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = "time", maxlag = NULL, inner = c("cluster", "white", "diagavg"), wj = function(j, maxlag) 1 - j/(maxlag + 1), ... ) \method{vcovSCC}{pcce}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = "time", maxlag = NULL, inner = c("cluster", "white", "diagavg"), wj = function(j, maxlag) 1 - j/(maxlag + 1), ... ) } \arguments{ \item{x}{an object of class \code{"plm"} or \code{"pcce"}} \item{\dots}{further arguments} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"sss"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, see Details,} \item{cluster}{switch for vcovG; set at \code{"time"} here,} \item{maxlag}{either \code{NULL} or a positive integer specifying the maximum lag order before truncation} \item{inner}{the function to be applied to the residuals inside the sandwich: \code{"cluster"} for SCC, \code{"white"} for Newey-West, (\code{"diagavg"} for compatibility reasons)} \item{wj}{weighting function to be applied to lagged terms,} } \value{ An object of class \code{"matrix"} containing the estimate of the covariance matrix of coefficients. } \description{ Nonparametric robust covariance matrix estimators \emph{a la Driscoll and Kraay} for panel models with cross-sectional \emph{and} serial correlation. } \details{ \code{vcovSCC} is a function for estimating a robust covariance matrix of parameters for a panel model according to the \insertCite{DRIS:KRAA:98;textual}{plm} method, which is consistent with cross--sectional and serial correlation in a T-asymptotic setting and irrespective of the N dimension. The use with random effects models is undocumented. Weighting schemes specified by \code{type} are analogous to those in \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} in package \CRANpkg{sandwich} and are justified theoretically (although in the context of the standard linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}). The main use of \code{vcovSCC} (and the other variance-covariance estimators provided in the package \code{vcovHC}, \code{vcovBK}, \code{vcovNW}, \code{vcovDC}) is to pass it to plm's own functions like \code{summary}, \code{pwaldtest}, and \code{phtest} or together with testing functions from the \code{lmtest} and \code{car} packages. All of these typically allow passing the \code{vcov} or \code{vcov.} parameter either as a matrix or as a function, e.g., for Wald--type testing: argument \code{vcov.} to \code{coeftest()}, argument \code{vcov} to \code{waldtest()} and other methods in the \CRANpkg{lmtest} package; and argument \code{vcov.} to \code{linearHypothesis()} in the \CRANpkg{car} package (see the examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. } \examples{ data("Produc", package="plm") zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") ## as function input to plm's summary method (with and without additional arguments): summary(zz, vcov = vcovSCC) summary(zz, vcov = function(x) vcovSCC(x, method="arellano", type="HC1")) ## standard coefficient significance test library(lmtest) coeftest(zz) ## SCC robust significance test, default coeftest(zz, vcov.=vcovSCC) ## idem with parameters, pass vcov as a function argument coeftest(zz, vcov.=function(x) vcovSCC(x, type="HC1", maxlag=4)) ## joint restriction test waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovSCC) \dontrun{ ## test of hyp.: 2*log(pc)=log(emp) library(car) linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovSCC) } } \references{ \insertRef{CRIB:04}{plm} \insertRef{DRIS:KRAA:98}{plm} \insertRef{HOEC:07}{plm} \insertRef{MACK:WHIT:85}{plm} \insertRef{ZEIL:04}{plm} } \seealso{ \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} from the \CRANpkg{sandwich} package for weighting schemes (\code{type} argument). } \author{ Giovanni Millo, partially ported from Daniel Hoechle's (2007) Stata code } \keyword{regression} plm/man/punbalancedness.Rd0000644000176200001440000001247314154734502015265 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_misc.R \name{punbalancedness} \alias{punbalancedness} \alias{punbalancedness.pdata.frame} \alias{punbalancedness.data.frame} \alias{punbalancedness.panelmodel} \title{Measures for Unbalancedness of Panel Data} \usage{ punbalancedness(x, ...) \method{punbalancedness}{pdata.frame}(x, ...) \method{punbalancedness}{data.frame}(x, index = NULL, ...) \method{punbalancedness}{panelmodel}(x, ...) } \arguments{ \item{x}{a \code{panelmodel}, a \code{data.frame}, or a \code{pdata.frame} object,} \item{\dots}{further arguments.} \item{index}{only relevant for \code{data.frame} interface, for details see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ A named numeric containing either two or three entries, depending on the panel structure inputted: \itemize{ \item For the two-dimensional panel structure, the entries are called \code{gamma} and \code{nu}, \item For a nested panel structure, the entries are called \code{c1}, \code{c2}, \code{c3}. } } \description{ This function reports unbalancedness measures for panel data as defined in \insertCite{AHRE:PINC:81;textual}{plm} and \insertCite{BALT:SONG:JUNG:01;textual}{plm}. } \details{ \code{punbalancedness} returns measures for the unbalancedness of a panel data set. \itemize{ \item For two-dimensional data:\cr The two measures of \insertCite{AHRE:PINC:81;textual}{plm} are calculated, called "gamma" (\eqn{\gamma}) and "nu" (\eqn{\nu}). } If the panel data are balanced, both measures equal 1. The more "unbalanced" the panel data, the lower the measures (but > 0). The upper and lower bounds as given in \insertCite{AHRE:PINC:81;textual}{plm} are:\cr \eqn{0 < \gamma, \nu \le 1}, and for \eqn{\nu} more precisely \eqn{\frac{1}{n} < \nu \le 1}{1/n < \nu \le 1}, with \eqn{n} being the number of individuals (as in \code{pdim(x)$nT$n}). \itemize{ \item For nested panel data (meaning including a grouping variable):\cr The extension of the above measures by \insertCite{BALT:SONG:JUNG:01;textual}{plm}, p. 368, are calculated:\cr \itemize{ \item c1: measure of subgroup (individual) unbalancedness, \item c2: measure of time unbalancedness, \item c3: measure of group unbalancedness due to each group size. } } Values are 1 if the data are balanced and become smaller as the data become more unbalanced. An application of the measure "gamma" is found in e. g. \insertCite{BALT:SONG:JUNG:01;textual}{plm}, pp. 488-491, and \insertCite{BALT:CHAN:94;textual}{plm}, pp. 78--87, where it is used to measure the unbalancedness of various unbalanced data sets used for Monte Carlo simulation studies. Measures c1, c2, c3 are used for similar purposes in \insertCite{BALT:SONG:JUNG:01;textual}{plm}. In the two-dimensional case, \code{punbalancedness} uses output of \code{\link[=pdim]{pdim()}} to calculate the two unbalancedness measures, so inputs to \code{punbalancedness} can be whatever \code{pdim} works on. \code{pdim} returns detailed information about the number of individuals and time observations (see \code{\link[=pdim]{pdim()}}). } \note{ Calling \code{punbalancedness} on an estimated \code{panelmodel} object and on the corresponding \verb{(p)data.frame} used for this estimation does not necessarily yield the same result (true also for \code{pdim}). When called on an estimated \code{panelmodel}, the number of observations (individual, time) actually used for model estimation are taken into account. When called on a \verb{(p)data.frame}, the rows in the \verb{(p)data.frame} are considered, disregarding any \code{NA} values in the dependent or independent variable(s) which would be dropped during model estimation. } \examples{ # Grunfeld is a balanced panel, Hedonic is an unbalanced panel data(list=c("Grunfeld", "Hedonic"), package="plm") # Grunfeld has individual and time index in first two columns punbalancedness(Grunfeld) # c(1,1) indicates balanced panel pdim(Grunfeld)$balanced # TRUE # Hedonic has individual index in column "townid" (in last column) punbalancedness(Hedonic, index="townid") # c(0.472, 0.519) pdim(Hedonic, index="townid")$balanced # FALSE # punbalancedness on estimated models plm_mod_pool <- plm(inv ~ value + capital, data = Grunfeld) punbalancedness(plm_mod_pool) plm_mod_fe <- plm(inv ~ value + capital, data = Grunfeld[1:99, ], model = "within") punbalancedness(plm_mod_fe) # replicate results for panel data design no. 1 in Ahrens/Pincus (1981), p. 234 ind_d1 <- c(1,1,1,2,2,2,3,3,3,3,3,4,4,4,4,4,4,4,5,5,5,5,5,5,5) time_d1 <- c(1,2,3,1,2,3,1,2,3,4,5,1,2,3,4,5,6,7,1,2,3,4,5,6,7) df_d1 <- data.frame(individual = ind_d1, time = time_d1) punbalancedness(df_d1) # c(0.868, 0.887) # example for a nested panel structure with a third index variable # specifying a group (states are grouped by region) and without grouping data("Produc", package = "plm") punbalancedness(Produc, index = c("state", "year", "region")) punbalancedness(Produc, index = c("state", "year")) } \references{ \insertRef{AHRE:PINC:81}{plm} \insertRef{BALT:CHAN:94}{plm} \insertRef{BALT:SONG:JUNG:01}{plm} \insertRef{BALT:SONG:JUNG:02}{plm} } \seealso{ \code{\link[=nobs]{nobs()}}, \code{\link[=pdim]{pdim()}}, \code{\link[=pdata.frame]{pdata.frame()}} } \author{ Kevin Tappe } \keyword{attribute} plm/man/make.pbalanced.Rd0000644000176200001440000001641614124132276014743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.pconsecutive_pbalanced.R \name{make.pbalanced} \alias{make.pbalanced} \alias{make.pbalanced.pdata.frame} \alias{make.pbalanced.pseries} \alias{make.pbalanced.data.frame} \title{Make data balanced} \usage{ make.pbalanced( x, balance.type = c("fill", "shared.times", "shared.individuals"), ... ) \method{make.pbalanced}{pdata.frame}( x, balance.type = c("fill", "shared.times", "shared.individuals"), ... ) \method{make.pbalanced}{pseries}( x, balance.type = c("fill", "shared.times", "shared.individuals"), ... ) \method{make.pbalanced}{data.frame}( x, balance.type = c("fill", "shared.times", "shared.individuals"), index = NULL, ... ) } \arguments{ \item{x}{an object of class \code{pdata.frame}, \code{data.frame}, or \code{pseries};} \item{balance.type}{character, one of \code{"fill"}, \code{"shared.times"}, or \code{"shared.individuals"}, see \strong{Details},} \item{\dots}{further arguments.} \item{index}{only relevant for \code{data.frame} interface; if \code{NULL}, the first two columns of the data.frame are assumed to be the index variables; if not \code{NULL}, both dimensions ('individual', 'time') need to be specified by \code{index} as character of length 2 for data frames, for further details see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ An object of the same class as the input \code{x}, i.e., a pdata.frame, data.frame or a pseries which is made balanced based on the index variables. The returned data are sorted as a stacked time series. } \description{ This function makes the data balanced, i.e., each individual has the same time periods, by filling in or dropping observations } \details{ (p)data.frame and pseries objects are made balanced, meaning each individual has the same time periods. Depending on the value of \code{balance.type}, the balancing is done in different ways: \itemize{ \item \code{balance.type = "fill"} (default): The union of available time periods over all individuals is taken (w/o \code{NA} values). Missing time periods for an individual are identified and corresponding rows (elements for pseries) are inserted and filled with \code{NA} for the non--index variables (elements for a pseries). This means, only time periods present for at least one individual are inserted, if missing. \item \code{balance.type = "shared.times"}: The intersect of available time periods over all individuals is taken (w/o \code{NA} values). Thus, time periods not available for all individuals are discarded, i. e., only time periods shared by all individuals are left in the result). \item \code{balance.type = "shared.individuals"}: All available time periods are kept and those individuals are dropped for which not all time periods are available, i. e., only individuals shared by all time periods are left in the result (symmetric to \code{"shared.times"}). } The data are not necessarily made consecutive (regular time series with distance 1), because balancedness does not imply consecutiveness. For making the data consecutive, use \code{\link[=make.pconsecutive]{make.pconsecutive()}} (and, optionally, set argument \code{balanced = TRUE} to make consecutive and balanced, see also \strong{Examples} for a comparison of the two functions. Note: Rows of (p)data.frames (elements for pseries) with \code{NA} values in individual or time index are not examined but silently dropped before the data are made balanced. In this case, it cannot be inferred which individual or time period is meant by the missing value(s) (see also \strong{Examples}). Especially, this means: \code{NA} values in the first/last position of the original time periods for an individual are dropped, which are usually meant to depict the beginning and ending of the time series for that individual. Thus, one might want to check if there are any \code{NA} values in the index variables before applying make.pbalanced, and especially check for \code{NA} values in the first and last position for each individual in original data and, if so, maybe set those to some meaningful begin/end value for the time series. } \examples{ # take data and make it unbalanced # by deletion of 2nd row (2nd time period for first individual) data("Grunfeld", package = "plm") nrow(Grunfeld) # 200 rows Grunfeld_missing_period <- Grunfeld[-2, ] pdim(Grunfeld_missing_period)$balanced # check if balanced: FALSE make.pbalanced(Grunfeld_missing_period) # make it balanced (by filling) make.pbalanced(Grunfeld_missing_period, balance.type = "shared.times") # (shared periods) nrow(make.pbalanced(Grunfeld_missing_period)) nrow(make.pbalanced(Grunfeld_missing_period, balance.type = "shared.times")) # more complex data: # First, make data unbalanced (and non-consecutive) # by deletion of 2nd time period (year 1936) for all individuals # and more time periods for first individual only Grunfeld_unbalanced <- Grunfeld[Grunfeld$year != 1936, ] Grunfeld_unbalanced <- Grunfeld_unbalanced[-c(1,4), ] pdim(Grunfeld_unbalanced)$balanced # FALSE all(is.pconsecutive(Grunfeld_unbalanced)) # FALSE g_bal <- make.pbalanced(Grunfeld_unbalanced) pdim(g_bal)$balanced # TRUE unique(g_bal$year) # all years but 1936 nrow(g_bal) # 190 rows head(g_bal) # 1st individual: years 1935, 1939 are NA # NA in 1st, 3rd time period (years 1935, 1937) for first individual Grunfeld_NA <- Grunfeld Grunfeld_NA[c(1, 3), "year"] <- NA g_bal_NA <- make.pbalanced(Grunfeld_NA) head(g_bal_NA) # years 1935, 1937: NA for non-index vars nrow(g_bal_NA) # 200 # pdata.frame interface pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) make.pbalanced(Grunfeld_missing_period) # pseries interface make.pbalanced(pGrunfeld_missing_period$inv) # comparison to make.pconsecutive g_consec <- make.pconsecutive(Grunfeld_unbalanced) all(is.pconsecutive(g_consec)) # TRUE pdim(g_consec)$balanced # FALSE head(g_consec, 22) # 1st individual: no years 1935/6; 1939 is NA; # other indviduals: years 1935-1954, 1936 is NA nrow(g_consec) # 198 rows g_consec_bal <- make.pconsecutive(Grunfeld_unbalanced, balanced = TRUE) all(is.pconsecutive(g_consec_bal)) # TRUE pdim(g_consec_bal)$balanced # TRUE head(g_consec_bal) # year 1936 is NA for all individuals nrow(g_consec_bal) # 200 rows head(g_bal) # no year 1936 at all nrow(g_bal) # 190 rows } \seealso{ \code{\link[=is.pbalanced]{is.pbalanced()}} to check if data are balanced; \code{\link[=is.pconsecutive]{is.pconsecutive()}} to check if data are consecutive; \code{\link[=make.pconsecutive]{make.pconsecutive()}} to make data consecutive (and, optionally, also balanced).\cr \code{\link[=punbalancedness]{punbalancedness()}} for two measures of unbalancedness, \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), \code{\link[=pvar]{pvar()}} to check for individual and time variation of a 'pdata.frame' (and other objects), \code{\link[=lag]{lag()}} for lagging (and leading) values of a 'pseries' object.\cr \code{\link[=pseries]{pseries()}}, \code{\link[=data.frame]{data.frame()}}, \code{\link[=pdata.frame]{pdata.frame()}}. } \author{ Kevin Tappe } \keyword{attribute} plm/man/pht.Rd0000644000176200001440000000767014124132276012713 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprecated.R \name{pht} \alias{pht} \alias{summary.pht} \alias{print.summary.pht} \title{Hausman--Taylor Estimator for Panel Data} \usage{ pht( formula, data, subset, na.action, model = c("ht", "am", "bms"), index = NULL, ... ) \method{summary}{pht}(object, ...) \method{print}{summary.pht}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ... ) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[=lm]{lm()}} for \code{"plm"}, a character or numeric vector indicating a subset of the table of coefficient to be printed for \code{"print.summary.plm"},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{model}{one of \code{"ht"} for Hausman--Taylor, \code{"am"} for Amemiya--MaCurdy and \code{"bms"} for Breusch--Mizon--Schmidt,} \item{index}{the indexes,} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{"plm"},} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} } \value{ An object of class \code{c("pht", "plm", "panelmodel")}. A \code{"pht"} object contains the same elements as \code{plm} object, with a further argument called \code{varlist} which describes the typology of the variables. It has \code{summary} and \code{print.summary} methods. } \description{ The Hausman--Taylor estimator is an instrumental variable estimator without external instruments (function deprecated). } \details{ \code{pht} estimates panels models using the Hausman--Taylor estimator, Amemiya--MaCurdy estimator, or Breusch--Mizon--Schmidt estimator, depending on the argument \code{model}. The model is specified as a two--part formula, the second part containing the exogenous variables. } \note{ The function \code{pht} is deprecated. Please use function \code{plm} to estimate Taylor--Hausman models like this with a three-part formula as shown in the example:\cr \verb{plm(, random.method = "ht", model = "random", inst.method = "baltagi")}. The Amemiya--MaCurdy estimator and the Breusch--Mizon--Schmidt estimator is computed likewise with \code{plm}. } \examples{ ## replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 ## preferred way with plm() data("Wages", package = "plm") ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, random.method = "ht", model = "random", inst.method = "baltagi") summary(ht) am <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, random.method = "ht", model = "random", inst.method = "am") summary(am) ## deprecated way with pht() for HT #ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + # bluecol + ind + union + sex + black + ed | # sex + black + bluecol + south + smsa + ind, # data = Wages, model = "ht", index = 595) #summary(ht) # deprecated way with pht() for AM #am <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + # bluecol + ind + union + sex + black + ed | # sex + black + bluecol + south + smsa + ind, # data = Wages, model = "am", index = 595) #summary(am) } \references{ \insertCite{AMEM:MACU:86}{plm} \insertCite{BALT:13}{plm} \insertCite{BREU:MIZO:SCHM:89}{plm} \insertCite{HAUS:TAYL:81}{plm} } \author{ Yves Croissant } \keyword{regression} plm/man/vcovHC.plm.Rd0000644000176200001440000001345514126043200014063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovHC.plm} \alias{vcovHC.plm} \alias{vcovHC} \alias{vcovHC.pcce} \alias{vcovHC.pgmm} \title{Robust Covariance Matrix Estimators} \usage{ \method{vcovHC}{plm}( x, method = c("arellano", "white1", "white2"), type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), ... ) \method{vcovHC}{pcce}( x, method = c("arellano", "white1", "white2"), type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), ... ) \method{vcovHC}{pgmm}(x, ...) } \arguments{ \item{x}{an object of class \code{"plm"} which should be the result of a random effects or a within model or a model of class \code{"pgmm"} or an object of class \code{"pcce"},} \item{method}{one of \code{"arellano"}, \code{"white1"}, \code{"white2"},} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"sss"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, see Details,} \item{cluster}{one of \code{"group"}, \code{"time"},} \item{\dots}{further arguments.} } \value{ An object of class \code{"matrix"} containing the estimate of the asymptotic covariance matrix of coefficients. } \description{ Robust covariance matrix estimators \emph{a la White} for panel models. } \details{ \code{vcovHC} is a function for estimating a robust covariance matrix of parameters for a fixed effects or random effects panel model according to the White method \insertCite{WHIT:80,WHIT:84b,AREL:87}{plm}. Observations may be clustered by \code{"group"} (\code{"time"}) to account for serial (cross-sectional) correlation. All types assume no intragroup (serial) correlation between errors and allow for heteroskedasticity across groups (time periods). As for the error covariance matrix of every single group of observations, \code{"white1"} allows for general heteroskedasticity but no serial (cross--sectional) correlation; \code{"white2"} is \code{"white1"} restricted to a common variance inside every group (time period) \insertCite{@see @GREE:03, Sec. 13.7.1-2, @GREE:12, Sec. 11.6.1-2 and @WOOL:02, Sec. 10.7.2}{plm}; \code{"arellano"} \insertCite{@see ibid. and the original ref. @AREL:87}{plm} allows a fully general structure w.r.t. heteroskedasticity and serial (cross--sectional) correlation. Weighting schemes specified by \code{type} are analogous to those in \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} in package \CRANpkg{sandwich} and are justified theoretically (although in the context of the standard linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and \insertCite{CRIB:04;textual}{plm} \insertCite{ZEIL:04}{plm}. \code{type = "sss"} employs the small sample correction as used by Stata. The main use of \code{vcovHC} (and the other variance-covariance estimators provided in the package \code{vcovBK}, \code{vcovNW}, \code{vcovDC}, \code{vcovSCC}) is to pass it to plm's own functions like \code{summary}, \code{pwaldtest}, and \code{phtest} or together with testing functions from the \code{lmtest} and \code{car} packages. All of these typically allow passing the \code{vcov} or \code{vcov.} parameter either as a matrix or as a function, e.g., for Wald--type testing: argument \code{vcov.} to \code{coeftest()}, argument \code{vcov} to \code{waldtest()} and other methods in the \CRANpkg{lmtest} package; and argument \code{vcov.} to \code{linearHypothesis()} in the \CRANpkg{car} package (see the examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. A special procedure for \code{pgmm} objects, proposed by \insertCite{WIND:05;textual}{plm}, is also provided. } \note{ The function \code{pvcovHC} is deprecated. Use \code{vcovHC} for the same functionality. } \examples{ data("Produc", package = "plm") zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") ## as function input to plm's summary method (with and without additional arguments): summary(zz, vcov = vcovHC) summary(zz, vcov = function(x) vcovHC(x, method="arellano", type="HC1")) ## standard coefficient significance test library(lmtest) coeftest(zz) ## robust significance test, cluster by group ## (robust vs. serial correlation) coeftest(zz, vcov.=vcovHC) ## idem with parameters, pass vcov as a function argument coeftest(zz, vcov.=function(x) vcovHC(x, method="arellano", type="HC1")) ## idem, cluster by time period ## (robust vs. cross-sectional correlation) coeftest(zz, vcov.=function(x) vcovHC(x, method="arellano", type="HC1", cluster="group")) ## idem with parameters, pass vcov as a matrix argument coeftest(zz, vcov.=vcovHC(zz, method="arellano", type="HC1")) ## joint restriction test waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovHC) \dontrun{ ## test of hyp.: 2*log(pc)=log(emp) library(car) linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovHC) } ## Robust inference for CCE models data("Produc", package = "plm") ccepmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="p") summary(ccepmod, vcov = vcovHC) ## Robust inference for GMM models data("EmplUK", package="plm") ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(capital), 2) + log(output) + lag(log(output),2) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") rv <- vcovHC(ar) mtest(ar, order = 2, vcov = rv) } \references{ \insertRef{AREL:87}{plm} \insertRef{CRIB:04}{plm} \insertRef{GREE:03}{plm} \insertRef{GREE:12}{plm} \insertRef{MACK:WHIT:85}{plm} \insertRef{WIND:05}{plm} \insertRef{WHIT:84b}{plm} chap. 6 \insertRef{WHIT:80}{plm} \insertRef{WOOL:02}{plm} \insertRef{ZEIL:04}{plm} } \seealso{ \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} from the \CRANpkg{sandwich} package for weighting schemes (\code{type} argument). } \author{ Giovanni Millo & Yves Croissant } \keyword{regression} plm/man/Cigar.Rd0000644000176200001440000000221314124132276013131 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Cigar} \alias{Cigar} \title{Cigarette Consumption} \format{ A data frame containing : \describe{ \item{state}{state abbreviation} \item{year}{the year} \item{price}{price per pack of cigarettes} \item{pop}{population} \item{pop16}{population above the age of 16} \item{cpi}{consumer price index (1983=100)} \item{ndi}{per capita disposable income} \item{sales}{cigarette sales in packs per capita} \item{pimin}{minimum price in adjoining states per pack of cigarettes} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ a panel of 46 observations from 1963 to 1992 } \details{ \emph{total number of observations} : 1380 \emph{observation} : regional \emph{country} : United States } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BALT:LEVI:92}{plm} \insertRef{BALT:GRIF:XION:00}{plm} } \keyword{datasets} plm/man/pdwtest.Rd0000644000176200001440000000510514124132276013601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pdwtest} \alias{pdwtest} \alias{pdwtest.panelmodel} \alias{pdwtest.formula} \title{Durbin--Watson Test for Panel Models} \usage{ pdwtest(x, ...) \method{pdwtest}{panelmodel}(x, ...) \method{pdwtest}{formula}(x, data, ...) } \arguments{ \item{x}{an object of class \code{"panelmodel"} or of class \code{"formula"},} \item{\dots}{further arguments to be passed on to \code{dwtest}, e.g., \code{alternative}, see \code{\link[lmtest:dwtest]{lmtest::dwtest()}} for further details.} \item{data}{a \code{data.frame},} } \value{ An object of class \code{"htest"}. } \description{ Test of serial correlation for (the idiosyncratic component of) the errors in panel models. } \details{ This Durbin--Watson test uses the auxiliary model on (quasi-)demeaned data taken from a model of class \code{plm} which may be a \code{pooling} (the default), \code{random} or \code{within} model. It performs a Durbin--Watson test (using \code{dwtest} from package \CRANpkg{lmtest} on the residuals of the (quasi-)demeaned model, which should be serially uncorrelated under the null of no serial correlation in idiosyncratic errors. The function takes the demeaned data, estimates the model and calls \code{dwtest}. Thus, this test does not take the panel structure of the residuals into consideration; it shall not be confused with the generalized Durbin-Watson test for panels in \code{pbnftest}. } \examples{ data("Grunfeld", package = "plm") g <- plm(inv ~ value + capital, data = Grunfeld, model="random") pdwtest(g) pdwtest(g, alternative="two.sided") ## formula interface pdwtest(inv ~ value + capital, data=Grunfeld, model="random") } \references{ \insertRef{DURB:WATS:50}{plm} \insertRef{DURB:WATS:51}{plm} \insertRef{DURB:WATS:71}{plm} \insertRef{WOOL:02}{plm} \insertRef{WOOL:10}{plm} } \seealso{ \code{\link[lmtest:dwtest]{lmtest::dwtest()}} for the Durbin--Watson test in \CRANpkg{lmtest}, \code{\link[=pbgtest]{pbgtest()}} for the analogous Breusch--Godfrey test for panel models, \code{\link[lmtest:bgtest]{lmtest::bgtest()}} for the Breusch--Godfrey test for serial correlation in the linear model. \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbsytest]{pbsytest()}}, \code{\link[=pwartest]{pwartest()}} and \code{\link[=pwfdtest]{pwfdtest()}} for other serial correlation tests for panel models. For the Durbin-Watson test generalized to panel data models see \code{\link[=pbnftest]{pbnftest()}}. } \author{ Giovanni Millo } \keyword{htest} plm/man/LaborSupply.Rd0000644000176200001440000000136714124132276014371 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{LaborSupply} \alias{LaborSupply} \title{Wages and Hours Worked} \format{ A data frame containing : \describe{ \item{lnhr}{log of annual hours worked} \item{lnwg}{log of hourly wage} \item{kids}{number of children} \item{age}{age} \item{disab}{bad health} \item{id}{id} \item{year}{year} } } \source{ Online complements to Ziliak (1997). Journal of Business Economics and Statistics web site: \url{https://amstat.tandfonline.com/loi/ubes20/}. } \description{ A panel of 532 observations from 1979 to 1988 } \details{ \emph{number of observations} : 5320 } \references{ \insertRef{CAME:TRIV:05}{plm} \insertRef{ZILI:97}{plm} } \keyword{datasets} plm/man/summary.plm.Rd0000644000176200001440000001102214124132276014366 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_plm.list.R, R/tool_methods.R \name{summary.plm.list} \alias{summary.plm.list} \alias{coef.summary.plm.list} \alias{print.summary.plm.list} \alias{summary.plm} \alias{print.summary.plm} \title{Summary for plm objects} \usage{ \method{summary}{plm.list}(object, ...) \method{coef}{summary.plm.list}(object, eq = NULL, ...) \method{print}{summary.plm.list}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{summary}{plm}(object, vcov = NULL, ...) \method{print}{summary.plm}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ... ) } \arguments{ \item{object}{an object of class \code{"plm"},} \item{\dots}{further arguments.} \item{eq}{the selected equation for list objects} \item{x}{an object of class \code{"summary.plm"},} \item{digits}{number of digits for printed output,} \item{width}{the maximum length of the lines in the printed output,} \item{vcov}{a variance--covariance matrix furnished by the user or a function to calculate one (see \strong{Examples}),} \item{subset}{a character or numeric vector indicating a subset of the table of coefficients to be printed for \code{"print.summary.plm"},} } \value{ An object of class \code{c("summary.plm", "plm", "panelmodel")}. Some of its elements are carried over from the associated plm object and described there (\code{\link[=plm]{plm()}}). The following elements are new or changed relative to the elements of a plm object: \item{fstatistic}{'htest' object: joint test of significance of coefficients (F or Chi-square test) (robust statistic in case of supplied argument \code{vcov}, see \code{\link[=pwaldtest]{pwaldtest()}} for details),} \item{coefficients}{a matrix with the estimated coefficients, standard errors, t--values, and p--values, if argument \code{vcov} was set to non-\code{NULL} the standard errors (and t-- and p--values) in their respective robust variant,} \item{vcov}{the "regular" variance--covariance matrix of the coefficients (class "matrix"),} \item{rvcov}{only present if argument \code{vcov} was set to non-\code{NULL}: the furnished variance--covariance matrix of the coefficients (class "matrix"),} \item{r.squared}{a named numeric containing the R-squared ("rsq") and the adjusted R-squared ("adjrsq") of the model,} \item{df}{an integer vector with 3 components, (p, n-p, p*), where p is the number of estimated (non-aliased) coefficients of the model, n-p are the residual degrees of freedom (n being number of observations), and p* is the total number of coefficients (incl. any aliased ones).} } \description{ The summary method for plm objects generates some more information about estimated plm models. } \details{ The \code{summary} method for plm objects (\code{summary.plm}) creates an object of class \code{c("summary.plm", "plm", "panelmodel")} that extends the plm object it is run on with various information about the estimated model like (inferential) statistics, see \strong{Value}. It has an associated print method (\code{print.summary.plm}). } \examples{ data("Produc", package = "plm") zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, index = c("state","year")) summary(zz) # summary with a furnished vcov, passed as matrix, as function, and # as function with additional argument data("Grunfeld", package = "plm") wi <- plm(inv ~ value + capital, data = Grunfeld, model="within", effect = "individual") summary(wi, vcov = vcovHC(wi)) summary(wi, vcov = vcovHC) summary(wi, vcov = function(x) vcovHC(x, method = "white2")) # extract F statistic wi_summary <- summary(wi) Fstat <- wi_summary[["fstatistic"]] # extract estimates and p-values est <- wi_summary[["coefficients"]][ , "Estimate"] pval <- wi_summary[["coefficients"]][ , "Pr(>|t|)"] # print summary only for coefficent "value" print(wi_summary, subset = "value") } \seealso{ \code{\link[=plm]{plm()}} for estimation of various models; \code{\link[=vcovHC]{vcovHC()}} for an example of a robust estimation of variance--covariance matrix; \code{\link[=r.squared]{r.squared()}} for the function to calculate R-squared; \code{\link[stats:print.power.htest]{stats::print.power.htest()}} for some information about class "htest"; \code{\link[=fixef]{fixef()}} to compute the fixed effects for "within" (=fixed effects) models and \code{\link[=within_intercept]{within_intercept()}} for an "overall intercept" for such models; \code{\link[=pwaldtest]{pwaldtest()}} } \author{ Yves Croissant } \keyword{regression} plm/man/plm-package.Rd0000644000176200001440000000462314124132276014274 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{package} \name{plm-package} \alias{plm-package} \title{plm package: linear models for panel data} \description{ plm is a package for R which intends to make the estimation of linear panel models straightforward. plm provides functions to estimate a wide variety of models and to make (robust) inference. } \details{ For a gentle and comprehensive introduction to the package, please see the package's vignette. The main functions to estimate models are: \itemize{ \item \code{plm}: panel data estimators using \code{lm} on transformed data, \item \code{pvcm}: variable coefficients models \item \code{pgmm}: generalized method of moments (GMM) estimation for panel data, \item \code{pggls}: estimation of general feasible generalized least squares models, \item \code{pmg}: mean groups (MG), demeaned MG and common correlated effects (CCEMG) estimators, \item \code{pcce}: estimators for common correlated effects mean groups (CCEMG) and pooled (CCEP) for panel data with common factors, \item \code{pldv}: panel estimators for limited dependent variables. } Next to the model estimation functions, the package offers several functions for statistical tests related to panel data/models. Multiple functions for (robust) variance--covariance matrices are at hand as well. The package also provides data sets to demonstrate functions and to replicate some text book/paper results. Use \code{data(package="plm")} to view a list of available data sets in the package. } \examples{ data("Produc", package = "plm") zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, index = c("state","year")) summary(zz) # replicates some results from Baltagi (2013), table 3.1 data("Grunfeld", package = "plm") p <- plm(inv ~ value + capital, data = Grunfeld, model="pooling") wi <- plm(inv ~ value + capital, data = Grunfeld, model="within", effect = "twoways") swar <- plm(inv ~ value + capital, data = Grunfeld, model="random", effect = "twoways") amemiya <- plm(inv ~ value + capital, data = Grunfeld, model = "random", random.method = "amemiya", effect = "twoways") walhus <- plm(inv ~ value + capital, data = Grunfeld, model = "random", random.method = "walhus", effect = "twoways") } \keyword{package} plm/man/phansitest.Rd0000644000176200001440000001035614161713622014276 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_uroot.R \name{phansitest} \alias{phansitest} \alias{print.phansitest} \title{Simes Test for unit roots in panel data} \usage{ phansitest(object, alpha = 0.05) \method{print}{phansitest}(x, cutoff = 10L, ...) } \arguments{ \item{object}{either a numeric containing p-values of individual unit root test results (does not need to be sorted) or a suitable \code{purtest} object (as produced by \code{purtest()} for a test which gives p-values of the individuals (Hadri's test in \code{purtest} is not suitable)),} \item{alpha}{numeric, the pre-specified significance level (defaults to \code{0.05}),} \item{x}{an object of class \code{c("phansitest", "list")} as produced by \code{phansitest} to be printed,} \item{cutoff}{integer, cutoff value for printing of enumeration of individuals with rejected individual H0, for print method only,} \item{\dots}{further arguments (currently not used).} } \value{ For \code{phansitest}, an object of class \code{c("phansitest", "list")} which i s a list with the elements: \itemize{ \item \code{id}: integer, the identifier of the individual (integer sequence referring to position in input), \item \code{name}: character, name of the input's individual (if it has a name, otherwise "1", "2", "3", ...), \item \code{p}: numeric, p-values as input (either the numeric or extracted from the purtest object), \item \code{p.hommel}: numeric, p-values after Hommel's transformation, \item \code{rejected}: logical, indicating for which individual the individual null hypothesis is rejected (\code{TRUE})/non-rejected (\code{FALSE}) (after controlling for multiplicity), \item \code{rejected.no}: integer, giving the total number of rejected individual series, \item \code{alpha}: numeric, the input \code{alpha}. } } \description{ Simes' test of intersection of individual hypothesis tests (\insertCite{SIMES:86;textual}{plm}) applied to panel unit root tests as suggested by \insertCite{HANCK:13;textual}{plm}. } \details{ Simes' approach to testing is combining p-values from single hypothesis tests with a global (intersected) hypothesis. \insertCite{HANCK:13;textual}{plm} mentions it can be applied to any panel unit root test which yield a p-value for each individual series. The test is robust versus general patterns of cross-sectional dependence. Further, this approach allows to discriminate between individuals for which the individual H0 (unit root present for individual series) is rejected/is not rejected by Hommel's procedure (\insertCite{HOMM:88;textual}{plm}) for family-wise error rate control (FWER) at pre-specified significance level alpha via argument \code{alpha} (defaulting to \code{0.05}), i.e., it controls for the multiplicity in testing. The function \code{phansitest} takes as main input \code{object} either a plain numeric containing p-values of individual tests or a \code{purtest} object which holds a suitable pre-computed panel unit root test (one that produces p-values per individual series). The function's return value (see section Value) is a list with detailed evaluation of the applied Simes test. The associated \code{print} method prints a verbal evaluation. } \examples{ ### input is numeric (p-values) #### example from Hanck (2013), Table 11 (left side) pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050, 0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475) countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France", "Germany","Belgium","U.K.","Brazil","Australia","Netherlands", "Portugal","Canada", "Spain","Denmark","Switzerland","Japan") names(pvals) <- countries h <- phansitest(pvals) print(h) # (explicitly) prints test's evaluation print(h, cutoff = 3L) # print only first 3 rejected ids h$rejected # logical indicating the individuals with rejected individual H0 ### input is a (suitable) purtest object data("Grunfeld", package = "plm") y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu") phansitest(obj) } \references{ \insertAllCited{} } \seealso{ \code{\link[=purtest]{purtest()}}, \code{\link[=cipstest]{cipstest()}} } \author{ Kevin Tappe } \keyword{htest} plm/man/plm-deprecated.Rd0000644000176200001440000000474214165357232015011 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprecated.R \name{plm-deprecated} \alias{plm-deprecated} \alias{detect_lin_dep} \alias{pvcovHC} \alias{plm.data} \alias{dynformula} \alias{formula.dynformula} \alias{print.dynformula} \alias{pFormula} \alias{as.Formula.pFormula} \alias{model.frame.pFormula} \alias{model.matrix.pFormula} \title{Deprecated functions of plm} \usage{ pvcovHC(x, ...) plm.data(x, indexes = NULL) dynformula(formula, lag.form = NULL, diff.form = NULL, log.form = NULL) \method{formula}{dynformula}(x, ...) \method{print}{dynformula}(x, ...) pFormula(object) \method{as.Formula}{pFormula}(x, ...) \method{as.Formula}{pFormula}(x, ...) \method{model.frame}{pFormula}(formula, data, ..., lhs = NULL, rhs = NULL) \method{model.matrix}{pFormula}( object, data, model = c("pooling", "within", "Between", "Sum", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways", "nested"), rhs = 1, theta = NULL, cstcovar.rm = NULL, ... ) } \arguments{ \item{\dots}{further arguments.} \item{indexes}{a vector (of length one or two) indicating the (individual and time) indexes (see Details);} \item{formula}{a formula,} \item{lag.form}{a list containing the lag structure of each variable in the formula,} \item{diff.form}{a vector (or a list) of logical values indicating whether variables should be differenced,} \item{log.form}{a vector (or a list) of logical values indicating whether variables should be in logarithms.} \item{object, x}{an object of class \code{"plm"},} \item{data}{a \code{data.frame},} \item{lhs}{see Formula} \item{rhs}{see Formula} \item{model}{see plm} \item{effect}{see plm} \item{theta}{the parameter of transformation for the random effect model} \item{cstcovar.rm}{remove the constant columns or not} } \description{ \code{dynformula}, \code{pht}, \code{plm.data}, and \code{pvcovHC} are deprecated functions which could be removed from \pkg{plm} in a near future. } \details{ \code{dynformula} was used to construct a dynamic formula which was the first argument of \code{pgmm}. \code{pgmm} uses now multi-part formulas. \code{pht} estimates the Hausman-Taylor model, which can now be estimated using the more general \code{plm} function. \code{plm.data} is replaced by \code{pdata.frame}. \code{pvcovHC} is replaced by \code{vcovHC}. \code{detect_lin_dep} was renamed to \code{detect.lindep}. } plm/man/purtest.Rd0000644000176200001440000001642514161713622013625 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_uroot.R \name{purtest} \alias{purtest} \alias{print.purtest} \alias{summary.purtest} \alias{print.summary.purtest} \title{Unit root tests for panel data} \usage{ purtest( object, data = NULL, index = NULL, test = c("levinlin", "ips", "madwu", "Pm", "invnormal", "logit", "hadri"), exo = c("none", "intercept", "trend"), lags = c("SIC", "AIC", "Hall"), pmax = 10, Hcons = TRUE, q = NULL, dfcor = FALSE, fixedT = TRUE, ips.stat = NULL, ... ) \method{print}{purtest}(x, ...) \method{summary}{purtest}(object, ...) \method{print}{summary.purtest}(x, ...) } \arguments{ \item{object, x}{Either a \code{"data.frame"} or a matrix containing the time series (individuals as columns), a \code{"pseries"} object, a formula; a \code{"purtest"} object for the print and summary methods,} \item{data}{a \code{"data.frame"} or a \code{"pdata.frame"} object (required for formula interface, see Details and Examples),} \item{index}{the indexes,} \item{test}{the test to be computed: one of \code{"levinlin"} for \insertCite{LEVIN:LIN:CHU:02;textual}{plm}, \code{"ips"} for \insertCite{IM:PESAR:SHIN:03;textual}{plm}, \code{"madwu"} for \insertCite{MADDA:WU:99;textual}{plm}, \code{"Pm"} , \code{"invnormal"}, or \code{"logit"} for various tests as in \insertCite{CHOI:01;textual}{plm}, or \code{"hadri"} for \insertCite{HADR:00;textual}{plm}, see Details,} \item{exo}{the exogenous variables to introduce in the augmented Dickey--Fuller (ADF) regressions, one of: no exogenous variables (\code{"none"}), individual intercepts (\code{"intercept"}), or individual intercepts and trends (\code{"trend"}), but see Details,} \item{lags}{the number of lags to be used for the augmented Dickey-Fuller regressions: either a single value integer (the number of lags for all time series), a vector of integers (one for each time series), or a character string for an automatic computation of the number of lags, based on the AIC (\code{"AIC"}), the SIC (\code{"SIC"}), or on the method by \insertCite{HALL:94;textual}{plm} (\code{"Hall"}); argument is irrelevant for \code{test = "hadri"},} \item{pmax}{maximum number of lags (irrelevant for \code{test = "hadri"}),} \item{Hcons}{logical, only relevant for \code{test = "hadri"}, indicating whether the heteroskedasticity-consistent test of \insertCite{HADR:00;textual}{plm} should be computed,} \item{q}{the bandwidth for the estimation of the long-run variance (only relevant for \code{test = "levinlin"}, the default (\code{q = NULL}) gives the value as suggested by the authors as round(3.21 * T^(1/3))),} \item{dfcor}{logical, indicating whether the standard deviation of the regressions is to be computed using a degrees-of-freedom correction,} \item{fixedT}{logical, indicating whether the individual ADF regressions are to be computed using the same number of observations (irrelevant for \code{test = "hadri"}),} \item{ips.stat}{\code{NULL} or character of length 1 to request a specific IPS statistic, one of \code{"Wtbar"} (also default if \code{ips.stat = NULL}), \code{"Ztbar"}, \code{"tbar"},} \item{\dots}{further arguments (can set argument \code{p.approx} to be passed on to non-exported function \code{padf} to either \code{"MacKinnon1994"} or \code{"MacKinnon1996"} to force a specific method for p-value approximation, the latter only being possible if package 'urca' is installed).} } \value{ For purtest: An object of class \code{"purtest"}: a list with the elements named: \itemize{ \item \code{"statistic"} (a \code{"htest"} object), \item \code{"call"}, \item \code{"args"}, \item \code{"idres"} (containing results from the individual regressions), \item \code{"adjval"} (containing the simulated means and variances needed to compute the statistic, for \code{test = "levinlin"} and \code{"ips"}, otherwise \code{NULL}), \item \code{"sigma2"} (short-run and long-run variance for \code{test = "levinlin"}, otherwise NULL). } } \description{ \code{purtest} implements several testing procedures that have been proposed to test unit root hypotheses with panel data. } \details{ All these tests except \code{"hadri"} are based on the estimation of augmented Dickey-Fuller (ADF) regressions for each time series. A statistic is then computed using the t-statistics associated with the lagged variable. The Hadri residual-based LM statistic is the cross-sectional average of the individual KPSS statistics \insertCite{KWIA:PHIL:SCHM:SHIN:92;textual}{plm}, standardized by their asymptotic mean and standard deviation. Several Fisher-type tests that combine p-values from tests based on ADF regressions per individual are available: \itemize{ \item \code{"madwu"} is the inverse chi-squared test \insertCite{MADDA:WU:99;textual}{plm}, also called P test by \insertCite{CHOI:01;textual}{plm}. \item \code{"Pm"} is the modified P test proposed by \insertCite{CHOI:01;textual}{plm} for large N, \item \code{"invnormal"} is the inverse normal test by \insertCite{CHOI:01;textual}{plm}, and \item \code{"logit"} is the logit test by \insertCite{CHOI:01;textual}{plm}. } The individual p-values for the Fisher-type tests are approximated as described in \insertCite{MACK:96;textual}{plm} if the package \CRANpkg{urca} (\insertCite{PFAFF:08;textual}{plm}) is available, otherwise as described in \insertCite{MACK:94;textual}{plm}. For the test statistic tbar of the test of Im/Pesaran/Shin (2003) (\code{ips.stat = "tbar"}), no p-value is given but 1\%, 5\%, and 10\% critical values are interpolated from paper's tabulated values via inverse distance weighting (printed and contained in the returned value's element \code{statistic$ips.tbar.crit}). Hadri's test, the test of Levin/Lin/Chu, and the tbar statistic of Im/Pesaran/Shin are not applicable to unbalanced panels; the tbar statistic is not applicable when \code{lags > 0} is given. The exogeneous instruments of the tests (where applicable) can be specified in several ways, depending on how the data is handed over to the function: \itemize{ \item For the \code{formula}/\code{data} interface (if \code{data} is a \code{data.frame}, an additional \code{index} argument should be specified); the formula should be of the form: \code{y ~ 0}, \code{y ~ 1}, or \code{y ~ trend} for a test with no exogenous variables, with an intercept, or with individual intercepts and time trend, respectively. The \code{exo} argument is ignored in this case. \item For the \code{data.frame}, \code{matrix}, and \code{pseries} interfaces: in these cases, the exogenous variables are specified using the \code{exo} argument. } With the associated \code{summary} and \code{print} methods, additional information can be extracted/displayed (see also Value). } \examples{ data("Grunfeld", package = "plm") y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) # individuals in columns purtest(y, pmax = 4, exo = "intercept", test = "madwu") ## same via pseries interface pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) purtest(pGrunfeld$inv, pmax = 4, exo = "intercept", test = "madwu") ## same via formula interface purtest(inv ~ 1, data = Grunfeld, index = c("firm", "year"), pmax = 4, test = "madwu") } \references{ \insertAllCited{} } \seealso{ \code{\link[=cipstest]{cipstest()}}, \code{\link[=phansitest]{phansitest()}} } \author{ Yves Croissant and for "Pm", "invnormal", and "logit" Kevin Tappe } \keyword{htest} plm/man/cortab.Rd0000644000176200001440000000154014124132276013360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_cd.R \name{cortab} \alias{cortab} \title{Cross--sectional correlation matrix} \usage{ cortab(x, grouping, groupnames = NULL, value = "statistic", ...) } \arguments{ \item{x}{an object of class \code{pseries}} \item{grouping}{grouping variable,} \item{groupnames}{a character vector of group names,} \item{value}{to complete,} \item{\dots}{further arguments.} } \value{ A matrix with average correlation coefficients within a group (diagonal) and between groups (off-diagonal). } \description{ Computes the cross--sectional correlation matrix } \examples{ data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) grp <- c(rep(1, 100), rep(2, 50), rep(3, 50)) # make 3 groups cortab(pGrunfeld$value, grouping = grp, groupnames = c("A", "B", "C")) } \keyword{htest} plm/man/pbgtest.Rd0000644000176200001440000000657014124132276013566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pbgtest} \alias{pbgtest} \alias{pbgtest.panelmodel} \alias{pbgtest.formula} \title{Breusch--Godfrey Test for Panel Models} \usage{ pbgtest(x, ...) \method{pbgtest}{panelmodel}(x, order = NULL, type = c("Chisq", "F"), ...) \method{pbgtest}{formula}( x, order = NULL, type = c("Chisq", "F"), data, model = c("pooling", "random", "within"), ... ) } \arguments{ \item{x}{an object of class \code{"panelmodel"} or of class \code{"formula"},} \item{\dots}{further arguments (see \code{\link[lmtest:bgtest]{lmtest::bgtest()}}).} \item{order}{an integer indicating the order of serial correlation to be tested for. \code{NULL} (default) uses the minimum number of observations over the time dimension (see also section \strong{Details} below),} \item{type}{type of test statistic to be calculated; either \code{"Chisq"} (default) for the Chi-squared test statistic or \code{"F"} for the F test statistic,} \item{data}{only relevant for formula interface: data set for which the respective panel model (see \code{model}) is to be evaluated,} \item{model}{only relevant for formula interface: compute test statistic for model \code{pooling} (default), \code{random}, or \code{within}. When \code{model} is used, the \code{data} argument needs to be passed as well,} } \value{ An object of class \code{"htest"}. } \description{ Test of serial correlation for (the idiosyncratic component of) the errors in panel models. } \details{ This Lagrange multiplier test uses the auxiliary model on (quasi-)demeaned data taken from a model of class \code{plm} which may be a \code{pooling} (default for formula interface), \code{random} or \code{within} model. It performs a Breusch--Godfrey test (using \code{bgtest} from package \CRANpkg{lmtest} on the residuals of the (quasi-)demeaned model, which should be serially uncorrelated under the null of no serial correlation in idiosyncratic errors, as illustrated in \insertCite{WOOL:10;textual}{plm}. The function takes the demeaned data, estimates the model and calls \code{bgtest}. Unlike most other tests for serial correlation in panels, this one allows to choose the order of correlation to test for. } \note{ The argument \code{order} defaults to the minimum number of observations over the time dimension, while for \code{lmtest::bgtest} it defaults to \code{1}. } \examples{ data("Grunfeld", package = "plm") g <- plm(inv ~ value + capital, data = Grunfeld, model = "random") # panelmodel interface pbgtest(g) pbgtest(g, order = 4) # formula interface pbgtest(inv ~ value + capital, data = Grunfeld, model = "random") # F test statistic (instead of default type="Chisq") pbgtest(g, type="F") pbgtest(inv ~ value + capital, data = Grunfeld, model = "random", type = "F") } \references{ \insertRef{BREU:78}{plm} \insertRef{GODF:78}{plm} \insertRef{WOOL:02}{plm} \insertRef{WOOL:10}{plm} \insertRef{WOOL:13}{plm} Sec. 12.2, pp. 421--422. } \seealso{ For the original test in package \CRANpkg{lmtest} see \code{\link[lmtest:bgtest]{lmtest::bgtest()}}. See \code{\link[=pdwtest]{pdwtest()}} for the analogous panel Durbin--Watson test. See \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbsytest]{pbsytest()}}, \code{\link[=pwartest]{pwartest()}} and \code{\link[=pwfdtest]{pwfdtest()}} for other serial correlation tests for panel models. } \author{ Giovanni Millo } \keyword{htest} plm/man/pdim.Rd0000644000176200001440000000677014155752550013060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_pdata.frame.R \name{pdim} \alias{pdim} \alias{pdim.default} \alias{pdim.data.frame} \alias{pdim.pdata.frame} \alias{pdim.pseries} \alias{pdim.pggls} \alias{pdim.pcce} \alias{pdim.pmg} \alias{pdim.pgmm} \alias{pdim.panelmodel} \alias{print.pdim} \title{Check for the Dimensions of the Panel} \usage{ pdim(x, ...) \method{pdim}{default}(x, y, ...) \method{pdim}{data.frame}(x, index = NULL, ...) \method{pdim}{pdata.frame}(x, ...) \method{pdim}{pseries}(x, ...) \method{pdim}{pggls}(x, ...) \method{pdim}{pcce}(x, ...) \method{pdim}{pmg}(x, ...) \method{pdim}{pgmm}(x, ...) \method{pdim}{panelmodel}(x, ...) \method{print}{pdim}(x, ...) } \arguments{ \item{x}{a \code{data.frame}, a \code{pdata.frame}, a \code{pseries}, a \code{panelmodel}, or a \code{pgmm} object,} \item{\dots}{further arguments.} \item{y}{a vector,} \item{index}{see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ An object of class \code{pdim} containing the following elements: \item{nT}{a list containing \code{n}, the number of individuals, \code{T}, the number of time observations, \code{N} the total number of observations,} \item{Tint}{a list containing two vectors (of type integer): \code{Ti} gives the number of observations for each individual and \code{nt} gives the number of individuals observed for each period,} \item{balanced}{a logical value: \code{TRUE} for a balanced panel, \code{FALSE} for an unbalanced panel,} \item{panel.names}{a list of character vectors: \code{id.names} contains the names of each individual and \code{time.names} contains the names of each period.} } \description{ This function checks the number of individuals and time observations in the panel and whether it is balanced or not. } \details{ \code{pdim} is called by the estimation functions and can be also used stand-alone. } \note{ Calling \code{pdim} on an estimated \code{panelmodel} object and on the corresponding \verb{(p)data.frame} used for this estimation does not necessarily yield the same result. When called on an estimated \code{panelmodel}, the number of observations (individual, time) actually used for model estimation are taken into account. When called on a \verb{(p)data.frame}, the rows in the \verb{(p)data.frame} are considered, disregarding any \code{NA}values in the dependent or independent variable(s) which would be dropped during model estimation. } \examples{ # There are 595 individuals data("Wages", package = "plm") pdim(Wages, 595) # Gasoline contains two variables which are individual and time # indexes and are the first two variables data("Gasoline", package="plm") pdim(Gasoline) # Hedonic is an unbalanced panel, townid is the individual index data("Hedonic", package = "plm") pdim(Hedonic, "townid") # An example of the panelmodel method data("Produc", package = "plm") z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, model="random", subset = gsp > 5000) pdim(z) } \seealso{ \code{\link[=is.pbalanced]{is.pbalanced()}} to just determine balancedness of data (slightly faster than \code{pdim}),\cr \code{\link[=punbalancedness]{punbalancedness()}} for measures of unbalancedness,\cr \code{\link[=nobs]{nobs()}}, \code{\link[=pdata.frame]{pdata.frame()}},\cr \code{\link[=pvar]{pvar()}} to check for each variable if it varies cross-sectionally and over time. } \author{ Yves Croissant } \keyword{attribute} plm/man/pvcm.Rd0000644000176200001440000000655114124132276013062 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_vcm.R \name{pvcm} \alias{pvcm} \alias{summary.pvcm} \alias{print.summary.pvcm} \title{Variable Coefficients Models for Panel Data} \usage{ pvcm( formula, data, subset, na.action, effect = c("individual", "time"), model = c("within", "random"), index = NULL, ... ) \method{summary}{pvcm}(object, ...) \method{print}{summary.pvcm}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{lm},} \item{na.action}{see \code{lm},} \item{effect}{the effects introduced in the model: one of \code{"individual"}, \code{"time"},} \item{model}{one of \code{"within"}, \code{"random"},} \item{index}{the indexes, see \code{\link[=pdata.frame]{pdata.frame()}},} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{"pvcm"},} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} } \value{ An object of class \code{c("pvcm", "panelmodel")}, which has the following elements: \item{coefficients}{the vector (or the data frame for fixed effects) of coefficients,} \item{residuals}{the vector of residuals,} \item{fitted.values}{the vector of fitted values,} \item{vcov}{the covariance matrix of the coefficients (a list for fixed effects model (\code{model = "within"})),} \item{df.residual}{degrees of freedom of the residuals,} \item{model}{a data frame containing the variables used for the estimation,} \item{call}{the call,} \item{Delta}{the estimation of the covariance matrix of the coefficients (random effect models only),} \item{std.error}{a data frame containing standard errors for all coefficients for each individual (within models only).} \code{pvcm} objects have \code{print}, \code{summary} and \code{print.summary} methods. } \description{ Estimators for random and fixed effects models with variable coefficients. } \details{ \code{pvcm} estimates variable coefficients models. Individual or time effects are introduced, respectively, if \code{effect = "individual"} (default) or \code{effect = "time"}. Coefficients are assumed to be fixed if \code{model = "within"}, i.e., separate pooled OLS models are estimated per individual (\code{effect = "individual"}) or per time period (\code{effect = "time"}). Coefficients are assumed to be random if \code{model = "random"} and the model by \insertCite{SWAM:70;textual}{plm} is estimated. It is a generalized least squares model which uses the results of the previous model. } \examples{ data("Produc", package = "plm") zw <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") zr <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") ## replicate Greene (2012), p. 419, table 11.14 summary(pvcm(log(gsp) ~ log(pc) + log(hwy) + log(water) + log(util) + log(emp) + unemp, data = Produc, model = "random")) \dontrun{ # replicate Swamy (1970), p. 166, table 5.2 data(Grunfeld, package = "AER") # 11 firm Grunfeld data needed from package AER gw <- pvcm(invest ~ value + capital, data = Grunfeld, index = c("firm", "year")) } } \references{ \insertRef{SWAM:70}{plm} } \author{ Yves Croissant } \keyword{regression} plm/man/mtest.Rd0000644000176200001440000000264114154734502013250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_gmm.R \name{mtest} \alias{mtest} \alias{mtest.pgmm} \title{Arellano--Bond Test of Serial Correlation} \usage{ mtest(object, ...) \method{mtest}{pgmm}(object, order = 1L, vcov = NULL, ...) } \arguments{ \item{object}{an object of class \code{"pgmm"},} \item{\dots}{further arguments (currently unused).} \item{order}{integer: the order of the serial correlation,} \item{vcov}{a matrix of covariance for the coefficients or a function to compute it,} } \value{ An object of class \code{"htest"}. } \description{ Test of serial correlation for models estimated by GMM } \details{ The Arellano--Bond test is a test of correlation based on the residuals of the estimation. By default, the computation is done with the standard covariance matrix of the coefficients. A robust estimator of this covariance matrix can be supplied with the \code{vcov} argument. } \examples{ data("EmplUK", package = "plm") ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") mtest(ar, order = 1L) mtest(ar, order = 2L, vcov = vcovHC) } \references{ \insertCite{AREL:BOND:91}{plm} } \seealso{ \code{\link[=pgmm]{pgmm()}} } \author{ Yves Croissant } \keyword{htest} plm/man/pmg.Rd0000644000176200001440000000646514124132276012704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_mg.R \name{pmg} \alias{pmg} \alias{summary.pmg} \alias{print.summary.pmg} \alias{residuals.pmg} \title{Mean Groups (MG), Demeaned MG and CCE MG estimators} \usage{ pmg( formula, data, subset, na.action, model = c("mg", "cmg", "dmg"), index = NULL, trend = FALSE, ... ) \method{summary}{pmg}(object, ...) \method{print}{summary.pmg}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{residuals}{pmg}(object, ...) } \arguments{ \item{formula}{a symbolic description of the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[=lm]{lm()}},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{model}{one of \code{"mg"}, \code{"cmg"}, or \code{"dmg"},} \item{index}{the indexes, see \code{\link[=pdata.frame]{pdata.frame()}},} \item{trend}{logical specifying whether an individual-specific trend has to be included,} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{pmg},} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} } \value{ An object of class \code{c("pmg", "panelmodel")} containing: \item{coefficients}{the vector of coefficients,} \item{residuals}{the vector of residuals,} \item{fitted.values}{the vector of fitted values,} \item{vcov}{the covariance matrix of the coefficients,} \item{df.residual}{degrees of freedom of the residuals,} \item{model}{a data.frame containing the variables used for the estimation,} \item{r.squared}{numeric, the R squared,} \item{call}{the call,} \item{indcoef}{the matrix of individual coefficients from separate time series regressions.} } \description{ Mean Groups (MG), Demeaned MG (DMG) and Common Correlated Effects MG (CCEMG) estimators for heterogeneous panel models, possibly with common factors (CCEMG) } \details{ \code{pmg} is a function for the estimation of linear panel models with heterogeneous coefficients by various Mean Groups estimators. Setting argument \code{model = "mg"} specifies the standard Mean Groups estimator, based on the average of individual time series regressions. If \code{model = "dmg"} the data are demeaned cross-sectionally, which is believed to reduce the influence of common factors (and is akin to what is done in homogeneous panels when \code{model = "within"} and \code{effect = "time"}). Lastly, if \code{model = "cmg"} the CCEMG estimator is employed which is consistent under the hypothesis of unobserved common factors and idiosyncratic factor loadings; it works by augmenting the model by cross-sectional averages of the dependent variable and regressors in order to account for the common factors, and adding individual intercepts and possibly trends. } \examples{ data("Produc", package = "plm") ## Mean Groups estimator mgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) summary(mgmod) ## demeaned Mean Groups dmgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "dmg") summary(dmgmod) ## Common Correlated Effects Mean Groups ccemgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "cmg") summary(ccemgmod) } \references{ \insertRef{PESA:06}{plm} } \author{ Giovanni Millo } \keyword{regression} plm/man/EmplUK.Rd0000644000176200001440000000121714124132276013244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{EmplUK} \alias{EmplUK} \title{Employment and Wages in the United Kingdom} \format{ A data frame containing : \describe{ \item{firm}{firm index} \item{year}{year} \item{sector}{the sector of activity} \item{emp}{employment} \item{wage}{wages} \item{capital}{capital} \item{output}{output} } } \source{ \insertRef{AREL:BOND:91}{plm} } \description{ An unbalanced panel of 140 observations from 1976 to 1984 } \details{ \emph{total number of observations} : 1031 \emph{observation} : firms \emph{country} : United Kingdom } \keyword{datasets} plm/man/pwartest.Rd0000644000176200001440000000461514124132276013765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pwartest} \alias{pwartest} \alias{pwartest.formula} \alias{pwartest.panelmodel} \title{Wooldridge Test for AR(1) Errors in FE Panel Models} \usage{ pwartest(x, ...) \method{pwartest}{formula}(x, data, ...) \method{pwartest}{panelmodel}(x, ...) } \arguments{ \item{x}{an object of class \code{formula} or of class \code{panelmodel},} \item{\dots}{further arguments to be passed on to \code{vcovHC} (see Details and Examples).} \item{data}{a \code{data.frame},} } \value{ An object of class \code{"htest"}. } \description{ Test of serial correlation for (the idiosyncratic component of) the errors in fixed--effects panel models. } \details{ As \insertCite{WOOL:10;textual}{plm}, Sec. 10.5.4 observes, under the null of no serial correlation in the errors, the residuals of a FE model must be negatively serially correlated, with \eqn{cor(\hat{u}_{it}, \hat{u}_{is})=-1/(T-1)} for each \eqn{t,s}. He suggests basing a test for this null hypothesis on a pooled regression of FE residuals on their first lag: \eqn{\hat{u}_{i,t} = \alpha + \delta \hat{u}_{i,t-1} + \eta_{i,t}}. Rejecting the restriction \eqn{\delta = -1/(T-1)} makes us conclude against the original null of no serial correlation. \code{pwartest} estimates the \code{within} model and retrieves residuals, then estimates an AR(1) \code{pooling} model on them. The test statistic is obtained by applying a F test to the latter model to test the above restriction on \eqn{\delta}, setting the covariance matrix to \code{vcovHC} with the option \code{method="arellano"} to control for serial correlation. Unlike the \code{\link[=pbgtest]{pbgtest()}} and \code{\link[=pdwtest]{pdwtest()}}, this test does not rely on large--T asymptotics and has therefore good properties in ``short'' panels. Furthermore, it is robust to general heteroskedasticity. } \examples{ data("EmplUK", package = "plm") pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK) # pass argument 'type' to vcovHC used in test pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3") } \references{ \insertRef{WOOL:02}{plm} \insertRef{WOOL:10}{plm} } \seealso{ \code{\link[=pwfdtest]{pwfdtest()}}, \code{\link[=pdwtest]{pdwtest()}}, \code{\link[=pbgtest]{pbgtest()}}, \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbsytest]{pbsytest()}}. } \author{ Giovanni Millo } \keyword{htest} plm/man/r.squared.Rd0000644000176200001440000000304414124132276014013 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_plm.R \name{r.squared} \alias{r.squared} \title{R squared and adjusted R squared for panel models} \usage{ r.squared(object, model = NULL, type = c("cor", "rss", "ess"), dfcor = FALSE) } \arguments{ \item{object}{an object of class \code{"plm"},} \item{model}{on which transformation of the data the R-squared is to be computed. If \code{NULL}, the transformation used to estimate the model is also used for the computation of R squared,} \item{type}{indicates method which is used to compute R squared. One of\cr \code{"rss"} (residual sum of squares),\cr \code{"ess"} (explained sum of squares), or\cr \code{"cor"} (coefficient of correlation between the fitted values and the response),} \item{dfcor}{if \code{TRUE}, the adjusted R squared is computed.} } \value{ A numerical value. The R squared or adjusted R squared of the model estimated on the transformed data, e. g., for the within model the so called "within R squared". } \description{ This function computes R squared or adjusted R squared for plm objects. It allows to define on which transformation of the data the (adjusted) R squared is to be computed and which method for calculation is used. } \examples{ data("Grunfeld", package = "plm") p <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") r.squared(p) r.squared(p, dfcor = TRUE) } \seealso{ \code{\link[=plm]{plm()}} for estimation of various models; \code{\link[=summary.plm]{summary.plm()}} which makes use of \code{r.squared}. } \keyword{htest} plm/man/Males.Rd0000644000176200001440000000216014124132276013146 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Males} \alias{Males} \title{Wages and Education of Young Males} \format{ A data frame containing : \describe{ \item{nr}{identifier} \item{year}{year} \item{school}{years of schooling} \item{exper}{years of experience (computed as \code{age-6-school})} \item{union}{wage set by collective bargaining?} \item{ethn}{a factor with levels \verb{black, hisp, other}} \item{married}{married?} \item{health}{health problem?} \item{wage}{log of hourly wage} \item{industry}{a factor with 12 levels} \item{occupation}{a factor with 9 levels} \item{residence}{a factor with levels \verb{rural_area, north_east, northern_central, south}} } } \source{ Journal of Applied Econometrics data archive \url{http://qed.econ.queensu.ca/jae/1998-v13.2/vella-verbeek/}. } \description{ A panel of 545 observations from 1980 to 1987 } \details{ \emph{total number of observations} : 4360 \emph{observation} : individuals \emph{country} : United States } \references{ \insertRef{VELL:VERB:98}{plm} \insertRef{VERB:04}{plm} } \keyword{datasets} plm/man/vcovDC.Rd0000644000176200001440000000656714124132276013310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovDC} \alias{vcovDC} \alias{vcovDC.plm} \title{Double-Clustering Robust Covariance Matrix Estimator} \usage{ vcovDC(x, ...) \method{vcovDC}{plm}(x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), ...) } \arguments{ \item{x}{an object of class \code{"plm"} or \code{"pcce"}} \item{\dots}{further arguments} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"sss"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, see Details,} } \value{ An object of class \code{"matrix"} containing the estimate of the covariance matrix of coefficients. } \description{ High-level convenience wrapper for double-clustering robust covariance matrix estimators \emph{a la} \insertCite{THOM:11;textual}{plm} and \insertCite{CAME:GELB:MILL:11;textual}{plm} for panel models. } \details{ \code{vcovDC} is a function for estimating a robust covariance matrix of parameters for a panel model with errors clustering along both dimensions. The function is a convenience wrapper simply summing a group- and a time-clustered covariance matrix and subtracting a diagonal one \emph{a la} White. Weighting schemes specified by \code{type} are analogous to those in \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} in package \CRANpkg{sandwich} and are justified theoretically (although in the context of the standard linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. The main use of \code{vcovDC} (and the other variance-covariance estimators provided in the package \code{vcovHC}, \code{vcovBK}, \code{vcovNW}, \code{vcovSCC}) is to pass it to plm's own functions like \code{summary}, \code{pwaldtest}, and \code{phtest} or together with testing functions from the \code{lmtest} and \code{car} packages. All of these typically allow passing the \code{vcov} or \code{vcov.} parameter either as a matrix or as a function, e.g., for Wald--type testing: argument \code{vcov.} to \code{coeftest()}, argument \code{vcov} to \code{waldtest()} and other methods in the \CRANpkg{lmtest} package; and argument \code{vcov.} to \code{linearHypothesis()} in the \CRANpkg{car} package (see the examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. } \examples{ data("Produc", package="plm") zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") ## as function input to plm's summary method (with and without additional arguments): summary(zz, vcov = vcovDC) summary(zz, vcov = function(x) vcovDC(x, type="HC1", maxlag=4)) ## standard coefficient significance test library(lmtest) coeftest(zz) ## DC robust significance test, default coeftest(zz, vcov.=vcovDC) ## idem with parameters, pass vcov as a function argument coeftest(zz, vcov.=function(x) vcovDC(x, type="HC1", maxlag=4)) ## joint restriction test waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovDC) \dontrun{ ## test of hyp.: 2*log(pc)=log(emp) library(car) linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovDC) } } \references{ \insertRef{CAME:GELB:MILL:11}{plm} \insertRef{CRIB:04}{plm} \insertRef{MACK:WHIT:85}{plm} \insertRef{THOM:11}{plm} \insertRef{ZEIL:04}{plm} } \seealso{ \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} from the \CRANpkg{sandwich} package for weighting schemes (\code{type} argument). } \author{ Giovanni Millo } \keyword{regression} plm/man/ranef.plm.Rd0000644000176200001440000000373114124132276013774 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_ranfixef.R \name{ranef.plm} \alias{ranef.plm} \alias{ranef} \title{Extract the Random Effects} \usage{ \method{ranef}{plm}(object, effect = NULL, ...) } \arguments{ \item{object}{an object of class \code{"plm"}, needs to be a fitted random effects model,} \item{effect}{\code{NULL}, \code{"individual"}, or \code{"time"}, the effects to be extracted, see \strong{Details},} \item{\dots}{further arguments (currently not used).} } \value{ A named numeric with the random effects per dimension (individual or time). } \description{ Function to calculate the random effects from a \code{plm} object (random effects model). } \details{ Function \code{ranef} calculates the random effects of a fitted random effects model. For one-way models, the effects of the estimated model are extracted (either individual or time effects). For two-way models, extracting the individual effects is the default (both, argument \code{effect = NULL} and \code{effect = "individual"} will give individual effects). Time effects can be extracted by setting \code{effect = "time"}. Not all random effect model types are supported (yet?). } \examples{ data("Grunfeld", package = "plm") m1 <- plm(inv ~ value + capital, data = Grunfeld, model = "random") ranef(m1) # individual random effects # compare to random effects by ML estimation via lme from package nlme library(nlme) m2 <- lme(inv ~ value + capital, random = ~1|firm, data = Grunfeld) cbind("plm" = ranef(m1), "lme" = unname(ranef(m2))) # two-ways RE model, calculate individual and time random effects data("Cigar", package = "plm") tw <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "twoways") ranef(tw) # individual random effects ranef(tw, effect = "time") # time random effects } \seealso{ \code{\link[=fixef]{fixef()}} to extract the fixed effects from a fixed effects model (within model). } \author{ Kevin Tappe } \keyword{regression} plm/man/pwfdtest.Rd0000644000176200001440000000744414124132276013757 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pwfdtest} \alias{pwfdtest} \alias{pwfdtest.formula} \alias{pwfdtest.panelmodel} \title{Wooldridge first--difference--based test for AR(1) errors in levels or first--differenced panel models} \usage{ pwfdtest(x, ...) \method{pwfdtest}{formula}(x, data, ..., h0 = c("fd", "fe")) \method{pwfdtest}{panelmodel}(x, ..., h0 = c("fd", "fe")) } \arguments{ \item{x}{an object of class \code{formula} or a \code{"fd"}-model (plm object),} \item{\dots}{further arguments to be passed on to \code{vcovHC} (see Details and Examples).} \item{data}{a \code{data.frame},} \item{h0}{the null hypothesis: one of \code{"fd"}, \code{"fe"},} } \value{ An object of class \code{"htest"}. } \description{ First--differencing--based test of serial correlation for (the idiosyncratic component of) the errors in either levels or first--differenced panel models. } \details{ As \insertCite{WOOL:10;textual}{plm}, Sec. 10.6.3 observes, if the idiosyncratic errors in the model in levels are uncorrelated (which we label hypothesis \code{"fe"}), then the errors of the model in first differences (FD) must be serially correlated with \eqn{cor(\hat{e}_{it}, \hat{e}_{is}) = -0.5} for each \eqn{t,s}. If on the contrary the levels model's errors are a random walk, then there must be no serial correlation in the FD errors (hypothesis \code{"fd"}). Both the fixed effects (FE) and the first--differenced (FD) estimators remain consistent under either assumption, but the relative efficiency changes: FE is more efficient under \code{"fe"}, FD under \code{"fd"}. Wooldridge (ibid.) suggests basing a test for either hypothesis on a pooled regression of FD residuals on their first lag: \eqn{\hat{e}_{i,t}=\alpha + \rho \hat{e}_{i,t-1} + \eta_{i,t}}. Rejecting the restriction \eqn{\rho = -0.5} makes us conclude against the null of no serial correlation in errors of the levels equation (\code{"fe"}). The null hypothesis of no serial correlation in differenced errors (\code{"fd"}) is tested in a similar way, but based on the zero restriction on \eqn{\rho} (\eqn{\rho = 0}). Rejecting \code{"fe"} favours the use of the first--differences estimator and the contrary, although it is possible that both be rejected. \code{pwfdtest} estimates the \code{fd} model (or takes an \code{fd} model as input for the panelmodel interface) and retrieves its residuals, then estimates an AR(1) \code{pooling} model on them. The test statistic is obtained by applying a F test to the latter model to test the relevant restriction on \eqn{\rho}, setting the covariance matrix to \code{vcovHC} with the option \code{method="arellano"} to control for serial correlation. Unlike the \code{pbgtest} and \code{pdwtest}, this test does not rely on large--T asymptotics and has therefore good properties in ''short'' panels. Furthermore, it is robust to general heteroskedasticity. The \code{"fe"} version can be used to test for error autocorrelation regardless of whether the maintained specification has fixed or random effects \insertCite{@see @DRUK:03}{plm}. } \examples{ data("EmplUK" , package = "plm") pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK) pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, h0 = "fe") # pass argument 'type' to vcovHC used in test pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3", h0 = "fe") # same with panelmodel interface mod <- plm(log(emp) ~ log(wage) + log(capital), data = EmplUK, model = "fd") pwfdtest(mod) pwfdtest(mod, h0 = "fe") pwfdtest(mod, type = "HC3", h0 = "fe") } \references{ \insertRef{DRUK:03}{plm} \insertRef{WOOL:02}{plm} Sec. 10.6.3, pp. 282--283. \insertRef{WOOL:10}{plm} Sec. 10.6.3, pp. 319--320 } \seealso{ \code{pdwtest}, \code{pbgtest}, \code{pwartest}, } \author{ Giovanni Millo } \keyword{htest} plm/man/pldv.Rd0000644000176200001440000000544514124132276013063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_ldv.R \name{pldv} \alias{pldv} \title{Panel estimators for limited dependent variables} \usage{ pldv( formula, data, subset, weights, na.action, model = c("fd", "random", "pooling"), index = NULL, R = 20, start = NULL, lower = 0, upper = +Inf, objfun = c("lsq", "lad"), sample = c("cens", "trunc"), ... ) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{lm},} \item{weights}{see \code{lm},} \item{na.action}{see \code{lm},} \item{model}{one of \code{"fd"}, \code{"random"}, or \code{"pooling"},} \item{index}{the indexes, see \code{\link[=pdata.frame]{pdata.frame()}},} \item{R}{the number of points for the gaussian quadrature,} \item{start}{a vector of starting values,} \item{lower}{the lower bound for the censored/truncated dependent variable,} \item{upper}{the upper bound for the censored/truncated dependent variable,} \item{objfun}{the objective function for the fixed effect model (\code{model = "fd"}, irrelevant for other values of the \code{model} argument ): one of \code{"lsq"} for least squares (minimise sum of squares of the residuals) and \code{"lad"} for least absolute deviations (minimise sum of absolute values of the residuals),} \item{sample}{\code{"cens"} for a censored (tobit-like) sample, \code{"trunc"} for a truncated sample,} \item{\dots}{further arguments.} } \value{ For \code{model = "fd"}, an object of class \code{c("plm", "panelmodel")}, for \code{model = "random"} and \code{model = "pooling"} an object of class \code{c("maxLik", "maxim")}. } \description{ Fixed and random effects estimators for truncated or censored limited dependent variable } \details{ \code{pldv} computes two kinds of models: a LSQ/LAD estimator for the first-difference model (\code{model = "fd"}) and a maximum likelihood estimator with an assumed normal distribution for the individual effects (\code{model = "random"} or \code{"pooling"}). For maximum-likelihood estimations, \code{pldv} uses internally function \code{\link[maxLik:maxLik]{maxLik::maxLik()}} (from package \CRANpkg{maxLik}). } \examples{ ## as these examples take a bit of time, do not run them automatically \dontrun{ data("Donors", package = "pder") library("plm") pDonors <- pdata.frame(Donors, index = "id") # replicate Landry/Lange/List/Price/Rupp (2010), online appendix, table 5a, models A and B modA <- pldv(donation ~ treatment + prcontr, data = pDonors, model = "random", method = "bfgs") summary(modA) modB <- pldv(donation ~ treatment * prcontr - prcontr, data = pDonors, model = "random", method = "bfgs") summary(modB) } } \references{ \insertRef{HONO:92}{plm} } \author{ Yves Croissant } \keyword{regression} plm/man/has.intercept.Rd0000644000176200001440000000235114124132276014656 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_misc.R \name{has.intercept} \alias{has.intercept} \alias{has.intercept.default} \alias{has.intercept.formula} \alias{has.intercept.Formula} \alias{has.intercept.panelmodel} \alias{has.intercept.plm} \title{Check for the presence of an intercept in a formula or in a fitted model} \usage{ has.intercept(object, ...) \method{has.intercept}{default}(object, ...) \method{has.intercept}{formula}(object, ...) \method{has.intercept}{Formula}(object, rhs = NULL, ...) \method{has.intercept}{panelmodel}(object, ...) \method{has.intercept}{plm}(object, rhs = 1L, ...) } \arguments{ \item{object}{a \code{formula}, a \code{Formula} or a fitted model (of class \code{plm} or \code{panelmodel}),} \item{\dots}{further arguments.} \item{rhs}{an integer (length > 1 is possible), indicating the parts of right hand sides of the formula to be evaluated for the presence of an intercept or NULL for all parts of the right hand side (relevant for the \code{Formula} and the \code{plm} methods)} } \value{ a logical } \description{ The presence of an intercept is checked using the formula which is either provided as the argument of the function or extracted from a fitted model. } plm/man/lag.plm.Rd0000644000176200001440000001136614124132276013447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_transformations.R \name{lag.plm} \alias{lag.plm} \alias{lag} \alias{lead} \alias{diff} \alias{lag.pseries} \alias{lead.pseries} \alias{diff.pseries} \title{lag, lead, and diff for panel data} \usage{ lead(x, k = 1L, ...) \method{lag}{pseries}(x, k = 1L, shift = c("time", "row"), ...) \method{lead}{pseries}(x, k = 1L, shift = c("time", "row"), ...) \method{diff}{pseries}(x, lag = 1L, shift = c("time", "row"), ...) } \arguments{ \item{x}{a \code{pseries} object,} \item{k}{an integer, the number of lags for the \code{lag} and \code{lead} methods (can also be negative). For the \code{lag} method, a positive (negative) \code{k} gives lagged (leading) values. For the \code{lead} method, a positive (negative) \code{k} gives leading (lagged) values, thus, \code{lag(x, k = -1L)} yields the same as \code{lead(x, k = 1L)}. If \code{k} is an integer with length > 1 (\code{k = c(k1, k2, ...)}), a \code{matrix} with multiple lagged \code{pseries} is returned,} \item{...}{further arguments (currently none evaluated).} \item{shift}{character, either \code{"time"} (default) or \code{"row"} determining how the shifting in the \code{lag}/\code{lead}/\code{diff} functions is performed (see Details and Examples).} \item{lag}{integer, the number of lags for the \code{diff} method, can also be of length > 1 (see argument \code{k}) (only non--negative values in argument \code{lag} are allowed for \code{diff}),} } \value{ \itemize{ \item An object of class \code{pseries}, if the argument specifying the lag has length 1 (argument \code{k} in functions \code{lag} and \code{lead}, argument \code{lag} in function \code{diff}). \item A matrix containing the various series in its columns, if the argument specifying the lag has length > 1. } } \description{ lag, lead, and diff functions for class pseries. } \details{ This set of functions perform lagging, leading (lagging in the opposite direction), and differencing operations on \code{pseries} objects, i. e., they take the panel structure of the data into account by performing the operations per individual. Argument \code{shift} controls the shifting of observations to be used by methods \code{lag}, \code{lead}, and \code{diff}: \itemize{ \item \code{shift = "time"} (default): Methods respect the numerical value in the time dimension of the index. The time dimension needs to be interpretable as a sequence t, t+1, t+2, \ldots{} where t is an integer (from a technical viewpoint, \code{as.numeric(as.character(index(your_pdata.frame)[[2]]))} needs to result in a meaningful integer). \item \verb{shift = "row": }Methods perform the shifting operation based solely on the "physical position" of the observations, i.e., neighbouring rows are shifted per individual. The value in the time index is not relevant in this case. } For consecutive time periods per individual, a switch of shifting behaviour results in no difference. Different return values will occur for non-consecutive time periods per individual ("holes in time"), see also Examples. } \note{ The sign of \code{k} in \code{lag.pseries} results in inverse behaviour compared to \code{\link[stats:lag]{stats::lag()}} and \code{\link[zoo:lag.zoo]{zoo::lag.zoo()}}. } \examples{ # First, create a pdata.frame data("EmplUK", package = "plm") Em <- pdata.frame(EmplUK) # Then extract a series, which becomes additionally a pseries z <- Em$output class(z) # compute the first and third lag, and the difference lagged twice lag(z) lag(z, 3L) diff(z, 2L) # compute negative lags (= leading values) lag(z, -1L) lead(z, 1L) # same as line above identical(lead(z, 1L), lag(z, -1L)) # TRUE # compute more than one lag and diff at once (matrix returned) lag(z, c(1L,2L)) diff(z, c(1L,2L)) ## demonstrate behaviour of shift = "time" vs. shift = "row" # delete 2nd time period for first individual (1978 is missing (not NA)): Em_hole <- Em[-2L, ] is.pconsecutive(Em_hole) # check: non-consecutive for 1st individual now # original non-consecutive data: head(Em_hole$emp, 10) # for shift = "time", 1-1979 contains the value of former 1-1977 (2 periods lagged): head(lag(Em_hole$emp, k = 2L, shift = "time"), 10L) # for shift = "row", 1-1979 contains NA (2 rows lagged (and no entry for 1976): head(lag(Em_hole$emp, k = 2L, shift = "row"), 10L) } \seealso{ To check if the time periods are consecutive per individual, see \code{\link[=is.pconsecutive]{is.pconsecutive()}}. For further function for 'pseries' objects: \code{\link[=between]{between()}}, \link[=between]{Between()}, \code{\link[=Within]{Within()}}, \code{\link[=summary.pseries]{summary.pseries()}}, \code{\link[=print.summary.pseries]{print.summary.pseries()}}, \code{\link[=as.matrix.pseries]{as.matrix.pseries()}}. } \author{ Yves Croissant and Kevin Tappe } \keyword{classes} plm/man/pcce.Rd0000644000176200001440000000625214126043200013013 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_cce.R \name{pcce} \alias{pcce} \alias{summary.pcce} \alias{print.summary.pcce} \alias{residuals.pcce} \alias{model.matrix.pcce} \alias{pmodel.response.pcce} \title{Common Correlated Effects estimators} \usage{ pcce( formula, data, subset, na.action, model = c("mg", "p"), index = NULL, trend = FALSE, ... ) \method{summary}{pcce}(object, vcov = NULL, ...) \method{print}{summary.pcce}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{residuals}{pcce}(object, type = c("defactored", "standard"), ...) \method{model.matrix}{pcce}(object, ...) \method{pmodel.response}{pcce}(object, ...) } \arguments{ \item{formula}{a symbolic description of the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{lm},} \item{na.action}{see \code{lm},} \item{model}{one of \code{"mg"}, \code{"p"}, selects Mean Groups vs. Pooled CCE model,} \item{index}{the indexes, see \code{\link[=pdata.frame]{pdata.frame()}},} \item{trend}{logical specifying whether an individual-specific trend has to be included,} \item{\dots}{further arguments.} \item{object, x}{an object of class \code{"pcce"},} \item{vcov}{a variance-covariance matrix furnished by the user or a function to calculate one,} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} \item{type}{one of \code{"defactored"} or \code{"standard"},} } \value{ An object of class \code{c("pcce", "panelmodel")} containing: \item{coefficients}{the vector of coefficients,} \item{residuals}{the vector of (defactored) residuals,} \item{stdres}{the vector of (raw) residuals,} \item{tr.model}{the transformed data after projection on H,} \item{fitted.values}{the vector of fitted values,} \item{vcov}{the covariance matrix of the coefficients,} \item{df.residual}{degrees of freedom of the residuals,} \item{model}{a data.frame containing the variables used for the estimation,} \item{call}{the call,} \item{indcoef}{the matrix of individual coefficients from separate time series regressions,} \item{r.squared}{numeric, the R squared.} } \description{ Common Correlated Effects Mean Groups (CCEMG) and Pooled (CCEP) estimators for panel data with common factors (balanced or unbalanced) } \details{ \code{pcce} is a function for the estimation of linear panel models by the Common Correlated Effects Mean Groups or Pooled estimator, consistent under the hypothesis of unobserved common factors and idiosyncratic factor loadings. The CCE estimator works by augmenting the model by cross-sectional averages of the dependent variable and regressors in order to account for the common factors, and adding individual intercepts and possibly trends. } \examples{ data("Produc", package = "plm") ccepmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="p") summary(ccepmod) summary(ccepmod, vcov = vcovHC) # use argument vcov for robust std. errors ccemgmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="mg") summary(ccemgmod) } \references{ \insertRef{kappesyam11}{plm} } \author{ Giovanni Millo } \keyword{regression} plm/man/pooltest.Rd0000644000176200001440000000300614124132276013756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_general.R \name{pooltest} \alias{pooltest} \alias{pooltest.plm} \alias{pooltest.formula} \title{Test of Poolability} \usage{ pooltest(x, ...) \method{pooltest}{plm}(x, z, ...) \method{pooltest}{formula}(x, data, ...) } \arguments{ \item{x}{an object of class \code{"plm"} for the plm method; an object of class \code{"formula"} for the formula interface,} \item{\dots}{further arguments passed to plm.} \item{z}{an object of class \code{"pvcm"} obtained with \code{model="within"},} \item{data}{a \code{data.frame},} } \value{ An object of class \code{"htest"}. } \description{ A Chow test for the poolability of the data. } \details{ \code{pooltest} is a \emph{F} test of stability (or Chow test) for the coefficients of a panel model. For argument \code{x}, the estimated \code{plm} object should be a \code{"pooling"} model or a \code{"within"} model (the default); intercepts are assumed to be identical in the first case and different in the second case. } \examples{ data("Gasoline", package = "plm") form <- lgaspcar ~ lincomep + lrpmg + lcarpcap gasw <- plm(form, data = Gasoline, model = "within") gasp <- plm(form, data = Gasoline, model = "pooling") gasnp <- pvcm(form, data = Gasoline, model = "within") pooltest(gasw, gasnp) pooltest(gasp, gasnp) pooltest(form, data = Gasoline, effect = "individual", model = "within") pooltest(form, data = Gasoline, effect = "individual", model = "pooling") } \author{ Yves Croissant } \keyword{htest} plm/man/pdata.frame.Rd0000644000176200001440000001534014154734502014276 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_pdata.frame.R \name{pdata.frame} \alias{pdata.frame} \alias{$<-.pdata.frame} \alias{[.pdata.frame} \alias{[[.pdata.frame} \alias{$.pdata.frame} \alias{print.pdata.frame} \alias{as.list.pdata.frame} \alias{as.data.frame.pdata.frame} \title{data.frame for panel data} \usage{ pdata.frame( x, index = NULL, drop.index = FALSE, row.names = TRUE, stringsAsFactors = default.stringsAsFactors(), replace.non.finite = FALSE, drop.NA.series = FALSE, drop.const.series = FALSE, drop.unused.levels = FALSE ) \method{$}{pdata.frame}(x, name) <- value \method{[}{pdata.frame}(x, i, j, drop) \method{[[}{pdata.frame}(x, y) \method{$}{pdata.frame}(x, y) \method{print}{pdata.frame}(x, ...) \method{as.list}{pdata.frame}(x, keep.attributes = FALSE, ...) \method{as.data.frame}{pdata.frame}( x, row.names = NULL, optional = FALSE, keep.attributes = TRUE, ... ) } \arguments{ \item{x}{a \code{data.frame} for the \code{pdata.frame} function and a \code{pdata.frame} for the methods,} \item{index}{this argument indicates the individual and time indexes. See \strong{Details},} \item{drop.index}{logical, indicates whether the indexes are to be excluded from the resulting pdata.frame,} \item{row.names}{\code{NULL} or logical, indicates whether "fancy" row names (combination of individual index and time index) are to be added to the returned (p)data.frame (\code{NULL} and \code{FALSE} have the same meaning for \code{pdata.frame}; for \code{as.data.frame.pdata.frame} see Details),} \item{stringsAsFactors}{logical, indicating whether character vectors are to be converted to factors,} \item{replace.non.finite}{logical, indicating whether values for which \code{is.finite()} yields \code{TRUE} are to be replaced by \code{NA} values, except for character variables (defaults to \code{FALSE}),} \item{drop.NA.series}{logical, indicating whether all-\code{NA} columns are to be removed from the pdata.frame (defaults to \code{FALSE}),} \item{drop.const.series}{logical, indicating whether constant columns are to be removed from the pdata.frame (defaults to \code{FALSE}),} \item{drop.unused.levels}{logical, indicating whether unused levels of factors are to be dropped (defaults to \code{FALSE}) (unused levels are always dropped from variables serving to construct the index variables),} \item{name}{the name of the \code{data.frame},} \item{value}{the name of the variable to include,} \item{i}{see \code{\link[=Extract]{Extract()}},} \item{j}{see \code{\link[=Extract]{Extract()}},} \item{drop}{see \code{\link[=Extract]{Extract()}},} \item{y}{one of the columns of the \code{data.frame},} \item{\dots}{further arguments.} \item{keep.attributes}{logical, only for as.list and as.data.frame methods, indicating whether the elements of the returned list/columns of the data.frame should have the pdata.frame's attributes added (default: FALSE for as.list, TRUE for as.data.frame),} \item{optional}{see \code{\link[=as.data.frame]{as.data.frame()}},} } \value{ a \code{pdata.frame} object: this is a \code{data.frame} with an \code{index} attribute which is a \code{data.frame} with two variables, the individual and the time indexes, both being factors. The resulting pdata.frame is sorted by the individual index, then by the time index. } \description{ An object of class 'pdata.frame' is a data.frame with an index attribute that describes its individual and time dimensions. } \details{ The \code{index} argument indicates the dimensions of the panel. It can be: \itemize{ \item a vector of two character strings which contains the names of the individual and of the time indexes, \item a character string which is the name of the individual index variable. In this case, the time index is created automatically and a new variable called "time" is added, assuming consecutive and ascending time periods in the order of the original data, \item an integer, the number of individuals. In this case, the data need to be a balanced panel and be organized as a stacked time series (successive blocks of individuals, each block being a time series for the respective individual) assuming consecutive and ascending time periods in the order of the original data. Two new variables are added: "id" and "time" which contain the individual and the time indexes. } The \code{"[["} and \code{"$"} extract a series from the \code{pdata.frame}. The \code{"index"} attribute is then added to the series and a class attribute \code{"pseries"} is added. The \code{"["} method behaves as for \code{data.frame}, except that the extraction is also applied to the \code{index} attribute. A safe way to extract the index attribute is to use the function \code{\link[=index]{index()}} for 'pdata.frames' (and other objects). \code{as.data.frame} removes the index attribute from the \code{pdata.frame} and adds it to each column. For its argument \code{row.names} set to \code{FALSE} row names are an integer series, \code{TRUE} gives "fancy" row names; if a character (with length of the resulting data frame), the row names will be the character's elements. \code{as.list} behaves by default identical to \code{\link[base:list]{base::as.list.data.frame()}} which means it drops the attributes specific to a pdata.frame; if a list of pseries is wanted, the attribute \code{keep.attributes} can to be set to \code{TRUE}. This also makes \code{lapply} work as expected on a pdata.frame (see also \strong{Examples}). } \examples{ # Gasoline contains two variables which are individual and time # indexes data("Gasoline", package = "plm") Gas <- pdata.frame(Gasoline, index = c("country", "year"), drop.index = TRUE) # Hedonic is an unbalanced panel, townid is the individual index data("Hedonic", package = "plm") Hed <- pdata.frame(Hedonic, index = "townid", row.names = FALSE) # In case of balanced panel, it is sufficient to give number of # individuals data set 'Wages' is organized as a stacked time # series data("Wages", package = "plm") Wag <- pdata.frame(Wages, 595) # lapply on a pdata.frame by making it a list of pseries first lapply(as.list(Wag[ , c("ed", "lwage")], keep.attributes = TRUE), lag) } \seealso{ \code{\link[=index]{index()}} to extract the index variables from a 'pdata.frame' (and other objects), \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), \code{\link[=pvar]{pvar()}} to check for each variable if it varies cross-sectionally and over time. To check if the time periods are consecutive per individual, see \code{\link[=is.pconsecutive]{is.pconsecutive()}}. } \author{ Yves Croissant } \keyword{classes} plm/man/ercomp.Rd0000644000176200001440000000544314124132276013401 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_ercomp.R \name{ercomp} \alias{ercomp} \alias{ercomp.plm} \alias{ercomp.pdata.frame} \alias{ercomp.formula} \alias{print.ercomp} \title{Estimation of the error components} \usage{ ercomp(object, ...) \method{ercomp}{plm}(object, ...) \method{ercomp}{pdata.frame}( object, effect = c("individual", "time", "twoways", "nested"), method = NULL, models = NULL, dfcor = NULL, index = NULL, ... ) \method{ercomp}{formula}( object, data, effect = c("individual", "time", "twoways", "nested"), method = NULL, models = NULL, dfcor = NULL, index = NULL, ... ) \method{print}{ercomp}(x, digits = max(3, getOption("digits") - 3), ...) } \arguments{ \item{object}{a \code{formula} or a \code{plm} object,} \item{\dots}{further arguments.} \item{effect}{the effects introduced in the model, see \code{\link[=plm]{plm()}} for details,} \item{method}{method of estimation for the variance components, see \code{\link[=plm]{plm()}} for details,} \item{models}{the models used to estimate the variance components (an alternative to the previous argument),} \item{dfcor}{a numeric vector of length 2 indicating which degree of freedom should be used,} \item{index}{the indexes,} \item{data}{a \code{data.frame},} \item{x}{an \code{ercomp} object,} \item{digits}{digits,} } \value{ An object of class \code{"ercomp"}: a list containing \itemize{ \item \code{sigma2} a named numeric with estimates of the variance components, \item \code{theta} contains the parameter(s) used for the transformation of the variables: For a one-way model, a numeric corresponding to the selected effect (individual or time); for a two-ways model a list of length 3 with the parameters. In case of a balanced model, the numeric has length 1 while for an unbalanced model, the numerics' length equal the number of observations. } } \description{ This function enables the estimation of the variance components of a panel model. } \examples{ data("Produc", package = "plm") # an example of the formula method ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, method = "walhus", effect = "time") # same with the plm method z <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, random.method = "walhus", effect = "time", model = "random") ercomp(z) # a two-ways model ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, method = "amemiya", effect = "twoways") } \references{ \insertRef{AMEM:71}{plm} \insertRef{NERLO:71}{plm} \insertRef{SWAM:AROR:72}{plm} \insertRef{WALL:HUSS:69}{plm} } \seealso{ \code{\link[=plm]{plm()}} where the estimates of the variance components are used if a random effects model is estimated } \author{ Yves Croissant } \keyword{regression} plm/man/pmodel.response.Rd0000644000176200001440000000510614164674063015236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_model.extract.R \name{pmodel.response} \alias{pmodel.response} \alias{pmodel.response.plm} \alias{pmodel.response.data.frame} \alias{pmodel.response.formula} \title{A function to extract the model.response} \usage{ pmodel.response(object, ...) \method{pmodel.response}{plm}(object, ...) \method{pmodel.response}{data.frame}(object, ...) \method{pmodel.response}{formula}(object, data, ...) } \arguments{ \item{object}{an object of class \code{"plm"}, or a formula of class \code{"Formula"},} \item{\dots}{further arguments.} \item{data}{a \code{data.frame}} } \value{ A pseries except if model responses' of a \code{"between"} or \code{"fd"} model as these models "compress" the data (the number of observations used in estimation is smaller than the original data due to the specific transformation). A numeric is returned for the \code{"between"} and \code{"fd"} model. } \description{ pmodel.response has several methods to conveniently extract the response of several objects. } \details{ The model response is extracted from a \code{pdata.frame} (where the response must reside in the first column; this is the case for a model frame), a \code{pFormula} + \code{data} or a \code{plm} object, and the transformation specified by \code{effect} and \code{model} is applied to it.\cr Constructing the model frame first ensures proper \code{NA} handling and the response being placed in the first column, see also \strong{Examples} for usage. } \examples{ # First, make a pdata.frame data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) # then make a model frame from a pFormula and a pdata.frame form <- inv ~ value + capital mf <- model.frame(pGrunfeld, form) # construct (transformed) response of the within model resp <- pmodel.response(form, data = mf, model = "within", effect = "individual") # retrieve (transformed) response directly from model frame resp_mf <- pmodel.response(mf, model = "within", effect = "individual") # retrieve (transformed) response from a plm object, i.e., an estimated model fe_model <- plm(form, data = pGrunfeld, model = "within") pmodel.response(fe_model) # same as constructed before all.equal(resp, pmodel.response(fe_model), check.attributes = FALSE) # TRUE } \seealso{ \code{plm}'s \code{\link[=model.matrix]{model.matrix()}} for (transformed) model matrix and the corresponding \code{\link[=model.frame]{model.frame()}} method to construct a model frame. } \author{ Yves Croissant } \keyword{manip} plm/man/plmtest.Rd0000644000176200001440000000756614154734502013617 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_general.R \name{plmtest} \alias{plmtest} \alias{plmtest.plm} \alias{plmtest.formula} \title{Lagrange FF Multiplier Tests for Panel Models} \usage{ plmtest(x, ...) \method{plmtest}{plm}( x, effect = c("individual", "time", "twoways"), type = c("honda", "bp", "ghm", "kw"), ... ) \method{plmtest}{formula}( x, data, ..., effect = c("individual", "time", "twoways"), type = c("honda", "bp", "ghm", "kw") ) } \arguments{ \item{x}{an object of class \code{"plm"} or a formula of class \code{"formula"},} \item{\dots}{further arguments passed to \code{plmtest}.} \item{effect}{a character string indicating which effects are tested: individual effects (\code{"individual"}), time effects (\code{"time"}) or both (\code{"twoways"}),} \item{type}{a character string indicating the test to be performed: \itemize{ \item \code{"honda"} (default) for \insertCite{HOND:85;textual}{plm}, \item \code{"bp"} for \insertCite{BREU:PAGA:80;textual}{plm}, \item \code{"kw"} for \insertCite{KING:WU:97;textual}{plm}, or \item \code{"ghm"} for \insertCite{GOUR:HOLL:MONF:82;textual}{plm} for unbalanced panel data sets, the respective unbalanced version of the tests are computed, }} \item{data}{a \code{data.frame},} } \value{ An object of class \code{"htest"}. } \description{ Test of individual and/or time effects for panel models. } \details{ These Lagrange multiplier tests use only the residuals of the pooling model. The first argument of this function may be either a pooling model of class \code{plm} or an object of class \code{formula} describing the model. For input within (fixed effects) or random effects models, the corresponding pooling model is calculated internally first as the tests are based on the residuals of the pooling model. The \code{"bp"} test for unbalanced panels was derived in \insertCite{BALT:LI:90;textual}{plm} (1990), the \code{"kw"} test for unbalanced panels in \insertCite{BALT:CHAN:LI:98;textual}{plm}. The \code{"ghm"} test and the \code{"kw"} test were extended to two-way effects in \insertCite{BALT:CHAN:LI:92;textual}{plm}. For a concise overview of all these statistics see \insertCite{BALT:03;textual}{plm}, Sec. 4.2, pp. 68--76 (for balanced panels) and Sec. 9.5, pp. 200--203 (for unbalanced panels). } \note{ For the King-Wu statistics (\code{"kw"}), the oneway statistics (\code{"individual"} and \code{"time"}) coincide with the respective Honda statistics (\code{"honda"}); twoway statistics of \code{"kw"} and \code{"honda"} differ. } \examples{ data("Grunfeld", package = "plm") g <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") plmtest(g) plmtest(g, effect="time") plmtest(inv ~ value + capital, data = Grunfeld, type = "honda") plmtest(inv ~ value + capital, data = Grunfeld, type = "bp") plmtest(inv ~ value + capital, data = Grunfeld, type = "bp", effect = "twoways") plmtest(inv ~ value + capital, data = Grunfeld, type = "ghm", effect = "twoways") plmtest(inv ~ value + capital, data = Grunfeld, type = "kw", effect = "twoways") Grunfeld_unbal <- Grunfeld[1:(nrow(Grunfeld)-1), ] # create an unbalanced panel data set g_unbal <- plm(inv ~ value + capital, data = Grunfeld_unbal, model = "pooling") plmtest(g_unbal) # unbalanced version of test is indicated in output } \references{ \insertRef{BALT:13}{plm} \insertRef{BALT:LI:90}{plm} \insertRef{BALT:CHAN:LI:92}{plm} \insertRef{BALT:CHAN:LI:98}{plm} \insertRef{BREU:PAGA:80}{plm} \insertRef{GOUR:HOLL:MONF:82}{plm} \insertRef{HOND:85}{plm} \insertRef{KING:WU:97}{plm} } \seealso{ \code{\link[=pFtest]{pFtest()}} for individual and/or time effects tests based on the within model. } \author{ Yves Croissant (initial implementation), Kevin Tappe (generalization to unbalanced panels) } \keyword{htest} plm/man/make.dummies.Rd0000644000176200001440000000756114162657250014504 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_misc.R \name{make.dummies} \alias{make.dummies} \alias{make.dummies.default} \alias{make.dummies.data.frame} \alias{make.dummies.pdata.frame} \title{Create a Dummy Matrix} \usage{ make.dummies(x, ...) \method{make.dummies}{default}(x, base = 1L, base.add = TRUE, ...) \method{make.dummies}{data.frame}(x, col, base = 1L, base.add = TRUE, ...) \method{make.dummies}{pdata.frame}(x, col, base = 1L, base.add = TRUE, ...) } \arguments{ \item{x}{a factor from which the dummies are created (x is coerced to factor if not yet a factor) for the default method or a data data frame/pdata.frame for the respective method.} \item{\dots}{further arguments.} \item{base}{integer or character, specifies the reference level (base), if integer it refers to position in \code{levels(x)}, if character the name of a level,} \item{base.add}{logical, if \code{TRUE} the reference level (base) is added to the return value as first column, if \code{FALSE} the reference level is not included.} \item{col}{character (only for the data frame and pdata.frame methods), to specify the column which is used to derive the dummies from,} } \value{ For the default method, a matrix containing the contrast-coded dummies, dimensions are n x n where \code{n = length(levels(x))} if argument \code{base.add = TRUE} or \code{n = length(levels(x)-1)} if \code{base.add = FALSE}; for the data frame and pdata.frame method, a data frame or pdata.frame, respectively, with the dummies appropriately merged to the input as last columns (column names are derived from the name of the column used to create the dummies and its levels). } \description{ Contrast-coded dummy matrix created from a factor } \details{ This function creates a matrix of dummies from the levels of a factor. In model estimations, it is usually preferable to not create the dummy matrix prior to estimation but to simply specify a factor in the formula and let the estimation function handle the creation of the dummies. This function is merely a convenience wrapper around \code{stats::contr.treatment} to ease the dummy matrix creation process shall the dummy matrix be explicitly required. See Examples for a use case in LSDV (least squares dummy variable) model estimation. The default method uses a factor as main input (or something coercible to a factor) to derive the dummy matrix from. Methods for data frame and pdata.frame are available as well and have the additional argument \code{col} to specify the the column from which the dummies are created; both methods merge the dummy matrix to the data frame/pdata.frame yielding a ready-to-use data set. See also Examples for use cases. } \examples{ library(plm) data("Grunfeld", package = "plm") Grunfeld <- Grunfeld[1:100, ] # reduce data set (down to 5 firms) ## default method make.dummies(Grunfeld$firm) # gives 5 x 5 matrix (5 firms, base level incl.) make.dummies(Grunfeld$firm, base = 2L, base.add = FALSE) # gives 5 x 4 matrix ## data frame method Grun.dummies <- make.dummies(Grunfeld, col = "firm") ## pdata.frame method pGrun <- pdata.frame(Grunfeld) pGrun.dummies <- make.dummies(pGrun, col = "firm") ## Model estimation: ## estimate within model (individual/firm effects) and LSDV models (firm dummies) # within model: plm(inv ~ value + capital, data = pGrun, model = "within") ## LSDV with user-created dummies by make.dummies: form_dummies <- paste0("firm", c(1:5), collapse = "+") form_dummies <- formula(paste0("inv ~ value + capital + ", form_dummies)) plm(form_dummies, data = pGrun.dummies, model = "pooling") # last dummy is dropped # LSDV via factor(year) -> let estimation function generate dummies: plm(inv ~ value + capital + factor(firm), data = pGrun, model = "pooling") } \seealso{ \code{\link[stats:contrast]{stats::contr.treatment()}}, \code{\link[stats:contrasts]{stats::contrasts()}} } \author{ Kevin Tappe } \keyword{manip} plm/man/plm.Rd0000644000176200001440000002731714164674063012721 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_plm.R, R/est_plm.list.R, R/tool_methods.R \name{plm} \alias{plm} \alias{print.plm.list} \alias{terms.panelmodel} \alias{vcov.panelmodel} \alias{fitted.panelmodel} \alias{residuals.panelmodel} \alias{df.residual.panelmodel} \alias{coef.panelmodel} \alias{print.panelmodel} \alias{update.panelmodel} \alias{deviance.panelmodel} \alias{predict.plm} \alias{formula.plm} \alias{plot.plm} \alias{residuals.plm} \alias{fitted.plm} \title{Panel Data Estimators} \usage{ plm( formula, data, subset, weights, na.action, effect = c("individual", "time", "twoways", "nested"), model = c("within", "random", "ht", "between", "pooling", "fd"), random.method = NULL, random.models = NULL, random.dfcor = NULL, inst.method = c("bvk", "baltagi", "am", "bms"), restrict.matrix = NULL, restrict.rhs = NULL, index = NULL, ... ) \method{print}{plm.list}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{terms}{panelmodel}(x, ...) \method{vcov}{panelmodel}(object, ...) \method{fitted}{panelmodel}(object, ...) \method{residuals}{panelmodel}(object, ...) \method{df.residual}{panelmodel}(object, ...) \method{coef}{panelmodel}(object, ...) \method{print}{panelmodel}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{update}{panelmodel}(object, formula., ..., evaluate = TRUE) \method{deviance}{panelmodel}(object, model = NULL, ...) \method{predict}{plm}(object, newdata = NULL, ...) \method{formula}{plm}(x, ...) \method{plot}{plm}( x, dx = 0.2, N = NULL, seed = 1, within = TRUE, pooling = TRUE, between = FALSE, random = FALSE, ... ) \method{residuals}{plm}(object, model = NULL, effect = NULL, ...) \method{fitted}{plm}(object, model = NULL, effect = NULL, ...) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[stats:lm]{stats::lm()}},} \item{weights}{see \code{\link[stats:lm]{stats::lm()}},} \item{na.action}{see \code{\link[stats:lm]{stats::lm()}}; currently, not fully supported,} \item{effect}{the effects introduced in the model, one of \code{"individual"}, \code{"time"}, \code{"twoways"}, or \code{"nested"},} \item{model}{one of \code{"pooling"}, \code{"within"}, \code{"between"}, \code{"random"} \code{"fd"}, or \code{"ht"},} \item{random.method}{method of estimation for the variance components in the random effects model, one of \code{"swar"} (default), \code{"amemiya"}, \code{"walhus"}, \code{"nerlove"}; for Hausman-Taylor estimation set to \code{"ht"} (see Details and Examples),} \item{random.models}{an alternative to the previous argument, the models used to compute the variance components estimations are indicated,} \item{random.dfcor}{a numeric vector of length 2 indicating which degree of freedom should be used,} \item{inst.method}{the instrumental variable transformation: one of \code{"bvk"}, \code{"baltagi"}, \code{"am"}, or \code{"bms"} (see also Details),} \item{restrict.matrix}{a matrix which defines linear restrictions on the coefficients,} \item{restrict.rhs}{the right hand side vector of the linear restrictions on the coefficients,} \item{index}{the indexes,} \item{\dots}{further arguments.} \item{x, object}{an object of class \code{"plm"},} \item{digits}{number of digits for printed output,} \item{width}{the maximum length of the lines in the printed output,} \item{formula.}{a new formula for the update method,} \item{evaluate}{a boolean for the update method, if \code{TRUE} the updated model is returned, if \code{FALSE} the call is returned,} \item{newdata}{the new data set for the \code{predict} method,} \item{dx}{the half--length of the individual lines for the plot method (relative to x range),} \item{N}{the number of individual to plot,} \item{seed}{the seed which will lead to individual selection,} \item{within}{if \code{TRUE}, the within model is plotted,} \item{pooling}{if \code{TRUE}, the pooling model is plotted,} \item{between}{if \code{TRUE}, the between model is plotted,} \item{random}{if \code{TRUE}, the random effect model is plotted,} } \value{ An object of class \code{"plm"}. A \code{"plm"} object has the following elements : \item{coefficients}{the vector of coefficients,} \item{vcov}{the variance--covariance matrix of the coefficients,} \item{residuals}{the vector of residuals (these are the residuals of the (quasi-)demeaned model),} \item{weights}{(only for weighted estimations) weights as specified,} \item{df.residual}{degrees of freedom of the residuals,} \item{formula}{an object of class \code{"Formula"} describing the model,} \item{model}{the model frame as a \code{"pdata.frame"} containing the variables used for estimation: the response is in first column followed by the other variables, the individual and time indexes are in the 'index' attribute of \code{model},} \item{ercomp}{an object of class \code{"ercomp"} providing the estimation of the components of the errors (for random effects models only),} \item{aliased}{named logical vector indicating any aliased coefficients which are silently dropped by \code{plm} due to linearly dependent terms (see also \code{\link[=detect.lindep]{detect.lindep()}}),} \item{call}{the call.} It has \code{print}, \code{summary} and \code{print.summary} methods. The \code{summary} method creates an object of class \code{"summary.plm"} that extends the object it is run on with information about (inter alia) F statistic and (adjusted) R-squared of model, standard errors, t--values, and p--values of coefficients, (if supplied) the furnished vcov, see \code{\link[=summary.plm]{summary.plm()}} for further details. } \description{ Linear models for panel data estimated using the \code{lm} function on transformed data. } \details{ \code{plm} is a general function for the estimation of linear panel models. It supports the following estimation methods: pooled OLS (\code{model = "pooling"}), fixed effects (\code{"within"}), random effects (\code{"random"}), first--differences (\code{"fd"}), and between (\code{"between"}). It supports unbalanced panels and two--way effects (although not with all methods). For random effects models, four estimators of the transformation parameter are available by setting \code{random.method} to one of \code{"swar"} \insertCite{SWAM:AROR:72}{plm} (default), \code{"amemiya"} \insertCite{AMEM:71}{plm}, \code{"walhus"} \insertCite{WALL:HUSS:69}{plm}, or \code{"nerlove"} \insertCite{NERLO:71}{plm} (see below for Hausman-Taylor instrumental variable case). For first--difference models, the intercept is maintained (which from a specification viewpoint amounts to allowing for a trend in the levels model). The user can exclude it from the estimated specification the usual way by adding \code{"-1"} to the model formula. Instrumental variables estimation is obtained using two--part formulas, the second part indicating the instrumental variables used. This can be a complete list of instrumental variables or an update of the first part. If, for example, the model is \code{y ~ x1 + x2 + x3}, with \code{x1} and \code{x2} endogenous and \code{z1} and \code{z2} external instruments, the model can be estimated with: \itemize{ \item \code{formula = y~x1+x2+x3 | x3+z1+z2}, \item \code{formula = y~x1+x2+x3 | . -x1-x2+z1+z2}. } If an instrument variable estimation is requested, argument \code{inst.method} selects the instrument variable transformation method: \itemize{ \item \code{"bvk"} (default) for \insertCite{BALE:VARA:87;textual}{plm}, \item \code{"baltagi"} for \insertCite{BALT:81;textual}{plm}, \item \code{"am"} for \insertCite{AMEM:MACU:86;textual}{plm}, \item \code{"bms"} for \insertCite{BREU:MIZO:SCHM:89;textual}{plm}. } The Hausman--Taylor estimator \insertCite{HAUS:TAYL:81}{plm} is computed with arguments \code{random.method = "ht"}, \code{model = "random"}, \code{inst.method = "baltagi"} (the other way with only \code{model = "ht"} is deprecated). See also the vignettes for introductions to model estimations (and more) with examples. } \examples{ data("Produc", package = "plm") zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, index = c("state","year")) summary(zz) # replicates some results from Baltagi (2013), table 3.1 data("Grunfeld", package = "plm") p <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") wi <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") swar <- plm(inv ~ value + capital, data = Grunfeld, model = "random", effect = "twoways") amemiya <- plm(inv ~ value + capital, data = Grunfeld, model = "random", random.method = "amemiya", effect = "twoways") walhus <- plm(inv ~ value + capital, data = Grunfeld, model = "random", random.method = "walhus", effect = "twoways") # summary and summary with a furnished vcov (passed as matrix, # as function, and as function with additional argument) summary(wi) summary(wi, vcov = vcovHC(wi)) summary(wi, vcov = vcovHC) summary(wi, vcov = function(x) vcovHC(x, method = "white2")) ## nested random effect model # replicate Baltagi/Song/Jung (2001), p. 378 (table 6), columns SA, WH # == Baltagi (2013), pp. 204-205 data("Produc", package = "plm") pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp summary(plm(form, data = pProduc, model = "random", effect = "nested")) summary(plm(form, data = pProduc, model = "random", effect = "nested", random.method = "walhus")) ## Instrumental variable estimations # replicate Baltagi (2013/2021), p. 133/162, table 7.1 data("Crime", package = "plm") FE2SLS <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "within") G2SLS <- update(FE2SLS, model = "random", inst.method = "bvk") EC2SLS <- update(G2SLS, model = "random", inst.method = "baltagi") ## Hausman-Taylor estimator and Amemiya-MaCurdy estimator # replicate Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 data("Wages", package = "plm") ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, random.method = "ht", model = "random", inst.method = "baltagi") summary(ht) am <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, random.method = "ht", model = "random", inst.method = "am") summary(am) } \references{ \insertRef{AMEM:71}{plm} \insertRef{AMEM:MACU:86}{plm} \insertRef{BALE:VARA:87}{plm} \insertRef{BALT:81}{plm} \insertRef{BALT:SONG:JUNG:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BREU:MIZO:SCHM:89}{plm} \insertRef{HAUS:TAYL:81}{plm} \insertRef{NERLO:71}{plm} \insertRef{SWAM:AROR:72}{plm} \insertRef{WALL:HUSS:69}{plm} } \seealso{ \code{\link[=summary.plm]{summary.plm()}} for further details about the associated summary method and the "summary.plm" object both of which provide some model tests and tests of coefficients. \code{\link[=fixef]{fixef()}} to compute the fixed effects for "within" models (=fixed effects models). } \author{ Yves Croissant } \keyword{regression} plm/man/Snmesp.Rd0000644000176200001440000000143314124132276013354 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Snmesp} \alias{Snmesp} \title{Employment and Wages in Spain} \format{ A data frame containing: \describe{ \item{firm}{firm index} \item{year}{year} \item{n}{log of employment} \item{w}{log of wages} \item{y}{log of real output} \item{i}{log of intermediate inputs} \item{k}{log of real capital stock} \item{f}{real cash flow} } } \source{ Journal of Business Economics and Statistics data archive: \url{https://amstat.tandfonline.com/loi/ubes20/}. } \description{ A panel of 738 observations from 1983 to 1990 } \details{ \emph{total number of observations}: 5904 \emph{observation}: firms \emph{country}: Spain } \references{ \insertRef{ALON:AREL:99}{plm} } \keyword{datasets} plm/man/Parity.Rd0000644000176200001440000000166114124132276013362 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Parity} \alias{Parity} \title{Purchasing Power Parity and other parity relationships} \format{ A data frame containing : \describe{ \item{country}{country codes: a factor with 17 levels} \item{time}{the quarter index, 1973Q1-1998Q4} \item{ls}{log spot exchange rate vs. USD} \item{lp}{log price level} \item{is}{short term interest rate} \item{il}{long term interest rate} \item{ld}{log price differential vs. USA} \item{uis}{U.S. short term interest rate} \item{uil}{U.S. long term interest rate} } } \source{ \insertRef{COAK:FUER:SMIT:06}{plm} } \description{ A panel of 104 quarterly observations from 1973Q1 to 1998Q4 } \details{ \emph{total number of observations} : 1768 \emph{observation} : country \emph{country} : OECD } \references{ \insertRef{COAK:FUER:SMIT:06}{plm} \insertRef{DRIS:KRAA:98}{plm} } \keyword{datasets} plm/man/make.pconsecutive.Rd0000644000176200001440000001513414124132276015535 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.pconsecutive_pbalanced.R \name{make.pconsecutive} \alias{make.pconsecutive} \alias{make.pconsecutive.data.frame} \alias{make.pconsecutive.pdata.frame} \alias{make.pconsecutive.pseries} \title{Make data consecutive (and, optionally, also balanced)} \usage{ make.pconsecutive(x, ...) \method{make.pconsecutive}{data.frame}(x, balanced = FALSE, index = NULL, ...) \method{make.pconsecutive}{pdata.frame}(x, balanced = FALSE, ...) \method{make.pconsecutive}{pseries}(x, balanced = FALSE, ...) } \arguments{ \item{x}{an object of class \code{pdata.frame}, \code{data.frame}, or \code{pseries},} \item{\dots}{further arguments.} \item{balanced}{logical, indicating whether the data should \emph{additionally} be made balanced (default: FALSE),} \item{index}{only relevant for \code{data.frame} interface; if \code{NULL}, the first two columns of the data.frame are assumed to be the index variables; if not \code{NULL}, both dimensions ('individual', 'time') need to be specified by \code{index} as character of length 2 for data frames, for further details see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ An object of the same class as the input \code{x}, i.e., a pdata.frame, data.frame or a pseries which is made time--consecutive based on the index variables. The returned data are sorted as a stacked time series. } \description{ This function makes the data consecutive for each individual (no "gaps" in time dimension per individual) and, optionally, also balanced } \details{ (p)data.frame and pseries objects are made consecutive, meaning their time periods are made consecutive per individual. For consecutiveness, the time dimension is interpreted to be numeric, and the data are extended to a regularly spaced sequence with distance 1 between the time periods for each individual (for each individual the time dimension become a sequence t, t+1, t+2, \ldots{} where t is an integer). Non--index variables are filled with \code{NA} for the inserted elements (rows for (p)data.frames, vector elements for pseries). With argument \code{balanced = TRUE}, additionally to be made consecutive, the data also can be made a balanced panel/pseries. Note: This means consecutive AND balanced; balancedness does not imply consecutiveness. In the result, each individual will have the same time periods in their time dimension by taking the min and max of the time index variable over all individuals (w/o \code{NA} values) and inserting the missing time periods. Looking at the number of rows of the resulting (pdata.frame) (elements for pseries), this results in nrow(make.pconsecutive, balanced = FALSE) <= nrow(make.pconsecutive, balanced = TRUE). For making the data only balanced, i.e., not demanding consecutiveness at the same time, use \code{\link[=make.pbalanced]{make.pbalanced()}} (see \strong{Examples} for a comparison)). Note: rows of (p)data.frames (elements for pseries) with \code{NA} values in individual or time index are not examined but silently dropped before the data are made consecutive. In this case, it is not clear which individual or time period is meant by the missing value(s). Especially, this means: If there are \code{NA} values in the first/last position of the original time periods for an individual, which usually depicts the beginning and ending of the time series for that individual, the beginning/end of the resulting time series is taken to be the min and max (w/o \code{NA} values) of the original time series for that individual, see also \strong{Examples}. Thus, one might want to check if there are any \code{NA} values in the index variables before applying make.pconsecutive, and especially check for \code{NA} values in the first and last position for each individual in original data and, if so, maybe set those to some meaningful begin/end value for the time series. } \examples{ # take data and make it non-consecutive # by deletion of 2nd row (2nd time period for first individual) data("Grunfeld", package = "plm") nrow(Grunfeld) # 200 rows Grunfeld_missing_period <- Grunfeld[-2, ] is.pconsecutive(Grunfeld_missing_period) # check for consecutiveness make.pconsecutive(Grunfeld_missing_period) # make it consecutiveness # argument balanced: # First, make data non-consecutive and unbalanced # by deletion of 2nd time period (year 1936) for all individuals # and more time periods for first individual only Grunfeld_unbalanced <- Grunfeld[Grunfeld$year != 1936, ] Grunfeld_unbalanced <- Grunfeld_unbalanced[-c(1,4), ] all(is.pconsecutive(Grunfeld_unbalanced)) # FALSE pdim(Grunfeld_unbalanced)$balanced # FALSE g_consec_bal <- make.pconsecutive(Grunfeld_unbalanced, balanced = TRUE) all(is.pconsecutive(g_consec_bal)) # TRUE pdim(g_consec_bal)$balanced # TRUE nrow(g_consec_bal) # 200 rows head(g_consec_bal) # 1st individual: years 1935, 1936, 1939 are NA g_consec <- make.pconsecutive(Grunfeld_unbalanced) # default: balanced = FALSE all(is.pconsecutive(g_consec)) # TRUE pdim(g_consec)$balanced # FALSE nrow(g_consec) # 198 rows head(g_consec) # 1st individual: years 1935, 1936 dropped, 1939 is NA # NA in 1st, 3rd time period (years 1935, 1937) for first individual Grunfeld_NA <- Grunfeld Grunfeld_NA[c(1, 3), "year"] <- NA g_NA <- make.pconsecutive(Grunfeld_NA) head(g_NA) # 1936 is begin for 1st individual, 1937: NA for non-index vars nrow(g_NA) # 199, year 1935 from original data is dropped # pdata.frame interface pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) make.pconsecutive(Grunfeld_missing_period) # pseries interface make.pconsecutive(pGrunfeld_missing_period$inv) # comparison to make.pbalanced (makes the data only balanced, not consecutive) g_bal <- make.pbalanced(Grunfeld_unbalanced) all(is.pconsecutive(g_bal)) # FALSE pdim(g_bal)$balanced # TRUE nrow(g_bal) # 190 rows } \seealso{ \code{\link[=is.pconsecutive]{is.pconsecutive()}} to check if data are consecutive; \code{\link[=make.pbalanced]{make.pbalanced()}} to make data only balanced (not consecutive).\cr \code{\link[=punbalancedness]{punbalancedness()}} for two measures of unbalancedness, \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), \code{\link[=pvar]{pvar()}} to check for individual and time variation of a 'pdata.frame' (and other objects), \code{\link[=lag]{lag()}} for lagged (and leading) values of a 'pseries' object.\cr \code{\link[=pseries]{pseries()}}, \code{\link[=data.frame]{data.frame()}}, \code{\link[=pdata.frame]{pdata.frame()}}. } \author{ Kevin Tappe } \keyword{attribute} plm/man/is.pseries.Rd0000644000176200001440000000260414124132276014174 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_pdata.frame.R \name{is.pseries} \alias{is.pseries} \title{Check if an object is a pseries} \usage{ is.pseries(object) } \arguments{ \item{object}{object to be checked for pseries features} } \value{ A logical indicating whether the object is a pseries (\code{TRUE}) or not (\code{FALSE}). } \description{ This function checks if an object qualifies as a pseries } \details{ A \code{"pseries"} is a wrapper around a "basic class" (numeric, factor, logical, character, or complex). To qualify as a pseries, an object needs to have the following features: \itemize{ \item class contains \code{"pseries"} and there are at least two classes (\code{"pseries"} and the basic class), \item have an appropriate index attribute (defines the panel structure), \item any of \code{is.numeric}, \code{is.factor}, \code{is.logical}, \code{is.character}, \code{is.complex} is \code{TRUE}. } } \examples{ # Create a pdata.frame and extract a series, which becomes a pseries data("EmplUK", package = "plm") Em <- pdata.frame(EmplUK) z <- Em$output class(z) # pseries as indicated by class is.pseries(z) # and confirmed by check # destroy index of pseries and re-check attr(z, "index") <- NA is.pseries(z) # now FALSE } \seealso{ \code{\link[=pseries]{pseries()}} for some computations on pseries and some further links. } \keyword{attribute} plm/man/detect.lindep.Rd0000644000176200001440000001620214154734502014634 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/detect_lin_dep_alias.R \name{detect.lindep} \alias{detect.lindep} \alias{detect.lindep.matrix} \alias{detect.lindep.data.frame} \alias{detect.lindep.plm} \alias{alias.plm} \alias{alias.pdata.frame} \title{Functions to detect linear dependence} \usage{ detect.lindep(object, ...) \method{detect.lindep}{matrix}(object, suppressPrint = FALSE, ...) \method{detect.lindep}{data.frame}(object, suppressPrint = FALSE, ...) \method{detect.lindep}{plm}(object, suppressPrint = FALSE, ...) \method{alias}{plm}(object, ...) \method{alias}{pdata.frame}( object, model = c("pooling", "within", "Between", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways"), ... ) } \arguments{ \item{object}{for \code{detect.lindep}: an object which should be checked for linear dependence (of class \code{"matrix"}, \code{"data.frame"}, or \code{"plm"}); for \code{alias}: either an estimated model of class \code{"plm"} or a \code{"pdata.frame"}. Usually, one wants to input a model matrix here or check an already estimated plm model,} \item{\dots}{further arguments.} \item{suppressPrint}{for \code{detect.lindep} only: logical indicating whether a message shall be printed; defaults to printing the message, i. e., to \code{suppressPrint = FALSE},} \item{model}{(see \code{plm}),} \item{effect}{(see \code{plm}),} } \value{ For \code{detect.lindep}: A named numeric vector containing column numbers of the linear dependent columns in the object after data transformation, if any are present. \code{NULL} if no linear dependent columns are detected. For \code{alias}: return value of \code{\link[stats:alias]{stats::alias.lm()}} run on the (quasi-)demeaned model, i. e., the information outputted applies to the transformed model matrix, not the original data. } \description{ Little helper functions to aid users to detect linear dependent columns in a two-dimensional data structure, especially in a (transformed) model matrix - typically useful in interactive mode during model building phase. } \details{ Linear dependence of columns/variables is (usually) readily avoided when building one's model. However, linear dependence is sometimes not obvious and harder to detect for less experienced applied statisticians. The so called "dummy variable trap" is a common and probably the best--known fallacy of this kind (see e. g. Wooldridge (2016), sec. 7-2.). When building linear models with \code{lm} or \code{plm}'s \code{pooling} model, linear dependence in one's model is easily detected, at times post hoc. However, linear dependence might also occur after some transformations of the data, albeit it is not present in the untransformed data. The within transformation (also called fixed effect transformation) used in the \code{"within"} model can result in such linear dependence and this is harder to come to mind when building a model. See \strong{Examples} for two examples of linear dependent columns after the within transformation: ex. 1) the transformed variables have the opposite sign of one another; ex. 2) the transformed variables are identical. During \code{plm}'s model estimation, linear dependent columns and their corresponding coefficients in the resulting object are silently dropped, while the corresponding model frame and model matrix still contain the affected columns. The plm object contains an element \code{aliased} which indicates any such aliased coefficients by a named logical. Both functions, \code{detect.lindep} and \code{alias}, help to detect linear dependence and accomplish almost the same: \code{detect.lindep} is a stand alone implementation while \code{alias} is a wrapper around \code{\link[stats:alias]{stats::alias.lm()}}, extending the \code{alias} generic to classes \code{"plm"} and \code{"pdata.frame"}. \code{alias} hinges on the availability of the package \CRANpkg{MASS} on the system. Not all arguments of \code{alias.lm} are supported. Output of \code{alias} is more informative as it gives the linear combination of dependent columns (after data transformations, i. e., after (quasi)-demeaning) while \code{detect.lindep} only gives columns involved in the linear dependence in a simple format (thus being more suited for automatic post--processing of the information). } \note{ function \code{detect.lindep} was called \code{detect_lin_dep} initially but renamed for naming consistency later. } \examples{ ### Example 1 ### # prepare the data data("Cigar" , package = "plm") Cigar[ , "fact1"] <- c(0,1) Cigar[ , "fact2"] <- c(1,0) Cigar.p <- pdata.frame(Cigar) # setup a formula and a model frame 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) detect.lindep(model.matrix(mf, model = "pooling")) # linear dependence present in the FE transformed model matrix modmat_FE <- model.matrix(mf, model = "within") detect.lindep(modmat_FE) mod_FE <- plm(form, data = Cigar.p, model = "within") detect.lindep(mod_FE) alias(mod_FE) # => fact1 == -1*fact2 plm(form, data = mf, model = "within")$aliased # "fact2" indicated as aliased # look at the data: after FE transformation fact1 == -1*fact2 head(modmat_FE) all.equal(modmat_FE[ , "fact1"], -1*modmat_FE[ , "fact2"]) ### Example 2 ### # Setup the data: # Assume CEOs stay with the firms of the Grunfeld data # for the firm's entire lifetime and assume some fictional # data about CEO tenure and age in year 1935 (first observation # in the data set) to be at 1 to 10 years and 38 to 55 years, respectively. # => CEO tenure and CEO age increase by same value (+1 year per year). data("Grunfeld", package = "plm") set.seed(42) # add fictional data Grunfeld$CEOtenure <- c(replicate(10, seq(from=s<-sample(1:10, 1), to=s+19, by=1))) Grunfeld$CEOage <- c(replicate(10, seq(from=s<-sample(38:65, 1), to=s+19, by=1))) # look at the data head(Grunfeld, 50) form <- inv ~ value + capital + CEOtenure + CEOage mf <- model.frame(pdata.frame(Grunfeld), form) # no linear dependent columns in original data/pooling model modmat_pool <- model.matrix(mf, model="pooling") detect.lindep(modmat_pool) mod_pool <- plm(form, data = Grunfeld, model = "pooling") alias(mod_pool) # CEOtenure and CEOage are linear dependent after FE transformation # (demeaning per individual) modmat_FE <- model.matrix(mf, model="within") detect.lindep(modmat_FE) mod_FE <- plm(form, data = Grunfeld, model = "within") detect.lindep(mod_FE) alias(mod_FE) # look at the transformed data: after FE transformation CEOtenure == 1*CEOage head(modmat_FE, 50) all.equal(modmat_FE[ , "CEOtenure"], modmat_FE[ , "CEOage"]) } \references{ \insertRef{WOOL:13}{plm} } \seealso{ \code{\link[stats:alias]{stats::alias()}}, \code{\link[stats:model.matrix]{stats::model.matrix()}} and especially \code{plm}'s \code{\link[=model.matrix]{model.matrix()}} for (transformed) model matrices, plm's \code{\link[=model.frame]{model.frame()}}. } \author{ Kevin Tappe } \keyword{array} \keyword{manip} plm/man/pgrangertest.Rd0000644000176200001440000000657214160641752014631 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_granger.R \name{pgrangertest} \alias{pgrangertest} \title{Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012))} \usage{ pgrangertest( formula, data, test = c("Ztilde", "Zbar", "Wbar"), order = 1L, index = NULL ) } \arguments{ \item{formula}{a \code{formula} object to describe the direction of the hypothesized Granger causation,} \item{data}{a \code{pdata.frame} or a \code{data.frame},} \item{test}{a character to request the statistic to be returned, either \code{"Ztilde"} (default),or \code{"Zbar"}, alternatively, set to \code{"Wbar"} for an intermediate statistic (see Details),} \item{order}{integer(s) giving the number of lags to include in the test's auxiliary regressions, the length of order must be either 1 (same lag order for all individuals) or equal to the number of individuals (to specify a lag order per individual),} \item{index}{only relevant if \code{data} is \code{data.frame} and not a \code{pdata.frame}; if \code{NULL}, the first two columns of the data.frame are assumed to be the index variables, for further details see \code{\link[=pdata.frame]{pdata.frame()}}.} } \value{ An object of class \code{c("pgrangertest", "htest")}. Besides the usual elements of a \code{htest} object, it contains the data frame \code{indgranger} which carries the Granger test statistics per individual along the associated p-values, degrees of freedom, and the specified lag order. } \description{ Test for Granger (non-)causality in panel data. } \details{ The panel Granger (non-)causality test is a combination of Granger tests \insertCite{GRAN:69}{plm} performed per individual. The test is developed by \insertCite{DUMI:HURL:12;textual}{plm}, a shorter exposition is given in \insertCite{LOPE:WEBE:17;textual}{plm}. The formula \code{formula} describes the direction of the (panel) Granger causation where \code{y ~ x} means "x (panel) Granger causes y". By setting argument \code{test} to either \code{"Ztilde"} (default) or \code{"Zbar"}, two different statistics can be requested. \code{"Ztilde"} gives the standardised statistic recommended by Dumitrescu/Hurlin (2012) for fixed T samples. If set to \code{"Wbar"}, the intermediate Wbar statistic (average of individual Granger chi-square statistics) is given which is used to derive the other two. The Zbar statistic is not suitable for unbalanced panels. For the Wbar statistic, no p-value is available. The implementation uses \code{\link[lmtest:grangertest]{lmtest::grangertest()}} from package \CRANpkg{lmtest} to perform the individual Granger tests. } \examples{ ## not meaningful, just to demonstrate usage ## H0: 'value' does not Granger cause 'inv' for all invididuals data("Grunfeld", package = "plm") pgrangertest(inv ~ value, data = Grunfeld) pgrangertest(inv ~ value, data = Grunfeld, order = 2L) pgrangertest(inv ~ value, data = Grunfeld, order = 2L, test = "Zbar") # varying lag order (last individual lag order 3, others lag order 2) (pgrt <- pgrangertest(inv ~ value, data = Grunfeld, order = c(rep(2L, 9), 3L))) # chisq statistics per individual pgrt$indgranger } \references{ \insertRef{DUMI:HURL:12}{plm} \insertRef{GRAN:69}{plm} \insertRef{LOPE:WEBE:17}{plm} } \seealso{ \code{\link[lmtest:grangertest]{lmtest::grangertest()}} for the original (non-panel) Granger causality test in \CRANpkg{lmtest}. } \author{ Kevin Tappe } \keyword{htest} plm/man/pvar.Rd0000644000176200001440000000526714154734502013073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_misc.R \name{pvar} \alias{pvar} \alias{pvar.matrix} \alias{pvar.data.frame} \alias{pvar.pdata.frame} \alias{pvar.pseries} \alias{print.pvar} \title{Check for Cross-Sectional and Time Variation} \usage{ pvar(x, ...) \method{pvar}{matrix}(x, index = NULL, ...) \method{pvar}{data.frame}(x, index = NULL, ...) \method{pvar}{pdata.frame}(x, ...) \method{pvar}{pseries}(x, ...) \method{print}{pvar}(x, ...) } \arguments{ \item{x}{a \verb{(p)data.frame} or a \code{matrix},} \item{\dots}{further arguments.} \item{index}{see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ An object of class \code{pvar} containing the following elements: \item{id.variation}{a logical vector with \code{TRUE} values if the variable has individual variation, \code{FALSE} if not,} \item{time.variation}{a logical vector with \code{TRUE} values if the variable has time variation, \code{FALSE} if not,} \item{id.variation_anyNA}{a logical vector with \code{TRUE} values if the variable has at least one individual-time combination with all \code{NA} values in the individual dimension for at least one time period, \code{FALSE} if not,} \item{time.variation_anyNA}{a logical vector with \code{TRUE} values if the variable has at least one individual-time combination with all \code{NA} values in the time dimension for at least one individual, \code{FALSE} if not.} } \description{ This function checks for each variable of a panel if it varies cross-sectionally and over time. } \details{ For (p)data.frame and matrix interface: All-\code{NA} columns are removed prior to calculation of variation due to coercing to pdata.frame first. } \note{ \code{pvar} can be time consuming for ``big'' panels. As a fast alternative \code{\link[collapse:varying]{collapse::varying()}} from package \CRANpkg{collapse} could be used. } \examples{ # Gasoline contains two variables which are individual and time # indexes and are the first two variables data("Gasoline", package = "plm") pvar(Gasoline) # Hedonic is an unbalanced panel, townid is the individual index; # the drop.index argument is passed to pdata.frame data("Hedonic", package = "plm") pvar(Hedonic, "townid", drop.index = TRUE) # same using pdata.frame Hed <- pdata.frame(Hedonic, "townid", drop.index = TRUE) pvar(Hed) # Gasoline with pvar's matrix interface Gasoline_mat <- as.matrix(Gasoline) pvar(Gasoline_mat) pvar(Gasoline_mat, index=c("country", "year")) } \seealso{ \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), } \author{ Yves Croissant } \keyword{attribute} plm/man/plm.fast.Rd0000644000176200001440000001206414155070235013635 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_transformations_collapse.R \name{plm.fast} \alias{plm.fast} \title{Option to Switch On/Off Fast Data Transformations} \description{ A significant speed up can be gained by using fast (panel) data transformation functions from package \code{collapse}. An additional significant speed up for the two-way fixed effects case can be achieved if package \code{fixest} or \code{lfe} is installed (package \code{collapse} needs to be installed for the fast mode in any case). } \details{ By default, this speed up is enabled. Option \code{plm.fast} can be used to enable/disable the speed up. The option is evaluated prior to execution of supported transformations (see below), so \code{option("plm.fast" = TRUE)} enables the speed up while \code{option("plm.fast" = FALSE)} disables the speed up. To have it always switched off, put \code{options("plm.fast" = FALSE)} in your .Rprofile file. See \strong{Examples} for how to use the option and for a benchmarking example. For long, package \code{plm} used base R implementations and R-based code. The package \code{collapse} provides fast data transformation functions written in C/C++, among them some especially suitable for panel data. Having package \code{collapse} installed is a requirement for the speed up, so this package is a hard dependency for package \code{plm}. Availability of packages \code{fixest} and \code{lfe} is checked for once when package plm is attached and the additional speed up for the two-way fixed effect case is enabled automatically (\code{fixest} wins over \code{lfe}), given one of the packages is detected and \code{options("plm.fast" = TRUE)} (default) is set. If so, the packages' fast algorithms to partial out fixed effects are #' used (\code{fixest::demean} (via \code{collapse::fhdwithin}), \code{lfe::demeanlist}). Both packages are 'Suggests' dependencies. Users might experience neglectable numerical differences between enabled and disabled fast mode and base R implementation, depending on the platform and the additional packages installed. Currently, these basic functions benefit from the speed-up, used as building blocks in most model estimation functions, e.g., in \code{plm} (more functions are under investigation): \itemize{ \item between, \item Between, \item Sum, \item Within, \item pseriesfy. } } \examples{ \dontrun{ ### A benchmark of plm without and with speed-up library("plm") library("collapse") library("microbenchmark") rm(list = ls()) data("wlddev", package = "collapse") form <- LIFEEX ~ PCGDP + GINI # produce big data set (taken from collapse's vignette) wlddevsmall <- get_vars(wlddev, c("iso3c","year","OECD","PCGDP","LIFEEX","GINI","ODA")) wlddevsmall$iso3c <- as.character(wlddevsmall$iso3c) data <- replicate(100, wlddevsmall, simplify = FALSE) rm(wlddevsmall) uniquify <- function(x, i) { x$iso3c <- paste0(x$iso3c, i) x } data <- unlist2d(Map(uniquify, data, as.list(1:100)), idcols = FALSE) data <- pdata.frame(data, index = c("iso3c", "year")) pdim(data) # Balanced Panel: n = 21600, T = 59, N = 1274400 // but many NAs # data <- na.omit(data) # pdim(data) # Unbalanced Panel: n = 13300, T = 1-31, N = 93900 times <- 1 # no. of repetitions for benchmark - this takes quite long! onewayFE <- microbenchmark( {options("plm.fast" = FALSE); plm(form, data = data, model = "within")}, {options("plm.fast" = TRUE); plm(form, data = data, model = "within")}, times = times, unit = "relative") summary(onewayFE) ## two-ways FE benchmark requires pkg fixest and lfe ## (End-users shall only set option plm.fast. Option plm.fast.pkg.FE.tw shall ## _not_ be set by the end-user, it is determined automatically when pkg plm ## is attached; however, it needs to be set explicitly in this example for the ## benchmark.) if(requireNamespace("fixest", quietly = TRUE) && requireNamespace("lfe", quietly = TRUE)) { twowayFE <- microbenchmark( {options("plm.fast" = FALSE); plm(form, data = data, model = "within", effect = "twoways")}, {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "collapse"); plm(form, data = data, model = "within", effect = "twoways")}, {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "fixest"); plm(form, data = data, model = "within", effect = "twoways")}, {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "lfe"); plm(form, data = data, model = "within", effect = "twoways")}, times = times, unit = "relative") summary(twowayFE) } onewayRE <- microbenchmark( {options("plm.fast" = FALSE); plm(form, data = data, model = "random")}, {options("plm.fast" = TRUE); plm(form, data = data, model = "random")}, times = times, unit = "relative") summary(onewayRE) twowayRE <- microbenchmark( {options("plm.fast" = FALSE); plm(form, data = data, model = "random", effect = "twoways")}, {options("plm.fast" = TRUE); plm(form, data = data, model = "random", effect = "twoways")}, times = times, unit = "relative") summary(twowayRE) } } \keyword{manip} \keyword{sysdata} plm/man/fixef.plm.Rd0000644000176200001440000001462514124132276014006 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_ranfixef.R \name{fixef.plm} \alias{fixef.plm} \alias{fixef} \alias{print.fixef} \alias{summary.fixef} \alias{print.summary.fixef} \alias{fixef.pggls} \title{Extract the Fixed Effects} \usage{ \method{fixef}{plm}( object, effect = NULL, type = c("level", "dfirst", "dmean"), vcov = NULL, ... ) \method{print}{fixef}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{summary}{fixef}(object, ...) \method{print}{summary.fixef}( x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ... ) \method{fixef}{pggls}( object, effect = NULL, type = c("level", "dfirst", "dmean"), vcov = NULL, ... ) } \arguments{ \item{effect}{one of \code{"individual"}, \code{"time"}, or \code{"twoways"}, only relevant in case of two--ways effects models (where it defaults to \code{"individual"}),} \item{type}{one of \code{"level"}, \code{"dfirst"}, or \code{"dmean"},} \item{vcov}{a variance--covariance matrix furnished by the user or a function to calculate one (see \strong{Examples}),} \item{\dots}{further arguments.} \item{x, object}{an object of class \code{"plm"}, an object of class \code{"fixef"} for the \code{print} and the \code{summary} method,} \item{digits}{digits,} \item{width}{the maximum length of the lines in the print output,} } \value{ For function \code{fixef}, an object of class \code{c("fixef", "numeric")} is returned: It is a numeric vector containing the fixed effects with attribute \code{se} which contains the standard errors. There are two further attributes: attribute \code{type} contains the chosen type (the value of argument \code{type} as a character); attribute \code{df.residual} holds the residual degrees of freedom (integer) from the fixed effects model (plm object) on which \code{fixef} was run. For the two-way unbalanced case, only attribute \code{type} is added. For function \code{summary.fixef}, an object of class \code{c("summary.fixef", "matrix")} is returned: It is a matrix with four columns in this order: the estimated fixed effects, their standard errors and associated t--values and p--values. For the two-ways unbalanced case, the matrix contains only the estimates. The type of the fixed effects and the standard errors in the summary.fixef object correspond to was requested in the \code{fixef} function by arguments \code{type} and \code{vcov}, respectively. } \description{ Function to extract the fixed effects from a \code{plm} object and associated summary method. } \details{ Function \code{fixef} calculates the fixed effects and returns an object of class \code{c("fixef", "numeric")}. By setting the \code{type} argument, the fixed effects may be returned in levels (\code{"level"}), as deviations from the first value of the index (\code{"dfirst"}), or as deviations from the overall mean (\code{"dmean"}). If the argument \code{vcov} was specified, the standard errors (stored as attribute "se" in the return value) are the respective robust standard errors. For two-way fixed-effect models, argument \code{effect} controls which of the fixed effects are to be extracted: \code{"individual"}, \code{"time"}, or the sum of individual and time effects (\code{"twoways"}). NB: See \strong{Examples} for how the sum of effects can be split in an individual and a time component. For one-way models, the effects of the model are extracted and the argument \code{effect} is disrespected. The associated \code{summary} method returns an extended object of class \code{c("summary.fixef", "matrix")} with more information (see sections \strong{Value} and \strong{Examples}). References with formulae (except for the two-ways unbalanced case) are, e.g., \insertCite{GREE:12;textual}{plm}, Ch. 11.4.4, p. 364, formulae (11-25); \insertCite{WOOL:10;textual}{plm}, Ch. 10.5.3, pp. 308-309, formula (10.58). } \examples{ data("Grunfeld", package = "plm") gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") fixef(gi) summary(fixef(gi)) summary(fixef(gi))[ , c("Estimate", "Pr(>|t|)")] # only estimates and p-values # relationship of type = "dmean" and "level" and overall intercept fx_level <- fixef(gi, type = "level") fx_dmean <- fixef(gi, type = "dmean") overallint <- within_intercept(gi) all.equal(overallint + fx_dmean, fx_level, check.attributes = FALSE) # TRUE # extract time effects in a twoways effects model gi_tw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") fixef(gi_tw, effect = "time") # with supplied variance-covariance matrix as matrix, function, # and function with additional arguments fx_level_robust1 <- fixef(gi, vcov = vcovHC(gi)) fx_level_robust2 <- fixef(gi, vcov = vcovHC) fx_level_robust3 <- fixef(gi, vcov = function(x) vcovHC(x, method = "white2")) summary(fx_level_robust1) # gives fixed effects, robust SEs, t- and p-values # calc. fitted values of oneway within model: fixefs <- fixef(gi)[index(gi, which = "id")] fitted_by_hand <- fixefs + gi$coefficients["value"] * gi$model$value + gi$coefficients["capital"] * gi$model$capital # calc. fittes values of twoway unbalanced within model via effects: gtw_u <- plm(inv ~ value + capital, data = Grunfeld[-200, ], effect = "twoways") yhat <- as.numeric(gtw_u$model[ , 1] - gtw_u$residuals) # reference pred_beta <- as.numeric(tcrossprod(coef(gtw_u), as.matrix(gtw_u$model[ , -1]))) pred_effs <- as.numeric(fixef(gtw_u, "twoways")) # sum of ind and time effects all.equal(pred_effs + pred_beta, yhat) # TRUE # Splits of summed up individual and time effects: # use one "level" and one "dfirst" ii <- index(gtw_u)[[1L]]; it <- index(gtw_u)[[2L]] eff_id_dfirst <- c(0, as.numeric(fixef(gtw_u, "individual", "dfirst")))[ii] eff_ti_dfirst <- c(0, as.numeric(fixef(gtw_u, "time", "dfirst")))[it] eff_id_level <- as.numeric(fixef(gtw_u, "individual"))[ii] eff_ti_level <- as.numeric(fixef(gtw_u, "time"))[it] all.equal(pred_effs, eff_id_level + eff_ti_dfirst) # TRUE all.equal(pred_effs, eff_id_dfirst + eff_ti_level) # TRUE } \references{ \insertAllCited{} } \seealso{ \code{\link[=within_intercept]{within_intercept()}} for the overall intercept of fixed effect models along its standard error, \code{\link[=plm]{plm()}} for plm objects and within models (= fixed effects models) in general. See \code{\link[=ranef]{ranef()}} to extract the random effects from a random effects model. } \author{ Yves Croissant } \keyword{regression} plm/man/Grunfeld.Rd0000644000176200001440000000422314124132276013655 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Grunfeld} \alias{Grunfeld} \title{Grunfeld's Investment Data} \format{ A data frame containing : \describe{ \item{firm}{observation} \item{year}{date} \item{inv}{gross Investment} \item{value}{value of the firm} \item{capital}{stock of plant and equipment} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} \url{https://www.wiley.com/legacy/wileychi/baltagi/supp/Grunfeld.fil} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ A balanced panel of 10 observational units (firms) from 1935 to 1954 } \details{ \emph{total number of observations} : 200 \emph{observation} : production units \emph{country} : United States } \note{ The Grunfeld data as provided in package \code{plm} is the same data as used in Baltagi (2001), see \strong{Examples} below. NB:\cr Various versions of the Grunfeld data circulate online. Also, various text books (and also varying among editions) and papers use different subsets of the original Grunfeld data, some of which contain errors in a few data points compared to the original data used by Grunfeld (1958) in his PhD thesis. See Kleiber/Zeileis (2010) and its accompanying website for a comparison of various Grunfeld data sets in use. } \examples{ \dontrun{ # Compare plm's Grunfeld data to Baltagi's (2001) Grunfeld data: data("Grunfeld", package="plm") Grunfeld_baltagi2001 <- read.csv("http://www.wiley.com/legacy/wileychi/ baltagi/supp/Grunfeld.fil", sep="", header = FALSE) library(compare) compare::compare(Grunfeld, Grunfeld_baltagi2001, allowAll = T) # same data set } } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{GRUN:58}{plm} \insertRef{KLEI:ZEIL:10}{plm} website accompanying the paper with various variants of the Grunfeld data: \url{https://www.zeileis.org/grunfeld/}. } \seealso{ For the complete Grunfeld data (11 firms), see \link[AER:Grunfeld]{AER::Grunfeld}, in the \code{AER} package. } \keyword{datasets} plm/man/pwtest.Rd0000644000176200001440000000472514124132276013444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pwtest} \alias{pwtest} \alias{pwtest.formula} \alias{pwtest.panelmodel} \title{Wooldridge's Test for Unobserved Effects in Panel Models} \usage{ pwtest(x, ...) \method{pwtest}{formula}(x, data, effect = c("individual", "time"), ...) \method{pwtest}{panelmodel}(x, effect = c("individual", "time"), ...) } \arguments{ \item{x}{an object of class \code{"formula"}, or an estimated model of class \code{panelmodel},} \item{\dots}{further arguments passed to \code{plm}.} \item{data}{a \code{data.frame},} \item{effect}{the effect to be tested for, one of \code{"individual"} (default) or \code{"time"},} } \value{ An object of class \code{"htest"}. } \description{ Semi-parametric test for the presence of (individual or time) unobserved effects in panel models. } \details{ This semi-parametric test checks the null hypothesis of zero correlation between errors of the same group. Therefore, it has power both against individual effects and, more generally, any kind of serial correlation. The test relies on large-N asymptotics. It is valid under error heteroskedasticity and departures from normality. The above is valid if \code{effect="individual"}, which is the most likely usage. If \code{effect="time"}, symmetrically, the test relies on large-T asymptotics and has power against time effects and, more generally, against cross-sectional correlation. If the panelmodel interface is used, the inputted model must be a pooling model. } \examples{ data("Produc", package = "plm") ## formula interface pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time") ## panelmodel interface # first, estimate a pooling model, than compute test statistics form <- formula(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp) pool_prodc <- plm(form, data = Produc, model = "pooling") pwtest(pool_prodc) # == effect="individual" pwtest(pool_prodc, effect="time") } \references{ \insertRef{WOOL:02}{plm} \insertRef{WOOL:10}{plm} } \seealso{ \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbgtest]{pbgtest()}}, \code{\link[=pdwtest]{pdwtest()}}, \code{\link[=pbsytest]{pbsytest()}}, \code{\link[=pwartest]{pwartest()}}, \code{\link[=pwfdtest]{pwfdtest()}} for tests for serial correlation in panel models. \code{\link[=plmtest]{plmtest()}} for tests for random effects. } \author{ Giovanni Millo } \keyword{htest} plm/man/pseries.Rd0000644000176200001440000001363414155651602013572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_transformations.R \name{pseries} \alias{pseries} \alias{print.pseries} \alias{as.matrix.pseries} \alias{plot.pseries} \alias{summary.pseries} \alias{plot.summary.pseries} \alias{print.summary.pseries} \alias{Sum} \alias{Sum.default} \alias{Sum.pseries} \alias{Sum.matrix} \alias{Between} \alias{Between.default} \alias{Between.pseries} \alias{Between.matrix} \alias{between} \alias{between.default} \alias{between.pseries} \alias{between.matrix} \alias{Within} \alias{Within.default} \alias{Within.pseries} \alias{Within.matrix} \title{panel series} \usage{ \method{print}{pseries}(x, ...) \method{as.matrix}{pseries}(x, idbyrow = TRUE, ...) \method{plot}{pseries}( x, plot = c("lattice", "superposed"), scale = FALSE, transparency = TRUE, col = "blue", lwd = 1, ... ) \method{summary}{pseries}(object, ...) \method{plot}{summary.pseries}(x, ...) \method{print}{summary.pseries}(x, ...) Sum(x, ...) \method{Sum}{default}(x, effect, ...) \method{Sum}{pseries}(x, effect = c("individual", "time", "group"), ...) \method{Sum}{matrix}(x, effect, ...) Between(x, ...) \method{Between}{default}(x, effect, ...) \method{Between}{pseries}(x, effect = c("individual", "time", "group"), ...) \method{Between}{matrix}(x, effect, ...) between(x, ...) \method{between}{default}(x, effect, ...) \method{between}{pseries}(x, effect = c("individual", "time", "group"), ...) \method{between}{matrix}(x, effect, ...) Within(x, ...) \method{Within}{default}(x, effect, ...) \method{Within}{pseries}(x, effect = c("individual", "time", "group", "twoways"), ...) \method{Within}{matrix}(x, effect, ...) } \arguments{ \item{x, object}{a \code{pseries} or a matrix; or a \code{summary.pseries} object,} \item{\dots}{further arguments, e. g., \code{na.rm = TRUE} for transformation functions like \code{beetween}, see \strong{Details} and \strong{Examples}.} \item{idbyrow}{if \code{TRUE} in the \code{as.matrix} method, the lines of the matrix are the individuals,} \item{plot, scale, transparency, col, lwd}{plot arguments,} \item{effect}{for the pseries methods: character string indicating the \code{"individual"}, \code{"time"}, or \code{"group"} effect, for \code{Within} \code{"twoways"} additionally; for non-pseries methods, \code{effect} is a factor specifying the dimension (\code{"twoways"} is not possible),} } \value{ All these functions return an object of class \code{pseries} or a matrix, except:\cr \code{between}, which returns a numeric vector or a matrix; \code{as.matrix}, which returns a matrix. } \description{ A class for panel series for which several useful computations and data transformations are available. } \details{ The functions \code{between}, \code{Between}, \code{Within}, and \code{Sum} perform specific data transformations, i. e., the between, within, and sum transformation, respectively. \code{between} returns a vector/matrix containing the individual means (over time) with the length of the vector equal to the number of individuals (if \code{effect = "individual"} (default); if \code{effect = "time"}, it returns the time means (over individuals)). \code{Between} duplicates the values and returns a vector/matrix which length/number of rows is the number of total observations. \code{Within} returns a vector/matrix containing the values in deviation from the individual means (if \code{effect = "individual"}, from time means if \code{effect = "time"}), the so called demeaned data. \code{Sum} returns a vector/matrix with sum per individual (over time) or the sum per time period (over individuals) with \code{effect = "individual"} or \code{effect = "time"}, respectively, and has length/ number of rows of the total observations (like \code{Between}). For \code{between}, \code{Between}, \code{Within}, and \code{Sum} in presence of NA values it can be useful to supply \code{na.rm = TRUE} as an additional argument to keep as many observations as possible in the resulting transformation. na.rm is passed on to the mean()/sum() function used by these transformations (i.e., it does not remove NAs prior to any processing!), see also \strong{Examples}. } \examples{ # First, create a pdata.frame data("EmplUK", package = "plm") Em <- pdata.frame(EmplUK) # Then extract a series, which becomes additionally a pseries z <- Em$output class(z) # obtain the matrix representation as.matrix(z) # compute the between and within transformations between(z) Within(z) # Between and Sum replicate the values for each time observation Between(z) Sum(z) # between, Between, Within, and Sum transformations on other dimension between(z, effect = "time") Between(z, effect = "time") Within(z, effect = "time") Sum(z, effect = "time") # NA treatment for between, Between, Within, and Sum z2 <- z z2[length(z2)] <- NA # set last value to NA between(z2, na.rm = TRUE) # non-NA value for last individual Between(z2, na.rm = TRUE) # only the NA observation is lost Within(z2, na.rm = TRUE) # only the NA observation is lost Sum(z2, na.rm = TRUE) # only the NA observation is lost sum(is.na(Between(z2))) # 9 observations lost due to one NA value sum(is.na(Between(z2, na.rm = TRUE))) # only the NA observation is lost sum(is.na(Within(z2))) # 9 observations lost due to one NA value sum(is.na(Within(z2, na.rm = TRUE))) # only the NA observation is lost sum(is.na(Sum(z2))) # 9 observations lost due to one NA value sum(is.na(Sum(z2, na.rm = TRUE))) # only the NA observation is lost } \seealso{ \code{\link[=is.pseries]{is.pseries()}} to check if an object is a pseries. For more functions on class 'pseries' see \code{\link[=lag]{lag()}}, \code{\link[=lead]{lead()}}, \code{\link[=diff]{diff()}} for lagging values, leading values (negative lags) and differencing. } \author{ Yves Croissant } \keyword{classes} plm/man/pcdtest.Rd0000644000176200001440000001474214124132276013564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_cd.R \name{pcdtest} \alias{pcdtest} \alias{pcdtest.formula} \alias{pcdtest.panelmodel} \alias{pcdtest.pseries} \title{Tests of cross-section dependence for panel models} \usage{ pcdtest(x, ...) \method{pcdtest}{formula}( x, data, index = NULL, model = NULL, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ... ) \method{pcdtest}{panelmodel}( x, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ... ) \method{pcdtest}{pseries}( x, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ... ) } \arguments{ \item{x}{an object of class \code{formula}, \code{panelmodel}, or \code{pseries} (depending on the respective interface) describing the model to be tested,} \item{\dots}{further arguments to be passed on for model estimation to \code{plm}, such as \code{effect} or \code{random.method}.} \item{data}{a \code{data.frame},} \item{index}{an optional numerical index, if \code{NULL}, the first two columns of the data.frame provided in argument \code{data} are assumed to be the index variables; for further details see \code{\link[=pdata.frame]{pdata.frame()}},} \item{model}{an optional character string indicating which type of model to estimate; if left to \code{NULL}, the original heterogeneous specification of Pesaran is used,} \item{test}{the type of test statistic to be returned. One of \itemize{ \item \code{"cd"} for Pesaran's CD statistic, \item \code{"lm"} for Breusch and Pagan's original LM statistic, \item \code{"sclm"} for the scaled version of Breusch and Pagan's LM statistic, \item \code{"bcsclm"} for the bias-corrected scaled version of Breusch and Pagan's LM statistic, \item \code{"rho"} for the average correlation coefficient, \item \code{"absrho"} for the average absolute correlation coefficient,}} \item{w}{either \code{NULL} (default) for the global tests or -- for the local versions of the statistics -- a \verb{n x n} \code{matrix} describing proximity between individuals, with \eqn{w_ij = a} where \eqn{a} is any number such that \code{as.logical(a)==TRUE}, if \eqn{i,j} are neighbours, \eqn{0} or any number \eqn{b} such that \code{as.logical(b)==FALSE} elsewhere. Only the lower triangular part (without diagonal) of \code{w} after coercing by \code{as.logical()} is evaluated for neighbouring information (but \code{w} can be symmetric). See also \strong{Details} and \strong{Examples},} } \value{ An object of class \code{"htest"}. } \description{ Pesaran's CD or Breusch--Pagan's LM (local or global) tests for cross sectional dependence in panel models } \details{ These tests are originally meant to use the residuals of separate estimation of one time--series regression for each cross-sectional unit in order to check for cross--sectional dependence (\code{model = NULL}). If a different model specification (\code{model = "within"}, \code{"random"}, \ldots{}) is assumed consistent, one can resort to its residuals for testing (which is common, e.g., when the time dimension's length is insufficient for estimating the heterogeneous model). If the time dimension is insufficient and \code{model = NULL}, the function defaults to estimation of a \code{within} model and issues a warning. The main argument of this function may be either a model of class \code{panelmodel} or a \code{formula} and \verb{data frame}; in the second case, unless \code{model} is set to \code{NULL}, all usual parameters relative to the estimation of a \code{plm} model may be passed on. The test is compatible with any consistent \code{panelmodel} for the data at hand, with any specification of \code{effect} (except for \code{test = "bcsclm"} which requires a within model with either individual or two-ways effect). E.g., specifying \code{effect = "time"} or \code{effect = "twoways"} allows to test for residual cross-sectional dependence after the introduction of time fixed effects to account for common shocks. A \strong{local} version of either test can be computed by supplying a proximity matrix (elements coercible to \code{logical}) with argument \code{w} which provides information on whether any pair of individuals are neighbours or not. If \code{w} is supplied, only neighbouring pairs will be used in computing the test; else, \code{w} will default to \code{NULL} and all observations will be used. The matrix need not be binary, so commonly used "row--standardized" matrices can be employed as well. \code{nb} objects from \CRANpkg{spdep} must instead be transformed into matrices by \CRANpkg{spdep}'s function \code{nb2mat} before using. The methods implemented are suitable also for unbalanced panels. Pesaran's CD test (\code{test="cd"}), Breusch and Pagan's LM test (\code{test="lm"}), and its scaled version (\code{test="sclm"}) are all described in \insertCite{PESA:04;textual}{plm} (and complemented by Pesaran (2005)). The bias-corrected scaled test (\code{test="bcsclm"}) is due to \insertCite{BALT:FENG:KAO:12}{plm} and only valid for within models including the individual effect (it's unbalanced version uses max(Tij) for T) in the bias-correction term). \insertCite{BREU:PAGA:80;textual}{plm} is the original source for the LM test. The test on a \code{pseries} is the same as a test on a pooled regression model of that variable on a constant, i.e., \code{pcdtest(some_pseries)} is equivalent to \verb{pcdtest(plm(some_var ~ 1, data = some_pdata.frame, model = "pooling")} and also equivalent to \code{pcdtest(some_var ~ 1, data = some_data)}, where \code{some_var} is the variable name in the data which corresponds to \code{some_pseries}. } \examples{ data("Grunfeld", package = "plm") ## test on heterogeneous model (separate time series regressions) pcdtest(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) ## test on two-way fixed effects homogeneous model pcdtest(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways", index = c("firm", "year")) ## test on panelmodel object g <- plm(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) pcdtest(g) ## scaled LM test pcdtest(g, test = "sclm") ## test on pseries pGrunfeld <- pdata.frame(Grunfeld) pcdtest(pGrunfeld$value) ## local test ## define neighbours for individual 2: 1, 3, 4, 5 in lower triangular matrix w <- matrix(0, ncol= 10, nrow=10) w[2,1] <- w[3,2] <- w[4,2] <- w[5,2] <- 1 pcdtest(g, w = w) } \references{ \insertRef{BALT:FENG:KAO:12}{plm} \insertRef{BREU:PAGA:80}{plm} \insertRef{PESA:04}{plm} \insertRef{PESA:15}{plm} } \keyword{htest} plm/man/Wages.Rd0000644000176200001440000000312014124132276013150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{Wages} \alias{Wages} \title{Panel Data of Individual Wages} \format{ A data frame containing: \describe{ \item{exp}{years of full-time work experience.} \item{wks}{weeks worked.} \item{bluecol}{blue collar?} \item{ind}{works in a manufacturing industry?} \item{south}{resides in the south?} \item{smsa}{resides in a standard metropolitan statistical area?} \item{married}{married?} \item{sex}{a factor with levels \code{"male"} and \code{"female"}} \item{union}{individual's wage set by a union contract?} \item{ed}{years of education.} \item{black}{is the individual black?} \item{lwage}{logarithm of wage.} } } \source{ Online complements to Baltagi (2001): \url{https://www.wiley.com/legacy/wileychi/baltagi/} Online complements to Baltagi (2013): \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} } \description{ A panel of 595 individuals from 1976 to 1982, taken from the Panel Study of Income Dynamics (PSID).\cr\cr The data are organized as a stacked time series/balanced panel, see \strong{Examples} on how to convert to a \code{pdata.frame}. } \details{ \emph{total number of observations} : 4165 \emph{observation} : individuals \emph{country} : United States } \examples{ # data set 'Wages' is organized as a stacked time series/balanced panel data("Wages", package = "plm") Wag <- pdata.frame(Wages, index=595) } \references{ \insertRef{BALT:01}{plm} \insertRef{BALT:13}{plm} \insertRef{CORN:RUPE:88}{plm} } \keyword{datasets} plm/man/cipstest.Rd0000644000176200001440000000407014161714674013756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_cips.R \name{cipstest} \alias{cipstest} \title{Cross-sectionally Augmented IPS Test for Unit Roots in Panel Models} \usage{ cipstest( x, lags = 2, type = c("trend", "drift", "none"), model = c("cmg", "mg", "dmg"), truncated = FALSE, ... ) } \arguments{ \item{x}{an object of class \code{"pseries"},} \item{lags}{integer, lag order for Dickey-Fuller augmentation,} \item{type}{one of \code{"trend"} (default), \code{"drift"}, \code{"none"},} \item{model}{one of \code{"cmg"} (default), \code{"mg"}, \code{"dmg"},} \item{truncated}{logical, specifying whether to calculate the truncated version of the test (default: \code{FALSE}),} \item{\dots}{further arguments passed to \code{critvals.cips} (non-exported function).} } \value{ An object of class \code{"htest"}. } \description{ Cross-sectionally augmented Im, Pesaran and Shin (IPS) test for unit roots in panel models. } \details{ Pesaran's \insertCite{pes07}{plm} cross-sectionally augmented version of the IPS unit root test \insertCite{IM:PESAR:SHIN:03}{plm} (H0: \code{pseries} has a unit root) is a so-called second-generation panel unit root test: it is in fact robust against cross-sectional dependence, provided that the default \code{model="cmg"} is calculated. Else one can obtain the standard (\code{model="mg"}) or cross-sectionally demeaned (\code{model="dmg"}) versions of the IPS test. Argument \code{type} controls how the test is executed: \itemize{ \item \code{"none"}: no intercept, no trend (Case I in \insertCite{pes07}{plm}), \item \code{"drift"}: with intercept, no trend (Case II), \item \code{"trend"} (default): with intercept, with trend (Case III). } } \examples{ data("Produc", package = "plm") Produc <- pdata.frame(Produc, index=c("state", "year")) ## check whether the gross state product (gsp) is trend-stationary cipstest(Produc$gsp, type = "trend") } \references{ \insertAllCited{} } \seealso{ \code{\link[=purtest]{purtest()}}, \code{\link[=phansitest]{phansitest()}} } \author{ Giovanni Millo } \keyword{htest} plm/man/pbsytest.Rd0000644000176200001440000001324614124132276013771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pbsytest} \alias{pbsytest} \alias{pbsytest.formula} \alias{pbsytest.panelmodel} \title{Bera, Sosa-Escudero and Yoon Locally--Robust Lagrange Multiplier Tests for Panel Models and Joint Test by Baltagi and Li} \usage{ pbsytest(x, ...) \method{pbsytest}{formula}( x, data, ..., test = c("ar", "re", "j"), re.normal = if (test == "re") TRUE else NULL ) \method{pbsytest}{panelmodel}( x, test = c("ar", "re", "j"), re.normal = if (test == "re") TRUE else NULL, ... ) } \arguments{ \item{x}{an object of class \code{formula} or of class \code{panelmodel},} \item{\dots}{further arguments.} \item{data}{a \code{data.frame},} \item{test}{a character string indicating which test to perform: first--order serial correlation (\code{"ar"}), random effects (\code{"re"}) or joint test for either of them (\code{"j"}),} \item{re.normal}{logical, only relevant for \code{test = "re"}: \code{TRUE} (default) computes the one-sided \code{"re"} test, \code{FALSE} the two-sided test (see also Details); not relevant for other values of \code{test} and, thus, should be \code{NULL},} } \value{ An object of class \code{"htest"}. } \description{ Test for residual serial correlation (or individual random effects) locally robust vs. individual random effects (serial correlation) for panel models and joint test of serial correlation and the random effect specification by Baltagi and Li. } \details{ These Lagrange multiplier tests are robust vs. local misspecification of the alternative hypothesis, i.e., they test the null of serially uncorrelated residuals against AR(1) residuals in a pooling model, allowing for local departures from the assumption of no random effects; or they test the null of no random effects allowing for local departures from the assumption of no serial correlation in residuals. They use only the residuals of the pooled OLS model and correct for local misspecification as outlined in \insertCite{BERA:SOSA:YOON:01;textual}{plm}. For \code{test = "re"}, the default (\code{re.normal = TRUE}) is to compute a one-sided test which is expected to lead to a more powerful test (asymptotically N(0,1) distributed). Setting \code{re.normal = FALSE} gives the two-sided test (asymptotically chi-squared(2) distributed). Argument \code{re.normal} is irrelevant for all other values of \code{test}. The joint test of serial correlation and the random effect specification (\code{test = "j"}) is due to \insertCite{BALT:LI:91;textual}{plm} (also mentioned in \insertCite{BALT:LI:95;textual}{plm}, pp. 135--136) and is added for convenience under this same function. The unbalanced version of all tests are derived in \insertCite{SOSA:BERA:08;textual}{plm}. The functions implemented are suitable for balanced as well as unbalanced panel data sets. A concise treatment of the statistics for only balanced panels is given in \insertCite{BALT:13;textual}{plm}, p. 108. Here is an overview of how the various values of the \code{test} argument relate to the literature: \itemize{ \item \code{test = "ar"}: \itemize{ \item \eqn{RS*_{\rho}} in Bera et al. (2001), p. 9 (balanced) \item \eqn{LM*_{\rho}} in Baltagi (2013), p. 108 (balanced) \item \eqn{RS*_{\lambda}} in Sosa-Escudero/Bera (2008), p. 73 (unbalanced) } \item \verb{test = "re", re.normal = TRUE} (default) (one-sided test, asymptotically N(0,1) distributed): \itemize{ \item \eqn{RSO*_{\mu}} in Bera et al. (2001), p. 11 (balanced) \item \eqn{RSO*_{\mu}} in Sosa-Escudero/Bera (2008), p. 75 (unbalanced) } \item \verb{test = "re", re.normal = FALSE} (two-sided test, asymptotically chi-squared(2) distributed): \itemize{ \item \eqn{RS*_{\mu}} in Bera et al. (2001), p. 7 (balanced) \item \eqn{LM*_{\mu}} in Baltagi (2013), p. 108 (balanced) \item \eqn{RS*_{\mu}} in Sosa-Escudero/Bera (2008), p. 73 (unbalanced) } \item \code{test = "j"}: \itemize{ \item \eqn{RS_{\mu\rho}} in Bera et al. (2001), p. 10 (balanced) \item \eqn{LM} in Baltagi/Li (2001), p. 279 (balanced) \item \eqn{LM_{1}} in Baltagi and Li (1995), pp. 135--136 (balanced) \item \eqn{LM1} in Baltagi (2013), p. 108 (balanced) \item \eqn{RS_{\lambda\rho}} in Sosa-Escudero/Bera (2008), p. 74 (unbalanced) } } } \examples{ ## Bera et. al (2001), p. 13, table 1 use ## a subset of the original Grunfeld ## data which contains three errors -> construct this subset: data("Grunfeld", package = "plm") Grunsubset <- rbind(Grunfeld[1:80, ], Grunfeld[141:160, ]) Grunsubset[Grunsubset$firm == 2 & Grunsubset$year \%in\% c(1940, 1952), ][["inv"]] <- c(261.6, 645.2) Grunsubset[Grunsubset$firm == 2 & Grunsubset$year == 1946, ][["capital"]] <- 232.6 ## default is AR testing (formula interface) pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year")) pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), test = "re") pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), test = "re", re.normal = FALSE) pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), test = "j") ## plm interface mod <- plm(inv ~ value + capital, data = Grunsubset, model = "pooling") pbsytest(mod) } \references{ \insertRef{BERA:SOSA:YOON:01}{plm} \insertRef{BALT:13}{plm} \insertRef{BALT:LI:91}{plm} \insertRef{BALT:LI:95}{plm} \insertRef{SOSA:BERA:08}{plm} } \seealso{ \code{\link[=plmtest]{plmtest()}} for individual and/or time random effects tests based on a correctly specified model; \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbgtest]{pbgtest()}} and \code{\link[=pdwtest]{pdwtest()}} for serial correlation tests in random effects models. } \author{ Giovanni Millo (initial implementation) & Kevin Tappe (extension to unbalanced panels) } \keyword{htest} plm/man/within_intercept.Rd0000644000176200001440000001105014154734502015465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_ranfixef.R \name{within_intercept} \alias{within_intercept} \alias{within_intercept.plm} \title{Overall Intercept for Within Models Along its Standard Error} \usage{ within_intercept(object, ...) \method{within_intercept}{plm}(object, vcov = NULL, return.model = FALSE, ...) } \arguments{ \item{object}{object of class \code{plm} which must be a within model (fixed effects model),} \item{\dots}{further arguments (currently none).} \item{vcov}{if not \code{NULL} (default), a function to calculate a user defined variance--covariance matrix (function for robust vcov), only used if \code{return.model = FALSE},} \item{return.model}{a logical to indicate whether only the overall intercept (\code{FALSE} is default) or a full model object (\code{TRUE}) is to be returned,} } \value{ Depending on argument \code{return.model}: If \code{FALSE} (default), a named \code{numeric} of length one: The overall intercept for the estimated within model along attribute "se" which contains the standard error for the intercept. If \code{return.model = TRUE}, the full model object, a within model with the overall intercept (NB: the model identifies itself as a pooling model, e.g., in summary()). } \description{ This function gives an overall intercept for within models and its accompanying standard error or an within model with the overall intercept } \details{ The (somewhat artificial) intercept for within models (fixed effects models) was made popular by Stata of StataCorp \insertCite{@see @GOUL:13}{plm}, EViews of IHS, and gretl \insertCite{@see @GRETL:2021, p. 200-201, listing 23.1}{plm}, see for treatment in the literature, e.g., \insertCite{GREE:12;textual}{plm}, Ch. 11.4.4, p. 364. It can be considered an overall intercept in the within model framework and is the weighted mean of fixed effects (see \strong{Examples} for the relationship). \code{within_intercept} estimates a new model which is computationally more demanding than just taking the weighted mean. However, with \code{within_intercept} one also gets the associated standard error and it is possible to get an overall intercept for twoway fixed effect models. Users can set argument \code{vcov} to a function to calculate a specific (robust) variance--covariance matrix and get the respective (robust) standard error for the overall intercept, e.g., the function \code{\link[=vcovHC]{vcovHC()}}, see examples for usage. Note: The argument \code{vcov} must be a function, not a matrix, because the model to calculate the overall intercept for the within model is different from the within model itself. If argument \code{return.model = TRUE} is set, the full model object is returned, while in the default case only the intercept is returned. } \examples{ data("Hedonic", package = "plm") mod_fe <- plm(mv ~ age + crim, data = Hedonic, index = "townid") overallint <- within_intercept(mod_fe) attr(overallint, "se") # standard error # overall intercept is the weighted mean of fixed effects in the # one-way case weighted.mean(fixef(mod_fe), pdim(mod_fe)$Tint$Ti) ### relationship of type="dmean", "level" and within_intercept ## one-way balanced case data("Grunfeld", package = "plm") gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") fx_level <- fixef(gi, type = "level") fx_dmean <- fixef(gi, type = "dmean") overallint <- within_intercept(gi) all.equal(overallint + fx_dmean, fx_level, check.attributes = FALSE) # TRUE ## two-ways unbalanced case gtw_u <- plm(inv ~ value + capital, data = Grunfeld[-200, ], effect = "twoways") int_tw_u <- within_intercept(gtw_u) fx_dmean_tw_i_u <- fixef(gtw_u, type = "dmean", effect = "individual")[index(gtw_u)[[1L]]] fx_dmean_tw_t_u <- fixef(gtw_u, type = "dmean", effect = "time")[index(gtw_u)[[2L]]] fx_level_tw_u <- as.numeric(fixef(gtw_u, "twoways", "level")) fx_level_tw_u2 <- int_tw_u + fx_dmean_tw_i_u + fx_dmean_tw_t_u all.equal(fx_level_tw_u, fx_level_tw_u2, check.attributes = FALSE) # TRUE ## overall intercept with robust standard error within_intercept(gi, vcov = function(x) vcovHC(x, method="arellano", type="HC0")) ## have a model returned mod_fe_int <- within_intercept(gi, return.model = TRUE) summary(mod_fe_int) # replicates Stata's robust standard errors summary(mod_fe_int, vcvov = function(x) vcovHC(x, type = "sss")) } \references{ \insertAllCited{} } \seealso{ \code{\link[=fixef]{fixef()}} to extract the fixed effects of a within model. } \author{ Kevin Tappe } \keyword{attribute} plm/man/vcovBK.Rd0000644000176200001440000001055414124132276013305 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovBK} \alias{vcovBK} \alias{vcovBK.plm} \title{Beck and Katz Robust Covariance Matrix Estimators} \usage{ vcovBK(x, ...) \method{vcovBK}{plm}( x, type = c("HC0", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), diagonal = FALSE, ... ) } \arguments{ \item{x}{an object of class \code{"plm"},} \item{\dots}{further arguments.} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, see Details,} \item{cluster}{one of \code{"group"}, \code{"time"},} \item{diagonal}{a logical value specifying whether to force nondiagonal elements to zero,} } \value{ An object of class \code{"matrix"} containing the estimate of the covariance matrix of coefficients. } \description{ Unconditional Robust covariance matrix estimators \emph{a la Beck and Katz} for panel models (a.k.a. Panel Corrected Standard Errors (PCSE)). } \details{ \code{vcovBK} is a function for estimating a robust covariance matrix of parameters for a panel model according to the \insertCite{BECK:KATZ:95;textual}{plm} method, a.k.a. Panel Corrected Standard Errors (PCSE), which uses an unconditional estimate of the error covariance across time periods (groups) inside the standard formula for coefficient covariance. Observations may be clustered either by \code{"group"} to account for timewise heteroskedasticity and serial correlation or by \code{"time"} to account for cross-sectional heteroskedasticity and correlation. It must be borne in mind that the Beck and Katz formula is based on N- (T-) asymptotics and will not be appropriate elsewhere. The \code{diagonal} logical argument can be used, if set to \code{TRUE}, to force to zero all nondiagonal elements in the estimated error covariances; this is appropriate if both serial and cross--sectional correlation are assumed out, and yields a timewise- (groupwise-) heteroskedasticity--consistent estimator. Weighting schemes specified by \code{type} are analogous to those in \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} in package \CRANpkg{sandwich} and are justified theoretically (although in the context of the standard linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. The main use of \code{vcovBK} (and the other variance-covariance estimators provided in the package \code{vcovHC}, \code{vcovNW}, \code{vcovDC}, \code{vcovSCC}) is to pass it to plm's own functions like \code{summary}, \code{pwaldtest}, and \code{phtest} or together with testing functions from the \code{lmtest} and \code{car} packages. All of these typically allow passing the \code{vcov} or \code{vcov.} parameter either as a matrix or as a function, e.g., for Wald--type testing: argument \code{vcov.} to \code{coeftest()}, argument \code{vcov} to \code{waldtest()} and other methods in the \CRANpkg{lmtest} package; and argument \code{vcov.} to \code{linearHypothesis()} in the \CRANpkg{car} package (see the examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. } \examples{ data("Produc", package="plm") zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="random") summary(zz, vcov = vcovBK) summary(zz, vcov = function(x) vcovBK(x, type="HC1")) ## standard coefficient significance test library(lmtest) coeftest(zz) ## robust significance test, cluster by group ## (robust vs. serial correlation), default arguments coeftest(zz, vcov.=vcovBK) ## idem with parameters, pass vcov as a function argument coeftest(zz, vcov.=function(x) vcovBK(x, type="HC1")) ## idem, cluster by time period ## (robust vs. cross-sectional correlation) coeftest(zz, vcov.=function(x) vcovBK(x, type="HC1", cluster="time")) ## idem with parameters, pass vcov as a matrix argument coeftest(zz, vcov.=vcovBK(zz, type="HC1")) ## joint restriction test waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovBK) \dontrun{ ## test of hyp.: 2*log(pc)=log(emp) library(car) linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovBK) } } \references{ \insertRef{BECK:KATZ:95}{plm} \insertRef{CRIB:04}{plm} \insertRef{GREE:03}{plm} \insertRef{MACK:WHIT:85}{plm} \insertRef{ZEIL:04}{plm} } \seealso{ \code{\link[sandwich:vcovHC]{sandwich::vcovHC()}} from the \CRANpkg{sandwich} package for weighting schemes (\code{type} argument). } \author{ Giovanni Millo } \keyword{regression} plm/man/RiceFarms.Rd0000644000176200001440000000354614124132276013771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plm-package.R \docType{data} \name{RiceFarms} \alias{RiceFarms} \title{Production of Rice in Indonesia} \format{ A dataframe containing : \describe{ \item{id}{the farm identifier} \item{size}{the total area cultivated with rice, measured in hectares} \item{status}{land status, on of \code{'owner'} (non sharecroppers, owner operators or leaseholders or both), \code{'share'} (sharecroppers), \code{'mixed'} (mixed of the two previous status)} \item{varieties}{one of \code{'trad'} (traditional varieties), \code{'high'} (high yielding varieties) and \code{'mixed'} (mixed varieties)} \item{bimas}{bIMAS is an intensification program; one of \code{'no'} (non-bimas farmer), \code{'yes'} (bimas farmer) or \code{'mixed'} (part but not all of farmer's land was registered to be in the bimas program)} \item{seed}{seed in kilogram} \item{urea}{urea in kilogram} \item{phosphate}{phosphate in kilogram} \item{pesticide}{pesticide cost in Rupiah} \item{pseed}{price of seed in Rupiah per kg} \item{purea}{price of urea in Rupiah per kg} \item{pphosph}{price of phosphate in Rupiah per kg} \item{hiredlabor}{hired labor in hours} \item{famlabor}{family labor in hours} \item{totlabor}{total labor (excluding harvest labor)} \item{wage}{labor wage in Rupiah per hour} \item{goutput}{gross output of rice in kg} \item{noutput}{net output, gross output minus harvesting cost (paid in terms of rice)} \item{price}{price of rough rice in Rupiah per kg} \item{region}{one of \code{'wargabinangun'}, \code{'langan'}, \code{'gunungwangi'}, \code{'malausma'}, \code{'sukaambit'}, \code{'ciwangi'}} } } \source{ \insertRef{FENG:HORR:12}{plm} } \description{ a panel of 171 observations } \details{ \emph{number of observations} : 1026 \emph{observation} : farms \emph{country} : Indonesia } \keyword{datasets} plm/man/is.pbalanced.Rd0000644000176200001440000000641714155752547014456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is.pconsecutive_pbalanced.R \name{is.pbalanced} \alias{is.pbalanced} \alias{is.pbalanced.default} \alias{is.pbalanced.data.frame} \alias{is.pbalanced.pdata.frame} \alias{is.pbalanced.pseries} \alias{is.pbalanced.pggls} \alias{is.pbalanced.pcce} \alias{is.pbalanced.pmg} \alias{is.pbalanced.pgmm} \alias{is.pbalanced.panelmodel} \title{Check if data are balanced} \usage{ is.pbalanced(x, ...) \method{is.pbalanced}{default}(x, y, ...) \method{is.pbalanced}{data.frame}(x, index = NULL, ...) \method{is.pbalanced}{pdata.frame}(x, ...) \method{is.pbalanced}{pseries}(x, ...) \method{is.pbalanced}{pggls}(x, ...) \method{is.pbalanced}{pcce}(x, ...) \method{is.pbalanced}{pmg}(x, ...) \method{is.pbalanced}{pgmm}(x, ...) \method{is.pbalanced}{panelmodel}(x, ...) } \arguments{ \item{x}{an object of class \code{pdata.frame}, \code{data.frame}, \code{pseries}, \code{panelmodel}, or \code{pgmm},} \item{\dots}{further arguments.} \item{y}{(only in default method) the time index variable (2nd index variable),} \item{index}{only relevant for \code{data.frame} interface; if \code{NULL}, the first two columns of the data.frame are assumed to be the index variables; if not \code{NULL}, both dimensions ('individual', 'time') need to be specified by \code{index} as character of length 2 for data frames, for further details see \code{\link[=pdata.frame]{pdata.frame()}},} } \value{ A logical indicating whether the data associated with object \code{x} are balanced (\code{TRUE}) or not (\code{FALSE}). } \description{ This function checks if the data are balanced, i.e., if each individual has the same time periods } \details{ Balanced data are data for which each individual has the same time periods. The returned values of the \code{is.pbalanced(object)} methods are identical to \code{pdim(object)$balanced}. \code{is.pbalanced} is provided as a short cut and is faster than \code{pdim(object)$balanced} because it avoids those computations performed by \code{pdim} which are unnecessary to determine the balancedness of the data. } \examples{ # take balanced data and make it unbalanced # by deletion of 2nd row (2nd time period for first individual) data("Grunfeld", package = "plm") Grunfeld_missing_period <- Grunfeld[-2, ] is.pbalanced(Grunfeld_missing_period) # check if balanced: FALSE pdim(Grunfeld_missing_period)$balanced # same # pdata.frame interface pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) is.pbalanced(Grunfeld_missing_period) # pseries interface is.pbalanced(pGrunfeld_missing_period$inv) } \seealso{ \code{\link[=punbalancedness]{punbalancedness()}} for two measures of unbalancedness, \code{\link[=make.pbalanced]{make.pbalanced()}} to make data balanced; \code{\link[=is.pconsecutive]{is.pconsecutive()}} to check if data are consecutive; \code{\link[=make.pconsecutive]{make.pconsecutive()}} to make data consecutive (and, optionally, also balanced).\cr \code{\link[=pdim]{pdim()}} to check the dimensions of a 'pdata.frame' (and other objects), \code{\link[=pvar]{pvar()}} to check for individual and time variation of a 'pdata.frame' (and other objects), \code{\link[=pseries]{pseries()}}, \code{\link[=data.frame]{data.frame()}}, \code{\link[=pdata.frame]{pdata.frame()}}. } \keyword{attribute} plm/man/pbnftest.Rd0000644000176200001440000000666614124132276013751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_serial.R \name{pbnftest} \alias{pbnftest} \alias{pbnftest.panelmodel} \alias{pbnftest.formula} \title{Modified BNF--Durbin--Watson Test and Baltagi--Wu's LBI Test for Panel Models} \usage{ pbnftest(x, ...) \method{pbnftest}{panelmodel}(x, test = c("bnf", "lbi"), ...) \method{pbnftest}{formula}( x, data, test = c("bnf", "lbi"), model = c("pooling", "within", "random"), ... ) } \arguments{ \item{x}{an object of class \code{"panelmodel"} or of class \code{"formula"},} \item{\dots}{only relevant for formula interface: further arguments to specify the model to test (arguments passed on to plm()), e.g., \code{effect}.} \item{test}{a character indicating the test to be performed, either \code{"bnf"} or \code{"lbi"} for the (modified) BNF statistic or Baltagi--Wu's LBI statistic, respectively,} \item{data}{a \code{data.frame} (only relevant for formula interface),} \item{model}{a character indicating on which type of model the test shall be performed (\code{"pooling"}, \code{"within"}, \code{"random"}, only relevant for formula interface),} } \value{ An object of class \code{"htest"}. } \description{ Tests for AR(1) disturbances in panel models. } \details{ The default, \code{test = "bnf"}, gives the (modified) BNF statistic, the generalised Durbin-Watson statistic for panels. For balanced and consecutive panels, the reference is Bhargava/Franzini/Narendranathan (1982). The modified BNF is given for unbalanced and/or non-consecutive panels (d1 in formula 16 of \insertCite{BALT:WU:99;textual}{plm}). \code{test = "lbi"} yields Baltagi--Wu's LBI statistic \insertCite{BALT:WU:99}{plm}, the locally best invariant test which is based on the modified BNF statistic. No specific variants of these tests are available for random effect models. As the within estimator is consistent also under the random effects assumptions, the test for random effect models is performed by taking the within residuals. No p-values are given for the statistics as their distribution is quite difficult. \insertCite{BHAR:FRAN:NARE:82;textual}{plm} supply tabulated bounds for p = 0.05 for the balanced case and consecutive case. For large N, \insertCite{BHAR:FRAN:NARE:82}{plm} suggest it is sufficient to check whether the BNF statistic is < 2 to test against positive serial correlation. } \examples{ data("Grunfeld", package = "plm") # formula interface, replicate Baltagi/Wu (1999), table 1, test case A: data_A <- Grunfeld[!Grunfeld[["year"]] \%in\% c("1943", "1944"), ] pbnftest(inv ~ value + capital, data = data_A, model = "within") pbnftest(inv ~ value + capital, data = data_A, test = "lbi", model = "within") # replicate Baltagi (2013), p. 101, table 5.1: re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") pbnftest(re) pbnftest(re, test = "lbi") } \references{ \insertRef{BALT:13}{plm} \insertRef{BALT:WU:99}{plm} \insertRef{BHAR:FRAN:NARE:82}{plm} } \seealso{ \code{\link[=pdwtest]{pdwtest()}} for the original Durbin--Watson test using (quasi-)demeaned residuals of the panel model without taking the panel structure into account. \code{\link[=pbltest]{pbltest()}}, \code{\link[=pbsytest]{pbsytest()}}, \code{\link[=pwartest]{pwartest()}} and \code{\link[=pwfdtest]{pwfdtest()}} for other serial correlation tests for panel models. } \author{ Kevin Tappe } \keyword{htest} plm/man/pwaldtest.Rd0000644000176200001440000001267014124132276014123 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/test_general.R \name{pwaldtest} \alias{pwaldtest} \alias{pwaldtest.plm} \alias{pwaldtest.pvcm} \alias{pwaldtest.pgmm} \title{Wald-style Chi-square Test and F Test} \usage{ pwaldtest(x, ...) \method{pwaldtest}{plm}( x, test = c("Chisq", "F"), vcov = NULL, df2adj = (test == "F" && !is.null(vcov) && missing(.df2)), .df1, .df2, ... ) \method{pwaldtest}{pvcm}(x, ...) \method{pwaldtest}{pgmm}(x, param = c("coef", "time", "all"), vcov = NULL, ...) } \arguments{ \item{x}{an estimated model of which the coefficients should be tested (usually of class \code{"plm"}/\code{"pvcm"}/\code{"pgmm"})`,} \item{\dots}{further arguments (currently none).} \item{test}{a character, indicating the test to be performed, may be either \code{"Chisq"} or \code{"F"} for the Wald-style Chi-square test or F test, respectively,} \item{vcov}{\code{NULL} by default; a \code{matrix} giving a variance--covariance matrix or a function which computes such; if supplied (non \code{NULL}), the test is carried out using the variance--covariance matrix indicated resulting in a robust test,} \item{df2adj}{logical, only relevant for \code{test = "F"}, indicating whether the adjustment for clustered standard errors for the second degrees of freedom parameter should be performed (see \strong{Details}, also for further requirements regarding the variance--covariance matrix in \code{vcov} for the adjustment to be performed),} \item{.df1}{a numeric, used if one wants to overwrite the first degrees of freedom parameter in the performed test (usually not used),} \item{.df2}{a numeric, used if one wants to overwrite the second degrees of freedom parameter for the F test (usually not used),} \item{param}{(for pgmm method only): select the parameters to be tested: \code{"coef"}, \code{"time"}, or `"all"``.} } \value{ An object of class \code{"htest"}, except for pvcm's within model for which a data.frame with results of the Wald chi-square tests and F tests per regression is returned. } \description{ Wald-style Chi-square test and F test of slope coefficients being zero jointly, including robust versions of the tests. } \details{ \code{pwaldtest} can be used stand--alone with a plm object, a pvcm object, and a pgmm object (for pvcm objects only the 'random' type is valid and no further arguments are processed; for pgmm objects only arguments \code{param} and \code{vcov} are valid). It is also used in \code{\link[=summary.plm]{summary.plm()}} to produce the F statistic and the Chi-square statistic for the joint test of coefficients and in \code{\link[=summary.pgmm]{summary.pgmm()}}. \code{pwaldtest} performs the test if the slope coefficients of a panel regression are jointly zero. It does not perform general purpose Wald-style tests (for those, see \code{\link[lmtest:waldtest]{lmtest::waldtest()}} (from package \CRANpkg{lmtest}) or \code{\link[car:linearHypothesis]{car::linearHypothesis()}} (from package \CRANpkg{car})). If a user specified variance-covariance matrix/function is given in argument \code{vcov}, the robust version of the tests are carried out. In that case, if the F test is requested (\code{test = "F"}) and no overwriting of the second degrees of freedom parameter is given (by supplying argument (\code{.df2})), the adjustment of the second degrees of freedom parameter is performed by default. The second degrees of freedom parameter is adjusted to be the number of unique elements of the cluster variable - 1, e. g., the number of individuals minus 1. For the degrees of freedom adjustment of the F test in general, see e. g. \insertCite{CAME:MILL:15;textual}{plm}, section VII; \insertCite{ANDR:GOLS:SCMI:13}{plm}, pp. 126, footnote 4. The degrees of freedom adjustment requires the vcov object supplied or created by a supplied function to carry an attribute called "cluster" with a known clustering described as a character (for now this could be either \code{"group"} or \code{"time"}). The vcovXX functions of the package \pkg{plm} provide such an attribute for their returned variance--covariance matrices. No adjustment is done for unknown descriptions given in the attribute "cluster" or when the attribute "cluster" is not present. Robust vcov objects/functions from package \CRANpkg{clubSandwich} work as inputs to \code{pwaldtest}'s F test because a they are translated internally to match the needs described above. } \examples{ data("Grunfeld", package = "plm") mod_fe <- plm(inv ~ value + capital, data = Grunfeld, model = "within") mod_re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") pwaldtest(mod_fe, test = "F") pwaldtest(mod_re, test = "Chisq") # with robust vcov (matrix, function) pwaldtest(mod_fe, vcov = vcovHC(mod_fe)) pwaldtest(mod_fe, vcov = function(x) vcovHC(x, type = "HC3")) pwaldtest(mod_fe, vcov = vcovHC(mod_fe), df2adj = FALSE) # w/o df2 adjustment # example without attribute "cluster" in the vcov vcov_mat <- vcovHC(mod_fe) attr(vcov_mat, "cluster") <- NULL # remove attribute pwaldtest(mod_fe, vcov = vcov_mat) # no df2 adjustment performed } \references{ \insertRef{WOOL:10}{plm} \insertRef{ANDR:GOLS:SCMI:13}{plm} \insertRef{CAME:MILL:15}{plm} } \seealso{ \code{\link[=vcovHC]{vcovHC()}} for an example of the vcovXX functions, a robust estimation for the variance--covariance matrix; \code{\link[=summary.plm]{summary.plm()}} } \author{ Yves Croissant (initial implementation) and Kevin Tappe (extensions: vcov argument and F test's df2 adjustment) } \keyword{htest} plm/man/aneweytest.Rd0000644000176200001440000000212114124132276014272 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_pi.R \name{aneweytest} \alias{aneweytest} \title{Angrist and Newey's version of Chamberlain test for fixed effects} \usage{ aneweytest(formula, data, subset, na.action, index = NULL, ...) } \arguments{ \item{formula}{a symbolic description for the model to be estimated,} \item{data}{a \code{data.frame},} \item{subset}{see \code{\link[=lm]{lm()}},} \item{na.action}{see \code{\link[=lm]{lm()}},} \item{index}{the indexes,} \item{\dots}{further arguments.} } \value{ An object of class \code{"htest"}. } \description{ Angrist and Newey's version of the Chamberlain test } \details{ Angrist and Newey's test is based on the results of the artifactual regression of the within residuals on the covariates for all the periods. } \examples{ data("RiceFarms", package = "plm") aneweytest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") } \references{ \insertRef{ANGR:NEWE:91}{plm} } \seealso{ \code{\link[=piest]{piest()}} for Chamberlain's test } \author{ Yves Croissant } \keyword{htest} plm/man/pseriesfy.Rd0000644000176200001440000000327614124132276014127 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_pdata.frame.R \name{pseriesfy} \alias{pseriesfy} \title{Turn all columns of a pdata.frame into class pseries.} \usage{ pseriesfy(x, ...) } \arguments{ \item{x}{an object of class \code{"pdata.frame"},} \item{\dots}{further arguments (currently not used).} } \value{ A pdata.frame like the input pdata.frame but with all columns turned into pseries. } \description{ This function takes a pdata.frame and turns all of its columns into objects of class pseries. } \details{ Background: Initially created pdata.frames have as columns the pure/basic class (e.g., numeric, factor, character). When extracting a column from such a pdata.frame, the extracted column is turned into a pseries. At times, it can be convenient to apply data transformation operations on such a \code{pseriesfy}-ed pdata.frame, see Examples. } \examples{ library("plm") data("Grunfeld", package = "plm") pGrun <- pdata.frame(Grunfeld[ , 1:4], drop.index = TRUE) pGrun2 <- pseriesfy(pGrun) # pseriesfy-ed pdata.frame # compare classes of columns lapply(pGrun, class) lapply(pGrun2, class) # When using with() with(pGrun, lag(value)) # dispatches to base R's lag() with(pGrun2, lag(value)) # dispatches to plm's lag() respect. panel structure # When lapply()-ing lapply(pGrun, lag) # dispatches to base R's lag() lapply(pGrun2, lag) # dispatches to plm's lag() respect. panel structure # as.list(., keep.attributes = TRUE) on a non-pseriesfy-ed # pdata.frame is similar and dispatches to plm's lag lapply(as.list(pGrun, keep.attributes = TRUE), lag) } \seealso{ \code{\link[=pdata.frame]{pdata.frame()}}, \code{\link[=as.list]{as.list()}} } \keyword{attribute} plm/man/sargan.Rd0000644000176200001440000000236714124132276013371 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/est_gmm.R \name{sargan} \alias{sargan} \title{Hansen--Sargan Test of Overidentifying Restrictions} \usage{ sargan(object, weights = c("twosteps", "onestep")) } \arguments{ \item{object}{an object of class \code{"pgmm"},} \item{weights}{the weighting matrix to be used for the computation of the test.} } \value{ An object of class \code{"htest"}. } \description{ A test of overidentifying restrictions for models estimated by GMM. } \details{ The Hansen--Sargan test ("J test") calculates the quadratic form of the moment restrictions that is minimized while computing the GMM estimator. It follows asymptotically a chi-square distribution with number of degrees of freedom equal to the difference between the number of moment conditions and the number of coefficients. } \examples{ data("EmplUK", package = "plm") ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") sargan(ar) } \references{ \insertCite{HANS:82}{plm} \insertCite{SARG:58}{plm} } \seealso{ \code{\link[=pgmm]{pgmm()}} } \author{ Yves Croissant } \keyword{htest} plm/man/vcovG.Rd0000644000176200001440000000501514124132276013173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tool_vcovG.R \name{vcovG} \alias{vcovG} \alias{vcovG.plm} \alias{vcovG.pcce} \title{Generic Lego building block for Robust Covariance Matrix Estimators} \usage{ vcovG(x, ...) \method{vcovG}{plm}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), l = 0, inner = c("cluster", "white", "diagavg"), ... ) \method{vcovG}{pcce}( x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), l = 0, inner = c("cluster", "white", "diagavg"), ... ) } \arguments{ \item{x}{an object of class \code{"plm"} or \code{"pcce"}} \item{\dots}{further arguments} \item{type}{the weighting scheme used, one of \code{"HC0"}, \code{"sss"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"},} \item{cluster}{one of \code{"group"}, \code{"time"},} \item{l}{lagging order, defaulting to zero} \item{inner}{the function to be applied to the residuals inside the sandwich: one of \code{"cluster"} or \code{"white"} or \code{"diagavg"},} } \value{ An object of class \code{"matrix"} containing the estimate of the covariance matrix of coefficients. } \description{ Generic Lego building block for robust covariance matrix estimators of the vcovXX kind for panel models. } \details{ \code{vcovG} is the generic building block for use by higher--level wrappers \code{\link[=vcovHC]{vcovHC()}}, \code{\link[=vcovSCC]{vcovSCC()}}, \code{\link[=vcovDC]{vcovDC()}}, and \code{\link[=vcovNW]{vcovNW()}}. The main use of \code{vcovG} is to be used internally by the former, but it is made available in the user space for use in non--standard combinations. For more documentation, see see wrapper functions mentioned. } \examples{ data("Produc", package="plm") zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") ## reproduce Arellano's covariance matrix vcovG(zz, cluster="group", inner="cluster", l=0) ## define custom covariance function ## (in this example, same as vcovHC) myvcov <- function(x) vcovG(x, cluster="group", inner="cluster", l=0) summary(zz, vcov = myvcov) ## use in coefficient significance test library(lmtest) ## robust significance test coeftest(zz, vcov. = myvcov) } \references{ \insertRef{mil17b}{plm} } \seealso{ \code{\link[=vcovHC]{vcovHC()}}, \code{\link[=vcovSCC]{vcovSCC()}}, \code{\link[=vcovDC]{vcovDC()}}, \code{\link[=vcovNW]{vcovNW()}}, and \code{\link[=vcovBK]{vcovBK()}} albeit the latter does not make use of vcovG. } \author{ Giovanni Millo } \keyword{regression} plm/DESCRIPTION0000644000176200001440000000606414200107742012553 0ustar liggesusersPackage: plm Version: 2.6-0 Date: 2022-01-31 Title: Linear Models for Panel Data Authors@R: c(person(given = "Yves", family = "Croissant", role = c("aut", "cre"), email = "yves.croissant@univ-reunion.fr"), person(given = "Giovanni", family = "Millo", role = "aut", email = "giovanni.millo@deams.units.it"), person(given = "Kevin", family = "Tappe", role = "aut", email = "kevin.tappe@bwi.uni-stuttgart.de"), person(given = "Ott", family = "Toomet", role = "ctb", email = "otoomet@gmail.com"), person(given = "Christian", family = "Kleiber", role = "ctb", email = "Christian.Kleiber@unibas.ch"), person(given = "Achim", family = "Zeileis", role = "ctb", email = "Achim.Zeileis@R-project.org"), person(given = "Arne", family = "Henningsen", role = "ctb", email = "arne.henningsen@googlemail.com"), person(given = "Liviu", family = "Andronic", role = "ctb"), person(given = "Nina", family = "Schoenfelder", role = "ctb")) Depends: R (>= 3.1.0) Imports: MASS, bdsmatrix, collapse (>= 1.6.0), zoo, nlme, sandwich, lattice, lmtest, maxLik, Rdpack, Formula, stats Suggests: AER, car, statmod, urca, pder, texreg, knitr, rmarkdown, fixest, lfe Description: A set of estimators for models and (robust) covariance matrices, and tests for panel data econometrics, including within/fixed effects, random effects, between, first-difference, nested random effects as well as instrumental-variable (IV) and Hausman-Taylor-style models, panel generalized method of moments (GMM) and general FGLS models, mean groups (MG), demeaned MG, and common correlated effects (CCEMG) and pooled (CCEP) estimators with common factors, variable coefficients and limited dependent variables models. Test functions include model specification, serial correlation, cross-sectional dependence, panel unit root and panel Granger (non-)causality. Typical references are general econometrics text books such as Baltagi (2021), Econometric Analysis of Panel Data, ISBN-13:978-3-030-53952-8, Hsiao (2014), Analysis of Panel Data , and Croissant and Millo (2018), Panel Data Econometrics with R, ISBN-13:978-1-118-94918-4. License: GPL (>= 2) VignetteBuilder: knitr URL: https://cran.r-project.org/package=plm (CRAN releases), https://github.com/ycroissant/plm (development repository) BugReports: https://github.com/ycroissant/plm/issues RoxygenNote: 7.1.2 RdMacros: Rdpack Encoding: UTF-8 NeedsCompilation: no Packaged: 2022-02-05 14:02:22 UTC; kevin Author: Yves Croissant [aut, cre], Giovanni Millo [aut], Kevin Tappe [aut], Ott Toomet [ctb], Christian Kleiber [ctb], Achim Zeileis [ctb], Arne Henningsen [ctb], Liviu Andronic [ctb], Nina Schoenfelder [ctb] Maintainer: Yves Croissant Repository: CRAN Date/Publication: 2022-02-07 03:20:02 UTC plm/build/0000755000176200001440000000000014177501551012147 5ustar liggesusersplm/build/vignette.rds0000644000176200001440000000052014177501551014503 0ustar liggesusersRN0tҴJh8u K@\5YJ+4f4Vd`ك`++O\c;|jk=|ٽbLɭ4x'="ɂU?3kz|˨y4E}{kl \ى_l6߇6Q JKem bplm/build/partial.rdb0000644000176200001440000075420014177501522014302 0ustar liggesusersYpY&9 sA vD& ` +kA,G{@TN]]MϢlj^MwKjI=ZfzL2Oz<}"3ٵk'u#LSOD?KQ6¹6UͲ\h~z{W$/yj/;vֶ=5z_'mj~k[74OMWί&.|b{YʺT_hi_tu\R4D/5咡:_n /JnXW?݈l:2@&ެv=/WTWͿJUuR]n&´5|E5+j֛-ݶ_nxA"vG }Ω2칮5څw@zbwO\j:ZДVVLWuu$I֡.&j郺ct>ܪ݆*P \{}BLj\ qH e]BAG\;6=S;j19CE7}@}bdSO#T/ގxlrq3ٞCF;}\@&HyTFFf"s{edK!&I[Ds]XST3x ʟIFT D;(IB)i `Z&m_dyFȪ_Z ʷhug)ĩN[Q獼]Q.b"E4Dԭ- EAyDbWZ%&se~RI2q.h=ffWhIMNz|5y\F^CZlSIzt#E$gJ&pphڋ8x#O!1$S|ժ2*փF)T3x,k(s5}6PSx]oPIDZ9Fz$=p0XK0=n`$eמ$d?A!>TC9#%2 }{fYH2Ņ8݈zG47}HsPR8,7YfP??}CZսYsYwn@Ua#i0y#i3(g'|gBLҧ<"@GWvc`8EDy2y& { (gd?E!&c"V=0iSH*Y ș "WQ^M^H)(?O^bTͲl}+j-KS5@7FTۖ]Q݈۱W[[X;.Qu!3B$X+coLC7aR548+"OUUwt,3 PSee -xHQ~8UuC;y7tP[AUt*I4Z߅͚mzq R)m5BNnri&GmƬC~6C5]mAe}p%X-Z5Ǫ%md43=0#O. sSS[)FZ3Wm75dC!&i21=!hoPl|&ΰ C$X+705f3sr4{_uȶmUHaqnWaqqU4 uRqM9RaJNb4Uj$I3rUʖ7E8EQQ%*OJu7&sP'LR$IVs܂ua"/S,aT>ZK$Q6KG[jA5X-\AFy8}<Q.QKVtFƐx$nx$yopf_ d5Ӈ8zeWՍcw C}b=r:de?>V_{3:Kv9xOmɿ=]Nf4^\f{'M?"_LSi^fs|X,od>hK Y|cj4KJjiW+Rӟcب.|W,?y"k789تhd[M_ WƖcc*Oyb=j2z,{́;0`{_/WM}Y2mKV^oBџ5w,BTs0I3rLY˵w1 .;pCv?B/Н}0-踩.b\0# "u_-M_6_-O=_=rd嫓T .@ }5u.G髻}_rk)AM-cp؝Mƿ]wYgpsqqC %qٸ"YWuڞf4wV৥NVW!,oVܨy(ē ׮ܚdeW5w4pALCEd'c,9S6;7}ƬeԬћS3~ުUvrVJ9ɯkoWKEMӊkk%W.TZRŕ)f;?Ym'VH.p#:6G_=/bp28h據?KmoDͫ,7! cK(=\xTEZA,\8,VLͪ9_jvWTײ\V_n Uiod^u)B{uoO8 & yg6|&c1g&k[:c}&cL} N4xB'z)^}g}7 Ban*?99=37;=99;0;[]WDlWjV&Ro=ŋ$I" gWB̷[^zR7LyоMڲ5 D\l/YwzaӪE]n[%m1yxVЪ*dX;*yHֱcסvJִhܲ)a5{h+j)U?߬4o+bff8n[1|zCp›˚˘({ڱZˠJ?\~2 "fq$RȱW($":*|OkL^@6 1q@pVGsYWk G:tl~-;j 8, 1U@t:g[î?i@18\t'#lu.r7K6ވ\0\isSfŦ/uoac&|" ?l?"n.ۡon;5[vo\8R%LL%:/?_hJisECص^lǿ7Ufv]tj[Nc m͖4M5pcl\?h΁iU9\#_ij%RߎʷLCل=UqI\8ֵoV4wעr%BK{Q{Yַo݋hu{ T|1 tg6ΆأֱsO}#ּTX*4b.nx3Y5;c31Ty#jC M9=},ktS=Q0Z$Y9־rYŰe_VQu|.Aa0vQk57ScBQ-nUvl5qzI_F_^:[xmQY!NU+*͓Sfб[5?:ĻK^/rP]Gk*yz"+n_zvZT{j\͍vc6GϲgR]jP ~Bynx3Ry}xw3\)߮z} L Z~fyul>1K}ErWѽ{H\G~ h___P_~̙!QpyrQZ;閵csYM8lp%? X4%xԩ/m۹ MܦW(2@ WRny9Խe?,IJ5%DyRSwz ~ޭU*W(JN5 g,[F }^Cz|W ?âՍ޼S JG N_7e\QOث Xf/(pM)(Aţ%c)_Rރ_&+6U:0UtOs毡'Px#ﱭ x@M?8UeW蛦y3|&K9a[jgrɯfTig@gNq+Rr)/t; ޘ0P}a@E匃Nz54H?Pgxlu_Vޭ_4@h/jҽiNi{//C:z&ӇU#^7JS uCym˄"]ldYW˒2.z?KX)6ڒ9_jsW/kg+SV+oZ4iПXfIB?QA" ph_JoQo]Nv4PߛXy^u}Fhȟ =k%ཽM&ךa(b[v4sH1-yʛWV_GO!&5"/@.{x4̕:9^{7 dG!&I&軈8bnamGx[R&9c(wo {x) pXe̵~52s8. !@bdE˿lwe&# Qh#39٢mPFDIVn-ȶy0 ;>2)=zIzV~!Z]ĒBL"]N9`ԭ ؍2i Љeoo밅Ȭ^r)2 .$Mx] ~n#I&΅Me 5p)$6AuB:<=(&z#dBLҝ]WnI.ÁY+:,{3u@>qǓ5>ߠHBc 1ɦPRmVԣ_JB7VmkK =x< J!>@A&Q/ EbLv>XqQ^La.rAG*%{{Pll[dS:k>MrhpC~<ԇDy2}"A 1Խ<#we=Vw:o4!s5dcO?2:6{;cb̞U˨UPo-'GO=揠KjUgށzIf8H dw_ett楟Ad zUF5HE7X;A R#h!Ɍ/Gfs (\T O={̵FB}V^sLx#9sFݮ"cxjɵycj0n~h0K{sÒ7UaC>"9uy9ʟ) 1Iⰶk"@ ҕQeñ׹#m[ ?0u %~PWi OSo w`"4cԭ tM5aM$DD oDe:UvfIͅK]sf\:9u&2 ϒgVjSI>l5ƛصk> reE!,ʳi)8\t)$Nۺͨ-ЭDThӶnjn:5D7`PJ[H%%uM/ӧdBLi0!TFh+L捦Xeo#q5e#m$`ՠHOPI:*;},}Dj`ɡfw5A̠5&fcje1 Gb߻i;Ț;0ns秊5x~lj9=(s5E6APΥO#>O!&0Rg8`Oa$`0ٰrMz3b]A⌤B \7F8#h3Z qBLD+:cyة/␵ Xxc!mµ&n݈9D7Di)J1S%|.rP1IbmfxkCsHfKs=Oe3f8_U̺l\Fy9}fAO)$Y5Qdh"5d&=\gT٨4By*}*AbN%&>0RIέ{= SQwZ9sbL}`R"%ɻ}z NظD9q S\~ .=-H"yvEވHP"q\PƐC;')Q{Y&4l,CN7bdd]2xF9q$` DZ鄘79cT|4ۭ\@)Lfq1PmHsy\;-V x'o3:H繳Hl"DzMuӁ=^2yŽBU,_S)1@fM$²hI;=T\By)yZQ < ?|Z!rj!VҏyR(s a5oSxo BL~;'Bhz WxW)AocCL,䓉$h22݋&ȱIda9i&M*a?N>OQ)^wSHI^Ow)8r w( d?Oa2w䠗c^.B M%B^N0^n ^n Pr@iI88E4DCi%@!&C y;! ]{P6qO+7D'\0΅"ч}/_"y"P^mfYsJdN'7(>!o)$7v#2nWV1]9l!blDՙGfIV~clMxmwZ5tLVKiA5x,ۥ]}O#)Ø!OUk:k9Ães C *35997>"H5Y+/LO/d Ta,tzfvP%HW^QNԐV@rWFTf|S!4D> ܇TDbƉEmQ?7rk Pȵ-j=h훁B_Hm̾oPl&4RIV'g.ת73~PBPkVpQq8{ !o[KoL!OT8E!&I^3r=*ʖf i툣J=$\*ݘlGgIMOZ uܡe$A^(绒@iǑ `hrq+#DDi&擁?Cb =b#ϰ(wI{=7؀$@>Ex1c(w~nW#{[h<" x%&Kr8\qUB&`jX;ﻻbʻ #=%T.xsǚY&XwtLGssjg _p4"c5Sc;q@O0BLQ`-{,`8=>TguY3=+xe[VVUXszmխ)= !XoCL͓lih,υ֜ЀAgav#sf pʼn Cnꃘ]!dF _T_*A7"&Z9 c5f.g8+UӍo~з3w:z>J58ib£~N32㟓bQ7`i^a4 @>Fv-5?ð7믋߿*.WJL5vX]&.ֺot7k3(z`&65 +Ye5O5gƙ*c*0Oybw󫎫Wy{_(O=@ُQI2{k*b=JR*=ΐ-iQ*^݈P<])S8{C1ޠn by3j֫c&-]X7zP بBM-6ҢJ/VeM{}Yq9]EVAk]78m^5PMʒ/s" SE)Jb{eêhfUos~dƙ=R$,–a=UfpI>n,*˵1*:ɚ+díuiJv=/w%kم3f]ɘrLOLL-Ο-YTʑ/6z,><7C(^ 1 lt]0s(`3SuI;)l^hD&(D1Nu3 !6OdmvQH0٤:~j7>*,'m:narj.>cOX!%d?Cb(G&EϰQ6KG8Ըx鳄 'P @t6 c-A 6B)5V>}e": 80"!BmDz)# %ASsefPȽ?g:g],Ȩ쓹kc/lOd\6ZdɯUfi?]7h/aq-)]7:Fq#FiF&DVpԫy\,pԇ2_e~/DL- }eʉtWQ !@bdQȊe:JcҸ\t tEԚG Bi/qJjG%> .1 C+ Ϝ_X ]=1$l~>C!&I಑ y:(_M-􅣈iN!&l0vTZb }HhUU,p<;}f>$ybwB/SI:tdU*vTߕ"Ph"H@9L<y7tP[AUtYF!VHR뻰Y\ã-!Y s!5c ( M>j&GlO6lr[%jrڄS#a^_v]rvDR ՠY.{=^V"W(cid"D<g;$kVoVWZCcInE c sB}bp:! W"Gj&ѺA!CU_-c. _cIjijyD*c2JZ*_MzNIeJWmW/Zy( dazqrr~~.<1 \܁Rn$I8uNJ!?$F!&I7ABPD8DE`=l M*1PxCR'q(85n"̏9OCv֌O1#`6+lu!NebP#C(S9IN9$hK0+N9$hޘCi䄘C- 1ms(-sH(BĦɴٷQӍӏQd6.H3*DZĬC'R!]PEcDtIp,M!]Rㄐ@yV6؁)b=CY™c%!bJ[X!Z#(*;!F`b%H^QNԐ11111* 1等⬕e򡷔ULsby0vl;hie:vP/`젴u):EՁucb :c / &uca@r]@j+hGU#S]&(VJr LrB!N 4YpUWcf Mhi!M(-M<@FIVj$\Шx=\-aT%c;_\_yl5FI)$6U@vQZ1l; nes?ggBԜ9WјYDeϢՏ*Ͱ<"Q^9#vm܉b.mi|!r)OtyOPOsUfɎ%/ B\u=vxpQR<<QV{^sdp,2Gl!} A*^ #8ɑ 6KE(~khfXSK~͛~׶oA-Pg"}U! V–} óg N-P.H%1V›ߓJK<}bsU'vL!w1=$!WtL1Q0袐tY .W[Ucc߈ˌ)ur1Jb_hhclycEGQR4T*D5+9{Q=,ky ߠpy_챈QUF=Jd<_~lypab[7؃Y1JĎb?#`XD!Vl6AYo` ëwiLϽXX3b¨5nKZznÜ&vBL9Aܽadڡe# ѬI_ C']U=b⬕O/"H_"7ZiT0SSы3݊sWMQJVd-Bd7CȵX!5b=ا꫅#Ur&|5Oaκ/WMQJNR)j-ԢԏWuqvAW?Ū{Wח){4)0,\_S8enfW@l[^eџhKowsr%ϴj<ޛi+zIݱX=yLh'ۗk_,&3?ĝyg6Yɒp{7}b*0OabC+\2;i1oȫ曬u/$k6 3f?1,)?]^7uwJU-=n9d]030193?-L>ƕ*f30YM A!]FJWJ~;ti9ɾ>sQkpK XOR_"}(I8w9yFW1w%/b[ϑ! 8J{75ߐ F!&N_UiuQ(_e)Q6 $aU[4`4Gг^,=FJu.w%ЇƜz "PvAyq/CEyTqLC|2W lw 4BAyF"bBvYYŃpuGd;c OUCǦwNOVRdߘ]3dFXOLޗ^+A'8yM,/FS_e4 3 [adx~{5c_FD^F2$VLh |q-a45RzeF4I;:8N.Zr$lUN.Z Mr0 ,Z/\uEC2l"&I6B^tjyg3LZ˶.)Q^h<qe<-ABLk>&4Zԏ%5}g=\x(l:R5 $tݼA"EI6NM2dVY^Ab]IdLTK-ys-݀S֮#[حAs&ӭ]4˨ $]>T^2}A r/be wis BL=uֱM$|:`n[l|'yP<,NQ 1I*}'duh2I@w)$7-#ǣCM*?dF!&N%-dFk'' Oڇ1<רň^st9p{iMIZlF*HtD'74{AFZRhr Vɡܮ6 ށ{o)/ٚc6}V^^' X-c#Kx# vw($m|X&'V 6 m"P/klq&oWZGܯGI$atrN -1#D1tCMG}k=u#~g'1׉ aINα F2ڪ]NxW.)0*64^_$͑qAqvZP V &WQdª#dL>`T1Ph$(Iޛ:pUWsXM!<"6:tG] $aduŐ}b]q:{xW }eѺg@!CBIP߬aڛjۺ9gY^M#sO!L*Mrƥpy"NC 1f' ȟA8 qBWQrl_UA] 'b͛zu~W!4ŕv  b2ۣ4MhéPȕ^&l< W]PK'=1IŲ[*7"B 2kK-]M5]D K0bLAQI2aژc)g"B OJ|'iPv1i"&ÖMe.+' [x5/I382BbTS KߴٟV C$N8n2]~W\U' Q~@.γF ck[<:uT036V[3!6 |f:@lG[&UfG"۶U!  v 2דBm aa6r'D1UBWuQjKtSJ-غlG%<\9}IrGI5=5qt\#\ nmXUgD !b⬕O'gõ`{RYEDZ|?byCV42 \͑wu3>W HְTū_\+. [brXogCT xJ;DmkKVWXuw JLf:] vm FʚElJUjRUF6yeoMXfp3ʲcIHBl:^0V?`@-8Sf]LhAZ[5*P戉 923Y2SX.пҟml&ӳٳRWD`H8 F6Rk5PBL[8WSʑxEc<~ _|:g_xFQR'( 7?,_1H2+МM4VG+T[v"5RVtzb:UhEihE&軈8N(MN A. Ce<Q檙\O(:UE ^ 1Ih#Bj4_Z5skSD+Gy\Nz!4msAzL!&Ns%VRVX]CPQhD.ƙ6^tKڧ+J?k5,P12*DT v{艹c[7VcTE $Rd̀ye)>abJSs:e83 1n5~VV )abGWB8- O8 SIZ?۟ dF5wG}J#ĔhIk q 1I&PU*ժ>HZcUWєWxMƠȚhsܦbdBLikQXkH>> =K3OPmq 1i3ϼ]U{,1-^Se6/i}%K?FOK!(o&xA79(${|Z5p=hu$N7 ٢2]~9Ln"3B$X+E3? V[fAjv='9 NFyPs+N-WRS|aqqab0{]NӴyF{%Xt/QR '_D/6\aA8!)K<i/kP,ۙX v'99i:) !90r'D1u3kM!6Ųt͟)R"%<*qzLs{´3smAQ;*ꈎ`[be%QĈz8)b<(l>$YrM5+W܂3UTI+%f/Gn ]ۋx=佩A-13CAyDZm'{+!sۢNoPS=~zeao!5ݨ8٧K) 7aIgσi'yZ`<E2SXOZnr4_Ё+6تhO2)*X`Aw*}&x&avӶezSE3s*p̜36|%3e.5SGJVm3fBɘr'& gˇ.r$aZ80R$pdrFp82U}va8Ҽ0HB&'gG!U!:euM/kiئH$MW>I^џeɔ7҂-ۡO )'k2]!Eid'S M=+o*Q(6>r83v!(G© oćS{ 8`7d¦pjlݦRd~ɄSK&Owr 2@jo%jOԨ!lu$5NeGRcP#Hj(?厤IN&hK" TN z)&<бzPLNK"665:뭵$_%fNvH|%$4վDM 8M(|jZ|5"Z]RMiSbnTE8rJR8EtmQ~pY])͡<3)$N\zl\"^gB~_SmSt}̒ m{(gg">G!&,jcnt`N[>z3<,g^F̠IAtqgd¦[Teԋ`P0j%-8 CS (xBL):^K>en:8[h-/#<K>wn7N.wNҥO9t6?m!sC{]DJhTe}vu2a:u;(LfssQk%I>#/P1GI3hY3Z kBLAנ҈v%A Ӊ "i0y "iȰE"pǑ*ƠHZMLa+#5pa^inmBw"3BY+I䁕7_]/nZ{W 0d:hyEjlR?&K׼kYΒ կ)CiQSfpKY+]dhۍ1`!8L .M1.1'jɚp|'3Wd<6NlΓ1Md6;ys*sgdzdjz01150y\J '8DW2Ec;}/)=ԦFhcL b&gY 2Jlq`'ПSŢ$IxwC"Lg2)D1VuG]6E*VdF*ݥvQH0@TT[v1"RQZ$~ߖ$G*S&Ar# ^ܡy2u\pA^ cڄHެ7[jˎŠFdNQL+-@}bdKӉ/Qxoe ʱZbo Z;VZ&9!I׆H`30Ft(ߖhDעmK8 $|ZZt-!Z]JMѵՁET3ˏZTl$vբ߇xHj"^G:Z1=)gGko!b̗ j3jvB,At]8ABɢ.ƥ͖FBVe%[aPYB#H/z!D15PoQI*fjmKK#k>ph&C'uf($3bJ#<52D+zƾu#<_sj1oh;j 緂scieѹnl#&W\WfPIp,V,Nnri&Gia;!l`mJv yjl-H6}V^^' X-c#h(k7;X(ooj~BLc6K7mDQAB *xBtĸ ^O\zYKA'E .R'D1u3 !6Et2vq)Z4(}iNd܂@P~>c=(yH($j"Y={Ta֜/P.Q8=DbRGn& #GWS&uGz9Iq\ظQpcE2dFX/82^v~[ڟ.|W,;ZgPu!jo2XK+ \UcQE)B]wh`?cm'M_6*Od.76?k`!?2-ΔRkA`:b=ا ӂ|uaWgaκ/WMuw}u2JZ*_MZpQnW]{8+sXDb9❆ΒiZ:yBewPa0fz/,#Ih>D@qBm_C L+߸,kp\OH+B^} dzOVl0HL*v:~mbbjl5^.:2b /Rre 1~A6 1Ij1~ r$Ưvk|)\A bU@t:g4[Rُ/ȰDbR4!ɒzI{09:/ڲ2RkӧrM$'4IgMĩuH}J=Ќ$*o?SBGv"s=]C* $YeF̲ej.)c(IiFHNV26HfUq9ke(+7Cܵ$Z[MaՁFf7K8M߈@C+:\ 2[W֙C|G^Qf7W 16b]K{/8XtAe#" w\RmM%ƏU^j-ۈgmZU٣=(&r:sO/k 1Fb2,']jl-ikWMqy=F\@y!}G /RIP!fS(6JE_82H*APFHƯ ѾE[5qħ(?M~O—WP^I)wQ)m5Ч^>8]yà}ҩVGs˶Lc3H n.=tm`3>6@%X)X=̣k O$ `rUhLf+:@)5@%]ÒS1 E̢f0޾4"\vM Q. [rȲ#>E>|F}"eTX=7dM!ՠ޼JpqqKJZ+٭WDgnz)8P[|NO^EY˭M y@:,L)4}y AH3ŇeQ~"fQO! ;ey?Ml?=ʑKIY ΂{4G2UvVO.51C+!j_Z<1,>]KiYG"CXCJF"שl)@ַ(lzI0-5N[,mRX!8q;~hA7|rh׃ʟ%O^:rXS)m5N -5[c=|u {'F佃.y)¶wVwk ĄSeeY ا."7uAApr,y[xPQH 5bR4W/eVEꆇ,f]-RAZUWw9DGypڋe)1\CGKDV>@IqchLYOY2\~ E\1.W!)r'ăd:E(8T؇7d?C!ՠO]dG&vIEGnɮUY)oo5t7 Es?:N~r4V+<$~ ;n kJ7X pcc1z]Ӧ4&:x,v-܉DX 8},58ڮjCqgQMh;9ҧd?O!a Ⱦú$Gpj*Pq\4h/A)lѺ$@ v[%߭rh@B0O էګZ&!SX!&di)LnkRj\qbuE7kN8:Yi uMHpI+NYC3hjo{T(OdDM1Rck ĤVā ak"~h[z""P.$hjTOҴ4+DLi15b2"˨P<CwswC5 knjL͠gP*Ŵ͐uqA"chnE@o)rYE (Ur_ Kf^C;mtf,*_.&mŠ >RRo05(_fPkNE1encmd>dǕ>$\~>jeKw 3XDb,a!~2 eK(/I3LÒ}H1f) TBa3d?H!k D1|de)V;1/DȾBLj}s۲+q;y_2]~9qjDfV>źz0?}d wXqGƚɷkYl[-i)ƠTQyw~lmW+ ^5t udヶ%[z_r*Mω}dL^5 5d9U!MUC·7Y$k؇ƒ1t"Y[M͟1sļg9z3SY25;=15B,We8bqȼ}_ u.0+LNNjBaq.[duaXiZ畘%uSE"5Z/%/duN1|[^*zR7jL9˾Mڲ5 \)z V-j#Jbs"[UWjG:6Cuvt:T'ѥE]K 'MK9i6fmO; ʮYNԖd 8|iǵ+O*2sC߲U AdU#NSu939CFjҹD))-^4HcRC"}Tm F!&VLe%8"&A X+ha)> KqqEIYA(ƚNQut$u8Ze ޹>DFၯvP,fwIȽystC`ijP0_ `sŎ9BQ(K^`M(%%fRk E~a{Q{<f5҇xe.DuĮNLw01 ٷQ( YǃyeUpey.cvoQ{kߢ)y1f@W((?:gK,ȸXBG44tM;Elョt3\>HiT#smuR]u#rjrajK-L[QWT3_V>Vu lbLZ3MDLm}<̩")[~tjEk_y(~Q'*Vh)o]<߿{>^Sb-aƷj,аAhW_41-nfc%7$O񇺚3{+ɘfEsuK^nx>iy{l[Gc"%&(Ry3 p**M< <[ggv C9'6sAy 1qyUF` :VA5j<0bܗI > 1I2ɥG> ~1nQ.nj%" ȇҲ$DM u-E5KQhm$a(YT <b;;7κq x-xN QREI!&ZZ&Ցmsddy#EV:PC(oN:ĦY?DՁ1e 1qcʶnW5b?D:f@A#>=Q.Î)F\Gh6}!b͗M5O W~gJ70NaZL)$)X j$dv`Or8y Yr!8CMW SdsfQ^i4t#g H#2y/Rג 5= A!&t9`TO_[O.H[Ke<({\4}H#/iC!&٤W -$ <2mWq#a|/y#a5#|dZ!3D{Z!HZ%5q#W+C 金R7>;یj "_B˝^$K u5$2WFA$ `[̼![(sMCĚ dBLjPaJtCok$N! :)9!iMq0D^ Zl0-]45khJ@*PfLr›-j-z5r/mid>NQKkqwYN:ژ@)$:{a\Ű+j3(sFm@oK!1inqc~zQ}m[RX\&$TW*v4%2דn} a_xt:EՁ. n}:ς'vQeNbmAʛ> @P~>Bۃ \QG\H##XI,E۴7?@+Pn`E($7?*'੽ rH?7jТ:.| sB}b}Qu!C%gs՗EoMju<q8MlxCkq"+YlkyE2ްy=&f*0Ob] j5 2Y3Χ?Wm]24z%8ށGS8kUb&7ըPOְ`A)\^VΔbd3YXq&m@ɘr0%s3g˟PWB`X9]E7hfY8 us#Jmؚ51%X0vw aʛq2Ba5] `b)쓹Ο-[МN4(`r-.)=Fq+Swt2 wtMr)q:4 ݴ,rݖX;ᾣIN+h[v5V3Meed/Gf4.ED3(ʣ)RL«'\嬕[1t ݈C+Z]zMWcՁ!ƨ,RkZC(_K '!bM_.uĦ a0 l%ײ9G̠IAqgdBLUJpZ>oޮ'phփx3b=PoQI2cΗ\F3)T[+¡_H;(I6$>A6mG($6UʨXҸg-6zOfetVQͲa"ws(s-cyKVe+!Abͣ2+l Y 1I&S:W;PƥseA9Q.+w;yӏ|8.l_M[1k7*U~ȾBLV 2#D9K\cosĩU;azήONi 4C oO(.#ݠrۥ}m+xa Ϝv F5 (g5Qj5mA9 1I9ׅ"T~ȾB1&HlX87\D\y1< t1.GCȝx)-"#ynn#*G." 6c>SF;HLO2-#>Fq$"i%} D4nFDL$wjP,=ύ$%j1pK(۪BRlRki&/%/$ }%g;o UECukfC])7ٷiZ[~p㔋YMe^ش*VUU$Q3EMPh,)a5{di)E?~iR܊ۚ$:=mI#L朦V/cJZU'$`Ij$ꄸQw1qNOF%7*-Qlݦ7_ܨцu.?QD3Qo$YQ %lu(NebP#Q(?IN%h6)FQ$TQ{i21^F34etAQ_UY$Y"&In@^9TMuQL!mSAzH!&NS58VbG ōByDk_/)n:0ƈ >VFQdW,:ro c=zsSTuX:a]EØ39Hx( xORI6?:g:|kʬ4Rz B*"t]ZoS^$ʴo5dQz#=i Jyx¡Y?m4t)WڤGu$+YQ 3 Ɓe TT!j649}J(s-шRrQ0O!&4X5wQ^WJh&5[sS "!rgbu6-@)$;ú֧4BIE> E8Rj {?/TySiTVfa 寒gV p?QE)kׯ4bKuRҍ&M~$ `uѐ|C/a4Լ&tM%A^4!*v# w5٥ъjhqZ_yl5FY\Q+] w.r%84tnk܆YD 142\{ǧ(uD\V(${^3 *S?Jw$:d_B% @EGy>yB "P^HP"$ylu!v J}[+J֕+Hesم6taӧ d?B!&~hPKUl$nꎿJpGWvPCKHnB) jא2Ϡa7DX5$5IP&!K!&I?UbzdBLj#6O}=u4I!&Z # jN0|ЂB?YO( uC;ڎZ:?(*qǜAE4Z_\bjK:*Zg)ltQy&Wfortx6;uro&Ur&Mx??տdkAt18%A3`pk<%fz>C#L"7ۍg㬳#j`^'$o}%&%;&󛈷P;Eƙy|ǀOUmXjDupX'B0(-mΪ:0S͒L4¨ rH3;V?0`= G[.]2wb2 12>4bd_U=vATyMN >C4c]B 'c&#R{kb#cQ6{W UJ+I/U,y$'\gdg:0颰 "󥊇`G#/U7 {@yॊc/ |1d"B;xb!8<瑄ͳ xeq1<Q.W8_x:ƓX~^gOޛ:pUWcf Ӈ8_TǽZ-Z)CmuʗNN@)w(GM"CJC;M(IT8y, _g  2%,ѪQgr5T=o#O?oOM_2YcKP?p`utASwD̶sS;4C?V!imمAmnQu`kBLtd!\|a }Εp ifCTx;^!˦j8âU Ui_Le?klOo~c;o;|AB=\V&&k؎:SM1kļ5.gIafqb0;{\H Í$'>/*C@6 1Ijo/%|+#/%oſ9V. ʃwY 1U@t:gXlEKgK ?&P2I27h\qz-aA O|-﫺C ( kP# 1qեv5Wx%_b+f,Eqw[ bSHkT2G.IkLnb¿&u/Y8NĻ(sȿj+sApg 0(ߦԠCeq.nps:Wc upf{jga*a$y^EIdRIR6fȻnf5dy8K"١lkwZɅ]Β:Qqi#0l> gq(nMHPjGlCfnn?Vb "C_SZT#z-j}bmMTjVfN8s <1q[G'ŗcBQŦȠ[¦r,MQ![!$p oSmW_Vcǜ&n36p屵OG}^ bQJ\L? }qebtV5[AñT6{\0;im{%FCkONX)l =%ZbE( W(LQ"2c,vmŗܨbSp#Fu0`N!&v"_QKb>+ip9Z uem]=(?ֺbwK ;Y%MYo(BrMcJsk 0Ԣ{ڮS)m5BwdžfxLjPR^Y)ݛ{hvƈIJ˚ϿaM`/ rA/7} OdVڙ aPϨ55)n>$P⯤<$hs (G&M^CU+䞕fڶZ3qsp(Vsq"c"t̓CH\Fq %iF, kKoPZtYBR)鮗Z6)kJsV:@t%*Fv;bDLҸ$?r_cu#mGw#7a [(M#ǏFCy.L Σ<߂n_@\DyQbs)s+g(?K$EUWMB)ĔtKB bJ[ { zCJ)G"P27?' kl!ʵQfxjDDk=ʙUS?Dc tN,oG%8tWTƕCT7X#?8;?QLGYfvLV# kF?rEH4ώD#UՁ23d8аq\PzJ-tD/w,#%V~( I!&A5nfL˜>V-:xQ;I^3*o$XaE UdF!&N!cD Ι( MQxq/#Q-i@VWtG#b: ?> <%ע ٷQ(voCRIV:z8[mήd[Qmm@Lۍm}W¥'x?9/G#e)y\O@99J!q:cJ|oDZBn?dàY"YM1JiκX՜yo,ˈwhou#faLئ&'9?J=ʣ0R:7VxBڮ& X;ut 1ӨUS_{U|^x89-ت.o".FϬUAfmWpRȣ.̋IEdZ'(?7%cӬS9KYMI _܂ck 1 !Jk`z2;A0p+9x@ ]|`U ;rf!FWTmkO/0[Jk:י:Dus#ChDyPi}[#8S򯍸~~ό^gU +>èB@pNE.@S`Qjeq6'1-kvec+(sxxFEg(pTA\EYJ k J[xBCl0,t.aT'*v)9w#WPZgkG]Uҟ' ϵ-!~jRaKzPg%qUd<Ϸ 0jƹm[hR)3\ "h _DEP{7e(}h,_eJ̎S7|;1]T$EpeHA͆/eQ?8Ճ/0X\'0%͛Bmyߋ|E=yY+'0Wpc.*yo|;Q"e $a5a2xczDLHa HP& ] 1I2a# p1zD2䂕h'QG(Kv=exN *ۃ()t\cMV !8W(S$Hj1#B9} (EeY |xeux.o7F:s`p*/xU)3Z,o fnTs5"UlU@.H-[ +O L~akz0[ã5RG Oˬ  m3~ 6i^fQwV.c^?z6M:ൺ)$߻3F`e.|tq84CDkd!]NCP~ ]7CyLY/^%ήU3dK "h̡AÇߠ~#$H@  D:FUQVv`PH`cdw1x~D,\f2 J}חs-3 g–% k(I3E?@U<7ԢN*D{ z'K*Q/( sS;26 ]"<"lE&Gz0W ; D-mMwURmMwݕښ..*kc pP9^t9Z@!DyCϱypӾjݬ\p~bmUc4K_ :4 ?$< lؚZ>ͳ"غ3z6^;tSjQ!˖u # Ղj.s>ЫqDxH2D K!c!59K~*cݰྀ hrq!yݼ 0OBS,%zh9)_JH=-Ij"b6 Э q^ux 1%ՎQĠiiq(Vck ĄN/F M;P|JGJ(˛Js$(օ&CQw1օ8LCaKAYem=Sjb'C.'.uf;N')'^ dHwtx?Ī;ވҦb\W۹iu}b3 ^ 1 ʫՌ7ئz k|$Cs y"P+wߚ(t1ހqZS,ќVl5P iPK"E*b1R=glt4_iR05 DžVwUGcnOQ~*wo5dUZ !ǘ}_`QUgI C$X+k/\{CA勇n^ק;$S T8{lT,u?bȗhX5ׄm=t֐#䅵iv6▏W2~\w֞n՘\?B~zeexJu(G8J)뎫{Ntr7p._a R_9x1OrR9 !`,SK*oŮ֖?wbi3SZ?\ʢu7O N|gYF;oYG+Tnk4u?2 :el~q 'r度"o¶-Zi7!05ޚr=/As ,Yj CeG7eqp oҳZ6#>U+;(ؾ鸶9d.\+Y7lZf98IRm0q .$s;8ooܯwu# Xȏƒg7xȟa`aTDG$O ;@?ZqbVR̲?3ZE6K+( G| +@UoQB_k34u x;@>ۇ_ìC?FVMzhQs !n C^@2 C:QZxtDAy&nܗV|ߣ€^ѓ*0b5[~C&3Ws,c~D<(z O~vDJ$w--8OnN'?Z@kITn@yWbKgW# 3P?1|kd^HQ0lqdF!&NܝYrGIV:-}¨D8V )D|GBdz# #<.H=&P^JJDY|8ܜ!'bTcF7u70M.l-8'MGff7b*Hf7rVƬv }b“Ӫۊv`4DLIUK:$D9wk'@1+;TpAaŮ܃qUԇw5mcџdFW%pٙ,_mU$(a5?57Ւ[ b2[(*VP-}nM*N**)Ua_\2ٕP1a61IQ38[zs= 58FgV}Oqf@AߨOLǤTս[ 6H=#6(\\ffgED"B.^~%7\bZ `Q\%Zc z~9UZ춨TLeulg 2:ήj HEɽ 5]$9ŧ NB{֛nTsN<)`uByHX9O#Solp}xCyNXG*j0kjxe#`Vҗ.-#Bݢ}}~x^8 jNxWPĂFu ry(g -'_E7n&ΐ*(oWS"/PC$0rkЍe~MK?F Yoc!&v1ŵvwP@ykȆ?7fTߑ=8FVV8p ouRhkfnkFoE6{A`՛?@`F~`[/jk%POj^Y[VW3k6*ϓ`[X%,u4{QuPJ/ aso.u ~9 GYPAxl'X @yC;MV~&%fo7dk"cK`  (F<*a<*hǝiN!؃rN\n>>P&Ф=n"S%S[6SPlVebLxkKb֣Raccy{2\;]٦sY9eO<ԲS;D9C+G̚]PޮR Kf9jjnMKֺGǤVuRI%1W!b5-kz/%48Z5̣z)j-Ы`Zf._ހ,P$ Xf zߎ\-5mҰdaYjG4`ee>zǨ?voCmݣ)N`Pp,1埠޹G2cd@rM0!)6KW3T0rNXiy[%+ PV1[%vsPrȽf)*x*aV꟡"(ws;D9YFs<]Z"G5P |3 (jRܖB>a[G^l*7*;w"7w#>r&Jm6Ge!6 1q!p!b⬕?>V_c%u\@tvQw\'3[/BgT?茎A_hj9ˌNEt4Fv4z0 /ޛzҮV?9^o͛4X^!o|Gwm\u>שy?o5~ J1S:75]3]*JeՒe+o^rx64*ͣ٦V&Za}^?CB+ҟݰjwゝ2+sެʿ;S&rm]_h[/Guj$I}G]To/ 7b.ɨPB[T\: SEd jCJt_W@1/#fP:S16qDž=gs\hcB KkHC 7<}[si9_@\CyMUtEByKZjnV ڔmmiJGK%)(w&o2P.C%(peY߱}gPKdz, 8cR ū(E\@Y<^cp.0C3BQ/2"Qҷ ,TTS2:ukÿnM5~/DnD~_=gVh^.tONC״\Vf;38*FVJuww?Ʌ-0n罱nޣ|1\X? }_+kxu@lfNIP `W5l_y(Q@{ ~vp8<>?l?WMo$; ;tf~,ջ?OFofc%7$O񇺚3{+ɠ W-y9摆5mЎd7SH'p*Iy#kYa3 U̡V <8ԈX/SL0J0=FGYb3oȾBL-&2KԾԑ|!WB&($$]DWrM8y:1\DSU cl!bl`â) rdnpQL~IC>~q:۞bi)d7|.x0#Q/0<76ALj(sc79 !q%8J]9ĈPqi9z~BLiA='y@lQƕ^F2:v͆ӈj\cu^#($q QߥSjP!\ Su{4zA V* >F8CG)w"P(䎹{a( kU_ o4@v oQ~+/…yֆ* =U(k#Oں 6<k}P~v6:C!՘1)1V(ۚtR'_]+ZWf]м)O(D5  s鶶[5>cgmS@lM@eN >K!ՠRJI^7UV("gUbz T3 qwT3Ivngf#꽈OQo( ,{^xeF>8r /dBLi@ -.'u[R(tX+kA>k(;% uO@"sڬ${ 0UKy8[%Qu(nirB7\Y6ѫOP_:ގѠezA[I:1]/dwqe^*fan?a{s(q۩__E'NuV?L•:V,7!&YVGߩSMADy0ٵ#^AϑПNz-: Xr}{ [L<m""u7}QHgI#& /^x]vmXSSr N"'Ta3lrT G)YP/=e}( ) MP+9h BUl[s<fG3Wx9ӸLm ~& pzsJ} j~plbW8VWQc@j^Pvrd$%쩫-Հ^kWu@x~ע(vF0I#NYNZoѴ <ƪKT+ݛe)ٺ;ƶ2D`;_gG9! ՄXi_SV&2j$uּf3T ZLȺkgT7N75C1&k3ǖeD:LYR(L-qƻ?$,5Rn%(6FW_^Xw"pI_dxZ kO#x- vcH=R:B S)Lej%uSw5dWPqG&3,m{[/Ɓ\;VB!`_aH+I0m3g1Ñd G Sga0 0Hi;r:#-|Y|~c8(8Ѱ45ÑTPKy,K^Ge-G4$eXGÏ '16n;8YK"WDAVu!j~t$kAG2vat$k3fAG2Ƴdvvbby$يHaA@hM; Q\, 5 d 6 1q (aKM'{ O#1ŨػH{!gp /G|]Th| ʯ5whu~_՝zb_ic ̵c4pN1-C}bnMT1IV~qݛ_ތtY2<}(IE5w7z|6 Jk9RA^(Ƒ>ˮ/-3e*A xe1voQVxF!& 3b+<g?:'L{k i.ەbNj'/jy[(650խ7WT3\%ȅ5 9~7 d?@!Vy4*r=G׆ܳQǨjve D\5T؅BҲd?J!&N+=8:7/ BlΨObֱ~6̀=(s"U:|q #,o<Ӗaf (pC.>¬5 ©/E]3U Vʌڞffhy[ח*jۇ*fPG^~Ԥ_T!\AXe(+s6+f3lC-,V);oza3߻zXN$8P: o+r입8u<y13%; >'dE_G5#8U&d_/Ɣx0íTz!b2V$ht"٠ uVX}6C7)Afp ŷ)>@A XVHghqy (qEcTG eU;V.AQ"7O +MuAc< ?U֎?F1sV?Iznx_ 5`3c3Q1}4 `KguDy3FXgiq uVggҤf(wDf{i;Qu1=y1;6]5Qu`M!&=1Z#fBW,ӿ&ϡTb܂ݣFY[CJkYW ŝ/nʏYRM s(ϥcLj(ϋOMIJy̲_H3Kgˬ ~Xf %/-sųi[Ud @Wߣb[HȡWdƁB\xXQ\@ Qt *}Z1SuFվ@ʟ@XQ?Z #bjee8hދr e@Z $kwxbIBUm"DL뱨:OA!Ӟ?{G Fp иH[`W '@2# PAgDuet[eue-]=se~<˜?`O|9b~j&fPSD􊊓%W\ٟ~s^Y#(ԨGȘ|2fSRvSOug,<|lZ:V`̜eۦ--dV~Y}/pӦ_pH`ҝUlΡ4IMd{qKc<,@.(HwVo2Vw _걣E:G t)4:dMGƺQZȦKԐ CMڎV+kkGܜgozaG`XDK-5،lkfF[/Pi%]̸mJ릭#[ŚJOLPDPJŹ\ZAz$8 |yvP9gҺF;}~ PлA˫yKݢC,d^1ásfݬfT-

iT4x0A9 "nC9XvTVkbK /BVކ|;6m-em 1MJӐWaB*E]c3R}M D2ΔJZRKԴʺ5bj=҇łт@M~Y/%crިKSQ2/:b{k/zӜi+\aF|)ۇ9+,c%hFmsj.;,TU];"" W`Loqyjh@ށ1,H47sQky !<9 ̺o, E^7I(% j|J\ٶJG!&k"dLm5p8KsauʦpGlƀSڲo %B}k3e*Α?{8D4ϽtS(@$Z= ܋F푇7O1AKPRט6DobrxԘN}SvyTE +Z1 I5*2:Íby{!TZ8 rYK](ǷuA}j.hRRdkHrtWP vxHxr_A Ol#<ݚn)b|8yNݦdw} ;+6.EːN װ+_lzٺ5sxr|ӴRC;2 | q2 }9ꎼAx;L! Y/6يޜ4)%*e)ܷYe"67eއ|_YFL^!Sy E. WbX,F2je1T 1_Dd]lbDxw~x| 2tAtKT]&lDpӐ1z$Ɉ}.G!*+H =D3ӱe.`.F [4Lcu혖N܆ʹEI JcSfio[T-̕unM-ŷ}ǐ+⺷抽e^cYտGBwG_1N%v:ew臽5ptcoEgw}__vaRXii "]W,JZw%'!aR ?=v@d_@NJ}1p0ٻ WTUMSɋƿUڳI>@| J.)-fG.d-1G"pxlIS A܉8/0%6C;)ȧ3]nn0{~ܮW zك Zn@Ըi%eǽ};*պYsXa_y|\ E.!/lo"jfl-H cz@vdPr2#2Hx rwExyʮx &ac*qf ?%F<g~6rI W^UXY [ AV?F~EuzK$y8Yn:'ARDa:I55a|'A=&Us7_coަae厌YkS'SZOa?dsa:TE8y@})( @>Q:9 Yʮe4sxձYQNn݀uO>^+vp̪6*2ǒ^wWG0|?8 ߁i5b17vkh㩠CCk<_z5?QPUCO }ee4*ڀMM[h oDži ujǣwsA6"]Cx؂eьJ?CnBTAoԘpCz8DJ'r`i @nŁ< e2gVWʮd{%2΋$=!Kۈ>Y3ȟ2F-)pupJQI\AQvAQ(܅fE&;2k8!$n?=YL83l1vΙ,n09V94]/9h^pK@I_A~0Q%zwߴnԽm2Huۓ tEDl=a|y4Gm/QA«B֫p~ՋX^J5/~ vMλ,n 8`AmgY`$Y݀u[OfG\fp~@1+_wQ]jВ6f;d )fs6a_BEEH&ʦ?{uě_UQȣCƓ6@Piذ*0?j7[/o}~Y!e:cȏ1rɋ7Wҗ68@Q[ zwb{OL\%x>#JX\T= oq < Վ<90Ǒ?6W>_GI Kbwl,aʩ KAyaDy=|Ĭ^qBQ<| ML{gѮ!ew*oߎine:cv5rt(丿I{ZHF#C/#.A ϩEoKy%ʃ? 77ȿAζ5Hk~ɯ m}0ӿerx|Ͳo B%/G75oy\[6͚e9-x* >a|9%A{yev2j~Cy?2,qDPא_B^\ ;g9"մΎl94"\[.`Mf?Q:kqOw8Klx"Jׁ6w l !/^NY033#oZpyo~{OOswF_DF{Pf}cEoP &4"9'ɛ4"k+#^oc-}h)TքƪPʏÓM{y' zb4^X`6Khɖ1l,ml+XPx e!X)7QH=6ݎ?]B Ɩ8UЦݤþνZs^P2hخ~GgKfͬ;U*!z!6gY׻Z1mͲ;:՗kK9FIgϩQ JE{d9 mb~?}+a@yfr%7|h-̭ϫ-̽ank-rǛ, %Q"T}aLʿJ)7BpIHh3޲qoDN!Khw ?4^{?d <cD;hM8^nܲ{ř6471 WL3m7/2bͣ_)|&P\zVEQ|Q2odޅ,u'W/!?~FS ykrn[4p2TK6Ln&5F"Oߠ\vMrGߦ+@1mݾI~0do/BNҜ <Yn[vu٬v>WQ&灋՛fwu]>Ƥ˶kیp)R }ja*5_w ie_AȃIpM+6(6aHggk4|yyo)\HAʈ^0rDλG!K=륦Hr>ݳ%;ɰ) mC?Rפ,D᭭[vuf-̛%RxWEZX_¢66zwlE+k+w nh[j +Te/ :,&{=L,uMjMz9̼ZX}f_4Ko{/o",ARڳOކTs1G㟹x0d*@Z5Mشʺ&Yqy*yI&ǀ!ߏ-7lm- sIm*J!$٤9bn|SW,7N?| >N8blaȾ49h"sC 409޼*)p[ GFd!J؍=I9"HI@ _ذݮe P*M*+ Yw;]:,.9:߰H^Q{cBe13Cv/%e?Mq5`_/63IhwٚnM[μ/zz!3H%)p4a@1 bvv.h=&6Z7+h\gZ4d"< =#n8M=ѭwvg׏BJϮڷ#YTcM 6ܣJxʟ 0 ) DJu-tcz&Gv4Afٝ@!Yn#QO/A[-hJNvR=ΎQΩ(2z'Xkgz}4<{;N-,? 5ށ|'6S:\e[KD[r<uFAҡ}vLjz9_z\V%/lيf5qp-qS/ P.Se,)de}UkT,BX QfeɻhY΃?SO2.e 38Z'l8n:J;6qވWQ/!\i\N7Kt?َ^XNCV.qf;qCl%76[}۴BztdVg(P~0}|O&7'_s,Bn#V '_Ofw}7^-޻W4"~+7ƅVQU7yoM.#@5ѹIN!Ϸ(?Q}^L(jɣ)ʙS169wRbh h,- < tݣ0|`q((eCF (t1!eáQ37]X+MKadscMEj6eҺF}!@Z(hGՌAM'*@m;%ca'sD;=ZPǿ2_Ƥ9 ȿs= O5_W=$ʴ8DEdIE>UBr*@\?|HN{"Ťq:qoIBP=SO%<(iPg8DI=zVMڨhٗj?jn nΑn()&\]Z垙UK3t ޖ:Ad"BeQ7p$dP@8T 'j9fM~K> hZC&gEĹARx(15 <Y3N47:UYq__liL)Y7mƧI['/R]:wT.zې,z0Fx TL~"#l3g Em1Q|7gծ}aZ*Ʈ4rB9R14{ !w",kGs+nFUN7L &a\$}a2ܩ3~5h#z81T#'&aU:4<>au=1> Ңs/Hzn1CA؇ҭ(;-㌄yRCl;yX\Pn_?#QbSҁ4C) _@ 54 ,e`f{c?K o8 yR_| u-ew%/̅G/yH&yGGٿ)iݛE&hz꾷mpe9w3\=0 -^|9ٖ^,gvwQS]ar+P^亻IZr ˝u!C;|Ql:ܝ~*琟'9s* i liňgiX6R"֟1.IٟP~&m$Y/P?Yl2wĨjDL{NkU+$nE@~6:Et-`1Zfr&h,6Ͻw _ޣs x NbBV_w?6BNW{R$0R.պY(jY[37Aii!;vn' O$>ٛǐǧoZ!KcWpԾk)W_WzMee%. /ĦFj*^|]} Pj^Fuͦ5Ụ g{n蕊@Qe Tq/eˡ\8qeRU#Q Xa<cx%좼! 9 d-/tRvGS[^vI,D]ˏ\Tۥ{RA d,ApX+O~e LF0Zhf6uT2W>>|R,Ӳn"r{c{v`yU:to`Jěuw\0YZmMgF1U_kY3M\?H8Yj }"2}CHYɗeG{AW-ʴd_XXl6@Gv>dY.d]4V6en/>L}㎻4Q# BvNC08$*򟦛s 3([)Mr6Z8Y[=E9B~V&ik/díbZvW2(jelau-^rd6T">8>%n{,h[%>&8ۏYDI}. d -/s_RLFAÑ1 ߶QwQs;/S掂]Qm{{nXR,s]>\zvl۷r=,*3ӻ 2'[z^'^77SdZ0~Q+CۧM^NG4{::^!ҭ<)T6E\bb<@,7WMF?olTC<*T _L$jrOzSL6~<ÌNPS8 +ijWQF9YPU`rn!R%3$xԓc&jVJ9mOtRM_ӐÃ5Lqe[mzc7mpJ߳1ɂdW)'d  `:EǸ{*m | _jBqc&q5q$;@i Q+z SdXۋp(Lp SUʟ2 IV?Xrs;8v]SvkxƖU>-vlboXx*Q?L"' nY 0F3Z1;˛55kVp>akrF0;SjU)oebh56[2k&V-ѻ:zzwWM=;:VJ91u fƋ#Y6>~3ur!{DB8JIDh'W<{z\ T/R;W{E6+5lMn'ZMў kw۠I]㟖,UeU5ڐZg?h Q[]()A+tQXFI4tG/!Iwsg;8F$ű{\q|yyb;|fbogbL[N%trX-KaA)xMմʦmx&f,Ӷs% /,yD؊ gWs[*ãoa {M!:p|vM뷧&a⨢%MG/aA)~n:"jt0U }vwu >߸}PuJ}6>{\g v"^9Ynd'p:z2]s1W_񟺮.Cps_у23zm&cuͪ5g<8_<)7tɳX~,<9Vn 7AOAe;J{vB+)n4!;Jo 0[/>3^en|o iJR /B(MsovbEXf*W1y)]bk.5fزm?l]|5O6J]Mn? dIRހ`w۞a܎w?dv/80Y]o%Dxm@!m/K1 -Ay > 7-[oH-] 5!|_p21\a\+ͱ Zتk η31kdWu e{=es[umh@69l݂Ϻ(<^/Te[׵m\BnpNR="IU:߹H20?hJ%!<.k gݴ"j2쬍T`Hgw]•WS {}sôvW1養$W+[ WCS2H\L ?:Tk\k҉xw˙[_ F0UӞ¼Y*7z^Xt.,z;mFhqmN^Z,AU{GѬ}&{^aϼsZtM&̏kzmlMV3o}ƞQg0MDn;S/}4wp_gػ`{)~bUԟY_d_-}]r~{`gF[6붱Uo="ȿs+uElݷY.tm^sX~ǥEqe<2mڣ "Il҈)M_T0UÆ1ɫigUBv?pT݄on8zؓ s|/@t28n&q b݂I醲?!RL9&z'p^AÐK+3^()&<*fx[glIgޣϴmѻxͮ%f `az?§ƨKp*a}R/G]2.)"Ir҉~nxRr,4nBzw6P& AR]z8C!5 < Y ,Wug ۖ-i2OɄ\7[5w.,eΆieN5ݗGtS!NA~ge6'#4 < Y` |L\?8d^9"hZX4NW Q$ټUP#:!R̭}GAZ^;l'iY8ћ5+3\NG[}Np+U4[ݻ!PmӐb I?p0t1y!P)*e%V|ѫ6p)ʏph /!LE*l:a~à uë &|U ݷYNvT'e,Eq5`w"=e[>d IF8Ylw A,3j0j5WL>k$B!?~H ?R7pў!R 7j6^zMOs4㨁erMAl b:Ig9At$ RG!ϣ]^|;1dziN$,dJq4"n,?2TP-oȬ^)&n;40j;4 Ps llFXF,N ;lϲ}-"K*l> v-4)Sc.[ql}ezK7* ̺oh^U"q< 2ctW{tY4Pin[,;eE?I^SD+%M j {3AjtE/P}s9Dv/% C>9*`pW,֠. ɏ*)QU΢!oΔH1o9 }.JI]v.* !װxrJP- ]O{J4Afw^QEsSi%ȗb+e1+tN]ʾCOYH\g]ߒ[U631?7q}G4 >7 " h7$x7b:6f b}cEj5KꚅQA*>vY>DLqF S$eô7k%KGlAoa8j!Z fou`8Ι3Vߟڎ<+:Ce.YFPE8]PoA,QPmVs5KqALY7\붙mKF6{Dp !<\vlA6n3ӺZ5[yтd@prA-6m{Y5zC{CU4B8#ȏԽY,;6"iF1؜u-u0'|˛ iX5 W2يqkH+p6f a;&¡{l:{ ȼ@;w~ܛ8ؕ< ̊*XGtF'oѠJ4Εl\d[h˳7͐rJ{؛VL{JKbcLprN5eYY_ը{:Ynm;L_~eAeQS69Q A (>!QPmwSD(5"uk2#-<ҴI?UB'GH&YڍKƑwTK[ S :kN$82m>2oph @⚽Rfo#K5xrE*znܡ: \z,Fn#.@=m_,qZ@^|VU0 $fFo5wҭ&|ԪJcA V8{8T ->(:4!LO}Ͼ|C!,'>{;T29їX\9ʔ#r6b} "֊FzS56e4z;U\{_6L'l_]*5fâ'նW[?+%E>Z]ܾcŬ]u̲x.WU|G8JIGU6Q-) WQ{SQqG Y6BqR4}7􆑂W> tW~(vlP~ޗj=|tEI+)$9jN|=iX+F-JslX0q?hMosG4kc/!T}R?O.6ƍhb{y?'&o_?в} |*m_Xϡ<ӡٗ ubj?'2$Bo\$36{OߺWo++Fn2 {E.ػ0à@E:tN(#LKc4,kU2fŨKר\a!Ny4 CVeWF[ 8R{~.8:+xG?zdߗdzLs!O v{;4g%X,B[lZKf(]5K+4J9^fś uן]/gz@NL~g7"vΣ6 G1sbZf&Py|?%E!\)4+%Yxeyq BVż|'SZ-2צ$>fD8yJMY7̣hNlM. CnKVv˖{&鎅r4 K͓ 2=/zs.Uc|SS{~|^|Aـ'߅'| i}E(D3:zs9HIH쎯+m{S":D"i6֍:s6yn@-0)V,#2M-I;4E]'9 /1IrO㴾W!_M-u]7!LF+׀ !ށ|'F`]F+SSm7uS+wS͛2$.jxep:B ˽A W8Wdo[5גnB;Dv2h8 y=24J98EuG @ Om蚐ٖ_t86FqɰB-GE2V5eЌ׸E:Q>I5wu-z 5_ŒvK _!s+qF/}ЌRѽ_(aeɈ{(apß9'Sp_acziF@%n&ɾzpnx~-Ag/jt<}C[J"h! K'o`4oKè3%p i=t -j\0P-䯶δV[-?5>ӬyoȋC՚RsEoLђ(gب;>3uDFQ`nݼ>۷xѝ{w\_KS.7O-ko-BDD߈ QI%|(:ߦS7EAzL7-^|!FU1j'AZr?(䣲r/Af1VFa_ /B(-֦e57^xh[mFmMԨiyAdf^յ6,m7g6-;T4a|#-c5JNigɴRlď ~R?XHu8YjߏIKP.oC_NC.g !)'YRHnk}{SVB^MVL%8/

з]4(C!|@J28 e#6p\ ${1rUwͰnZv${5֌3@>oڲcczo$` gu#t@ 22lQVUfs2i͢,wqSA7 GE,=_sFW,sȎ7ogya֜G-w$Ȝrt$saGBJH~| #=:<|{>nxTUXxa;T"%Mnz:`tKcuJ{p,zШt7C  ,$}" O)aN.gZ3,#H;"BuO]d7 g=!f!gvd$xrGŨ"KRS8.ۨ1 Y48y^GmCi^ߑP˾=LCg,gw;a!&#hۗ,lƕ G4s<|Þ@mr!x)id] {4WS]M Ag֙:,3kM z-a`\ %1NB쾗r{ <>8e4 d[\#Sw`Iu,)Z⌸#j6V.|5_vc, ђJXK z;D"<Z>_neM#ȏh& O ?Q0x/c:{ӑޱ϶~ۿ{-S-IƷ @+OyѰ4#f^#(=!-ZQAֵe٨يD/B9Ӟ-eRA\RΙKsSؔ}Cnr6,5T i(H1o>wpzJuT}H-r*j9ˑ)A6DExD E&|Y}>V̮%c[;un9;+@t,8Wn,Nl#"8QDpҡavWKʭ7뺭Wřf||([PvYճV qkUsAguۆ;3z&6`Og5*q]l{ڵ5ͨW[7{ZJj-[MB8<ךuuQ17t=aeYtuV-ׇy*F.s%w>ƂLʨ}}_2(nwEq Ty$\(oqG|/lZfgXl_Ht>j ZM_۔_/}꙽N9[\斣-J/?Wv5 HdrOI .>_pW)OӏG$Q/Pa<|y=O7p;]Ldʦbtx 1fbF^qǕU3 ˈ Wba nއ|?U{/@~#̰i'2E6CV|ۭ}^MTݮэ,&蚇z[_o*n3cSL/3YwS6hg[7[os g.V\ k(C|CZ'^gR()ʪek[xC$ /(#ڹaju#g,4)gfF8y.6mFM8R(fjࡢv3m۷b0A!ӖڊAT K-W< 0Dߧ?u}I Ms3aS!, cD8 otOEB)+nwh 1 4oLM܋kl;#c틃,SwOxX__aQ7:}r W6xfw!S[1YsXZoZsA>k=ezor#Ejl=Oq uKf^3y֨љegݥikU6j%jj17iT`I8&Ή1&Q[*[ieAl,2V;ڕqS/@0 w릎z!ݘ<28;s[oVHhi䮨"׸R\)g`lZي+4d5*a8JE6lCw\q 0r&Bߺ{ǍMO/[搦M26d;F[?oU<^T;Д/H5(|z`q<&JUYߗA :⸨C%787dhoFn8zW|nB"xέ)vC&7v`w |,l-U"m*m<>3Fmcȏ%~C$ECHI d-KXcj B]t}Aʷ=2tD۔_G(ۃAȃJ"U[_$n"F'!_s솀iieߧA_r7 I*pv)RC=P"ɷw=aZ7/AB5,[% d`J5}/|4D)NRDQ;ZvQjPmn!6/8\ygZSka?tkTƯb+y@W~Ciu9%~, BޛE"4`=ǝȲO<~C8y$wnDd Y},ki߅,v:| 2?^x PzH?s(-wpNkWTA&7 n?Q8ј7 g[GŢa@ e{xWAQW9DloA 5(69>jm^Dpz:Ï]n1Q÷3AcBV&^8\q4_LxY];j89j|d#됥wae YbYLmmYD,|Y i'T^1Q!N1QC"}.}:B6 dnhG/g!K]hߢ] @ݯR~o@9ow'=9DJFu`oY[x wh!Dn2z' PV&S$Sz9\)rMDF8D982Y8yvxm.UbkQ*Ld.ܤNC&*5) "ܤzUR oB ;YnB<7L-؝{͊rg! #5(pF!ԎT)!3R7hDNBZjL0d ?vL,͊XBf3XߙfjM)4 E6vDx T ԦюOC> q<| q<M5Mz!R|'d- Kf%"<Yj.>a"{bAhM!X4rꡔ]β7oċjxlbQċ-m|%n8ZeG#Kf4>{vygϑS@SZs'UӪ6*:tqh'aV{hf\e/b7$gYz2XI)M/%ʅ&BeZ(!wN-p>$ R~߹xoa|/c`IׯQ(B@s.`<.uun¼\ MD>e]n&JAĮ"r7+gi.EqR;`y(mX?jtr=b5)(~`sw3)d\ĦNi6_{Y_[SV`|»Ra,Rk\VlyqtKth]}Eіа) awq0qdžwG?/7@l+%oM 8n)7SQqK<0Ơz72)5ڢ氅)" mpiFZV:؊$sWJ*iJ 4"@:}3SGDuFq|<+*~^#@/˷&C#<Y@ס폅eXy%ᘃ r+yE:/Z o[oo{EY~hAsi;rUR^9xBJ=!Gw#rtW;D#nk#"6e\;k˨1͊=11cޕM#C]];]wo߽}ѻ[r)C;=.Tڝ ?ޔ)݄2%>e.Ouǩi/v KObQ;m4Y嚹b{ۍ+~E.|wetJz"7P#/^30O7 bֽ/u^{:-]@'o`?W`CɘCJfhaį5{M}v^!PJS[)B\v[t"_E3(p$鮷)J寮i&"):+U8/DrŨ?;I< ,- dYq߃^|Q9}nZ\SFUg N4M!uˌv+9Mk}&Z ^{ھTZ!њ,uT+IKP| q,~q89"[!e.@^P6W)W_uTפLN0'-AoA d:+:F[MBk-oH[$p=Rꓖ<<O!?MZA~l7M^!tsYWxڨuDZ~b CQxxTubFz:ʾCQ]<0")ʓgA `T*&5!6ƒ^s<aW k\oz]glMђ '%9ҺԤy!M 21|pM+B?Yg,~ˊD')p@^轾aZa{z S ' CDR3"ŤK;[F5PG/f <xMDI5CT^9QF;t]~h Փv("Ťu_=n5[Q#<Yi *BxD)&]1Uw|C0GNfe _%ހ,G(1JXL%ۓReP~tH t"oh)V>ja2\h͇d2WA"#Sq8Gbwi8PHute'4-LP?c5-y[T9St5_(e5zV7J!W{J;̚^|;?/NkTkPc"G=SuP+d!fG!cȜrOzH!'؝/b+Xp E0`w;f D*ޙfه!p=Բ--Lܢ9EMZ)0a?d-'Mm0 Fa576q#sE"{(er3m"k;dUcfmWm,Ջ_|h:`4<'鉼;҃SӐQFzS3Ǔ?aM 7N)Ф.eCipS] 1^ u"dɡ`geỶPvǁ!`N!RHMAfɷ^"HIȣҊ7VHN dw}sfMQrgNB}Lԋ3Pvǀ K5_ŷ(Y!idw. :d Io@;Az1lm^е{f>y4+zY,p2;YM.Vne<)CO*(R76򻞱TPg;Ds-ݦ&yrv{[mw|{YR-l;Mtp;7!ߖ嗯B~| sp|p\򞎲Ci R,4V1 zqͿv^X]7l+xs{lUK ?R)(źfcѨ*-hSo~7lw48eCJ4n"S6w:jۗ]\cowB%o,Ewh.j .7D{[TGܾgFFfL02Jz۷Ҵ,eQsDphCQ |(JD_CbI7h&HIӘ@ إ4tJMFt2Z2֜ "\3Ϭ!M4l5NVoR6ɖt;3kS}(we+5`6gM 7lsZ"3<9sV; |)[1=?vØ,mC ;tiE`96sw̶ #j6]L[ut-<{=5*"<YjT&fTaH\|FEOrQJCC)0QQS"ǁERq)| %oJ8H1̂Tm]IJN|!'5}"aw||S"<Y].k۞Wrz-6%@ӣ;4+fP/`D/Rm۹6(H1ԡya5:Ͱxkh lϢuK!?VVA\YDw Z-:<Fsw_\*M_|r]VDx r;^DC>P'8T{+\zZ!Ar`%Rqܟo+u-rs{`*Z= Rˌ'cmKu:up}EMo aw!_MCN'o%b6VY詤/azOU~JY/Xd 9 @t߂@Iނ("T}\DH3("pVa"I6=tR~ b<~ 333li2):~٨R> C~\8[vR7 gB=niV hi-Hr pQ 8 WP)22wjYR_lc 4@z@) $-ÓmnN<՝#S6A߽a'70ga5żX 7{aMQ]0XLT?~utsDzG)b# ֨u_ uERBf~v;b|ܾ;bLeô7k%waULl<{CmU?02 ΄9-EZc3_+dEDw}-m͟z/或[p'<\'g`GbdZd6\{ |Q 7_=!/N$Zy5GJz]+MYG;ݢ(6Q=.-Ԏ}j~ߧ҉cԭjz:~mF)u{כIWi&JF 3eߺQtr\ˬ[Fb ȁW?6j/jwDp(!583(8/\ Kz%vcW'̕0)nY'.*JA-%֐w4wnV׺b5 ^G~HÜx'f 00wfeVWYCvc@ޙPwV@eOu7TmT{*gm'WFj#ٙt~L}fp{vzduwMpb¨#({}s2}΢u1%߹dOLuԪ"yK S3B "~)q}~Yoθ6^hu766,^fYs{2cpTM:L"n۟k-dUׂ >NFi%t[)Bs].0 OwW'0݁lɬUݱ*i'"񫦻ۣ>VJ91} dFl|v.7~?-rHiV^+F`SBFoQ/DCG[h VlTLQRuT8 ;OᬛVDmPf߫؍|PF:s_kO /+]bNDhzô\e|4yP8Dpϻ%60_Ft֎s-I'Y3.?Tf͒V)q#¢So}Wua[ъʝ;*TZnA=@ P.YuK {t['\dqsMM$ >X"y02̴8w?9PR/ݼ}4~wKLZ*iU~bUԟ0@_-}]r~3/ccmʃMgn[XVWbv?d9r^k[p,y2Qcwr~Qܬ{@:ʔk! Ȱ(R?]!;o!Omـ";#[S ' C^bHJ=pC\MM/ћp>zwo{*ն߫sm˼åN%,RlKJ}}$wNyiqdF|̲|>/ 5[zmahꢈ]&C d@+ԏD6ې,GgUY7斸 a'ILOFfirg[v}ܑ%"#b?E.G7Da3l|;?/Nm\ZiYZig|˪It]T WJk$VlFK ;$YCmHW0h> .C>F0T>WY-Os%C~V-6o~| aRh{" ٻ\KC>C].76Mkkks{mnffgdN^k&_p؅QҏLbmCj(s.ãsh@R;?J: i `Ml;/42'Tr١[nZu)O?/)ҹ 𐴍nq}/^BI:A'rX,d_b1m]a@mE^KAٝ^-D| <M)?>} A>Vq)r^XZlV|r0 Y*bWi`]y 9Dv0j5B}4e?!R4n."ȌD/0Iawgg1 >9^,)EiAU XtMEcma'|)4HIȡFJ/P}9h.+1qQw9K4ˌU&v,5aZu/D&;16E{H@E>jXÜ bqseVYiTkT[-QvFu՝ i.QxDH" QQv ~ (>H}Ͷ?Bom`uߛ Lp-+u’FSKҖV2#)o5bQ{w>4Yшn;7l^`rͮ _#ɇu*síc4>!R4Pv)TG;A*tK뚥ef۱KwƺQZgf]w%3Z>,O} n+#1~j'<Yj_KT3pdu8e Y=.뮹kzM7nQKƪgśƦo;"Tq|8h%T)"HIӸKi TL`4F j ~ nNê<{UqĻC=ߩh&H.1>VGBT7wZ8!R\Lj iRHc d缡*:k6yjW»TtI=$dhR&CLR2YsRSj&8y..C$`δ7l@-jk^ bB6ЖP)ؒkK(&ɷ%H1}aDd Ou5qs) JIƃ}0ytƨ%5-pWxە+-״OB 7Sm\Dxr(^1ꛩ7[14;W#Kt+ay<\G|?Dk_awQ KN5>!RLmmwQBuZce7 fCÛBUubL}u(znFh: JQ!&+5#HuY8,ڒTՔD1`r~[).1+  oR4*m. uג_GD6|68|)eCiZJX,ain Dd{ 8y,)&jeD6lDfT!)ǐ'sM'Et2?Ud+5o*v S} *vxg|&YV٨6Nn`LgY(pr UD?P~ 7Edʝw$ã2Q :8>r.d[/?KjtbA\g]|T}W5:F&','Yrew ce.m(Lg!jmמv[G@q '(53DGXM7W̆e O>iRިH "dy4⼞QȣkhEBC9DJ@CER:.HTs돪gYBe08+ntj~IC$j _~8!̔t[LY& *nZYfϫV5*=c9,C#'ᰲ6EIeMHݶ)0Y}VHԭ W6EmSa9ĹQU}JaW3X)!)j1إf.eJ#= ,)v Pze@Lyϡ0^9JZۛժH-:*Q'vx4?+A* NKms͵wv,^`*dmA;DQ ,w@ou[i2CpɪVhzp FO]6oZF !O+c%g\FU[]k.{,5`]+-~'֕ rQ3jU-Һ^zr;\h ƄQ[GSE#dbew e}A<%D.ϭ2Uݢ| _!jD?aFt804k5PhN@3$ >d~d(IrkWkT;C<"ں)Kr{6+9|}ŞS#ަ#\X2ka;1( h*M f [U Q?~ `sS2Uez~-e 55 gJE9_kTŒ6jv#85G[LN%R$!N~ d`Q YWضuGq%>E8' "Qv7!OOSAIc!օK_*sm**|m{ Yj_RM)7K\Ðߚ)#շ8e.&"G!K&*W ^M]Ri k B[|]iK5K!O%k xxΙ^$&g -QvǀS o/#E$|X g4: d5 %Zw i`MkVO԰V`L+ +> : ,@.t߾(;<ͫ%PLsغ% D|Y}^M3rg  4dtCbEUWoH{|?Ik&m@aR6WZn8h` m*x̚p S0 [JC'Z\C9,du427#[byA3w!ԵНm]qA @2 ;Y Cban,;-Fݡox6M#h⯿uk`Kx\*̻gg 07a|^o˳;.ns܉2 < N7#nZ,дABWܱD^x]&jPDz z̴no>sC‘cR}S#@z^8Mx ID~ކ|[YuG0Ձ%LQ"6wO!˭s}ʟ0a'~vu_WmfX;+DuIAa!\kgss T,as F<.rm[Ӑj-PbeXlx Lؤ%so_0*GZy{`[T.WaV!ǷZ,nbģ!RM[oCqɔ;&6jBަFzزm?t;Pw!wd~_meu11y|9:pb eC$rEw?萋('WYϒՔ7ԝul3ǣj$e7 GEZkVV+_ɉ/:N8y*l #myLW0|O NR9-ꗈi`r~; Y #٨WD]NCViQـ(oۘ.9xe<3xg'Qf} 8tחԾFb4,5'!:3"|#x|Y}/g+,>r4ϖuK8U VFjѰ;/i8/5,{c5}#>dFML5[w%{}s2}tҺ^~?;t_.MM޼V9re{p/[C@2c7G$,.8ːwuf((~= dEnK&+f7~KD>Y*D",BZ uCjNt%SvcYžQAVBgجܐAkad~/Mz5QStTYC#>*n=Lw8!FcX8oMoV12\C~,vP*rS;qXBFF#Bb۬}̼1U~3{[U%҄!_GgNz65qw47K«&5NnA`⽻_ pM[؝mgd6VIq ,2&e[΋R7Pl_HRHzSD_Os"ukogЙ&7I?URNgwRMGG GV&:}Rsr</ly0/yi ' VꆣUQTQY$ GcFt 2Uê5+="^/AV#޴.05Y,n)ccݬ[0j}{[[4Qď};nN'!0&T Q3ǐqܺ&9#"T?E|:F461A=XA+\gO0Owk#{7#3!jL^RH1{i &</77L+l?f !*G:^Hrޠ?ةL6HS.\k)'93Qxk]x0jzhy: WxWEZX_¢726zwlE+k+w JPjHUa˻EYtgs+=2?n鵱 V6pZգͼZX}f]dKo{ozB%!w[$ H1g0P>ܨh}|<# ' "ŤO֊QM}N{ѵ^(1*1JX %DI) w6Q>:W=ÓbF|̲|>/~ h@?Ԫy1a#.e†[: ",}r^3:7"]%怴s+B]YYq?,+V#a6'!K&L,kYdtۃ!f gbiG Fye $U:Jqss%E!dCAVUtPTlI,=nuiF_C᝾tX\Pn_"J5n()@`ф)1 p*@8+[ GFCPaHIj 00MvB>(C'+^YmXκn1ZV+:NE/{ A \mFz{v߳PvG)uhc)eZ^QVqt9]HQ?dF1#z'!/}e.q8<r”tRF<1 9s1*bqK É wdyo+/ ^Bt<K息!Vr8!~Q^1=,zrWMQ""g)ڻZpr Yˆ 9<}CTs>GQ/.j3"׷r ]]7sd6]'~B!-p T fH58qe .%r8Y޸s'~7Yz_-&a{7/r]_ (ɶ]]iG"-_RL9sQGY|B-cԁ*W!5VQ(K[x^'k*eVEocMYje8u5xSջi`Jvs5M֨5.FLo޹5*f⫢zb9KFcZɟD3zd--z#q\kGmvUMO\3I,)ރ|]9eN@PV_?YWκ2+}3I/+ ѥd-Sc5JN?r\F1E0"<^YsYUn uUn z+JQW5 zYAzEiյh[jj+Wj2연L٥G&Ec_^l 8\C}HfySD#us9DVDC%ƣ4 3Q[+t6DIWif+B߲$:F/:2F-f 7VOǹdPg2Ic 0^gTb"MFYmpL;f:ͲD十!7HإK (ЭUvGrBn"A5ncYM'|%nP-O,jzc0ZEpaUC{9D<]jĭQM*Bn+X]7>@1?"?[^oIjBj=V۽/v/Lb;t<]Lbw}vVIO|r;ةJ nj?ɾSO}/zg>nSwh9^WY2ΑNC\-4m^igL߈]Zv!PP[I ӸpGu;Y#&%~ Z{^|47r!jTjզCw/>tW-=DŇPHK\z?SUN-`37&E<_z5?1:yZ7 _[jTYwx-̽a)uUGn/VJM?S0tqTM?F=N}.n(10(OMV17_f٘[z٠Aun||vh^+d7)S)OM~U!8Jg:_ 23)\{"{OzfU_fSGcKfssn7Jܑ'jD-w_Cni";~ caMagq (W2k[ظq \ws\-[řp1rlg+kR]"oBL%(#Gb oAo]7oClG5!|m^jH+k"Z$ ܁-YW[UzD# K]Gsϻ(dnEd rmg}{SVI%'!_LVL%8A wC>U!dI2 +]0 ͒6ISO3V<<f lcWh{i}HԹRs ݰղ+XKp\{ :9_\3^ nzOxDTL N,/_@Vtp@/Pk9 po0|mp昘9kռ`Nn >I~`>~Za |2P) u~m(C)bPӪan'F.Ve!N*~!R5ew̯m-I:hPe?!RLժfme4 < h^w{%)P9DI3GQs*|:"g"ŤR>za8eGP7 ' eCtsTgKlմ"uAr?η069S C/ _H^G=IRG>N T%@$jZoFMިdgO"q/Ņ'h?EE+cnغ#N x)g5ܣ8Hd^fL_]KdLڨ^_β 8A# 2 SSzר˺iVeA0dߠ${.ݗoi P;EEZ#W|" p-hS$#!:r`j[=^$;U.'~XA`LCAȃ2o16݆08aܰ/0v cб,&q+&2'W _+> ;V  -a?d.ҧflC0,dᢨ-sviy㎽}'8E.Y75 v13ekN[&a96&qM"I0κ˘I&,: b])1m79YdN4]$䡝@QIRI^k<|-kƾ冭X@\POj?QpF dJُM`HC/1{K%:.*C~d+:Y(a ،}Ոlw@~S"%M#;=֞5b`Ԅ$t_ [= [ʯZic[L /@Vm"=^{/e)i|r>@A_uI0CV$>R>P˩8m잌s;!K_>@Z|sW`d#GwuRFiiTq5`k;!W%&@n]3׸tW%vTSġ|rQ*ewC}Cmb^o!wg}Cip; 7Q TTv.мfFͱr;,3k:3WEk' OHjgm7D:*pT-sö6G(fZLP7(dPK#h<0VN/CV%VvO0$]&킹0 5C#L>I,uX$}`련'!:gi{U4b[(˩րEhnQKn0 \ނ|krxԲh!p T2 <|Kp.Fk,;֘C إ.-HFƽ@.s:kFX-2-5<Yjo۹zkRxB$סnG6۲T+ 0p) gI åsmp &({ %M0>KTNtή|Jd;jxԬ5 ш ݷQhAf eCiQvi+ئ)(n Sq{jgF#REm&Apxȱq,@.t+G!&D[Cknϔ8HIG إ 7 /l_sZ"3 N,J-YM8ɛ eCiB إwIm*aMoMRhTUVkkz^eK #3NZ81NAsF,oCӐ7-~xgQxH ݡ&w&Dl]GU~ȔrHy*"T[짔I{Qe:nmQOA&; < z[IJfьQ[5$2|aơ%?!mve2;C=9}<,@sGLMڦvG.9zC8Rw:nEM&t6N8y&tfCFJڄ("lBELAaB{ v݌|'*jJ8901cɛe?ΡL¶G?&a5G;]' rIiJ4,r,c0R݈o?6důOIa0dO]b|w|S"<Y].k+B٬6%ӣ;4+fPaD]ҚT2(Hql)|!T4<7r[+9dѺ%ǐ+ ./ ==N))fꏸlwyʾCV)X7a}uY*0ٳnLp)Oomc Rƿ蝺 nHhk٨Ki9[`j,3Cs=5:ؼV *tVGgb#|Jep4'AuLsuOPb*eo`opwhɁIѡ")^=̚Y*ԖtQ ymZT)BS(&:]Q㳝g,+J{qS$ i.zԺOC}£a36j^XkDC]-kAC+$)ͼm%lUl!Lo9Yi^7tJpD   p2 6^|5S_6\Y٢vD'!OGBڦ-#q(,(f5](d7Gq\2`n:f`Z-1>|Y=ߺF˚j̀$GV*oЛ0LT F Iu%B?a~vFiXT,W=7>&&DyW1cʼd D{ }kMy)\;C/@N2LYIy7mެVuFhhaغ am\ڨT"%ʜ4jK"j2E4ݖ3\iP-&s6ެ^kV$0FN{?X2z%־2JeO y6cnMr͆sZkBnׇ@Cn`ۍ*ͅ[7%+ްѠ7-'o7 ڃz;ꡱ5 :[̀QtZp@J-z>doD[ @5r'\v`AT\qi>Zvj vM簘Y.='lƿ@愻!͌'XVSݷ`n4Ce!-Zf=f}wGa3k_fl5=f856-|o`p  Q讀t( pʞHD>pzInN5H>gKІAA0BfF+ 0o;aKE]aOi0?5e4-EȋNzm2tɖb#+g,c-wkVmh]S˞mS)`rAYgWXԽf#,[ici;v2vQ"7(SqRTiʦ7ler%Zw+Ffk,]͚-G4urYw4#Ge.g*,S="I6ßJ'*DVDРQ++~yt͗kkVi,W@Tg_݆䘷 (S12kv}X/i|r U+[yie6M2s%^eP%ҥr]wU|s._6W(m0!\k&-d~WclhT)Cs].0ɛW3tW'0VMbgKf7+^]%]vT$tIwuso3SNJSLq$ˊw-lc5s33uǩF6eKNdV KAT u(,QY([*PܞUII^Ԟ7гX+J#JIwvoMTsO'*FPz5N |.o{ŶwGc[b~+)Dl[D% bZhQս-Om7O լñ475j[/nbZ`+n|U*)2펊ꨧx3SGDu d(޽w+G_Sj?HěSD>>DtxLx4v"^wNNR5%?vϼ&ߞhSE9Ӟ` .̽a,<]u$젛S0tQuU1Ġ#0(OMV17_f٘[zN: RgwW7 lJ>;4׃˖܂~Jm<5}cя_G$F*_Ha~j5-)JT8 lwYk8Q؍"@5[,W޶%~2ߤc~؄8dôf?~e~Ab(c"U@ݒgߢ) eAG~~s-I'YW3nlgZa^0oJjj}c} ^<6zwlE+k+w nZj2Te/č;%{=&Xd5b`ݍʢ|̫ٗa͌Rmx훧9"[ldZ3bMs+ %'0:N:3{"զv2KAni^nZ5*6_A8D !_a*O7߲Y^*5XmW6!o\IR9o\ }L1Q: yE jZ5lٍF MAiAu? d u߲V1 w=II)cGBXy &}VB!gK e?!RLZ9c2e\5 a0 )P:a0@Q1ޛyB% J@=P iȧWeC3}\e 684? ,@  < d /$$G|ntNT%lVUVgfȣ,uXuk$˒lK݇%^z^{e{yw՛_?L"uB3nk< !P"1K#U..eR9_Tj@Q|r6Ry5 T&aCnS .Ec!"t Y*BhGSv=a w"Ǵ+XaM߾׽ߊ9d*=nJV(UDEy(.lWD<2de.1„ @! YjAR{ׁ'/PC"%Mݺ鐿/-;%NLzFEQ7Qw%y`vx rdT<̼%R ,պ|jFF89,R)"ڥ|#0pr^ԗQYG zqIH={vի^ҺZ^]^g{׫42dxr_YyU40 9-U)aZUG|#I3>!R4FQ(P^ rKnP=Pm|`Qq p}<̊Z%=IrS}T}jG Q)NJpxhM/T9LCNǦN׸&hjx 6H8;zEeCiD آ=F< YXGh;}&AxoBp+!>S|V2dN\ކ,['4d4|I2z| Y}AS8Dj˿9sZ9HIӸ5.#8/$Ȏ, ;6D8d]3+mXԉs/މPv'w$GΊ,‹vw-0lBFLf_) b@S={w1EXp6S$d*}MTjeݢ!QBda1^@:I(#Pv)S}z Ö>)d#tJnOUּmh{кaYf8Uh{>:Adk3i)t㳿}kzeYc4{XN8橇*MyD/P4VpoVFS NBܳY)z̈́K{cs+ޯEy-[JaFeճyںCeRI V[ &lӔHIl Å7&rNIRsn93*޽KM7;ƮUnG[h3@NVqD& r !Kt1-S3ϴ>zg!UV-sVCQ!j}[WtΥ%ħc~Վ5Ft1Kː@Lٝ^BHW޴ShoK̮!K"v3$= OIx5[t< t{9B_ͱESHk- gMkɭN{9a'DLg K& DRq*cݱl’dr7If*OM\C|34p򀲎XFB! x Ԯ@!G_{,[bt >K*7 oogHAx2 Ů}2ˡa͌' 24"12 i#oVgxUzĴ$&ϟBL[S#O"v5:q5%gLrgA=euק觰 i[ =hI;ZD(0H*Ġ'6JJZi`pZ|_c կ: ЈE bʉf&1A̮' KR*~m>4HM5F| y.~Ci̡lcaAj3xۙhn`[sp率sK|0>%LE*hiy }k]Yf{rvJ8Y* !̒7HIӘG o{8W㾄>Y}B0MJm3 ːN:tǬpGdnG >G!&Qc"گD!=&ݠ)"%Mj C5ۂ^|GB~@~Zf{f)2l %=,d3x 'lw솁w мX?C0Tݨ`R]o)^0lV-7òD}'xt o|e{5Ds4@ SW$+!CS1R}|LbOٍb?UYډ} | 2}4dbfDWՕZ|Ss}8HM)鹬_@rOl̤5=^筓3|0Y W3:[\b[ul G)?%T7sj9Z-,/PjnOCh̅?!R4E ޫHԾ C%)榿=z(M?X2*n{J5ZsDky7pr =@I޴(GJoR} -$(Y+UDH*WDR B߅m1 I(jE! ȝ![dRv'#Gv,׌[ӤQCY\1K%sr±l{Rٗ/Sq.־l|%?1#PK}*aoJuw dpdc^lЋ]Cg)L~UQ]|mP2awm7͝)fs?lw=`߅T["i])zkm\k+jTM{\Y!J~C͕;Ձ "lPͲP{t81eD=ioaĂUh*ҸHGm|Io}0lG $6(QbnmӣޡAv@H3JMa]7VjzQ{U!⨚51A^%R%F5Q^7*[ުJ{TVbVU%R[TMڪ("=WCW 2+Ö㟫9MɸDN?a"!N\(3 j x։*L+  x"gda?~閵mCQZ4O+rJ o@Vrvkm[-MZ1_A~̴DTa6퐥3j:xZ[X `)IDoHUn`/ַ*ʮx ӶJNOAv8Q`r:BTVAU2z @^5v{!GrGpc $[x5|+4et= e!6_y LuIV<+" &ʦ?a4)m; ]Vܬhe ZIB"㱢hBI>4Υn,x9a)5uzjfKFaS?qpvnEwD/5܄MwGҐw,ތfmBTļr O=q*t~~1濌5`A/c+;a|ӭСe7n˵c W53?jZ_]!>,~KAKw! 㐥vGOm,lXzu4 0(]cdm&E40XS-twYV>\F()|Tgas!8No-CS~A5j.,M@pr1fZn8-]Z͜,J.D[pz̻kN\WL١3B>k I.:+i>+85:Rn7^cAⷂ=cȏKn 솬>,SYv4㺽#W,AhL1al &'&DߖY 'p]oC}Ʒ=thfIDzD>/>׮ ?~U~;sȟ~; _$^["%Mwg*Ӭ.5B\lbe6&J? ~W!_E,&"ڀ)k䜲ʎQ"y][Onń# #!Û Y'Y#SŔˬbFBgO9fsfJEz^]>pQe@5 EǸ\% ߍ*{< KL ޮ(sկOU=O;t~|+KF0ܞYVQ*~J撾A3B 5vzh5}4*zN ?tn9_ GU)mfSt>҃c,+h5oςmC[3^> Z?vqva~«Z=0}ҎˢJl%܏bȅ eK%bz34;5:11GL!b? 9pKi`2 @sXЪx% }2z%"wE珢 sOq7vO1f2X2]c 6Ʒue7ż'r)q"TzM} `$j~]ρ'a޻QsbCP.-ßo:lk#p[;ޗˎfG&+__ېo+ssXބ|3^擣.5҅I SQ@0NY&b0x>_BO`8/G/:4ib|_UFyFΓ@-ÿ ބ-| %U"T CsX*ǪU"QJătʿCy* @𒾡F[uC%P^4\:J篧k[J//e/FN˪vAG6ۖU{:]*j~P㫏~P)O鎈и#wqc &ټ$uHJ&k=mZMW:/?ysU\ۗL'l'a|u԰[s {C_'̊Y6 lѩ yZKnVMm1u,bb8ecw M5%O/^^՞>t׏'6COҝ`5-~Us;WTZZ[.^ ؋.ۅ\;7}:qM|/4.T|~}}=W4MbT/땒FYw,`ɿ\UiׁUJθ~w[Wv67W1vg\ޫ 70݄\61F7;1]SzY*Vs SJ/ܽԑћ?v:Q?#{z_2YѬd-fZ!. _A]w^q?kOAcH:ewocpC*㍎51 %=KÔ파ފOGĉ⛈жPL}}|H!ߝnC۬V=tD(q$[)H *cuؚU2Cvʿ"1v'%D}, xc?ƺo  (Ki[ /zvd$z L-ې(K.@^͊ /%c@(| yYJ.Xkߒf떡Xo6`war.mmbpb2MT{Yȳ3o i};N;# [T\epxf^t#(>iwјz\;l]JQn/"Ô}jp*b:")Jt#4l[?oC=={b3%欙VDmPf`wm.T^爥ZmGu ұ~H}oV|?2w! Hr> -NdО~C;??Rפj.GO2NoT*_\]_[Wݱemt\[Vӹ\P?\)Qgw̢XWMfzelh;h8=z}fZIe9PR7}d5Gll nj;W1ӿV3i2@_-}^p~tHsfƦGKu}mmF=vl(;|%fD1!R`(U毰%]uߌf{2hTBjKznA09[($hxb?qBa1q~E;Bٟip.KwjVE/FCӐuܮ.K 9 Nm vs>tOAu}𐓕K2E}E)3ː/ǦC~nG $+Qȣ9eZmKYf4mj 8>K;%R԰\9g^{$7$yT]XO{"S\M܋TO!R4΢lMqЛևCxBDl2UClxOW'QQ^\m =JT+L>6cRk[_'HʹچQ2&;;WV5*vP MK>N$>Q׃г%n]oJ%Z[pRicj%R;./-CT8,rf71r`U75', ,l@~r4[,u5Aj4юk18ˮ&JJ|LIUf0 z@N)Ti22P#Wșjp)`-ar;b#B7SLxz7q;mIv5QwCD 7Q&m,(=(j= F3hKRr rRӐJâu^E+j+NCVhALd5w KoyY߮,~E`񅱝xP^% (49*sDpxbsS_aw Yj2/Kq7!l캀 R6^Kg("z5;cX ]];Y1=(v::vRʾC$IթJٓ|bl[rB험 P1Y 4oܮyBz988|?NoBr[M96FQE xއfԛ;6Yޏ+ Bn9&k:v`p(>RϾ ޳pPtnStCQc¥*r<ʂ\\}>5KCC!K]eus5V,} vz%k~ž@V7L+Xq;;`xǦR]EZyҿ#m0r~]@Z;KKUH՗Ī]ڣx |w&щsDq m.R?dKcXE dvsmE^23FRՂN>~;?7‹ѱ{ḊVlNTǁ! OR4 tq+Bl_pff#f DθjچqM[tArh?^oV[zg3wbjKTgSȴ/\׌>i;hߗ[1tR΢v,Y%{؜Am97Eu]>xГ, bd%<9U5[_-yϛ0)*t|E14+rx֛ewxe]ae],l@yy6~(^NCVg"'o`O٤:zE62&z1ҪoÚ !ު)S‘톎&zl>HtFw!y@yN@V&2+׉$)䧱iHh" ځ xy-m6 ^9׽^C(Ŝh#@o603 |Y&qAKsHc{YE֋I75nZޢy.X-.U߭CYqqxol[XRLS[XƨaAd祝%-<%gǭvK_ Cdopx<[5u,TaHþyJGߎ&Jm"I=J'rHJ[}rԪ0cTrÃ^O0FeuVʲ-5lVl^bœ/9?t9?d׼+?hٲtĮ׸l&_#\'N0Uv7n ir&ԪUVR1eA2R9-~3#LCN+WG3ڥAXr`c/?`sHz+xkK@ڞ M|۸*Shw#h|4glwcMX38%MT Kf`&lАx^(!V4i_xںX+##8>'L3 .jmt[ .zID|G-̅^ʾCWLbD`+iVXִ6N~K9~' "䋱Lׅ[ k|`C#,n Z\qep8IGwOщ-gtGU5;XحrھTf:aURo{g f,6oR{kx^%,SicX6KћƜ7oan?=6ݾ9<111njQ0 NKF\,fsIW #Heܜ*Pzk&Vu⛈Fϫ7R=[ߖ10UG(/6?Ts2}enqe)C|=WyO慰lA/y+lcEcO{d=L8Oug, N4ZzkNS f[`i̶F=q79vsx]tgHvdtl1ouc5RҮ3uQILnR~Eq]S;\̆ME][E#L9Vs]=7kVE+)D:QxZʹ:VGDut{vwƆ'cnb5 țìXn))5ш9j4jNEoo9AJsb]rCf ݋ݦH)D}6$g*o+Z_ ?o驖oÎХvmȷcS-F o/^D{g-cp;PQ&nwo!v9=.m F=~)oϿP1C#t'οPnpŻ!S= K9S sAIO^gF8Dy*m[jhҙKM--GR_$;AQ :@i-.]2B)}@c>Rn*b.텎x0d@fd6Ps̕ךGG^dY.hbu8 y4FG&*[(8 I! O1C3uB/lͧp*xibڙwz*T}7 !wsLW{y#!6gc8FcSv'(odx | 2cfU, RHzߗӇaL䆐H!>gZo2q ̔tӿK5_; M/@~xVk>Φ'otH~.R/pQo7^ e%Ācb7(/Gqp/%wnr4 yrrB>*Cͣ=ucUKnboW*D֟%tA~&]u{fD}Qy\z_D!/*}B~c#\O/᧐?MSq4 s[zEEdw5"IZ<_f ?@Ď/@ ]ouI7Y.. n8yxqVDlDUhxv=G\N=_0hj )SO)kTGiucSU\Qb7 | i2z|Ynpvh'sO L4Fj"Po>U_G'E6U8Wl:.H'%S3!Rb)&fD lD k@QVǓ>cnˡk -̦i}»¢ѡc7K5[:Y5]wFZs̸ T?+2Նnxށهozi44AW*4q3&YaMC\fomz+pؚF}Wب|/5ʅ:Z7lG)Bi0A;Zedyyw[&6hj"]FS#,nW뻑4ot, RpZz z{;o8J]r #I56MorY1]E[#< 9U-ktJmw+nǞyC[,wMozK LOA"l`vט5a5d Zn%s(hinMJN*= |Y}f7۰iCe},#.['T;z:PxvV؈0 9zctl(O)2pܦO_,J)hxdtHleXrh'Jo ʵcTKFp6C!_rU#K]U7aѠq*hS"F]3;qٔ(vYgUˤEtL:dۍ-u[ؼ[!̛{|7Fk;n40f㐥 7U?GpßNAAKFKx(jIL&d,vxn*|/%ۥm$}H1U%o $`vxw?"(]xvPIVy\Dz?`v{mA7o C SWiYf]K§^^rc}UұŹɻ9*}i̓p蘾Jx!MʌNܽ=$a9җeHo bZw!7/pIصUW:4 ~6Ǔ1Y(<ar: ~U 'E-x!ChM1 KE.XF5Rp_Q!JmCt(>¡3ӗ!\gn%97V(mhJrTq"| r2ޖC`{ѭ6 9&ȖOu]-ix)Ȥ]7# iui&]m7)h:=EZe340ۦnۃ-m4+yE@uϟ.w7#>C6[5Wz:VKKn;xW'YQ"m.w9gvǖ'uLxѢ=b띜V*޵EQݵtg]+[P׎EK4RBD7-[?aFCz=L}_M57\;Xe:)W_7Xl:quUЋ5K^Yߨ٫ɻwcꧩ*g! ߜ'Ow(&|x.CVo>WQ6|zq#Xf'. 1D3E_q¿2AbAP}a<r?Avj ew8y@YG7_'LdĀy$uQ <~FR6#8n8eFNewvh3'jAVBG0 >->}ɇu]4*XUAJӠA̋I4: _Fu!KO*h M;idtCe5e%6}i.}@Ev_]+Hy7 E،Kvu3%Yeރ}2/[3KE51 +ef 4(e?^Ƭn {0ɼ'6`CvT8jE5<㣆k4Ԭ غ΂-"үi!^-d{-D~MMCQO*WM1@ff$5"={?^OdwA\NAzF C>Ew^UP{[R0ua& u,N!ڬ`h6$-CDZ1MU^'a;8 "gFAohy,{EK,SWfE];!>5Y!3~ iB)^\Y`G`lM[+c>ܼ#^kp.OwʅY8&fViuW\ik0oDxbTJZHEiq*5 g[K?խV!3ziը]mҾ2J0]*"4!@e%ʴr,ۼh*krjQUF,V5tX5띧F/sܥ0st+אg= | R}7Ow43kT;k~ 뉥nawߋU3kC[-te 9Dx6YB|zb!&PQCn!ibX@x;X0/p{X\5t_tt?w[HB1{o}Fy,!Xy m 5t0#!eiz:~j*+z~vm+]-%arZMr6b]Rvݖ _6*ﳬCԿ]Bno"ƽon\6u2&UǹW:\JߕzMBs[x,rxxw% |_1VPmTC׺8DROnۡV*}~)}OacpvAGf^pێ.h`9c#LO{A!"r.tgvߐ禍:幷<`-ޡ/?N،y|[bu&8n)\յӖe{J?mc{Lf:d᱑]s;^`7s^f`O}u@̋%}ܟ(0d88:LfI>cVybK{}{#3O^ԝߔjij9accwd֞%qi.ٕ-Ǜ~#%Gڣ=SG=ҝ[wn[7m C>;ΦCE/aaغR=u(q$ڕRC_>Ŀ+\C􌔿ׁp@dT8wL|f'])wv K_2"J0K/B?ISMfLHҶzdlTZ.仱u,dč2 '~Sb*}ǒZ6#:> 8TT鼣F!bt~7*V /A7坱YHVsL+*(HFl;& +)?!c}oVا=@k餂$WÚmy(vJBu]G^.6&WWsi<̿uο#VkaR^ru}m_"c#wǖqmNZ*Z% j?9{Vn2ԻwvY^dEх^zp7byj~~eq~~@Uwp[͓a' moF FebUWIzjqXCG3M 5mdF=FMl(;|%fD0!R`]_aKFh͂wZ/UK/ĭ R1H<>!ukQ>] !?Q C>,C(bxz[G I^Q΄&r#%4CKt*l2tpO"Awr>ڵrY6sz9]BM@/Wa%$H1w('CYgNAK^;qv2ϴF:o͒iY1ʚJͲn1*1RXE@I^i(HJ;t"4t'j960PT*r9`˵&~☋Qb;w&JGSԾXu1l8!nv,x ;>|)gJ(ɉ1}麼):ϿFGZ\/F5B)<ĩN^}BVy&IZ"9E"6gǑ9!7lUɣy4A,{PIBDH&ص>{ Ȑ %ӨjBY%FNA>l.rڒ #^p.0w_ mx+Ϣ  TJCơ;;<Y*dz\&cC"pxE8 >4*085Fƪn]62Y;G2ifcw)I$~֍2z ΂a?~eǃV:&|$;1w D;P"5[[ !(Tx M^7֯J|b'jS!F҂1 mMnh,/%/0nsL,#B|-]S۶6.)`?dH#E쀤z Xԋ\j/mP۬T"%M#5^ rv`'d)G mlt`/^%OsKexkؘvZ*]/$Cr09c=DTcFkrk>u{;'[ h%724K+8ğ$:ꯪ*z\^/8xwj^DŽM}e(z%RɨB\(E.\4"o@@ٝf!Ͻ G}08ŢA,rҋ>!R4lMw|.Hv`21,wwKG?bN5Btj  i`.xU~Ä5߈=EJ9%A آ%eo"YIځG!KM@7 < 9}h{hlFT!'0#Gٝ@P6^ܴVP=qb[oŨ%M<&*@~nB~9DRG2]Ʀ6<<=YMUk>}Ao\^,v|PvW _Q֔7+$j4D*]Xs t}bal섐~eVTO F'(hprZxQ8T_)u}CE-u KC?é2Pg8DJM@-zxG݂vkFVf%%t WJkN&<&iREb~ z$whV~jWǗ}ja:@9DRo\'|^p?*v,R#sߢ xBDY}ѭ˴AfZqӀ`ItGhK tnE*BUVppHcAG{d51 ;k{h!>M`@AK]fWVIA\Xt} VD旀#1\<$2H15Wn|2KrΟbS̿2E[߶tVr)O-׌R;?4V2 vL:P\fN _QSsz}f;p-˂*;}s*=8bau)tTӟ`3=?;?9?_yW!YeCOFg7.%~dJ6C<:,Nܽ=$hD}+€L OcJ Pmd6o&G:r_m;,qz@tqV7DƹԮ]BMlgfN}gw'[&*Pz&2Ne)J90&Ḏ,^2yjh|Ml Ϧ.NQŶC!aU_&LcT}P4\.y;tJ!t@s?*`(}(z!JmTl  |^#4l[LGp=NVsL+6(ߢb76[`H~#:v[!KZ O@~% X7bD] Hr[m aE(vJ&|~w ~ڋ I'\GniJ~Z}9ZYJ7z_p~_┱c踶|'ysWל\P?L)Qf~d++^-o eyY^dEULEá;3l5mͫm^+FI+1;2ar>0%8p,xg [SM~) nmLW-\}H4B-2S)rs RE+-%XG]`d ВV2at]()&tm@jB J@5ӐO' Mw+8TӸXP;³&g$ܗv(i\Q;7-;IOl;9.H! rr C;!`eC$IMWޤoϙ,r[ICA߂,w6lFFP[I tC YkzH,MKCm> VO%]mFE.6q:\}8|%VXWȤioQ p`H'{sKmyMv˘B׶{DJxokZ:FYp\6m֜qX˺f? ZmC1#ܯL| qZAV c {iV`қ<ĨO&ýAGV<6&ÞH,68K  |0m^ǁ Ku7rnܗrKtQ1& L#~P3$yU:4vrss')6](ؒ6щS"vxzkN]*F9ȹX5LE`z v<pxl9QJ13(&Gʊ~!RlxW!w$)'"%Mj n|bv`ÞWڙceU]Yao[c)mYчrIĻ!?lQsCDp4 I i#Hw,m܊U_Ӫ@HkH"Vn}Cipr-";6ELM5Qšfi*߻"7nzI+w&n^ |Y= =xXf;Ï ArQRm|34O_)ija\!K| ew8yPوeV8 AZz\dAKF)8dS)&Hvܖ^c~!R4lJv`+WiA{޼p\g?~)jĵ8Yi5hZ*TviePhqv 2/n43bIȈ+ƓL,YTF8 y8y+s"%M:j sƘ 0_u/)m7"Jy}]?pEgN0GV.<'!zsm Rj͞H1R}GH~]Iٷq$ـҡxοVvt9{ۄ\s@Qv' /ЋlISݤGhkZX)նKٷqvT錤XHre[t%'8Xb6Q(PqhKE.X7J(qlwg &QC##") ='cnddJz=YFexZ-v~ArpS}86N6[ְ;ߋ 1} @>|*ҁcHBnݰmK{⯜zh0kO zi~U%c۩{"[-7z r&2YvL^j%K׊AZr}k x^0s^+~q#!w]C\SjfE^6%H]ހ|#^2BR HYceY-a do |Ǒ BW޻tc[!^ye4S}TQd۷(tgoQA`ŠɩT\&dJ2E]ZkOᨷctۍ?dzZdH'HdId/@nL8"d]=Y\sX}_YrM"Lb >0E !zo:mc1(m^a/g&iiBbo>LՇ@םm8zxCu?ۋ.ͼsMMn(ꚹ׭,MQB t@O' qrwQg,e!/Xs[܊krwD#*mDeJbdċ[:kyVصjմNxr|o$"s8y&eϺP7YX*fS -&Jm"Ii4wCVMExJ04]uI?ldT \ LE$ GV&u¥Uͮ4 nRe7XɪW OO¬?S<2u8!Yj߾ ^% ڵñz/b̃֍;hgL{ ('!7HfwL?ϐwR6a!̔ivVrcۨF0/@09 :. Q b3BX֍44+\o6@}X1ՊERT5ѭp#9.ڸtJF3]wۭd;] XTͳt3CXz-g=^_s4lVG!}wҾ"|RfI߲jTVuQmNYNgL gYӔ?CUAJ:w3~ ۛ~"$OwJxqE)B孇;Cf fNZF\ۗL'lZ+RjX'mOi^% [:R11uteحѱ;{ex1&/-C )iSjO^RtN!vo`WgF#\ieJeFo+[t[)f!6E|Ԭ[<(Z񈢵i9QFQ߹FwH HI.M(ڱ!I1XE&1qyM|Eģяwi uշ7uۮ]݂+wIzٵ#;^¬xzy^$rURo<7k-Z'"c֨H<i1uD QDZؐLa662s ŗld|͑;̬9N՞s6ݩXЋr?7yrBIW #OEܽ512vQQtva&q;TJG%Ź5ߔtqbkT2n ꧹ |amR!oqv#Mδ?L^f3kU(?ɲ12t.sAϽainn|vgo\ulRPuROfy{\aEawwO]|Yέ!uVa%}H͊JNQWVS jJ:4ףKw{ö-)UJ)xhFRH.M빽DRl_m+ *N=5ZbyT@͖ڗfZC*vn3&$@5ift4R5?A ;6t,ɺiMU=뤊$WNx[?@S2w==c#{t"^]ͥyh2 ;QOW _ \]_[W/|;kwn/k5Ô=zM&s^aOni8nzel~knw}f\<QԔMwEbo<|7wm-oR0;(y3k]̬-(Ws:Ҝ٫4i<ڜ͌z6[Mr[kw؊Y0Hm9/8t.t gE]P/w+˪[6%T I0 ZdT<%Rm0/33wS{Cwu7܈Tn2{c_jI2ʞ{3HIF-tT={Jev:JLz -rU5uqx*L/CWxxTi`r ZԫRJ{KޝQyPh[FL;PiOi(Nh鶨n`[.7)6:l%s(h,3V9r6ΟLXARb l*vwYi1fm]inخ閧;Qs'׀/!Tf_܂.rc LԀ`d1!M2-Zi0W<*;,clnI,8c%Yo!R4#LE*hx!O?]YϚ*Uh1sB_)iPh.&؍&:rn {Rs1 3rʅ3 ːB+-ڍQȣF)+1c6^PQ8!䇱)'eB~B4yC!"`+3xdQUmԅ/T㪧c7>}2r!8^+揽wz=4ҔrkuURkQQۨVGQGGy{o9 H1kybj&U7W(qi)Oа*;t;u}fQѺ9qnѩo ]3. >#b[w%PPb*}ǒ;*JR!4R8Tmt0Hҳ]"QRO=1Fݑ=AfvF.Tm$d!K} awj;D69aNt2$WA۶<)s w?1!d-g >o2g^ƥRO_!nߕ?"m t !!ЃdQ>>QDq'ʾæwA\GB\?gReaRBF'{~Q6'-URt]Kl̞(eE=TdGRʣ'8DTqCD!>%j7qN2o3zw0V9jtLHduc3JOc]{hFtaIr0< J1ei͘eYrG 2sǼ2tHx 846"N$zb5~lG|&zr[@\-DU㱶jժ\eEm3+2KA\#vH zV)Ȱ< fÈ3 I&wcݨwBG3T5 ƺU|;t0ɽ3RaL7>'!Oү+u5_e5`۸ v5k[Jsy1v@<ݩm(N(v@NS^;PnG(TڞT%=^K7_>!R4.l{퀚D;0R E?"s/w?Z aojk-r?|!"}s؆",B̴mIeHIB آX)H:LP=htAc]JV=ӻW b .6 RDPm*:.,5k ],d9E /@o+ o@r⊹BC?/@<7ImZNűiM8`z+񄑗i*{xǦ+g| v! > ZoÔ`c5 댊gQ"^#9rs;}?OLN(|Ew/ x߻@ ]>}v wWa+Esa,Vx o&29G7G^Zs?T|p2iv4gZyН.U߭~6;᷋ ӏ^Eg bšot6cJ2,E;aMv sxΎ4o^x[6 nnp uɫs=q+U x" KEьRؖTp`7v d'|CDJ/S"DNݯ2Ҷn9x$fߵK\S':4'5 Pk9FBRmOi^%[#{Lf:dƇ8bnM_h[(A5RL8~߭}}aJK)D_nF¡8(qYvaT߾xv,ӰmM*rOݤVsGVDmPfEQ""@5iG /x#[7^70ǬC'!})* n3oNd/Sϋ I'\&oݑ7*jhfA+߸U~)WV?U~[Fǵ;yw/k<ͩz!MS_Qwx%pQn>Y}!UN'ҙJ6lB:SQ}_]^;]HW* ;Jjh@xxC]ꕂ~ԖNCnIJ?bѪ7] 肰roz.COJ/IWˊik%MB/Ǡc tqlwr 0^tTKLc9EpZP JZ)SLJƟšᚈg+"^hdV5P9DI3Gyapoj0*ij~,1ug]׽;Ͳ%?MbI2ܻ| qz4u3o=,Pޙ:J10"oNy1b; ͺ޻|Y+9ڪArٖ1K K8yL9F)tͦA1= h[  ƪc~-*Ї"EW3XL[H"W9aE:!}sսA6ĝ*0RCmdƳlUw^y7gG!6$zI^r;T0Κ˘J+bt\-w![䴽ݖ15aNׯr_n;3ld-08< 6<56|6 (̖MBo&< iѝܒQ'ks!!Hbaݐ%sے%CAIQd"s8yh,&*$Xb܂߂NIhl$bzc+3f!nč6*$Qnc܁ >\ٜi$D 6g"s s E2m .^O0hy!329hyn%K3{g.A?Rq\HL8 ϘM8 pM=;|w}ǁNr@AMr hdN/SSYq#'!?#A;]?F?_ 4w"61TD> u3y^n< `k,g rOlJ;LOޢ@5i[tE_ǫ 6MN!MЦ 3b`ϒilZ~L8C|PhB[ s+az8dQ}kQ^|U f`p J޽R9Dj{ork]lZ8"$}*x(-oK^%bׁ7!RZ_*^,u /ނ,+ewxcSZ_};{c'8DJF5`N7+ +|JG^TaXxraK <,QM a/^ށi]>=VY^qJY%Z)Wصjմ$&Cu돞'4ZPʾ] ]A آi JT8)Kk >/2^GYfVtf*1NB[wNB(:]CEBmg\mӖeOOAVƷ|˿YF' Kͬ40 9K:^|96_-qq +[ƺcDp`%Xpob!KK)adADjuܴʕ>M e!R45qA"B p=J]S~D$HuOBD] 9T;R̕Pv!uy]/xR2Zބew x T[rxRPxc URs4 5`3{c;xyVaZѭwshPYsMZD~-ZD4p򌲒/rjeƸOëRq ,@~\# s 9lwqe.9{5~yZzw)MRs~2 ^p\a%ꬱ1ۦk׌šhS~RQ_tocEZȖuϙ (P)k\ie?!R46Q%^Y$qRNBRG,J~\rC{t[MJ%'!ˍ|BwxՋ)~j$T"6!̋0 (.`w*; ݀P[5r xԬZzwI-@8Չ5uד% Rc~e\@}ŧ9= QPv QDm"S!h R_ȟ$P "%MgP&;lp) A?{{S>D]-f%4 ZD,p&U'MY^\1 w6Aׄ'!Kmkk|?eVOٟ)i5`gNCZao*!os]dhV6:7@PbE8Y}E X B N%mr:y9ܥ5`D.2b ňw+$hf gb7UK/3䁷 'pg;e7 Y= }qv>%>a 7n!HI[cڊˬ0-l:cM+ oh܅yTK#Z(!du_ĽK/Om}~?^F6lբ@%8DJ?5mpKAZ.@Z.y=|}kx9Sk5eyxr;#LCa7 !>!R4@1ezrCTa63+W]7WI׼cmzIZ7NA='f:$Y*FS3+HIQhEӿTML~"<xl#/)Brx1ae {0XsuJe'n/dք6eHIc[4Tp0hRRqޠ+`Jd.`8*"dQܖ E~G35q#)RZӦs4?Ew )߫ '==aJ0A'Q{X!r=̟D;"ECp<̟B آ1 ? ##H]/01ҕ Q,H-f4 7eCJd~($o&[oITr_" IVNL+"B'w4s1ʓ{N (-'j+?^|)/!MZ o6-9 %.]FAbJvCV^WbJ:'%lRzbp.IW`0&/3dgS~K؛R)y*.S<|C? @Iސ(Qb6 {AfFCMa^pg0"]޲pAͲ(bÖn{ۢä{R'ۚhnOu,~`t?: >] >"g~PlcxvZ%/_@<eY !R }] D/ 绛FƬ6 >=ׄ ؇[i†=IR[zX1gd5a.]P"lhq%xJAMx7H2g!b=&ޙP}Kq"Y~:~ wD'Cη=SvieaUtȌ@~Lk}!!~[i,CE W}dBtE@P˶Jפ{8D{C+-|WSTMwPd%s(;dVd .Zރ~bƇ3[FMi-Ze&H  51MRg~. YFVvD,n ߦ ѫ; 8ѭͽ$Hf!*Oum! /!Ѥ\ZM̻P >,e:WoeekȯM?.@^h}\kY|Oٿ)]&oޞ0-5r K=%f.&Bxͅ?!R4&j xŶ/-[0})_gE#' zNu T]S$dB2v\֬M\!Qi dlKv^.3dk*9 ')e7 ݸjα7Le g\o|J4 fi ~GshHyG!޾ djǐ'1,d1gM8<~ Y}5w pkz摮aFSڲYsX!D,Rq,ێKv׷dk°f{+/WUt9t<ƺ畋4] Hm;`ٵjdP3?5bkn1BI-uB;Mtq@x EBk vK,/3"1aC-#x?.|8]> *9ɐ|oX o)6$[qb0CkeF9V^2Ǣ kvwQ? G!g op).W qEԢ=SO):V)q(߁BMCKf*ZD;]>}jKU:nʟ)f,.R~'MxַG);[*` [+:}wԢ$G!K csO} sī g Ϩ7ӌ P[)ƽiVB:g!'kASZlؠ'&s^ё﷕pr1 eNBVIHKjӈ= /oc_umwJ6zcڀ SVI[3<\4\kJAoD8d+E)5倣8Fecǔ3_6h"3,7!*ܠ'no>F ,մLk|\Y+r[ZeY+=)E?`s9)E^ScKF5V1ڞ&D:$</AϿEiϐuilۇy$ק3ڳo Z9ͫV5:X:kF][w-ȂD=#g&.sU:tx;2dK @/֘:7'jLD.p2|R^,OJĔF ^luS͆Pm{?>E}j}ZɱbvU}jfocgҹbU+jkh{gF-˂*;}s*=8ǔWzp,etTӟ`zrW wƾ~zمG ",}G?2OuӖiiltؐ9 seo2E}EsMaHxK.d+OH*e!q1|Y4ptCqrwF=7K x̴o)FE==>'C{'-<`GL/j-N8yz!7=t~6䳷'}@? q.; W<ٶfT\q{B_2E`b**NWtd?@% 'ʌ,6cS!TֿǺp_!cݶ~U/rtWeǢ"x MάXfi w] }jV6ktՁctWc[[Fr@Q.}V 7toR|%7Mx}2\ݪǣOיj&ӊE-^|50@zxT8 *#0(kQrROPnj=vDj .̨`!,q[>~c"e8Hl9ªf ?u>fm`Vhark|VXR!n$7ewH7Uׁ(-؅80>Fg%)#V5+5NCT ծ6ُ(6㢞h=JYY]BEB46m(;Bn2J %/է6d1dLF%%ȥdTː2F^1kv*i+ۀΏo߽;cTT?$ J0:mU'V BO_|xqCgC4g?tLi֪U#rsGeL_}O)<' Ta/^e0[/y_64}؞@QfkN8@; wHEV_h4# 5@ՄvߥE8q@ځ)Л~%sx y}1'g_N~:0=y=GpQ3=2TiS{dr3Z-͛Tk-^hjebщw$Wg2Ŋa 2n(,tO[qɻ1yT d?<t^{T-=W<]${L] c̗ŏ.`yʮ`^}3_t}3 o'jrѳɻ1PԳ3IS3^ kLwVySX~ı$>#cRwT(VBqqơZ &Jm":uQ2jR?Bg1A7" sqϦ.N;VjT 'e`^hV)!gCe&gi~-,V_hh-g!K]rq]kGp $<CV?,~x ܻGK^Nh`Cz`G\;/ +>/!M;g # &@/Bz%7~%sRkl1d粄cNH46me-~ KĪUYO@r1x{c;BފwGcŚBw&ܷƶ/e(^+>5G2?P—( J>D HBSH.rh5Rơ#)5Z#ywiS:kC@ !J02LW_Ȗ+U:~H4W9Z"2p rn+XS̯,7ܟ 4=M]0ބ,P=zOA峊 ;x jmu*P9ގܨ(Kp'}ԪUVR1aDꞪxm3nwۿh%V 4 Y*.O5ȃͲmW~p&Ҿq ֶti݈YXxo, >C7{Þ~嬛HҖ!pG{zKc<{vW>#>DGQ/.#cU\N,ULvm,`tpx,{씸X8\`L<Y;`-2& c0EʧS0Ӕ_4+*9eY5eY+6[βϞ JCᙼA65m¬9<6rKE$o> 42٪ЋSrnD:3EK_u}wpeU.@64Of 岂jQ  p[P.س렑2@O;*JFOh>Cqԯ~Kqć=!]Q"ǐk`+0xy:5 N5iHI?xz6Iˡ>@)(죦btԷj]pp $i=O2?n>ߏUqx~5h! Cy┦Ap7= x=thSK۳P֏TV: e@œ@YU:teHW$Y+?o(\]n>J@v|k?齽I`o6;'4=}\ dJP}۵Β]xSZDtL8<,W͊w+[|!Pj}Bb]tW*[/"Q1!F~Y=*nP)˔&my={`DY2-`#UR+o.;Bw,)DыxlZŴݺ[FCYvݑ1/7RҞ{<:r.;huٝyuC9lPxOj_| 7ekYZEgP÷>^^L1oH|Z^.aotSIZ񘤵7ǴFGlll|xx5HbD7qI;^R FXO9py On!DlECLVug5M@&=85*#Z;{LDkq $FoN-ϑ@/k '/| FˆW/N>oD5GQ+"2 ޅ3ppA 5(SHxl*Zd#t/(sɦIl 6=Z%lVIFkT$lVGG]mFGl֝{w$nl}K*ƅb HĬŁf-S!Q*ϞOҦmx#^b5Gt?6bS|ړe5O>7*3W-.4S)j*_`v7WJCL,7rROgAbal * Wx֫++F m#چ7uq WYJ:SJZDvыi%:juD [ /r{t 8\2o\\#pw?x t6x Yٕl*E?W*a/߈ۊcR42.^ˎhD_)5*O%hf"#E2o\ѹ«;cgKݘʸ7Ogl2--.zqȘxB .9 {bT Ggmd$z-( .21-?0`1Ż F~7Zn)Gb+h8_+y*_%if"ÑE<ibn1uD#Q =:<{lw5VLZcxTCEJ;;>KI.7cLw0 ؽJD e$ɡ)f*,kqhux]0&mv,ٺl3"Rc+ʾU*w,J$Zn$aZ% U@U=IVsE+6(H6RF#{ yѠ/x6-B1'+? U@9}:ɰq"~w ~ڋ I'\Gnw{Vi3,h\/8G/x3c#wǖqmNލxeB I7e7O1|VWS[MfzelMV1,0}ƨQѫٗ!{T~mq7Oj۷5يFw3bO^?dcmA^Z&4Б>O4 hsF3mmm_+FI+z&9D l9k[p,1x+ F-䩦\[6p&C+>~C$ =dOgfBHOs#]dHEn*Z9dte ;yP="Jv!KMhL{DI RL:9x&+#r ܛ^B(&$H1' ݊_+E.QFAxttg I^7rn_hVYٓ'lVrj-ƛ`Q@z;Ex5N)jC&eC$I͝P:QzZwf#r~a k"yA6M-UBC-E@CIk'B_^xSҖ"pxzp ׼Bu0'ϦX!6Yvẹm!qar^u1gJQ#U=~.CxR[֝%b6pQ<6q},UwhC}]s$٣lsB{h3XIm&A \_ӴNeT} 'K5l#;y]f gi1!IԾpuuFMY*dKC{U' eCJo8z9sQj]eCi8-OK MŇ3$3/ @$$Hdd=Žu YQ5{{==vVZig[R뵒vjWE&d2L&t'D@MUN9~9@M3ʩXnԂyƒJms6<+.;+tRa09O9hG!6Cې֣< w8yLݘK:!N{7TҦq-bgi:An,C]Ӂ6NC+Ses1kM[p5DxZuі%++?5Zs&ɜ Ë7!e$wQH.KKT9 Ae-^$b3|Y. K\0\& 셜䑪C⺀}Ur0O3(rVp'Mᢛ~0Yj)3ė&Ԛod<4w'e|$w9weolQSyAzn3 \%6|&6gE&qqIuB>=~(,7z0Ջ^NI}R>(հ ݶ2ZQ'Jħ LT PE(O 'T7%eS:u ұguJIAgܟ~m5$ZއY@:A[U EIY~2rWPZ#{A:v8z+)jDi7TxQE)mAQdF+J[Pg4&Yng=2Pin&J|ndSC|>ƳWJiw_*>!j߳<QT{0,DC|}u*Lp'd)Ry2F'TK*KoE ;4*8"d.%/? Yj5}j#C0j(Y.n*L0܇OU)ku[fV-{ÁLy &I8y<1c:XѝmfMG%uɤnBT3*ۙ QoWuGg,MV`٠z8I.|aRc&aru˪2o%mHF ޝitLL7;95!r8&4e3 &y :?8Sq!P0Hew K]ya˜[jpL: 'S1wK1UYό pY`mx?=yUD`>NAR+6>-N-0eZPyl0amjUoD-.it)29Ckѿq%5 "lV/J'R&䊥N>R31?LCV7|8l6>x?2Z' o45>zvxR'frYU/D74O<Ҫ^C$D±"^ݿ4>E& F_AF\,tLIh#*ǀ'!켟z '׼mD46?3vmO^NB09k#uu ,:<9i(0 $rg߈A` < R *#6`r 7ʩ AVO>EG}uNSDrG)2 Q{(% $J XXf?H(p@bʑLGd d}q^,E6N^(mxtE ]DpL4 @>|41CfMx[w 3e%eAFE^Q޴LBUw 'w"Jj'* ?JGOi8b~Mfq^e71zyT>R26#ecyYMDx .fL+ Q0 RM~ VCשfzt0}b7eZV$ f!g>^2Q0??bvjBp{5)"U#8V'QOy܊8w`.^E3MFS Biq_ax+2!OU>:8$^/A!՘R]_7!w8T u(pO絞ר !byITW̯vFż:!uDQv _MjNU_OLZ˅?vyt$6p~:fc/QV>}7ÿEU_gabf^@5)es001Y W7OȝUa@ 3ٙeZ5ݵ22czxz,XjGmrW^1F6g֪ɾ4zsoҎԞso ] z ;I/&`?=_Ӻut:wݾr9.' w|Y"ge*?_L]>ݶ=ZiyI?ބ#8#9^d݋ɵRzcN A3*];LKV6h8<4F _/menGŨcMH K|1 g\1"PU.rU(SXn2aZP6 GZOL|k37MDIbUAk[%'Yzf5( -phY%!QxYuݺtF=6~ˋCFvH!+pVl<hB#=qH4Ð). #ͰF+‹fs6UQXDZTwV*HCm]>謖bH<謒Gw:bΨGg Ѓ6ğ[q[U1x#<\qǹiշo xZuj T\eT&}M {/󭽗aʚ9/И{?,kePnyM]/9lZԏ$VM$UU`ץaQ1tz A:%j9tF ldtX5G a_/m7T ?0Ȧ6c0 9b,^ۜ.e*xCl.q UWK2xWU˪ 0ԪVaӶe8f,gkxnn|=VuD[o)S[Mg|:sޅ|7}Q8'OOYz:'̅ aJAFFU+3O!N(hϊtzsK W\z3IݽZI+,MSxm"kPek+˖xn!_TyF݋፲"# lvśq^GFY>J]X2GAhfCȦHK!.$:58ClWֺZ5۸ ^p̥pr HR[ɷ txrr1lbMwWv.pM0YKe@}I܆I%ȗOAB s VK YjL)[; <Yj(jɧ ˆӽXF lEweyVd#Q/$I wgT ҦC ءm5}D dt[N7!'w2v]3.Q xr ]* ,g# idHF%9`WIX~MgoYVJ# j"q$t2 ~-C|n||a?!i\G ء?d(Hnp>9B$>-)0 ,5m9魷5Dm8YjC|Zsh[-L`~CRx1 y|I!N;\n(3y.}OG?_4SKtiAjunWb*sW)ڪai&Ϩ.Ѧ%} 諚t,WtnnvYObii=Ҧ11GUNr  %ڽ/{d }݈ !hAf C|iF ء\h>%$pf8Vj$^,^.d!vOLn\iC+ǕL"+͢!?!N;t¡LݛaMc-b^P@Ȧ'Q%2jބnOB>P8ė6 .Sc'gOAjaɇr7CG֨nQߪa1>d%I1 =>(}Ӣ9ėP{1xD S6k&Cd:JN&[b2&M)PZR~փ\~X:c3AIFY11&w8yHYilf2!jGDe8^em-CeK_^6F2Cl < hbcg40| ޲}xDpr :Df[C O{GޅgT'No&IQ 'Cwބ$Ng&D_&Իl^)}Ъ 'teFHjg7Q@DEMCbtC8y$}SG9ė)P>2_ kgt,#efEm| gC*ކ,4 " gcC| r); އ)|$1\WlݛIWU mJz#ǁc4+fPaD]ҚT2(*~C|I/}!L~{Tc/7&o-U=Ck8Gox?m["|8e$v0Ppr6u*C| Jw EOvL 256߾8Z; ANJ_MjØ8Q9TK`AJ\~#6P8ߏ2aV($7 +$}tlA?{1UmU.ɉs8#mzc2XGא]=x|7n:7 ᒢ63i,lO__B߷EDF3mڤ DI=tf3A">VyufcGA~yVLl[Q/` 4Jxz<&3DWqt N2`)9ZhMLN^~P+Qrs D-C\*cmo~nZ>Jy&B'I'q/2A@x P1{/`/2I槿 ilai?k͵)SH~~% u6ZK-wWbot5ѺC\םUˁ$^*wZed?9> s%3R:Kt³*+PLq^+U^fҢ&Fr Fm _#<-6mQZ3qva1RqYBx4pOu@L=!˶)YjuV* 9Kz?xZux "6Ta[4: n.{,ھOl -)1?ߟ=argU1zw:)ڑ@P-3}TG>Kp_&ZY0$c2w8Yνm(Ο2J(h8Ynw6JA?]% _;yٝov^_C~L qə@>,8|B^|AYGq_h0!jAĊ Uk}q ǥGì$punyE}r7#?l֒R62sŰul{S2~êFo;w>PSkޟjA~;1N}V P'U㾊^=k&<8kRXoOe䩂/0F+**d00].u7p T_WaB7#KݿX]O oZգ~ܦN*C|a҉ _\Or׶poBP~OoWkYwF1B)t)zEop2W={EF/V܊Sϳ?b$˚'߀J8KbB0Cd[ +ȯkՏr~Y}&d6<کw(;dvP !< hbEMp(Dp8Kwq*y N؅(~7Ǻko٨Τ])8N.5j7?˹Gq\P`Tnx.hGM}r,Ąa:~E>4- lc ZyU|&̛b=6wof槦^E4cE(:_jŠ _}h矲mP>Ua@ 뎿iVeo U5ۛDg N00<32T۶;( [/mW=#K^|ްܨUXwVχfʖit6ڎE/XMM/i;;LKV:s76~{XYNcϋ7ocJDuz@K yT>L-z___ؗD.±.U:f&8">UbX44ؼQ 1j1AUFF갋l1r .#<Y*BdzͲ|wPqW C|r y7jgdl2ʗg{T{5xf~zb7-q sp^ Uz[|;?3 jKc4kJ)l>*69\mě):adU,fZ.+KXbӘwOyeYZug{7E7qc~ڸf̲E;OXWs2We749??^Ia.iUJQ1=WT27n-U}?I m9YzkXr*G΃7g^t-Mpʥqh$-v]h.l\]ƑbfQݙ 'dL&< dOqvAx{UCw?$d6,uߢV5cO&YZOs/!|?%=n)i/tCx D__Bz:Ӯ'i5j/Bs_&BxZj+ Bxjj%eTS7TӝUS7Tbj{VÛgmP|_hU6y= LLkV HZG8'g)KmI%t['},R$C]ILZk<Qkoj^% C#)RXtAeRnVeWs@ڜU` ri9\h qGsL##m}`K^QkЍvvHȚ[${ IC# 6v?Z&iۇaχ;c?So 0U> MNԶ=aX0aR\Lp0~Dz?~$;U:G3".ѧt>غ4&۞~ړpGqJ^%7?Yb)1 Yg;Ӟ9 ̒̏2[jpP:>.0˖S;)M[jp\:>LY;NhfZby!FI ]e!H{$r/mܹjLrbz6 +=>̦;e'Bo,TEM.Lp?wv 6{*nY]g^?h^ /\wQߤ"t8y#)t(!C}:HҰ%5tb5 | 2= FN(Md.%(^ހ|#A 6އ&ЉYRs YX Nŗ8:<.CBcjC$?!j+GQ큌T|$]^U:⺟d6dL1:_Wax[EI7X]ܾ2JZeϥ\z*K k.yG zP1۳ IjAPڧur Ɉzh 7f۳bkSclJ/V<,Ģ׽+Zw%6p0񋍲Eˆ$5*(@>V̆Jhp ӼʘJ@>.a_M< Ynu\0X#ark4f݅D#jʌû#M<,jDptM| q,,~WyDF_'Wf] 9Ǩ>h?'Ýŀ Pׇp6*1Y~G9:Iš$/GΠᭋm%T9D9U:tC|exNsAx!(U`Dѓ@NS FMx;'yPRz Pz1KPO<Ҫ^{LwV-IׄX8 K<"~؛\F!bH>;QP-Jdz/? QmTwz&ev|̌:NxINT)am-46] DI\OCV_E8w ΁}4^Uk/CLygwjY; &Ls3ٽXc g,r`o-Vӆ(]Aӌ:1'(rΜ_*pM'^n ;x<+;,'Hg&T[OYK@!]]TJO@ o6 ^Ϛ 9^,wt+^gJA׀yT^|]YAO "S[=2;n*E8J)FBLfy2wHn8O(%]m5w\pwj->P&V`jf]rK gCy6yiR*rQ]ϱY"tSb&'%2pO)$ϸ <_i/o/PNQG!&fD;qT\xMeI,[mjTLZbY0N6Y9z7x\m74Bψ>AULp܎Ĭ >$YC|4"76#7Ԗ*ϒpvFȝY-t=4(O.p9W`}@ks<`k_PMBjG[%z/}GsO ڳ ӡ9g)`I^+OXkkCOcp~}L&tWXydCӹFxpK=:d]LBL%R< k;IWi̵ ^8|Qb_ !`v4"DFQu 1/6VpwAi__˖祜RiK߶s‡oU91K-!fA0w.}}?A!&;S&Qރä-t/F;ߴ؊p#>cB&L647#}2c$Λݼsxs| sߊ'v.Of6;ẗ́L*i\i^:1~Sb5ɜ=X؝bXꔜ|B~ox#)d+ h?2[~"+o~W fڒeÇAui;/s=j-y>u$Cx .G!!q 9B#yx ԥyX T\SdP(( %Vx$<ĻD"-R!>ɮ{F Q 4Ok*Ed%Zp?d+]ĪxځXC>@LLt윌.!&+WAmQ!= kb1| Y=@ oe-ۛ׭ Az_*qICNz_DD9Qۛ~.{X>jN*[FdJ{կ,݃ϡȽb3-zsɚmTٺW+9XEr࿆q}p[uRM*,+llWCcu]Rq=㐥 mh rU78"w8 Yna<1M!0wzJ}qa z2{rB_J3L ]h ~؄ ߠcxSǻl5LwsG΋ v L0!ĵDZ qNhȶ+$ j^|uh<' d+w˞2*M*c+5E緰ewͻ^ND2 dT"bwx\?{}Nsǔ– A~>*c!zqɳU֬Fmta#h }&7*j똿 Bb͛D(JnE*C|}}*خysf:,獢x[Vx쏂Zpiʿt2`ڄ=8@f?Mj}@U_C~\XMeeqF777[5P'|z5(LzDvK]_xehr! lxj_gqR_0nCɬ<#߃#ar~(;byVWuߥh:(t 0?\#{bK̩ecyKrOoD%׸J]:>Ȱjk{s*{f5lS;= ڻꫩK8@g52ԱdU+/7/mtۮp"#kYUgbbbҼb9٩QtslxhdththDv0Sb`g#i c3n0ۥHF=,Y‹ ugbpӒe u~+UvkQѴl]{xŜL;ݳh5܎7IW\^]Mia lS՜՟umhh5acjPC_m-f*k,USm)/+[i~̿ҵPDlhџeV SKf֌^*[5r\asRmi=~uZfCl\2⚶t~IӥmeW'cWÓӁ) 8zƋ/4#f{"wVG]EN#fE3_`NJwwN)|1H'I6ٔ^1RhD,l>RycyOxGH/Pe.q$SX8vcyIUB4HzgPY%QxYa 6:5V3|G _K/ml>Q 7 gtƈxg0аRzoTWCіN$Vo%Wi 3D`gtFG!JgFLmFvPxs|t~3K6ZrߑLCp [Xo/H&'"Pg2=0|Es6"T4 vZF* ,A.%fc1;OW3qd\V |[} k'݂Lv y) ,C.?+K],1Q &QP-R/[saZ._B7=^e4@"D5i4׵+u& B>`}YvL_C\Vu5P9'3MeoP파IF)g=?zG |5xm:z;GV޸>*kz>k+?) Y҆Gz6Xlp=r'~.>b}\_͑ V'e/V5焦_ϼ2C]𳽛wogEm ޹_vo3:JK0SaWT_z3U Oyb*]q<^#6Z禾eo' {""B9kXp*7j|aZmY^{[vwmdZ$hD 08R1Wm7r 9ٜm*vr_*9ķ*!GYm"KݷU -jy K1t"t[ -if/Ax4 <DOr/!;Znsf˒M8,|*}wC| Dk4 |6 uC+ K_CTy%L/tjړ r}WZ\íFQRC|T:I KqNOTN2$0[&t$n$H_{B`@u53q cz<OJ3ުaRPԴZ5ӲkZj. Z6y:qsꕷ*&W :ySҚ< 6'3[1V*Ş%%s". اQ8aŋ<PvmxcW&& ? e`/d)gIǖ uxrrŚZQZg3$gr ԑ Af`yp7,̖T Ӑ\DM{ԇ;&ӗKΎ† A11yX.aSWO w8Zyk>%^|a2`\b oh+Q+_2JI(.C'ҡ?!& s !LiNI: <t֡lhkV{]B ^GPπE'2GVLW3LzpSp2Ü@ۆ0 3iNvr na.|A'yAΛށ|GYypO?˖]kTfEƁ/ P % adq%`G`R >bC|TY-a0{~?SqSP1=l&k1N1IȓET}M2Z mHlq7h!>};#"J' 2áazQلvkw7SN@HG=9]ws2r]ð n8~senED4O]zSuXhOAko'E]tWl[\J9ė6kh;矅FݫxAj@OKQp⮘rs8~$m?_4h;hI,^*Z> m9ǵؒgjzer|S, dŞȁuHt'B{ČT\8 Y}:WfP' ?&&k˵W<+p/^N&F~ ݻq+@ؔw Ma ^wuo_-!]-T]/N/(0!ױ?(5nSANaq<ꋋR^('!;טx=fjaSs &5+zs5e {ny$2qYi( .vi(' Kc; p򃟙86?ė&ܺFsA81U*ZUhl/: b}cU}Nq rrk{貃 *%0{ *.NUm^ݖ9qCwFeY1uF5DgC|1:ؙ-GKM !i#tv c" ̛{5 V0e~l 0\ˉPtj^na'J&Cn^T\W唺2I:>țih2 'cFR9 xts&Ӻ r&Ħ1Һh_&RW,I'|̈́'1ݍ&V,)zL\ ͛nLAWu|~Ȅ!0ǣ. )L.f8BU ^g,Mr_f=YMJnQӐxk=T^d.* j.]Js (_kP;v@yl=w12jZA kz3!,u@HM@:"'暨;Ssg010P!?OS/8ė6)@7{Ղe'Ct9dYlu8"B 'C pk'!O;T}yLZYsi!rmUiurq on^$f_(F$O'F3nsČf9YқgΪըV#9,ZKOf.fDiC|i3Sw}'Hk6!ⓜb䡗4fTv甍چ eD3i1p.9H t$Ct uxԽ `;훊y#Z,)dZ3C\MHWYdT4| Yj(9s LZE6 qv@]W#ÜʊןWse7laVravmnxp4s|W+y+sHiOi̡BHv7P=X+I`8s2oqe_@VVڙ*.+.6 &ObZyT>Rcb6*xĔ/+SNdi[Tyu:], 釚T<_4ޡBL.%*bN/2g"T_<:vpuY3Clã HLÐћEVVܑXBt@~yBōB~lGfSל)?W52-[6-%-7LYWԆD#< keQ!* x r 7wxz}7%Ts8y0P;;gEtyI8 VZ@VG"91AznK5zM;)xue.Lx E&AY%0WDkU`#>r[q5-1:|&ְ5ūU/  ~@K=2lj*U_$(uqOcL+ D|foN)3|ZfD2A"[0#14Svz. )+ ϥW ek^~*"6 |Y}jzeBo`0 /Kj@C|t27h½LiC| Fp&FSSH 4dT{XN_b0< Y>pLm)WKl. P9uTD qx\ $)@>n]&=e2:L/(䣝P*Pf[Tq 'ҳL ֨mejmez5XejFm-S5jcKƥ̥6L2FMs 镵1\9.T˕- ~1[Z\Lx ;&|Ynv%eepy{܆Vģceq+kYb]aYvjAgZf[M vxYaW_Vx[ԴIP1\ Iݮ wQu 0{}P8y(1 =AM\ƀw!MG+{E*0p GQ$)d+&*  7ʺ8&I,j=УEmt+5mDq^`Q L.rΪe~f LȌ$.d)ڡx=.@NPqo c'o/" y9&m_T3o7~_B o?wQQ tGj&8+"C,4Lt S%`,L0V2sUTp4VY4l?UΖtݤ-G"<\7ǂi̶,zQw뚩WYEs5a--Vtlu:m T|j*j&ؔQ~)zse2&H5,;k<2dcbn; Y g)V͆LiDg }|Lm|i;7GJlJ&̍GhdV "5[lr/BVN;%aӆ_ ~Ŭv]?Ɣ% ᮬP/Z>,ug7 uoP.'ͨ#|x*M8Z&CL0G6.Bld5M/0ţT\70dy=$j^on@r -~˱Ǐ&|71>PȲ^HxN&d91U*ZUG/~2.2?aMٿ^QO.&!OL髹{(E0׃ӫV°,9+y.xq)bFt"Ʊ6Lvߓ}]J/0ÝnGr9kVX6Z3fp(؟#{聄?GJ\di^[>s(!32L7k?4dM!T* 8y@Y;7fZA/l+v늿0opUQ"g!VfK$bn׭ ÎDu\m w V1|xY ?Ur-+VhjM7VV[mwJ(XO ޑvVɫ$ V㟁:dlTG;tYQW+v? |w34yu[<Y}9 Ą>[^OaL{A$_xj#pBik  [|>[2-hӤw\5%J.\vFTJFZ&)o,h]3$ DUmaِWKtk+y*4*ʪ: *],#d V?Z+[M/qre)0<֖ZD;7kkX֝7fo6j dפ;Z{UؗJ=W = LN[p/1/۽lٔR Ks-d~Yr7X蠄Nq/!>.kd+oY+,'5 LT=S&d|Y}g-iSe -ZM+WWf5䯕u# א̣W*rfr 9AoNRtbfB@>ByagjT+"|0wEl jP3,YIk'|7!jY-Xaֽg<0 9yˢN/AVc*Ȩ2 d;±*QI8Qȝ-asl6ۉiiŵf&3kf 8 YݩjReF~G ɻBuU">|Lnٶz-@^]R RAXh &7!KuWnAŕcomE'p5rzƊiN7)k.&oa+'!Lb#I#_Rv:6dT>^,/d[MsmCxEdr"d)+,^7!LL/ b E>HY1[+΄YJb3 \MiiqߗnNTU$mmc,d[¨'(Rx;!>E=a%wa="KFi10daP]K-b2q{. >,w!kv6/)އ|_Co5&_x(;/N3(bYewO۴U]NO]:TM~ m0%Q"=?EqDP8Z8T3A4">Vk76_v ~2MWq{ZݕOwS!߅u8,S؅ Cw0$v,{yrk%Ye]f5l:Iwid45ٜL}_f5LضwQWSӚ&jg52ԱdU+pnċ}Fn"Fܛ7/CwLJN鮪aS:UO55U}no.T!wnU(&OWgmnbî緷mŲoo~3Ӣ[o7E;oo wVuodm^V%ڙi: :SL6=hGigaH5w;$9=ã.@s{GވY)a+~Xh@'[ oҠkVE

v 0u:(iMo^96%6Wcogi0w؈VGxl6/N)n⧀;JI?i?^P hq/cMc5{cԪQujͨukf`#;mxE͆7U\]SZymXV4J\ bMsrt5aOV5o쨎ˀˀĮ[7w:R[ <l{옸+$gSƒ^m7%b=m? nm 9뵺kQs:jlx*V]zb/ΏvaH58"/ <`d=ٙ;oZ րp< "|p k4jM[tfnӪ/֎p>j;>wcqX8m*3=1Ǩ0~O?G~d/Z\Wo{m>|3\TXsVYkV_[]v?Н%mxT[Wk5DR?6#gemRž,-3#b1r&TQ9?g{7E qvy_{{Sכ1 0WZO{ߵYWXׯ}UvCmC=텽LJʵH&u{l٨[I !@r^ko*G{a0-n]Kxue-Gtbeݙ`fKGQ̤l>_]*Q\BjR-jUCZ%A+n %PKH!^IB1{ cR C| )^IA=)' @>zC| xM[A]SkE6Ļ+# 5j ]BM_oTMI҉}f,C^lgd)0#Ö?'NkjW"ai,9+NV$˘48pw2c'nUICZ,Aټ8># 2Ջ f}t(0&ó/B0k>݋፲bT=K$鼺E; ipFX,ض-8uƷ~];nr HR[N`txTTS0&PIe{YKtL@I܈)eQ܈OABoyB")}y fA2gϪ`H|^^>"+7+d5cnVtUb\6U6O]IA0bGBy֌1? @l jg(P)7m%j~Nn/ Ϣ!vV/.!sC kAriniY-YU*S W6"[d2DC~]4\S,MfLNr/m!v&FS_djB6v1 >>}- r{Q,5T\? ,EXi/ܪpK"VAn$8a<ҏqtI0|41OUrz"2<Yj_ÑdѦAۇ`?!N{, 9TyMAr5"HѺՉ@%Ϥet˰糲,DQN!N;nITEM Z !^ k!+ 4+xQq׶*^ 2 V% yCvϹ$< Y*9`[2v]!x"JH3y^, urLHt/qU"; !쀩+KF-b6}*H- AR"3 R}F'!:9T$T %R]XѻSʕ#M2Z)G!KUMr? w*:} v_4KI;AjtI P0ҝX5 Z}f[%護v33Uq dEC݆يvnM,dB1K]>$}K?_}P8ė6@2fZ7n_G֨n4$O4^E"aVí7\Q '})SpGe[K˴i%TfQvxp榲Y+5MI*Za2ӏM)ǔҥiTW?UQeea lTlI u>Ȥ! lm(U!G'jKf8Yʷm\lU֚a0{B h,^;3*sD j7hFD&*iFWl!&տ2l|+JlOA>kS1&<1+vSPq(BG]@Zu?$gTx;^Ou /(kTi#Tʆ"֟qncn=*w hG ؙԻl^)}Ъ ]O=@?z;#BFR;O( Z41< !91~@IߔQM!Z Xe )/=mn!{(Y6>+|rKh^#ȏ|Ǚ9AjlB.IBSa(ٳmD,dbsL*$Y=9|^9"p`gCJT0Ҧ13`e)-@7# +3˞Pjcq`0!uBN̮C{܂DEŏs/m\ZڵYX1fGpT^ʖjIl~Xk8z%!ڶDCeDJZ)H $8q\ۘ_4BP]֪nP=޴4G+Q#A7'!T7&QSooU3D<0iލOAi6} Fܮ' 0o-knuI3X !7_KFӐ6|&C|ixCk[)n`&5q=+ 9y=7/ڸ(p Zy.R\,woC+M[Pw8ė6hz禀jKW ; R+Ԟ0>iqتA:q9RY;=,H&BJEU j}6jDf^gT8C-!>@X`q-D||&|1-&sЛwFqdspDPؼZBnґyZ4'f{ +D5#;JÅo;w |I5| L.LD"kMhaި CpUZv>ts EV~a|Ыf'LON4R/F܆!K-ш"w8yRSSћZ)} C!,e4-J}F7*x r x*2P-a~1>5OrM7)x!`H-KȢ)A};oT\eƩ^9ueQ":!V5Tg<^ nwY fE8yhm rrX;ↁ/ PwOlyKKǽl3 "l<ݲĈK>3t6*:KlQFԬ ݃EnDtG;ԆDAf&* "Z:/^kZZB?¿7ǺkoMIRp\mE\jo~0s:liRKN6gm?bJ!nb0v)ʬK^XY+od?}|95?16t?t5zl,OM/hQx6P_\ *=9Yj,7<>6@!l"gӊqJlΥhlE7u[{Nk+j;*[̸Ȋ"gšZեJ}8ħh_{=6m[hf48a?GKᮆwF7b76QFڝr fy}3 KɋJ{AeGPځ%P'8'ўwSe~ٞ=#՞kqM#^y9=1Λu898U?\mU֪o(kpVW~pՍ Y҆GAo5XAZ*/>XT?d]z]١ZQg $}р.ƞAwG KVا݊qIR1z6l)xd9_+'l1Dt*P$a.!)r9jp(l6/N@>L1zg#݋?V/jV p].NlT9❧ 1̕\%Z0xNBT~NprӾ eRQ@\0"ñ\Le}àFr/! ^PQI8y$\B_r*)>0NARVD _W$| qyLarAPK9@M3ʩXnL%F8AܰfqXο2dlZ.A!o=TҦq-bgf{$& 6L+YОXy՛] 5A7H}YeˮQR&ee6!,nQEhb&2G`ލќBBhN!??IbaD_n٫99ZvggTr x|@\%W!oўL' O(3q4|lxSC+CΧ?Q9ė6Kh;4҂ 3ZX=1~g:G OB>yCOAV?O0.ӘNBNp5$xSFAEH&*0Րb|O&p^b1RoŖfٿՖZAp8]J\ (W∱ѩ׫-zSCQ *!^-q_9`;io/ iᰲfۤ+`#.T;ùD:16yN:9öUB~\~4'HobAޗ~Dws(F`;  rf!<YjtgUkYՂ׻ti~`ܔ 95Jppx=:7@E=N^A!KT=2-6Tz۞n{Z7- frG/[fŋWl]`/{BoHj{uhm EkݳNr9= Ǒ B!'wѮ{qmG 7Vu,'*]ð`cW.!ϓK?Y E-$o$;"b*ru+Dcǔ۶J^44rx:_6~ӎIKZ -mҽAf T_FMrijLi=Ӷ>ِ?,4B~lx#@i bV1I2G.2FQhFqZ+2biU*~?q-b\ƈ [jctKeS%꽙4_V?`KNf7; &Mo*@^ź-؇

*]#,uߢTf;)š?m_)0\!SlG VB2sV.3>Hm}kt݆+ !Qxٝ.+#8l<qh;e͔ۨ,J~1ZxJp/GQt؟I>Yp̀];GE#ʚIz?P,jUKի5f/oSTd9y3-X@  N{<%zQo2*G4- B !?W U~r5k6Tމ'Ѷ\d)d)[dT#<=1C|4 2y { yOb!u^AL ,7%6J;&<BTWdpJMsyAk j_xK,=i/w6@>! z6:vzq?ZQ&ׁ_AJpsϟq4HfGT _Ąܖp=i^| 5ko &;3=,5lGwM*(yPq9٩ ELjShAS;)(#,D,yNћti^U&7Ô#ΚQ bh*G4PKהXa-Gx$GÇF~"l>cX`_Er[ ;G5b;1̥/:א_3d~Rb\ރ,u$_?y .@^P~ϒmhw#2od(|>V]L N/L,-UJ2>i?,߯ KÉɖÿBW|Qp^߿HrHOu{놪u5O,y?Β])׷NqM//뇧rܝlTY'&~mv{#3 ҧP ƍFT>n}2uh3Ĉ E-5v(J؍[#LW5>l?yául,S%MwXyu rĮ>X&M&H (|@)P̦!1RgņM*x -0dxg ˮ#E u?r Vf2:R } 3# oeK8N@J!fxT ]w=B^Ѹ| YA=oy4dhzܒpbw0w$]q?mٺ.t] !<Y׈o5~<7~* :瑽)it&E4)dqߺkYbohM}hxY@ tc<7%^$LMD>HO`-HBKUp%R*Ճ}0* 갚a66,< &w,6#<f#|xW`NCZЎLϯP-9v7~׋ou׸#1iW KQc9wQhx^.[ZД?dy#vL}r&& ӛߔ WeVsl!g/d ^V^+xɶ6u{bb]WzOlBy8y(uAͧG[lڽ\Qz=0724|Kt钘s52} &_ '\I=gfG^>^xś7sã~O(LJV3~}"7eVl0eZ<;Sb}cY&;=U`z .erMMA'7Y=[oZ"z&ҲGAq>o,Z߂=arʩh~*\/Z闛Z^xF /=꺶pims•Ŀ(&ب,"lxiaFВW/͋<[CwㄻJYürOhC=<;b[: 9 Bv~*Iŝ^$ej!a>zcI 2%(dZoB;t>ꫦ=[Yc*G|?1"ڊ )ɽ#< Y+tޛkG:h7$IŔU˺Sb/-> ]Jj#Z20ŔG 3 `gGM p$[(Nz%V J'D`APC9yXz5*3;$Z}K?^ӸD2WIIG;>E[V" ƙΖ{#b7bk>Yo#p$/Og K=,,p 8 yVYO O=AS&2%5o$v?ښT;OyxኬfccZ"GA^Z#:E¿k)}f//Qy_D# .I:J' | Bħh;<ޣCLf1K r'v\֫lM7o慉VA0 9Liͪ|6k7쏘ˊ`en0cVg^]hO-J}@E_B~ CLqG.1VWcg五܏&d G (|9,f70u" T !s!B5Dez͛^] LxԖ*Dl]?"]l=~w)S1~&(<"=n5Q:M7[8T-8*L3l8D|bmGP8EW/&~|o"΁Liug¿MzӦ_ZVbol?7$~pE歙eZ5ؔU?04m[S,@:RlrZ}-F+56sAϽe)9NiGfϋ7ocJDM%_֗D?'hD,lww{bU*{^`oʫ55e`SWTK\..֫ߝɖn9w:-x}k|c 4h*"ۓk?:ãM΄6 9r@ǙX|wT,#GnJCCccw7G#7#AaϢGs 31O1MRM$W ,n OjxψWnKb {w пhZKw[qbtֱYnǛ+~|hw2NUsVvvg7;J)]ş:vݞ7E;F{ڶ39X//j]tN[x﫽E۽h,U'O`8tlfs?_YOkn'ʪڥ֧Ei)jm Fq{A>'>q{@χ` a./FxٗjqyhS5%#wm8[CzXUVtV{v5=GΣ8Eo!6<G1*Vo!>O?ICTz k3IƱYC>}2b=V#մt"m 9~RYEjhQ{=lk()?!r)B{7F9{SOPaﴔCp/!k*Nw^|&$aD2CY%Q. [FS $>TYE j_b7\S,2 ?K<_4iPa&V9ˍZ9 ;Ae4Ε?py*zi Q@I̻(bg!2w޳Pq(>st$!p2@#3H/ r}< d]QS|C|i83s=lJc7r !j߳،"4}vP]ђ0ng3ecStnzgӉYQEldyE^}RY R$Gb ` }P*'b<{nbe˶jM.rͲInt?Y̽-yQ,ERţK]Կ )a rIY=~{^NTcxu-ĞQ%Rs{3E[\gCguny^w'Ļ8 yZݝԽ1Exn޽!G:pwW2!2ڛ09wV(glQW5vy1lٍzX o⋺\Ek\l8t+;ڦ gKlA%@}=-p7bvx ]$^8 yrԦHT)iu5/2FEgڊծoSmmS,(J p2^."^ȁ!wJ/mQtj{b8cJ Q7/h~Jg$:ٵC>o@3ÔQ ' o(+aF[6 SfPUTĮ|Y})g;&gJF 6QbipE BK0 [ ,{*,|7ʹj`6 !jjЖo>CCmy' P8}dYǃO*$"dK/s3M<*">,zIg{SF]_BXf1!իg $֫1P#d2fnk<#FG6nrYV+* ;ە;ST81. [yu`5!YǒQBnrHxWA2ӣ&eNJ𨮸9C!v8l,K,"^n4AEwq6F}rB8:2">V:}"i/4>cC# 2]5SLFe6eju2%wbM?=_Xbp1O%roouG[v:Rx@F% n1ꦇ#4ݣNqCn0OM'V17\/1(]FOgH&W@gG#4>~-.զU/#n5S_[H /fQ[ YKprM8oY[#fsd*X M_~ܡ{ǐ۪>QCOT @NNTg!o2əSr9;r@h}\J 3WUȫЀll~ |}'L*m3V%M#!qbj9V0Uh _BDKκ҈s~ {F/vSVg`*@_*En|qQIFa>ե8'[TPvC|İ>hiyZJ0COHx) STo<]f#\]_:"lzWƿN[\D/n*3]F/~v)_OYO4o&s$fauqg}?U|@Yߴt"m 9-Uԉi)?!r;oǔ !8r%cMtYߎ' #MK?m񬯠~c:~vbb,cӿX\{3^Do[?UV;!?WnجeoAeCbgAY #r#2<*2$ O=bryhBK._{Ikdwqض$(^q:q;? E|9̦{O/ۥƴIX6G\`ClsJz6/n3$mp)ĝe}辎X} #(AE S6spɘ6q;<nG)R.ICtgZCĻ upwiDb}zn1 CwoK|fӻʫP1T9̦w%>zX=p8y(1!'1<ޖZޅ|WY+A\Zu6 'ʌ]9/@>rpL:8Dpv8>-m 0 3ʉyCx&k#Pwogu elzCYI&l$2Mo(wQqMo(Ku2ŢN\!ϫsRzC:sņax>.D|i83sk7i?ؓ􆲠l_Q e lzCY)| VDx> NS?2P5`g^_zC9Kg9ė6 }y!A^ k6>gڵ^'&Lf}J8y~=Lgt_H -aօ?,Y w]n~ׁ5C)ۆ Kvv,:mj*AvvO B $0g_w0g][ʺ2 ytZ5lMuԔ{2ŚbS_79BGA: c1"| F/Pviԋ*|Н3elINCV&x 4dSLu01%rk#W+ُkr|[7<.* gSX&N/@|M> 7ښd*iED>γ=#33lG \ Ue]X뿜5ҭ81><  Y`|}5'l4\j̊UckZ}D둇]>HSFM|}qJ*ZN8Yj%4Z@j9@INK쑅Aވ{W٥k&D~>$><`6ٚ4YKK 8?.+aJ\N}>F؋V5sEw& =EOp5VL} }3X%* K*Eō!qos|&EBVDIH FQ p;=.Q|BŅo@s"@,Vxnb2k2dTJy4V< AKg߼ 7M-h t{UP[_$CyeT-sVV&D1a"<u_ԚO.jnE{bÿg7b3pq =OOr|;<JM.;[b :m)Sϡͳ>zBwbvx ħ}ZM bE䱎+J@̗մ“$1|Y}؋Fśx!8ϭN6,Љ&̄0E#i59AZC{mH ~Y*kXLD,w eov v&jJ!L/Y;v "TKXMTgZK3Č ,A.)l hxfT5[Ԣ d˄״`-"8;u0t:Z£mb4, T M7sʿ Y}=*МH>K?:41Ky>$4{Cr8y!tnem G7x D3 dbwsq>U*0ZUf4-1W7:pL>G{^^Bɺr5c |ؗI>-lL_c,;;z=UtGxTԵ\QUWQ5r8oMDr Q{HlƐ5=Ӑֆ5~3_Q5 ]{/!T 7y2W8T3)uZ/MFcrCi0Z3yf$LdwG^ݡ?;X 6W _|W3ͻ52Iw$^k9s t YKf+Z^]f®\Z3ݑ: ٮaUfKaR]# btx3LNjrVY[mnmhTy6>|Y}`x"Πi$!Kb< R}2[D"d~#Aɬ9fZ‹+TV8y\Y[iW *_L y7o /< R01ߙU.36ODǖ[>:۩QiRúX24OU$rxrrK[[^{U7 'w)cK\ 8G*7AW<.qV,{S(yW4z01d>K]jk zatݤVAE͉]>>p-phv;15iћ3} rl䂂 ^p wBD΁# O|CJ»CV34̆ b J!z[hnYh^23O_x!'$(9<>L,5IhW}B8'9T:=\|C|G#̼"egjYV`p*le=ǐ%$tfVZz#q#g7| W*+&6nTx~vF:QBnN݄?G!&c¥K~ f^yv](: VG`bI/(arJ@$kx:=U7xCL2yCqsSGm5 thQ 9~) jEX/QBnSS_yI}"}I :D8Y}=F~_!!9&nkvE#z㍌M:MS]E}t~ f3!S\%e/VYE(6Ѓv޻~,\xUa@ +ҙ-s?&{xa^SP,>v>#]5,{yrbkB>YM7.հMMΪgĭ:];LKV6zs#^>|Nqxllg=/޼*Q/m,hC ?IЈbHL:!Ş6< BHݚ)[Ue6 E븹>m[S,уChUAlJߊtG[RΪ#7W 973R,R| _JoNesRG*hJf#CH%OpI bHr-F+ΐT: *g6 *Ȑ(?=u>I%,7QoQrFa$H]k˂tV2ݘ_{IjP5{!K-RxΘP4ar[a+FT~?0 *E>9<\:J9<6)eRfjYV.!&QE!'VkUNJ LiNwq6tpO5|bX44ؼQZC=3EZvLkPa*"D5iw]{W[qkAjc7 _쨍PS55w!kIƦ23Q파9F~ٞ=#{9Gzk0=1mg0uZu7\pkՕo\F,iã`Zi`x1zͶWImSž m}\_͑ V;t4Ӧ_jf\bW3/̋6Qo0]𳽛wog=e7cz1 %T~b7߼-هmV7s_t[PO{aMl/z9rSزQշ=DC|?a {]5G b#C K ʄ%%e­GrOFd֋Vt)}x!N1sSEA7}P}V,4[Ԫjؓ\HK%T|?RIe:O@>jB'!L_5T)%#PM*vA#!NA;H8y }wC| iNkކ3rY:o@~]íF HPCW"?!>I%T:K?fzcJ% ߂,7F8jFP[J1tCYj8#OAAgAVw#8HZ0Y0]* d\0+?#jQӳyIK'9s`f!$Kuv{~<قRsYFsCfNx8 y6Qh+QLsh֟Խ,}"D|*i";o9'9Z'LWJ%B>+nu 17+ڻ.o@X?:,@.(w濬] SHCkNSCOLk?>|ĪH-oVۑ>rO,>!joz-sKQ@Ʌ}XT,7j|< _:g ͜)B%Hi'pwcr>11XoBpH w8 yTݐK!N{>=Fiݘ!iG ؙI䞊{Z@aX4&ؗiNmIJvskӽ ;N{*xc*q^ ET|C|i6:tr5nni_˔+0^HzCoVdO#J0@ "=!~Hqcȏ;kQ ͜"\E_U7OhAJ¹⡍,!Z 9i:}*xn+xutVC| վg9(ȨCJM@wqOOC]a?R^Au"CvaAfw^TqEx*? Rb߷A6^. ]6]*C>C޳C|2FźFM|8DĨ;t#u+RpB@5Ds%<\u_vaۿJ\rh;e~5ȶ0X}j=*=llɷڑ ʫz}t٨Vz%m{kY(pr,Nҳ*>Qr^FHZ8|!|2x֚n%=[3+w ^E2>,5PS^'8" CzJ*1g>8g^/WJl ˋ7T< -[\mvd[X~ lٶj̴Ww]rJ8y$}#ȣ1dڒAo^$>cBcTY+#f瀃;?N )+xURBV*>wsu'<%݀ВV҈ieȗ;oCTL]ˣ Kjry>>41 > &% VHjpw{^,oόc"AJ*At3(魞 p[j~7ybU sE>3ϔ1WBNBhmD*l]T|jO;$PIgPّ{LFS_$QPmѯJg6 Qݝ/Ut^ޓLNx]T0?q? {!K^ 2K1b íaT~t`LuET' ?JTzd+C1cu4duPqS |iE-ldZ;u dz8 YΟ ''nx[JX4 /bm7~ tum* c U6VjF 9c XKpryb0VY\R?:1e/ сZ2n:y ~ L6}{&dB\Hm!6۶5b“vL&6[=8&yܦT|$;r*wC| TfQ파9_D#z[>x\~!63^_C,L%sJ"wYS78'A#2\`qBtN1Sȏ<-!S~ 1-PKH%O5b񍯚M7kFs8:vY~nY+' O$(i돊!>I}2þLĈ|2t\tceu75qC/Y&egFR@ 6LːobSАҡ} q L3{ =GXg?aEPuֽ0+ڿLX,Ƅ>1T\X\R^ItA%V$=|>>>O%2QL:'wI@_ĽqFd =rT|jN„t+1[rF,<@%>F\*WKoE{p5Ț2yvmm˩Fj?j%}cFsS۬#3wyNk,U\*`klx-{7>^NAN^z!gRn[idGk74n+nH"I%"صuOZ)T̿jjcaƐN[sGUl5cd5fvT2<:3X Ěі2,`ʛ#iw҂@l/r/ʰV<ͧ4Jԝį;ί@ǡWmݹ%~ѳ [>t8vhKO4}OEo_^]gxk wj] C<ڄ]7OG({8T=thQ(}4g:.ԝz Df$g{k#y؅j6$N$ڎ)k#È1d\]E2~sGZ2  "gmZ *m䅷}#pymt ;R菙w!) |l4-,^N}h\N\2NjZYoWcΑ״N?]cOF=`܃&par^i #i[*.} k4jZ7ݛgWĩqcF\ 练jL$ '树Easiԧ=DZU:=yDO@a>Qc8zN]/C,nm܍=0&䛑ח4a rJc<≬!g`CF{[w+Tm[@u7E&BSOR < @vzn׶X$8 l.u8y(~0f: vC<ݦ5Zxf)Xdv&K%c4T Na({I2U1hhAn-;$.d&Ag -._qAއ|?RJd!Ѽmnd6Ѽh6̜JdV.'D1a)^@)P&^BO@!w%FF%:%vmˌS%/J./CrEb2*vqE]F7:-ށ|'?NNARn ᐑOi\@ Oڋ[Ar<_VRrekrx٢~\C3P _WO_O4u]0"^-$ <CW։b?!;8bd*C<ݦѽ_t xKV]+Y&FswiN( a.,SNBOC^PV34J H?%@Wvq\oTx"}焎VtJM0#ɾ= ! 0I$tԠ"€Ñ@V8z :W!K-mETY`rRYM)a%V,c~f>5QC"f(3emD_3nSB\->][k5`]ԖlLZ>eGSViayصc7"-RU?YTHRn͛^7mP_FcKXH^ UHUr;G->%fյzMv~26Ppr rUFͰ:4PY2J}Q|IοdIg--d捷\آ=8XL6gZ7 M/ӢV5l*ERFW mh_" 6IJ~t'^QGe6 2σ-d%H_{y T$dA6~$Y>X#땚wۦch[X^3s3Ը@ޫl$- Wv> QroLp Ѹ.n3OB>) ysGclgEO@F,g eܙ]A7ʦ_ȮHH r񀇊UX26+Y3c_fԛlZk]>mJnVEZ*5 !/*Qrm6+Ⱥ[k[$}'L;<[Pw!< t;R8(%xibdSÊ`F37`ZY}m>f풨h]/Pp]Lc7^]N߬,2[Zgb=F 6tdVmˏ$i4;at%papA>Fz-];QbK]wA0Ns qt]WND;,;&1ѼI3N8Yjn6q-7d-@O}#<p+ԁ4tӀ XPmMx ŖC=1m 򒒪o:̃lztA8o6<|7{A.x %Ym8y$~N^ѦH_&%%i=mުժL>22ec;Yf/1*zYЬuw[kxZ1Q0-S6~d<:t`aeDD:N@.nKSRc##I @#|~Sf?G~\Z~Ό3C$etja dMG 6^=R<[R'e楬Ȭ@~&ߗ}fL"sxTY;w x!)\YV=&(JfjөHBWӷ=C~Q0hTYblfÒkTpr.a_VF?mV‹3x `迴I}JmS2{U&>uld ;$cnVL IB.]"%s&{ V| *o eƫϟ9}կ)t4mMxZG;%AV aS`ddxYۼ%^ CgO:?+ k^hjw3Fwnp~iB.}4q ^w HCC}\ZgakFA֔ifZ`kQ3 S=hFY40e0?GC~\/ز"EeB."ۡ^RXr_d 2Yc3ڶy>G)BMUx N-X ኹ?".^K; Mi{! GVO1Ssq㭝jnFڬߜLh,kd,x” .,1ނ/o2]w\*5^ :*m3dK|Gp(X52dq՝&[sB}nUc'دԣqE_kYgPX?߹nVExѶoa~W&n%.^+'\=e;7/-/ ewL]4M6ݑk#ڻVnՂ6D׊J<^e^/3EQVtiV0il+uďƫLV5u FlD6{gbjyϗW߄b@u\`GYf__ыyF MG(G%؝"1 GW 2uyh˕ vakOb緕J2زˢ."5R׎W\tڮ丷Ylͳ R[hăx31tģcmlt2_ޤ _ ͧ^YesǓqŀ$p.~bF=uCqPk;T*V٠-#Qd Ft Mֶ4ûxz5 Y`hORI%ǫ.d{-4撏rG΃d> STA6Ѯm20f׭-46$,5rkhzLxجPmWݷNk۪2 GԯDVkщctͭoMSF6i9^%H|z3uLQ&i]I _xVZL6ģDyib~A~hR=7x{:1UH4%zv ⢋ƚ4O[muoeģ*(#^]3uD?5:h>s9?v="k?nM %#OIGFGё0!;/]_ "_ERx/&BXH߈6Qdl vv巶{+w=1_ӭuXar_$v+w݁p򨲇NSO<ƀJ#̝t'7U>ɝT\_T}⸓;2v!qGp*xK MYjOeQ1'tۆN۝–Q6-%Hgd.A,>Hgv6!8 x zZC?6;5đ50cDPd XSQ=ŕ=t>%ഁx[ei}+S{aJ¹0wI^mYvHkPaF>.|TVg8Us›x|&ٶ% ³v_1T95@LD264G zԟ`JkZ 3a;GViWrUK7F_[G?W@c#c踾>^{s~KL圠r}o?s\מkFq֧M26CƢX@|^x2ȸ8WSj޾yEFj*,`!WSG0&ן3__.PVXk85r&zX/afDC<`dp*{$kUInEܰ{g7{EG8#ACW o982B4/ Z Gk?!=y#~RMX5dAKhm*~C<N;|CZA ZA!Z3H-V}ddWeSB4{EY+:$~H,x$xK.HB>QlS\.'OD8YQc:z+0@XRx,5Pr3Sj+K$eOjTH2%!R2`܃dZ9w-}3-)[09#ɎvT'~ ~(G<]YΐvJ6R`2^,=pxzV++rǒ0 Yuv VƁӐ,.k֌rH[얗%!n঵GUPZԎ^1d:Suۻ;.Zh)Aȃ,v<PxM$Zx&1;#Į (IZwbhu(f4bP !7N$.(Gg {FUBs&,@~+U"oeැ t.J㤘JN{p8dZ/' G␻ s /tG%/J./CrI:2*vqI]F7ݔSIx HU2!Q$6NmJNx.zw!f$3\dT× /)7pO?OD[k-)Ra 3&=G~0:\h^?W^<T݋#IaWFt.&˕j scZD)ӴRԐ0 oB7N"j^{o~Exrt1ᵏzFĞ *C5tL=!Vʖ}VhT۶^{ĥm(4[xtIކ+o4st RZW _̟Ե.&(T 0Y=P6z*>!I[<}bft^T%Z6)w;6HH +lYcU(hZo㝔FeJ 7~cVyaa̓f^,?}^M\}[ˆӨiz)'g:ñȰo)pUQڽS]<=,yz|h8۬Ǵڂ!}#DC0oE }dPq_|n(᭣Ʊ?d>7=%_3wM] #ŶxЄJTpr 5uknN3l_.fK>,eB*݈5>LBoW=A,WK;S/=MgDyhM]c<\cU9:4Q 0""k^M}ӽƄ^U " stBL,NPlBAV7LaM?"^7pgA;h6b5c49C2o8U`nqWAAwH2Y8 `:і#QӀY8$uIm9?6 mZumYQ{"bK^ě\5'ڒ)/bĸ\Ly_$ڒe7<8 yT٦qc?Dg!J3Ũ" d޾OҋQ^s|-SA#XdK I/o"+vW&!: t~2l3-ò 74:[~WZ{~ScmeM>P0e79MKDf)P!wh\m=_B+if* Qn 0i 2UO>dN+uhoػ;Bt#!>h$o,h+\4wPC! 2Fy:Eo45GG2x/K< /w QR|fY$-euG+O|ň֡$ːvکS+vY]qcjr<+YnHԬ 9doA%L}AW2Ea^MEd _߼ 됯CT MR[u虌NrqI 8ybt2 N:yNF'GuG'S㵜NKoNVs (1pRy#<7?@2!*o:]ipAxzwqPtFD{t{GԈ 7mDTh&gMeyȔr5ɨQ!j9q$T3\=\ݒsw^W KdI2t4)4C+W.zUT1z$.n@,w'ӷdDK -GEQ%Ot'͗JGc;yQǠxgm!QgSI E梖DT@trbD #*|z\ny%d8 d2 TzI&1^Zcf^4G|2z|29˺G1g4#˸߱8usbiF\jp^vNAR8y@ԯs/qF&r17U[7Jֶ$7O˄ w:_`<Ū ɝ,fˢL]8y( ,ZKsP $Pj1}#7DCXkz*ڶ5 CE_6 bӜ *\(*YM# Ղ^M$2E Qfec~VMEmW!ol~x^4sTun_ma)JK`oŢIP/5oIWU]:b%O}hrjFV\@Es }]>E:jO%}sv"-^ .([̊ӵ|n]17+&=;@KO„gA;Hd\ݽ1v|* eƫϟ9=BDWb]\)9cCg0]̪}kBKfe/q -L)hF7 m[&KL` neP&bVf+!VG}r#>Ѣ{8/k!sM2&?C}TU=~/M |Z ީ֊ky/`ZII՟>,u⧴_hO:kGY*YWԨF\͆ej2֊ RR Yfcn;\Z۰׸,w]ݪ%xz֪n& Qa#) nhKb͂Zkg_-4lb;l>A+U6[p-' gܮ>}B/puvdtÅ .Kw{`cC m5 ]^aewC$o''"h]k*x:,*dѣ~_*4ԈGSF+jĭP#uK3h6;:\HB {ƳBhnx{NqE{ eߴ 5-p][r7x:qCCDV! #T*t 2Z轋QMFYQF<2UI/uD?5:0cjŜJ`{{; 57nU2Mc;ё0!;]_ "_1ck;ކ=cmIGǔRx${dk %Lq(dS˧A`>k|XaO_$vG=dt6v1TJ$a "/ d6O*R^=#8cPf Xa({mrNa($g8y(` S_ؙ3r4-7NL;DGKA%P5{áZ\٣Jw 78m VxbZJtO| |\z Df$kze!A~om lՁƦm8iUyy›x|&ٶ%?2B>}P8#32~B264G zԟ`JkZ 3a;GVi}UK7F_[G?W@c#c踾>^{s~KL圠r}o?-撹=1*׌"PO;FelF+ZZŪiFѬ[, s> ^Xzd\)Eo! ɽίJxA 2+YWPqǻ*C<{rG!KL`&stK#T D C!|k4Ax k?! /Cr89"Ƴ,it$,r0Ji}Z1ͪ(HO4~v\!MQE#2 9Q!d0BO蔬JCJh@T%0e86dثm?O>Ax^2*s /tG%/J./CrnCh2*.m+6r*IoAJƥT2 <IXBO!KBU2!k o XrͫnjPz3!dlWE푊Oi\G KnO܀uZKP+)y |kro[ D] F] wx =poo#RaﵜN1cM8w*~C%Ax T8/f)(6ݷ!*>!nH|i@-0BJSٸYj4}jY%G3+L2藢KO!/*T#C,g'r(56YpNB% zqGF-.\T x{EnL &S"/+QŐ"zW nT)AjTڷmU;P dl]C/8pI3PQ>z(0\잘^D"*daW{Qqg͗g~T`UjYqgD,|4!#ރmbUhsellzp&^Aj̡Ğ *C5* NpGU흢n.qZ&)"du:Rt+P+FI+3QGȭG `Z#Xʱ aZG8J8lIgV.QFjrZ3+m7cy-fKG$Hb\nzj±4(JvSI 'VC^لXXέR‰ː6]rk܊*O.huARːcGfAZ2v$@~]ʘz z9S}|E<>uQR wӧ.?@CdK` rIPgܛ$ !wR__wX_`9cuP7֜F#qo Rr7x3v&#ˈy7* o3trG3+5+T}me±^ifMԤSOY2ehhG,%R[V [szhL)'W_V;<\U^7+n_'=fd˖mNpL@99Z#Q^\βёQc>NS{FpGҷR:~1Y(xzzMO%_V^Hfe”7@<'ׅ܊$}L!3Jt?P-mO(_+ 2l֫xʕy'|rENkq-ŀ q0 a6n[ڼmJzź鴿&Jov2~62f<ޖ]X'5t0+V`2 &u ^qM +OzZ2ȫY|h:x>Ǒr}\!B%VL}Jk1T)VS/u{5oZW?qOK0L1$[s͊~pf8aq(eP$6+=Y2mjRXⷠmH2y]zqɪ^!-ѿateB(GP*أkpAARh P-nM%LU›GU§j|ڿ ^9v1&,u_gs#ud:5'̭)6N2Z~EcK=pfƬu'cg69<4aJX [F'f[dڿp,Ni;^De]kEF}k^5WoWRY~=퉖xF\Rwhm[6m ˌ6ՙ[ޡzLT`kV-ha,T*u[NrJCL㪵Qm@*nuMUU>SǺU J:m4_>7!2Z'Mw `sPʳw zgz°tVNշE-k5ml"Yj ߖ {!D8%m8h-B^ @Ek=ij-hM uReeptC& ?TE}*\,6mYkTmYĴO O}ŽTϧn"VS m]ْELs Yfr j8yNP^8C{虰MxpOgzU.zշ:]Ϋ4n5wOUI-9EpUD͙Xj'(n%=ĮP#ؑ50c!IңJ燄wHG<2Ĵ>ꕊ !<ږeȏ lu鳍MpY/lCxrt -}0v-;hwPYg*x x=L5T;!cFGO HW\ڼZɿu 0>|sor5R+W6ߏ~ί/aFq}}*_-eF-bNP177Z%s]s5HmΦQa;FE6xaZsW/^, -k)E+o<"ȍ-UXcV6 3wߟ/-VW 5k?Z؛t!~lhXkYmmu .{J."!Lr0{]{]2t_FkCFal[hxZj$%%t#Wͬ:];Ls[3׹/(ؒ/ROO"8/ !m^' K I:lDT*R}>xrV6j[V I 0`qHx{R_CZ!M$~Ɛ;G/\r^a] iL.z.@#{Eeq;н{.y0 yi;5?_ϘywHWRYE5- }Jfb9ծ+~z$ 'ʃ'@CQ`#NӎNBCisv+>!W&"7pg_ߐÙ~r5B-CwxmooP8^9PiȡGq 9VT:0:s!n9J X77_5p`KuG Z8 M\G ҡS9q'>Im#;{] " t!7ӑh".[ĕj=D-b–lYRrz՚.jD+ \Ls+E̜L׶ږYl{(ilpI$ gFd!omT#ȏƩ(E7 D::sanasB#LBNo.Ty0ausЌ!jrZuP78mZǘ&,|$ܮ& 8d8,Ev"3<Yn&#LeuRv-L7 ۱8*&0Y. <`䯏h%YjUI\+i=4.QkeLJ+s'tG+3*kEx9{Ӡ\nxT3tF-c<AZ9dF!a/r 3.FInVu9-nH^=b[ez `$.d)'`^Ȩdr|>7 | Y狧BaD<8_/0TrͫrtP^ȄD<2". _J!_#\^6Q0KT`tKr*In@%R*NBZ|WmR]Mp»eѻoDt2A\ťqO&MevO?Oip1N&zE !K'EwN&|Ћ}>~\o-V wx J[H)=W2: uG'7={'8{Ej/W;6hsPZЁ4{JӶQFݮmۛy''\pP6]Lacr'5PIZP +di8pO񟞙WNTB]NBV5$"r8yNRa/3 !GkE)f֫Ğ*C5_Iy>[.Pw<_tL,UCZtqۙq۰ FuQme5^6jnb1?E~xˆr/*L g!*WaP/,x [r3=e޻$CI􍶫7h3)$FJ'5o҂V½rkr[&m4iY5> +vuCԂyns甹2TM}\'6g)HbCwx %eh) \^|%@n ndx z&M# OJ^Y6uqX>HP`[u 7xKizg.A~ ~ET`aTr!pqeCcYٺz]-\wm0*hEf@pG,Rvq"?`uԬ0s%z9ZzVeN: ߃x{wEϽ6ph;ÒG"wۖ"7 bg$ :瀗!KT dqKYѦ.]롷wR`ՕwbB{g'jn`ba/nI3 <Qq;AZI pt:R7@t K׋?ݡ(š{g#)5 `{oW)j'6i ml$IQ%5Le{s<4R6n[h*|ypj^ͽ;Mpa<{41c/q4 }Y%ӲMfNfy^,世!r.[p)\SCV'+AoD.K3KΫNV]boPۆs\R Xܒ[V*+A;lƝpu]˱tGsF08=1B`94t?4 *7i]xAi[%ET%kӪ;ޛwˡ=%rm;̌qEj:>CGU4K%%K8^m`=_RAV>N"<$x 8 Y~k)坵-[ZՙV_VUۢ9_V3o52(UWG֨+kϣB-n*Z:S$K]s˥r9bwgvB6LH< Lg}n8æmU@;Y"C :`|rOЏlj\)N9z Sn{2|7pyg3{^R\=< ,u WvYzYXy;RlN<)ai 2Uhwhv}rI~V:hfd""7г f6`Ȅi$G>)C^}H6ߔY9> ^|x"a d ^h_&)YnkP|I%{ARJ] 5sQ3Ւx`_ +| Y}wE;;n.I WkzM^|~HxV.a/E 7[;$QE0}\z"nҼ=5/"3h\WyQq!_S ʿIe w2:!K I 8Yw:ށ|'Z, a"3 |Qwt2\~FAN'%joNVy;Jy \4Pf|D LiȬJ囎fmWd~_{wqPtFe5"bs߈8 ,5RT~L)GzXc!Z@~B~wVB5s%9-Y<~1po9b٢2t4)]%fhNnVٝ}Si茨T1""3܅ T-rd6Qރ|/2|Um<.B^N >OҝF'ŏw)a:ݴwRB>? O.&!'#3ZQI3QQq,d䀣vO&'d2 Tz*1-Z#f^>]G`"ersyTc hFn3q;cQq6뾃P?,jm8yn<>܅#T<9dl,jZE)0"QR2=!;|2~ͼaoJ?=5D42‘70QD2:NRېoGiN3Y*ZLx)Ӌ|{sfKY<#ag4.|R: /x:ǦjwJzi?vȸ;RCwcGVl[LZ=l˖yr7!GFT.$.9/CVF&$)rvOny;ΟTiPpLG|$ 1 } /(k舿CPK"jBf+BCXx j^ꖗ/ZEBLhQ0b~57DPK4+0>{Jw w8y@ԯs[zr3ed#G5DcY==fKfmGxHsO.|6BTZ~PO(nagKpS_J'!,#%z^S׶UXPjI$&C\5B LsgTLm:մGjAgmȾd_+LסބշAQ&Z=%&h"Xr7)+2~x6E5bRsgLpBH7b`p T{XK9@ͿV   }]>6) 6:gyfOFٴS>2=y[(h|-f~)2i17+&=LŅ Iv7ɒn!xoT7A><f09[2ڦ͌K(#{)0 fS`Y{[;aKs8{>)7+4+`EӜamiw2ykݶ]}Cp,&'SM_Eqw P#QE>rZgA0Y H,E hr)Va؆S !e_Sp@ڣA@RP"j7 @~\L-EiO以m"YjrذLZ9ኹ?4HӞGO M6/^ ١Þ>(5pjNJ Shc0ɟSg45Rsv~x^maJ?ataݶMdL~aF/A.2K=V*5^ :*Q T~x"xшY0l&1ҽf eGatSWP#Qw/*k8w눁vɪD EȽSU`*kF >l}ɋ}쟂? z}l\-}c=bI>msmEzΥo6~h3cn/Y-oGfFk!h0`&mWmVVK,`GZݵmp0٢w)NAVOQg`sr]jֶ$'WlYu$/H}a(\OA>>R ɌPFakGq3P# #E`GE] [S=ǁ4)K|GSGH:elvl||y.|0U67p-h?+[W$ry^Oj3(SPtZ\6`Uс=/W;CmLUجPmWmʚ4 FVkѵ[īZuVoAZtpWIs<*_WG=cw:BVQDZ6>2͎M/х`_yVZLҋlȿBūs\V& \%)88,1Ni!fFJ7V6J{J];"h]+xQBxT$wīF3}hFcqr]; Rȿ㈷ 2wݿI( w.O>$&s[lFܨĢ с)2bSt-*<^ڟYm2Xuc.^tA|HaK;l^r#.7(p #ſE,uh1">Z[tjA1mK9Ի9L+4reHDYdUFJ=?^B}_i&4G/x312?G1ѩlvz|z.@|p ի3#[%f ,wmih߾p%Q;ء_hd6*ZA]psfWPNakb{U+?ãT5^utMC7SsnW)-z?a e9{ؠ_h]ܭQO\t~>*QYD'ѵRώWC܋IG:hmԶuW ]Q|0^]3uQGjt2eS-sYsXq/m֡JFil?#aCrƫŃku=DJb`wtA+XBXH߈NE!H (Gѝu?i,l _ZI!#t%@|{:1^,uF_@MB.G!ϥ *;%x x=.|zgm}?-̭̿dEW"C?Yת6fBco321} /"Yz0\% ٩b/ tr:N m.zȵ8Ux/"!? :6-wh)A\<Y0}nS_XWr4-o"CLn@YCYs . XSQ=ŕ=t6 ģ*W*,,gYG^-a>0='Hܻk[ao`l[ve|qGmeP턌MMw=D3zxLcNѬUzݚnRQWjغ>:O嫥rW\1~3uzGILĨ6yOW֧M26-b,r«/^tUwBogOZ *XTb6߽-Oz_Z]P-C}P/54yG˶^zنY2:|%bD&o"O9W.cx\ nħfkm%_OOr+=+n<*>! A#a_%5"㐏p ,Trd+h*xT#e!K5M`HJD>8=aj9U| j9U|jp'"R(fa0l '+ zr'"L4w/;:]s&ak`-z8‡FĚY+ CP+~)#b x.rXܿYndPk>c:(B,ڇdA"[F7p0ݹ9rg]Eԧ+C)T@ l7hUQתc̏fVj&SS5 Dw:E̬r(.2ƆeZͮW Av\n{#*:xM:Zxb{A^7$J{ 3\[߷j5YW%(O7I2OAZ }rK JFEr'鶽CjT6h&#~uHN hW~uIz]DsNuø *,0 9ZyK7#1>@Mb~e :Y'nn% EkR=H)u;>PN*KQlV:y,4H8yL%D}JgmPEwqr ɡi#Rv!IV((ʍpITuӹ.96ev fU%f^mIS"} lڜuBlKהzB\tF[,z84^`CbQX!wCBku/dJp-e5a1-4݃O(%j ,'g3$/)JiG![ٗKf-W3>z ɦG[rcvo%k< f0suXߔaF杢itfOn[Gpy Ճotl)sɱD 0FZ\Y^y2??sw:nEy4P[]XM`JnzfuӢ]?jPmNX1+ȯ"(E$ y=ycŷ~Y'ro &=Qi\*Vrk';1 |Yj?Z|c4wm9kWwNM%TFmk)t(€꺤 dmZu -޻ \,VOOG<D[Z8ݵbZ~b H˯/GmiiO.rSlE>N94M<,n$槊<,;$1?U5W2R)쟣sL 9 ,Tȩ˺#jD0Y*]Qq0 9=)hu[/kᛪ;N=ŕtG-#@NVTጻ&9ꖬ^]wYշ7u`=k֦N#} zӐQ,cDsY!Y.UL& S{R#^Qm<.B2UGO4+8Oҝ6_*I'> SE"|EAB>GDt"sQK"*iRX1K▄݈j8ED%䀣嶼&%"d2 TzI&1^ZL/o^@Fܜ~#3e34XTͺ `i$lG47F=6 Qz9dl,jZ5ב)Nn "OB>f`;IOe{ 9 9\~R&Qހ|;hb]o42:IoC]":(tLxzV|{杇sfKYl<#`3OB>)Z6Tc6RNq;%S=鴉sYRd܂K Bo[h#+-&vʍ<{#*Mp XK!KU&DBu"!2𸍷MNtHZ~YjoܮV:oPȝpa%XHuHss] o|A+6R\2uŁCw2H : FVl¯{]&yAS5`|Ւ᤽|ڂ{iRνIqFȍf0oVm(Y~ד`_&Gw:_`<Ū ɝ,fˢL]8y( ,ZKLP&c F?VLz8#ϝR:]=sC<"cc4zMO%_V^`yzGS1Aȃ$W?&(JfjөHBWӷ=C~Q0hTYbe~SfPU۾!lKfZa ^,sT{U@?sFɭ6yśXٜbq4ئ>e٤n^XW7TMiD^ي?fgsbC%LHr)t ,6)[oנX/oCYwAʜRL/)PU (Iկ+5׷rv֠f({ʚ3zIpx҄9;ޫg'$[P'<\L-y)>Ʈ-ꗡ4^Q;׫,0\1\֏:nԑ m@eY }ʧ?NIvmY9EdZx*0A0anۂ4Yb_u BԪ-A!VG%ϸg-k"FȤ4A\jst=~M+}ZR*_/Y(.">lׇ[_{[<Bx_qAo;;jͪmao+tS -QYۡmCN=r{XjZU zM]#*uxu^zMR*I8G[-5]gaR[(M\Z뙘gXJŮXFf79|yM_Y)TE\h>J𬲁jaد/8gW:tWu 6A=\mej/X6h6*v*=1U4 Pؿ!W #F"5RWilShU 8d_+4G[!Hg AQljD:MNf'/O҅(`GZ (2~E!$> SB 0J6:Ulud\x O^xRRw,)IQꩽ*k.pDJdPkn%kmZ%a!ʒ%*)4,GEaI:ģcm|d2_ 1 _=IU67R*$HMLrѻݳw+E\L)0H&zymդ!f~dQ6Ec -2A/fhr=_Y܍eZEԣDVgh$V8J3!Hs9?v=tXq6P%#O:GFGё0!ۏ]_ "_ ;[c6dmsX[ f!H 1ޙwt~e7 '~MWVF{e5^HkWVGw H볍MpӪ&g"mZBg!bsk}[j'dl2hL?%ڕ&n?ī6fovf%?_isor5R+W6ߏ~ί/Fq}}*_-e9A ^Xzd\qs}EjJCmQ7އ-UXB3aM6h13ouk-5Pւ(ۺX/bfDC<`dYp*ѝDgJfYşV-{vWd-xT|C<4o|k D_T̠f_A ' JJ,6^K~z8 {x"1oo!4]!Un酊?!rB!zbC@GdHP1x88+b9aˬ@Q1iw; x;lgI/_u$+ݲ"kf4ByHH*/jx$Qln0ˉ; mByP-5ꢨP&ch Ry ;: < YYGk^ݐAs=)a{!_C>L䐦}s9 E.w476Rɧ #ɌtK)`̃q&iq"wɟմBg'f$ũqsCS2f/>.΋n6S8ZMI(qSF' %I9iDimTj)4mmT5׸]P$Yh&sN'vO|-jLׇlK!생&VN4gq&x1~e"rc61l$˾/ dRl/WP8ҘSw͠Ř#(k0:F / >V ΩJx5D$HKKxU>⑌Y9W4kBnې  t!+ўE\7!ߌgƣSSf2JI3冉˳Jie8 y;ZBalP/{pH,C<ݦq-ctBDrV-]ד|LN?Qk[,l\'ZDp`&b uV0Wt0Zx2:6cv KOz[%O&}ŌfU $ss4$.(Gg 'ũ{GZQ 'Q,)DPo!i/V]I1\*""뽄|"RI Q"{Kːn"J]nRqWM7Tނ|+RLHd8 y;* Y}DFs C[Hg YjdZ× ?6hcz/ gj!u6k-' 1kizMy,ܷ['w4T\8 YʿQ2lC;{Mt#0=Oipׅ`{qC a&AjonSAz#-Ke} uDm7赅Uffl259U`nSǫǐՇaff^eӽ E.B$VviX?}oD_OiF SFsj̼VqP-B`ѤwMt.BMŝ&!'tוnV_ANrD @~&j*266̂I]8 [H>zPdbO}á:JOpGU^Zn_ےѼV48iVn Ѧ$*w_ n*"kCxf]* "LT;թ.96]T-:6%Qɳr@ #D < hJ T[x?=9%0Rx JǀC"kkE)fOb^T|jǪ*{0EtxhxPiX"wW3MoΈaؤQ\EuIO K=g""޻Ħs E7d^]̢ ԪKۿoc‚Y3^UJ; ]\Y^y2??sw^T%쑼ڒJh3n0\0麼6FM2M7ejFbh[fazgq /?"fH6g8LicuMVwv՚U3 xx[Vļc<h.7p7 0B3ӗZ,ʎl'[Xf*Vc !+WCc3eUf.( GA3dbG(h¡wmWxLL/ #,1FwQLCN,ZoAzImOdmZu- \,@oM|4ewk1ܚ&Ƽ/@GmeӋ]T@iM<,M<*pܛF{ULw |!yoZdK 7-RCMD SO?T gXkن{IvMp:[~..|V]w`'  bڴDdTOA+3l73ӓMک=O Ouc~^xfV*l>ImYhEԧ*LT!%yx*!ouZ򣙑 :;U¯e m붙;4<%5622!jD:ɑOʐo{k 47estvǥ8#0a F@~Ln?jm2w,*f{04n/8yn<>,~k!?,Qz "| udJ飣d8;#C5*m{Л|!W0LB$2ҽ^]bkq o@\ބ,idtކ|;N/Eu1=Q$頙 >d$;$Ŗ#^!OIyFqkh\< huJh_Pu EK:ULܧ.fIq .5dmضص{L+7.nB\4I\r1c_*.,V9$)r-xTiPpLG|^76i;6.^|AYCG}Z"W ";v I`rc/uxBS[^n8vhN 1Q0RCGȊ ^MA-k2^ '].#Hj30 Hun&N3Dn4;9~jF|pf@ ;SX!,ruYK<CY+z4|d(ɘqяp8U?HsNhF8ģh,<ޢ}f_`Qk* 4<u&=BT&39PF)U6SN5GIezAFzxX,5{ڼzͪr;!HfZa ^,~n?ymzFr?B?Vb.~{ݖ6axh^,&mE_OinS:MQ*uzG5^fЏ!]BA'm$cnVL{V $ +e ,6i[o5PYk(Vo>{ ~eNi[f~62gl,ZHV\z+7+"3I͢Qv5em'Gf+&S0?hV̙wNH- !+"S{dM(㮗;_OEWk!WYtabzd#)B `MG~qD&TLxi1}Oziړ#nTs3-r~{25X K=CTA)matCL۲4b_xo3 Z.쨴Dá4xe_{R4AؔD}TU]~./M ~Zˊb_/Z(}AJ \ÊފH-zfw>h!F/p SYEʆanŜO)VFQwtgV>T@c.΍.[5R׎W\tDsڢ^ӵy6+GiZ>SǺU*vM2d6;6>˫oBBJ1*JBW*yV@0p瓳+FeWu 6rAng=\mej/4Ҳʟn oAO "nqD@8 yTCI'c@4&RY*rHfcfqK/e*>q,#8T惊Xa(RmrNa($C" )0 $*7i*Nނx1 Nd qd1 X!Y§BރʯT$ഁx[ei}+S{aJR3j5z4J3H8Yަ<*E=KBxȌwM׶,;DT_%G5ou}݇*M@>`l[vВ_Ag!bsk2j'dl2hO?%&n?ī6-:?J~ZVA/j~Vnom_q_`LTZ*z%$9NPA7ZdkOaw4iTfUf}"0ŋAy7?״?x;Ƽ}8;}xO-{ۺRi365p 3w~bg 5k?Z؏6NJͰ F<:[/lf]GC<݅8}lYJTE)JcY!7Ɣ@vu"t x Yr|݌6_}^4ZG8@{=h1h=18[rWr=쮮M`sfD˷ 7tmXmȄ/ P׷Sbn!)7ȽsWG$$WGy,a?~e\Lǿ*qf8@AsݛRJ ~w6<oIkX 61zwg_'zJ*~C<վo1(8ߣp*C<* ϓ+ïtƁONl0#g_m5S]LAZkwӐ:q5ns4eg6;vq9f6s* , _@V_#`M?8""kR=,/,-Q=áZT|j|ģ* o:`hЍ.!}_XGH*%\,e+rU츧wfS v>{è8XlZkl3 *vk >u*6aKV00Xec{KitzISSoB-؆Q1(h?&)uJu{h [9mt47p\czS\l~ݠA,Q Sm: -h5 yȻTouK*S6:] H: yy)O⑥O"wRiC#95۪嘣Gsux_5,Lp2U W6ΒgiOm VoOFsXcK[o1sېo+ Y(iO2({;U0-ފ7UqA[}.F8!d{W%n޶]AVǰ pH욶u{ D>F}XE8lפw9!BDR *;oIIe5 R4qAS8TRt#9%39 7-+*+ljP3?li /M7mG 2ܑ'8ۓX#G"n.蝕jo2ny8*,Џ-[5 KƁK2^ts䴗V dIUۂr$*W _߄K됯+kw~9J8yN7eł^w nծ=p`e-3o[s@{PyȄo3G|_ސv&\8"(=?+}T'-T\?dvwRfq6C I6NS1 \oo%mM08ɽha~Jx`G֊FM7KAǡ9nI߈f2!9tB{#cQ4EOU1 IB»#fVKVKxGPOj2Zş6 zh?jDVrFj0ΨGNG5kb%mp轉u\K[RKlV6E):jRθg1p˴Z(r ByF~׺p ӊwaifL (0GMnU _Et k~? rw۝}>dtlHmʆdh"_30'b Z\n^ɢ>' /(KzC^0J(V (A鏫fV zլW%ӊgUy %Ͼ'rBg43m[ϨɾAէ$Dod(N5/.^;#Τ(2}X挿%.ravF$‡\㨩gǢUZA5Vv*]fmszEۭat|Y.G~h/x)^w:vuy۲uO~ڭ>cPRηpkzVfg[I}4$ӿsN~7p Gw5|װ&TÚY66&UwϻݚT+5MwrHmUFiiiq {}pW%ƨ} ӧp- ,m 90~JF@|'#A3cwߛ^u]a T G (^ vW5/Rމb{lR;zJf0z0"]r1FQMϛYK~'rނOoeP&6(?ThVC:j;MO3Q-,M'n<7eJR~ޚ >v~X8(@G2 ,蚱Fk*i~CpG%WatV?x[vb_J N6`D[vXnK%:/W޺{'e3A:I76*~e+uRRu hG{R7Fn(ڻVnՂ^G6J0.yߺUUgy~αl߰M#W1j0!Mƫku==홝v嫵Bvw)ۼo~jm(-n竴u{fw%wh7dSntH-:/noo swժe_8y5(8޳f%KYWёGGOhȶ).3Wzv`UQ͂6_K;)z>sh(W6UҌI=״o,SZ9W9|yM_Y)&~Gr!)ȧf;!m/ oPXoD(pG1)'e.i|~NzeiArf;#Nx ]dCig] ^e]Hl @LFX&z֜t46[Z- ;|PHX50(@HFzP<^PaG\nLFzm ?HFᣚW* o"< 9cg۲!%V C %\VignetteIndexEntry{Panel data econometrics in R: the plm package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction Panel data econometrics is a continuously developing field. The increasing availability of data observed on cross-sections of units (like households, firms, countries etc.) *and* over time has given rise to a number of estimation approaches exploiting this double dimensionality to cope with some of the typical problems associated with economic data, first of all that of unobserved heterogeneity. Timewise observation of data from different observational units has long been common in other fields of statistics (where they are often termed *longitudinal* data). In the panel data field as well as in others, the econometric approach is nevertheless peculiar with respect to experimental contexts, as it is emphasizing model specification and testing and tackling a number of issues arising from the particular statistical problems associated with economic data. Thus, while a very comprehensive software framework for (among many other features) maximum likelihood estimation of linear regression models for longitudinal data, packages `nlme` [@PINH:BATE:DEBR:SARK:07] and `lme4` [@BATE:07], is available in the `R` (@R:2008) environment and can be used, e.g., for estimation of random effects panel models, its use is not intuitive for a practicing econometrician, and maximum likelihood estimation is only one of the possible approaches to panel data econometrics. Moreover, economic panel data sets often happen to be *unbalanced* (i.e., they have a different number of observations between groups), which case needs some adaptation to the methods and is not compatible with those in `nlme`. Hence the need for a package doing panel data "from the econometrician's viewpoint" and featuring at a minimum the basic techniques econometricians are used to: random and fixed effects estimation of static linear panel data models, variable coefficients models, generalized method of moments estimation of dynamic models; and the basic toolbox of specification and misspecification diagnostics. Furthermore, we felt there was a need for automation of some basic data management tasks such as lagging, summing and, more in general, `apply`ing (in the `R` sense) functions to the data, which, although conceptually simple, become cumbersome and error-prone on two-dimensional data, especially in the case of unbalanced panels. This paper is organized as follows: Section [linear panel model](#linear-panel-model) presents a very short overview of the typical model taxonomy^[Comprehensive treatments are to be found in many econometrics textbooks, e.g., @BALT:05, @BALT:13, @BALT:21 or @WOOL:02, @WOOL:10: the reader is referred to these, especially to the first 9 chapters of @BALT:05, @BALT:13, @BALT:21.]. Section [software approach](#software-approach) discusses the software approach used in the package. The next three sections present the functionalities of the package in more detail: data management (Section [managing data and formulae](#managing-data-and-formulae)), estimation (Section [model estimation](#model-estimation)) and testing (Section [tests](#tests)), giving a short description and illustrating them with examples. Section [plm vs nlme and lme4](#nlme) compares the approach in `plm` to that of `nlme` and `lme4`, highlighting the features of the latter two that an econometrician might find most useful. Section [conclusion](#conclusions) concludes the paper. # The linear panel model{#linear-panel-model} The basic linear panel models used in econometrics can be described through suitable restrictions of the following general model: \begin{equation*} y_{it}=\alpha_{it} + \beta_{it}^\top x_{it} + u_{it} \end{equation*} where $i=1, ..., n$ is the individual (group, country ...) index, $t=1, ..., T$ is the time index and $u_{it}$ a random disturbance term of mean $0$. Of course $u_{it}$ is not estimable with $N = n \times T$ data points. A number of assumptions are usually made about the parameters, the errors and the exogeneity of the regressors, giving rise to a taxonomy of feasible models for panel data. The most common one is parameter homogeneity, which means that $\alpha_{it}=\alpha$ for all $i,t$ and $\beta_{it}=\beta$ for all $i,t$. The resulting model \begin{equation*} y_{it}=\alpha + \beta^\top x_{it} + u_{it} \end{equation*} is a standard linear model pooling all the data across $i$ and $t$. To model individual heterogeneity, one often assumes that the error term has two separate components, one of which is specific to the individual and doesn't change over time^[For the sake of exposition we are considering only the individual effects case here. There may also be time effects, which is a symmetric case, or both of them, so that the error has three components: $u_{it}=\mu_{i}+\lambda_{t}+\epsilon_{it}$.]. This is called the unobserved effects model: \begin{equation} (\#eq:errcomp) y_{it}=\alpha + \beta^\top x_{it} + \mu_i + \epsilon_{it} \end{equation} The appropriate estimation method for this model depends on the properties of the two error components. The idiosyncratic error $\epsilon_{it}$ is usually assumed well-behaved and independent of both the regressors $x_{it}$ and the individual error component $\mu_i$. The individual component may be in turn either independent of the regressors or correlated. If it is correlated, the ordinary least squares (OLS) estimator of $\beta$ would be inconsistent, so it is customary to treat the $\mu_i$ as a further set of $n$ parameters to be estimated, as if in the general model $\alpha_{it}=\alpha_{i}$ for all $t$. This is called the fixed effects (a.k.a. *within* or *least squares dummy variables*) model, usually estimated by OLS on transformed data, and gives consistent estimates for $\beta$. If the individual-specific component $\mu_i$ is uncorrelated with the regressors, a situation which is usually termed *random effects*, the overall error $u_{it}$ also is, so the OLS estimator is consistent. Nevertheless, the common error component over individuals induces correlation across the composite error terms, making OLS estimation inefficient, so one has to resort to some form of feasible generalized least squares (GLS) estimators. This is based on the estimation of the variance of the two error components, for which there are a number of different procedures available. If the individual component is missing altogether, pooled OLS is the most efficient estimator for $\beta$. This set of assumptions is usually labelled *pooling* model, although this actually refers to the errors' properties and the appropriate estimation method rather than the model itself. If one relaxes the usual hypotheses of well-behaved, white noise errors and allows for the idiosyncratic error $\epsilon_{it}$ to be arbitrarily heteroskedastic and serially correlated over time, a more general kind of feasible GLS is needed, called the *unrestricted* or *general* GLS. This specification can also be augmented with individual-specific error components possibly correlated with the regressors, in which case it is termed *fixed effects* GLS. Another way of estimating unobserved effects models through removing time-invariant individual components is by first-differencing the data: lagging the model and subtracting, the time-invariant components (the intercept and the individual error component) are eliminated, and the model \begin{equation*} \Delta y_{it}= \beta^\top \Delta x_{it} + \Delta u_{it} \end{equation*} (where $\Delta y_{it}=y_{it}-y_{i,t-1}$, $\Delta x_{it}=x_{it}-x_{i,t-1}$ and, from \@ref(eq:errcomp), $\Delta u_{it}=u_{it}-u_{i,t-1}=\Delta \epsilon_{it}$ for $t=2,...,T$) can be consistently estimated by pooled OLS. This is called the *first-difference* or FD estimator. Its relative efficiency, and so reasons for choosing it against other consistent alternatives, depends on the properties of the error term. The FD estimator is usually preferred if the errors $u_{it}$ are strongly persistent in time, because then the $\Delta u_{it}$ will tend to be serially uncorrelated. Lastly, the *between* model, which is computed on time (group) averages of the data, discards all the information due to intragroup variability but is consistent in some settings (e.g., non-stationarity) where the others are not, and is often preferred to estimate long-run relationships. Variable coefficients models relax the assumption that $\beta_{it}=\beta$ for all $i,t$. Fixed coefficients models allow the coefficients to vary along one dimension, like $\beta_{it}=\beta_i$ for all $t$. Random coefficients models instead assume that coefficients vary randomly around a common average, as $\beta_{it}=\beta+\eta_{i}$ for all $t$, where $\eta_{i}$ is a group-- (time--) specific effect with mean zero. The hypotheses on parameters and error terms (and hence the choice of the most appropriate estimator) are usually tested by means of: - *pooling* tests to check poolability, i.e., the hypothesis that the same coefficients apply across all individuals, - if the homogeneity assumption over the coefficients is established, the next step is to establish the presence of unobserved effects, comparing the null of spherical residuals with the alternative of group (time) specific effects in the error term, - the choice between fixed and random effects specifications is based on Hausman-type tests, comparing the two estimators under the null of no significant difference: if this is not rejected, the more efficient random effects estimator is chosen, - even after this step, departures of the error structure from sphericity can further affect inference, so that either screening tests or robust diagnostics are needed. Dynamic models and in general lack of strict exogeneity of the regressors, pose further problems to estimation which are usually dealt with in the generalized method of moments (GMM) framework. These were, in our opinion, the basic requirements of a panel data econometrics package for the `R` language and environment. Some, as often happens with `R`, were already fulfilled by packages developed for other branches of computational statistics, while others (like the fixed effects or the between estimators) were straightforward to compute after transforming the data, but in every case there were either language inconsistencies w.r.t. the standard econometric toolbox or subtleties to be dealt with (like, for example, appropriate computation of standard errors for the demeaned model, a common pitfall), so we felt there was need for an "all in one" econometrics-oriented package allowing to make specification searches, estimation and inference in a natural way. # Software approach{#software-approach} ## Data structure Panel data have a special structure: each row of the data corresponds to a specific individual and time period. In `plm` the `data` argument may be an ordinary `data.frame` but, in this case, an argument called `index` has to be added to indicate the structure of the data. This can be: - `NULL` (the default value), it is then assumed that the first two columns contain the individual and the time index and that observations are ordered by individual and by time period, - a character string, which should be the name of the individual index, - a character vector of length two containing the names of the individual and the time index, - an integer which is the number of individuals (only in case of a balanced panel with observations ordered by individual). The `pdata.frame` function is then called internally, which returns a `pdata.frame` which is a `data.frame` with an attribute called index. This attribute is a `data.frame` that contains the individual and the time indexes. It is also possible to use directly the `pdata.frame` function and then to use the `pdata.frame` in the estimation functions. ## Interface ### Estimation interface Package `plm` provides various functions for panel data estimation, among them: - `plm`: estimation of the basic panel models and instrumental variable panel models, *i.e.*, between and first-difference models and within and random effect models. Models are estimated internally using the `lm` function on transformed data, - `pvcm`: estimation of models with variable coefficients, - `pgmm`: estimation of generalized method of moments models, - `pggls`: estimation of general feasible generalized least squares models, - `pmg`: estimators for mean groups (MG), demeaned MG (DMG) and common correlated effects MG (CCEMG) for heterogeneous panel models, - `pcce`: estimators for common correlated effects mean groups (CCEMG) and pooled (CCEP) for panel data with common factors, - `pldv`: panel estimators for limited dependent variables. The interface of these functions is consistent with the `lm()` function. Namely, their first two arguments are `formula` and `data` (which should be a `data.frame` and is mandatory). Three additional arguments are common to these functions: - `index`: this argument enables the estimation functions to identify the structure of the data, *i.e.*, the individual and the time period for each observation, - `effect`: the kind of effects to include in the model, *i.e.*, individual effects, time effects or both^[Although in most models the individual and time effects cases are symmetric, there are exceptions: estimating the *first-difference* model on time effects is meaningless because cross-sections do not generally have a natural ordering, so trying `effect = "time"` stops with an error message as does `effect = "twoways"` which is not defined for first-difference models.], - `model`: the kind of model to be estimated, most of the time a model with fixed effects or a model with random effects. The results of these four functions are stored in an object which class has the same name of the function. They all inherit from class `panelmodel`. A `panelmodel` object contains: `coefficients`, `residuals`, `fitted.values`, `vcov`, `df.residual` and `call` and functions that extract these elements are provided. ### Testing interface The diagnostic testing interface provides both `formula` and `panelmodel` methods for most functions, with some exceptions. The user may thus choose whether to employ results stored in a previously estimated `panelmodel` object or to re-estimate it for the sake of testing. Although the first strategy is the most efficient one, diagnostic testing on panel models mostly employs OLS residuals from pooling model objects, whose estimation is computationally inexpensive. Therefore most examples in the following are based on `formula` methods, which are perhaps the cleanest for illustrative purposes. ## Computational approach to estimation The feasible GLS methods needed for efficient estimation of unobserved effects models have a simple closed-form solution: once the variance components have been estimated and hence the covariance matrix of errors $\hat{V}$, model parameters can be estimated as \begin{equation} (\#eq:naive) \hat{\beta}=(X^\top \hat{V}^{-1} X)^{-1} (X^\top \hat{V}^{-1} y) \end{equation} Nevertheless, in practice plain computation of $\hat{\beta}$ has long been an intractable problem even for moderate-sized data sets because of the need to invert the $N\times N$ $\hat{V}$ matrix. With the advances in computer power, this is no more so, and it is possible to program the "naive" estimator \@ref(eq:naive) in `R` with standard matrix algebra operators and have it working seamlessly for the standard "guinea pigs", e.g., the Grunfeld data. Estimation with a couple of thousands of data points also becomes feasible on a modern machine, although excruciatingly slow and definitely not suitable for everyday econometric practice. Memory limits would also be very near because of the storage needs related to the huge $\hat{V}$ matrix. An established solution exists for the random effects model which reduces the problem to an ordinary least squares computation. ### The (quasi--)demeaning framework The estimation methods for the basic models in panel data econometrics, the pooled OLS, random effects and fixed effects (or within) models, can all be described inside the OLS estimation framework. In fact, while pooled OLS simply pools data, the standard way of estimating fixed effects models with, say, group (time) effects entails transforming the data by subtracting the average over time (group) to every variable, which is usually termed *time-demeaning*. In the random effects case, the various feasible GLS estimators which have been put forth to tackle the issue of serial correlation induced by the group-invariant random effect have been proven to be equivalent (as far as estimation of $\beta$s is concerned) to OLS on *partially demeaned* data, where partial demeaning is defined as: \begin{equation} (\#eq:ldemmodel) y_{it} - \theta \bar{y}_i = ( X_{it} - \theta \bar{X}_{i} ) \beta + ( u_{it} - \theta \bar{u}_i ) \end{equation} where $\theta=1-[\sigma_u^2 / (\sigma_u^2 + T \sigma_e^2)]^{1/2}$, $\bar{y}$ and $\bar{X}$ denote time means of $y$ and $X$, and the disturbance $v_{it} - \theta \bar{v}_i$ is homoskedastic and serially uncorrelated. Thus the feasible RE estimate for $\beta$ may be obtained estimating $\hat{\theta}$ and running an OLS regression on the transformed data with `lm()`. The other estimators can be computed as special cases: for $\theta=1$ one gets the fixed effects estimator, for $\theta=0$ the pooled OLS one. Moreover, instrumental variable estimators of all these models may also be obtained using several calls to `lm()`. For this reason the three above estimators have been grouped inside the same function. On the output side, a number of diagnostics and a very general coefficients' covariance matrix estimator also benefits from this framework, as they can be readily calculated applying the standard OLS formulas to the demeaned data, which are contained inside `plm` objects. This will be the subject of subsection [inference in the panel model](#inference). ### The object oriented approach to general GLS computations The covariance matrix of errors in general GLS models is too generic to fit the quasi-demeaning framework, so this method calls for a full-blown application of GLS as in \@ref(eq:naive). On the other hand, this estimator relies heavily on $n$--asymptotics, making it theoretically most suitable for situations which forbid it computationally: e.g., "short" micropanels with thousands of individuals observed over few time periods. `R` has general facilities for fast matrix computation based on object orientation: particular types of matrices (symmetric, sparse, dense etc.) are assigned the relevant class and the additional information on structure is used in the computations, sometimes with dramatic effects on performance (see @BATE:04) and packages `Matrix` (see @BATE:MAEC:2016) and `SparseM` (see @KOEN:NG:2016). Some optimized linear algebra routines are available in the `R` package `bdsmatrix` (see @THER:14) which exploit the particular block-diagonal and symmetric structure of $\hat{V}$ making it possible to implement a fast and reliable full-matrix solution to problems of any practically relevant size. The $\hat{V}$ matrix is constructed as an object of class `bdsmatrix`. The peculiar properties of this matrix class are used for efficiently storing the object in memory and then by ad-hoc versions of the `solve` and `crossprod` methods, dramatically reducing computing times and memory usage. The resulting matrix is then used "the naive way" as in \@ref(eq:naive) to compute $\hat{\beta}$, resulting in speed comparable to that of the demeaning solution. ## Inference in the panel model{#inference} General frameworks for restrictions and linear hypotheses testing are available in the `R` environment^[See packages `lmtest` (@HOTH:ZEIL:FARE:CUMM:MILL:MITC:2015) and `car` (@FOX:2016).]. These are based on the Wald test, constructed as $\hat{\beta}^\top \hat{V}^{-1} \hat{\beta}$, where $\hat{\beta}$ and $\hat{V}$ are consistent estimates of $\beta$ and $V(\beta)$, The Wald test may be used for zero-restriction (i.e., significance) testing and, more generally, for linear hypotheses in the form $(R \hat{\beta} - r)^\top [R \hat{V} R^\top ]^{-1} (R \hat{\beta} - r)$^[Moreover, `coeftest()` provides a compact way of looking at coefficient estimates and significance diagnostics.]. To be applicable, the test functions require extractor methods for coefficients' and covariance matrix estimates to be defined for the model object to be tested. Model objects in `plm` all have `coef()` and `vcov()` methods and are therefore compatible with the above functions. In the same framework, robust inference is accomplished substituting ("plugging in") a robust estimate of the coefficient covariance matrix into the Wald statistic formula. In the panel context, the estimator of choice is the White system estimator. This called for a flexible method for computing robust coefficient covariance matrices *à la White* for `plm` objects. A general White system estimator for panel data is: \begin{equation*} \hat{V}_R(\beta)=(X^\top X)^{-1} \sum_{i=1}^n{X_i^\top E_i X_i} (X^\top X)^{-1} \end{equation*} where $E_i$ is a function of the residuals $\hat{e}_{it}, \; t=1, \dots T$ chosen according to the relevant heteroskedasticity and correlation structure. Moreover, it turns out that the White covariance matrix calculated on the demeaned model's regressors and residuals (both part of `plm` objects) is a consistent estimator of the relevant model's parameters' covariance matrix, thus the method is readily applicable to models estimated by random or fixed effects, first difference or pooled OLS methods. Different pre-weighting schemes taken from package `sandwich` (see @ZEIL:04; @LUML:ZEIL:2015) are also implemented to improve small-sample performance. Robust estimators with any combination of covariance structures and weighting schemes can be passed on to the testing functions. # Managing data and formulae{#dataformula} The package is now illustrated by application to some well-known examples. It is loaded using ```{r echo=FALSE,results='hide'} options(prompt= "R> ", useFancyQuotes = FALSE, scipen = 999) library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` ```{r echo=TRUE, results='hide'} library("plm") ``` The four data sets used are `EmplUK` which was used by @AREL:BOND:91, the `Grunfeld` data [@KLEI:ZEIL:08] which is used in several econometric books, the `Produc` data used by @MUNN:90 and the `Wages` used by @CORN:RUPE:88. ```{r } data("EmplUK", package="plm") data("Produc", package="plm") data("Grunfeld", package="plm") data("Wages", package="plm") ``` ## Data structure As observed above, the current version of `plm` is capable of working with a regular `data.frame` without any further transformation, provided that the individual and time indexes are in the first two columns, as in all the example data sets but `Wages`. If this weren't the case, an `index` optional argument would have to be passed on to the estimating and testing functions. ```{r setdata1} head(Grunfeld) E <- pdata.frame(EmplUK, index=c("firm","year"), drop.index=TRUE, row.names=TRUE) head(E) head(attr(E, "index")) ``` Two further arguments are logical: `drop.index = TRUE` drops the indexes from the `data.frame` and `row.names = TRUE` computes "fancy" row names by pasting the individual and the time indexes. While extracting a series from a `pdata.frame`, a `pseries` is created, which is the original series with the index attribute. This object has specific methods, like `summary` and `as.matrix`. The former indicates the total variation of the variable and the shares of this variation due to the individual and the time dimensions. The latter gives the matrix representation of the series, with, by default, individuals as rows and times as columns. ```{r } summary(E$emp) head(as.matrix(E$emp)) ``` ## Data transformation Panel data estimation requires to apply different transformations to raw series. If $x$ is a series of length $nT$ (where $n$ is the number of individuals and $T$ is the number of time periods), the transformed series $\tilde{x}$ is obtained as $\tilde{x}=Mx$ where $M$ is a transformation matrix. Denoting $j$ a vector of one of length $T$ and $I_n$ the identity matrix of dimension $n$, we get: - the between transformation: $P=\frac{1}{T}I_n\otimes jj'$ returns a vector containing the individual means. The `Between` and `between` functions perform this operation, the first one returning a vector of length $nT$, the second one a vector of length $n$, - the within transformation: $Q=I_{nT}-P$ returns a vector containing the values in deviation from the individual means. The `Within` function performs this operation. - the first difference transformation $D=I_n \otimes d$ where $d=\left( \begin{array}{ccccccc} 1 & -1 & 0 & 0 & ... & 0 & 0 \\ 0 & 1 & -1 & 0 & ... & 0 & 0 \\ 0 & 0 & 1 & -1 & ... & 0 & 0 \\ \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & 1 & -1 \\ \end{array} \right)$ is of dimension $(T-1,T)$. Note that `R`'s `diff()` and `lag()` functions don't compute correctly these transformations for panel data because they are unable to identify when there is a change in individual in the data. Therefore, specific methods for `pseries` objects have been written in order to handle correctly panel data. Note that compared to the `lag()` method for `ts` objects, the order of lags are indicated by a positive integer. Moreover, 0 is a relevant value and a vector argument may be provided: ```{r } head(lag(E$emp, 0:2)) ``` Further functions called `Between`, `between` and `Within` are also provided to compute the between and the within transformation. The `between` returns unique values, whereas `Between` duplicates the values and returns a vector which length is the number of observations. ```{r } head(diff(E$emp), 10) head(lag(E$emp, 2), 10) head(Within(E$emp)) head(between(E$emp), 4) head(Between(E$emp), 10) ``` ## Formulas In some circumstances, standard `formula`s are not very useful to describe a model, notably while using instrumental variable like estimators: to deal with these situations, we use the `Formula` package. The `Formula` package provides a class which enables to construct multi-part formula, each part being separated by a pipe sign (`|`). The two formulas below are identical: ```{r results='hide'} emp ~ wage + capital | lag(wage, 1) + capital emp ~ wage + capital | . -wage + lag(wage, 1) ``` In the second case, the `.` means the previous parts which describes the covariates and this part is "updated". This is particularly interesting when there are a few external instruments. # Model estimation{#modelestimation} ## Estimation of the basic models with plm Several models can be estimated with `plm` by filling the `model` argument: - the fixed effects model (`"within"`), the default, - the pooling model (`"pooling"`), - the first-difference model (`"fd"`), - the between model (`"between"`), - the error components model (`"random"`). The basic use of `plm` is to indicate the model formula, the data and the model to be estimated. For example, the fixed effects model and the random effects model are estimated using: ```{r fe_re} grun.fe <- plm(inv~value+capital, data = Grunfeld, model = "within") grun.re <- plm(inv~value+capital, data = Grunfeld, model = "random") ``` Methods to display a sumamry of the model estimation are available via `summary`. For example, for a `random` model, the `summary` method gives information about the variance of the components of the errors and some test statistics. Random effects of the estimated model can be extracted via `ranef`. ```{r summary_re} summary(grun.re) ranef(grun.re) ``` The fixed effects of a fixed effects model may be extracted easily using `fixef`. An argument `type` indicates how fixed effects should be computed: in levels by `type = "level"` (the default), in deviations from the overall mean by `type = "dmean"` or in deviations from the first individual by `type = "dfirst"`. ```{r } fixef(grun.fe, type = "dmean") ``` The `fixef` function returns an object of class `fixef`. A summary method is provided, which prints the effects (in deviation from the overall intercept), their standard errors and the test of equality to the overall intercept. ```{r } summary(fixef(grun.fe, type = "dmean")) ``` In case of a two-ways fixed effect model, argument `effect` is relevant in function `fixef` to extract specific effect fixed effects with possible values `"individual"` for individual fixed effects (default for two-ways fixed effect models), `"time"` for time fixed effects, and `"twoways"` for the sum of individual and time fixed effects. Example to extract the time fixed effects from a two-ways model: ```{r } grun.twfe <- plm(inv~value+capital, data=Grunfeld, model="within", effect="twoways") fixef(grun.twfe, effect = "time") ``` ## More advanced use of plm ### Random effects estimators As observed above, the random effect model is obtained as a linear estimation on quasi-demeaned data. The parameter of this transformation is obtained using preliminary estimations. Four estimators of this parameter are available, depending on the value of the argument `random.method`: - `"swar"`: from @SWAM:AROR:72, the default value, - `"walhus"`: from @WALL:HUSS:69, - `"amemiya"`: from @AMEM:71, - `"nerlove"`: from @NERLO:71. - `"ht"`: for Hausman-Taylor-type instrumental variable (IV) estimation, discussed later, see Section [Instrumental variable estimator](#instrumental-variable-est). For example, to use the `amemiya` estimator: ```{r } grun.amem <- plm(inv~value+capital, data=Grunfeld, model="random", random.method="amemiya") ``` The estimation of the variance of the error components are performed using the `ercomp` function, which has a `method` and an `effect` argument, and can be used by itself: ```{r } ercomp(inv~value+capital, data=Grunfeld, method = "amemiya", effect = "twoways") ``` ### Introducing time or two-ways effects The default behavior of `plm` is to introduce individual effects. Using the `effect` argument, one may also introduce: - time effects (`effect = "time"`), - individual and time effects (`effect = "twoways"`). For example, to estimate a two-ways effect model for the `Grunfeld` data: ```{r 2RE-amemiya} grun.tways <- plm(inv~value+capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "amemiya") summary(grun.tways) ``` In the "effects" section of the printed summary of the result, the variance of the three elements of the error term and the three parameters used in the transformation are printed. ### Unbalanced panels Estimations by `plm` support unbalanced panel models. The following example is using data used by @HARR:RUBI:78 to estimate an hedonic housing prices function. It is reproduced in @BALT:CHAN:94, table 2 (and in @BALT:05, pp. 172/4; @BALT:13, pp. 195/7 tables 9.1/3). ```{r hedonic} data("Hedonic", package = "plm") Hed <- plm(mv~crim+zn+indus+chas+nox+rm+age+dis+rad+tax+ptratio+blacks+lstat, data = Hedonic, model = "random", index = "townid") summary(Hed) ``` Measures for the unbalancedness of a panel data set or the data used in estimated models are provided by function `punbalancedness`. It gives the measures $\gamma$ and $\nu$ from @AHRE:PINC:81 where for both 1 represents balanced data and the more unbalanced the data the lower the value. ```{r hedonic-punbal} punbalancedness(Hed) ``` ### Instrumental variable estimators{#instrumental-variable-est} All of the models presented above may be estimated using instrumental variables. The instruments are specified at the end of the formula after a `|` sign (pipe). The instrumental variables estimator used is indicated with the `inst.method` argument: - `"bvk"`, from @BALE:VARA:87, the default value, - `"baltagi"`, from @BALT:81, - `"am"`, from @AMEM:MACU:86, - `"bms"`, from @BREU:MIZO:SCHM:89. An illustration is in the following example from @BALT:05, p. 120; @BALT:13, p. 137; @BALT:21, p. 165, table 7.3 ("G2SLS"). ```{r G2SLS} data("Crime", package = "plm") cr <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random") summary(cr) ``` The Hausman-Taylor model (see @HAUS:TAYL:81) may be estimated with the `plm`^[Function `pht` is a deprecated way to estimate this type of model: `ht <- pht(lwage~wks+south+smsa+married+exp+I(exp^2)+ bluecol+ind+union+sex+black+ed | sex+black+bluecol+south+smsa+ind, data=Wages,index=595)`.] function by setting parameters `random.method = "ht"` and `inst.method = "baltagi"` like in the example below. The following replicates @BALT:05, pp. 129/30; @BALT:13, pp. 145/6, tables 7.4/5; @BALT:21, pp. 174/5 tables 7.5/6: ```{r hausman-taylor} ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, model = "random", random.method = "ht", inst.method = "baltagi") summary(ht) ``` ## Variable coefficients model The `pvcm` function enables the estimation of variable coefficients models. Time or individual effects are introduced if argument `effect` is fixed to `"time"` or `"individual"` (the default value). Coefficients are assumed to be fixed if `model="within"` or random if `model="random"`. In the first case, a different model is estimated for each individual (or time period). In the second case, the Swamy model (see @SWAM:70) model is estimated. It is a generalized least squares model which uses the results of the previous model. Denoting $\hat{\beta}_i$ the vectors of coefficients obtained for each individual, we get: \begin{equation*} \hat{\beta}=\left(\sum_{i=1}^n \left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\right)\left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\hat{\beta}_i \end{equation*} where $\hat{\sigma}_i^2$ is the unbiased estimator of the variance of the errors for individual $i$ obtained from the preliminary estimation and: \begin{equation*} \hat{\Delta}=\frac{1}{n-1}\sum_{i=1}^n\left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right) \left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right)^\top -\frac{1}{n}\sum_{i=1}^n\hat{\sigma}_i^2(X_i^\top X_i)^{-1} \end{equation*} If this matrix is not positive-definite, the second term is dropped. With the `Grunfeld` data, we get: ```{r grunfeld.within} grun.varw <- pvcm(inv~value+capital, data=Grunfeld, model="within") grun.varr <- pvcm(inv~value+capital, data=Grunfeld, model="random") summary(grun.varr) ``` ## Generalized method of moments estimator The generalized method of moments is mainly used in panel data econometrics to estimate dynamic models [@AREL:BOND:91; @HOLT:NEWE:ROSE:88]. \begin{equation*} y_{it}=\rho y_{it-1}+\beta^\top x_{it}+\mu_i+\epsilon_{it} \end{equation*} The model is first differenced to get rid of the individual effect: \begin{equation*} \Delta y_{it}=\rho \Delta y_{it-1}+\beta^\top \Delta x_{it}+\Delta \epsilon_{it} \end{equation*} Least squares are inconsistent because $\Delta \epsilon_{it}$ is correlated with $\Delta y_{it-1}$. $y_{it-2}$ is a valid, but weak instrument (see @ANDE:HSIA:81). The GMM estimator uses the fact that the number of valid instruments is growing with $t$: - $t=3$: $y_1$, - $t=4$: $y_1,y_2$, - $t=5$: $y_1,y_2,y_3$. For individual $i$, the matrix of instruments is then: \begin{equation*} W_i=\left( \begin{array}{ccccccccccccc} y_1 & 0 & 0 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i3} \\ 0 & y_1 & y_2 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i4} \\ 0 & 0 & 0 & y_1 & y_2 & y_3 & ... & 0 & 0 & 0 & 0 & x_{i5} \\ \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & ... & ... & y_1 & y_2 & ... & y_{t-2} & x_{iT-2} &\\ \end{array} \right) \end{equation*} The moment conditions are: $\sum_{i=1}^n W_i^\top e_i(\beta)$ where $e_i(\beta)$ is the vector of residuals for individual $i$. The GMM estimator minimizes: \begin{equation*} \left(\sum_{i=1}^n e_i(\beta)^\top W_i\right) A \left(\sum_{i=1}^n W_i^\top e_i(\beta)\right) \end{equation*} where $A$ is the weighting matrix of the moments. One-step estimators are computed using a known weighting matrix. For the model in first differences, one uses: \begin{equation*} A^{(1)}=\left(\sum_{i=1}^n W_i^\top H^{(1)}W_i\right)^{-1} \end{equation*} with: \begin{equation*} H^{(1)}=d^\top d=\left( \begin{array}{ccccc} 2 & -1 & 0 & ... & 0\\ -1 & 2 & -1 & ... & 0\\ 0 & -1 & 2 & ... & 0\\ \vdots & \vdots & \vdots & \vdots & \vdots \\ 0 & 0 & 0 & -1 & 2\\ \end{array} \right) \end{equation*} Two-steps estimators are obtained using $H^{(2)}_i=\sum_{i=1}^n e^{(1)}_i e^{(1)\top }_i$ where $e_i^{(1)}$ are the residuals of the one step estimate. @BLUN:BOND:98 show that with weak hypothesis on the data generating process, supplementary moment conditions exist for the equation in level: $$ y_{it} = \gamma y_{it-1}+\mu_i+\eta_{it} $$ More precisely, they show that $\Delta y_{it-2}=y_{it-2}-y_{it-3}$ is a valid instrument. The estimator is obtained using the residual vector in difference and in level: $$ e^+_i=(\Delta e_i, e_i) $$ and the matrix of augmented moments: $$ Z_i^+=\left( \begin{array}{ccccc} Z_i & 0 & 0 & ... & 0 \\ 0 & \Delta y_{i2} & 0 & ... & 0 \\ 0 & 0 & \Delta y_{i3} & ... & 0 \\ 0 & 0 & 0 & ... & \Delta y_{iT-1} \end{array} \right) $$ The moment conditions are then \begin{eqnarray*} \left(\sum_{i=1}^n Z_i^{+\top} \left(\begin{array}{c}\bar{e}_i(\beta)\\ e_i(\beta)\end{array}\right)\right)^\top = \left(\sum_{i=1}^n y_{i1} \bar{e}_{i3},\sum_{i=1}^n y_{i1}\bar{e}_{i4},\sum_{i=1}^n y_{i2}\bar{e}_{i4}, ..., \right.\\ \left. \sum_{i=1}^n y_{i1} \bar{e}_{iT}, \sum_{i=1}^n y_{i2} \bar{e}_{iT}, ...,\sum_{i=1}^n y_{iT-2} \bar{e}_{iT}, \sum_{i=1}^n \sum_{t=3}^T x_{it} \bar{e}_{it}\right.\\ \left.\sum_{i=1}^n e_{i3} \Delta y_{i2}, \sum_{i=1}^n e_{i4} \Delta y_{i3}, ... , \sum_{i=1}^n e_{iT} \Delta y_{iT-1} \right)^\top \end{eqnarray*} The GMM estimator is provided by the `pgmm` function. By using a multi-part formula, the variables of the model and the lag structure are described. In a GMM estimation, there are "normal instruments" and "GMM instruments". GMM instruments are indicated in the second part of the formula. By default, all the variables of the model that are not used as GMM instruments are used as normal instruments, with the same lag structure; "normal" instruments may also be indicated in the third part of the formula. The `effect` argument is either `NULL`, `"individual"` (the default), or `"twoways"`. In the first case, the model is estimated in levels. In the second case, the model is estimated in first differences to get rid of the individuals effects. In the last case, the model is estimated in first differences and time dummies are included. The `model` argument specifies whether a one-step or a two-steps model is requested (`"onestep"` or `"twosteps"`). The following example is from @AREL:BOND:91. Employment is explained by past values of employment (two lags), current and first lag of wages and output and current value of capital. ```{r gmm} emp.gmm <- pgmm(log(emp)~lag(log(emp), 1:2)+lag(log(wage), 0:1)+log(capital)+ lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(emp.gmm) ``` The following example is from @BLUN:BOND:98. The "sys" estimator is obtained using `transformation = "ld"` for level and difference. The `robust` argument of the `summary` method enables to use the robust covariance matrix proposed by @WIND:05. For all pgmm models, `robust = TRUE` is the default (but set in this example explicitly). ```{r gmm2} z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) ``` ## General FGLS models General FGLS estimators are based on a two-step estimation process: first an OLS model is estimated, then its residuals $\hat{u}_{it}$ are used to estimate an error covariance matrix more general than the random effects one for use in a feasible-GLS analysis. Formally, the estimated error covariance matrix is $\hat{V}=I_n \otimes \hat{\Omega}$, with $$\hat{\Omega}=\sum_{i=1}^n \frac{\hat{u}_{it} \hat{u}_{it}^\top }{n} $$ (see @WOOL:02 10.4.3 and 10.5.5). This framework allows the error covariance structure inside every group (if `effect = "individual"`) of observations to be fully unrestricted and is therefore robust against any type of intragroup heteroskedasticity and serial correlation. This structure, by converse, is assumed identical across groups and thus general FGLS is inefficient under groupwise heteroskedasticity. Cross-sectional correlation is excluded a priori. Moreover, the number of variance parameters to be estimated with $N=n\times T$ data points is $T(T+1)/2$, which makes these estimators particularly suited for situations where $n>>T$, as e.g., in labour or household income surveys, while problematic for "long" panels, where $\hat{V}$ tends to become singular and standard errors therefore become biased downwards. In a pooled time series context (`effect = "time"`), symmetrically, this estimator is able to account for arbitrary cross-sectional correlation, provided that the latter is time-invariant (see @GREE:03 13.9.1--2, pp. 321--2). In this case serial correlation has to be assumed away and the estimator is consistent with respect to the time dimension, keeping $n$ fixed. The function `pggls` estimates general FGLS models, with either fixed or "random" effects^[The "random effect" is better termed "general FGLS" model, as in fact it does not have a proper random effects structure, but we keep this terminology for general language consistency.]. The "random effect" general FGLS is estimated by: ```{r pggls} zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="pooling") summary(zz) ``` The fixed effects `pggls` (see @WOOL:02, p. 276) is based on the estimation of a within model in the first step; the rest follows as above. It is estimated by: ```{r } zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="within") ``` The `pggls` function is similar to `plm` in many respects. An exception is that the estimate of the group covariance matrix of errors (`zz$sigma`, a matrix, not shown) is reported in the model objects instead of the usual estimated variances of the two error components. # Tests{#tests} As sketched in Section [linear panel model](#linear-panel-model), specification testing in panel models involves essentially testing for poolability, for individual or time unobserved effects and for correlation between these latter and the regressors (Hausman-type tests). As for the other usual diagnostic checks, we provide a suite of serial correlation tests, while not touching on the issue of heteroskedasticity testing. Instead, we provide heteroskedasticity-robust covariance estimators, to be described in subsection [robust covariance matrix estimation](#robust). ## Tests of poolability `pooltest` tests the hypothesis that the same coefficients apply to each individual. It is a standard F test, based on the comparison of a model obtained for the full sample and a model based on the estimation of an equation for each individual. The first argument of `pooltest` is a `plm` object. The second argument is a `pvcm` object obtained with `model="within"`. If the first argument is a pooling model, the test applies to all the coefficients (including the intercepts), if it is a within model, different intercepts are assumed. To test the hypothesis that all the coefficients in the `Grunfeld` example, excluding the intercepts, are equal, we use : ```{r } znp <- pvcm(inv ~ value + capital, data = Grunfeld, model = "within") zplm <- plm(inv ~ value + capital, data = Grunfeld, model = "within") pooltest(zplm, znp) ``` The same test can be computed using a formula as first argument of the `pooltest` function: ```{r results='hide'} pooltest(inv ~ value + capital, data = Grunfeld, model = "within") ``` ## Tests for individual and time effects `plmtest` implements Lagrange multiplier tests of individual or/and time effects based on the results of the pooling model. Its main argument is a `plm` object (the result of a pooling model) or a formula. Two additional arguments can be added to indicate the kind of test to be computed. The argument `type` is one of: - `"honda"`: @HOND:85, the default value, - `"bp"`: @BREU:PAGA:80, - `"kw"`: @KING:WU:97^[NB: Oneway King-Wu (`"kw"`) statistics (`"individual"` and `"time"`) coincide with the respective Honda statistics (`"honda"`); however, the twoway statistics of `"kw"` and `"honda"` differ.], - `"ghm"`: @GOUR:HOLL:MONF:82. The effects tested are indicated with the `effect` argument (one of `"individual"`, `"time"`, or `"twoways"`). The test statistics implemented are also suitable for unbalanced panels.^[The `"bp"` test for unbalanced panels was derived in @BALT:LI:90, the `"kw"` test for unbalanced panels in @BALT:CHAN:LI:98. The `"ghm"` test and the `"kw"` test were extended to two--way effects in @BALT:CHAN:LI:92. For a concise overview of all these statistics see @BALT:13 Sec. 4.2, pp. 68--76 (for balanced panels) and Sec. 9.5, pp. 200--203 (for unbalanced panels) or @BALT:21, Sec. 4.2, pp. 81-84 (balanced), Sec. 9.6, pp. 243-246 (unbalanced).] To test the presence of individual and time effects in the `Grunfeld` example, using the @GOUR:HOLL:MONF:82 test, we use: ```{r } g <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") plmtest(g, effect="twoways", type="ghm") ``` or ```{r results='hide'} plmtest(inv~value+capital, data=Grunfeld, effect="twoways", type="ghm") ``` `pFtest` computes F tests of effects based on the comparison of the within and the pooling model. Its main arguments are either two `plm` objects (a pooling and a within model) or a formula. ```{r } gw <- plm(inv ~ value + capital, data=Grunfeld, effect="twoways", model="within") gp <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") pFtest(gw, gp) ``` ```{r results='hide'} pFtest(inv~value+capital, data=Grunfeld, effect="twoways") ``` ## Hausman test `phtest` computes the Hausman test (at times also called Durbin--Wu--Hausman test) which is based on the comparison of two sets of estimates (see @HAUS:78). Its main arguments are two `panelmodel` objects or a formula. A classical application of the Hausman test for panel data is to compare the fixed and the random effects models: ```{r } gw <- plm(inv ~ value + capital, data = Grunfeld, model="within") gr <- plm(inv ~ value + capital, data = Grunfeld, model="random") phtest(gw, gr) ``` The command also supports the auxiliary-regression-based version as described in, e.g., @WOOL:10 Sec.10.7.3 by using the formula interface and setting argument `test = "aux"`. This auxiliary-regression-based version can be robustified by specifying a robust covariance estimator as a function through the argument `vcov`: ```{r } phtest(inv ~ value + capital, data = Grunfeld, method = "aux", vcov = vcovHC) ``` ## Tests of serial correlation{#serialcor} A model with individual effects has composite errors that are serially correlated by definition. The presence of the time-invariant error component^[Here we treat fixed and random effects alike, as components of the error term, according with the modern approach in econometrics (see @WOOL:02, @WOOL:10).] gives rise to serial correlation which does not die out over time, thus standard tests applied on pooled data always end up rejecting the null of spherical residuals^[Neglecting time effects may also lead to serial correlation in residuals (as observed in @WOOL:02 10.4.1).]. There may also be serial correlation of the "usual" kind in the idiosyncratic error terms, e.g., as an AR(1) process. By "testing for serial correlation" we mean testing for this latter kind of dependence. For these reasons, the subjects of testing for individual error components and for serially correlated idiosyncratic errors are closely related. In particular, simple (*marginal*) tests for one direction of departure from the hypothesis of spherical errors usually have power against the other one: in case it is present, they are substantially biased towards rejection. *Joint* tests are correctly sized and have power against both directions, but usually do not give any information about which one actually caused rejection. *Conditional* tests for serial correlation that take into account the error components are correctly sized under presence of both departures from sphericity and have power only against the alternative of interest. While most powerful if correctly specified, the latter, based on the likelihood framework, are crucially dependent on normality and homoskedasticity of the errors. In `plm` we provide a number of joint, marginal and conditional ML-based tests, plus some semiparametric alternatives which are robust vs. heteroskedasticity and free from distributional assumptions. ### Unobserved effects test The unobserved effects test *à la Wooldridge* (see @WOOL:02 10.4.4), is a semiparametric test for the null hypothesis that $\sigma^2_{\mu}=0$, i.e. that there are no unobserved effects in the residuals. Given that under the null the covariance matrix of the residuals for each individual is diagonal, the test statistic is based on the average of elements in the upper (or lower) triangle of its estimate, diagonal excluded: $n^{-1/2} \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is}$ (where $\hat{u}$ are the pooled OLS residuals), which must be "statistically close" to zero under the null, scaled by its standard deviation: $$W=\frac{ \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} }{ [{ \sum_{i=1}^n ( \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} } )^2 ]^{1/2} }$$ This test is ($n$-) asymptotically distributed as a standard normal regardless of the distribution of the errors. It does also not rely on homoskedasticity. It has power both against the standard random effects specification, where the unobserved effects are constant within every group, as well as against any kind of serial correlation. As such, it "nests" both random effects and serial correlation tests, trading some power against more specific alternatives in exchange for robustness. While not rejecting the null favours the use of pooled OLS, rejection may follow from serial correlation of different kinds, and in particular, quoting @WOOL:02, "should not be interpreted as implying that the random effects error structure *must* be true". Below, the test is applied to the data and model in @MUNN:90: ```{r wtest} pwtest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ``` ### Locally robust tests for serial correlation or random effects The presence of random effects may affect tests for residual serial correlation, and the opposite. One solution is to use a joint test, which has power against both alternatives. A joint LM test for random effects *and* serial correlation under normality and homoskedasticity of the idiosyncratic errors has been derived by @BALT:LI:91 and @BALT:LI:95 and is implemented as an option in `pbsytest`: ```{r pbsytestJoint} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="j") ``` Rejection of the joint test, though, gives no information on the direction of the departure from the null hypothesis, i.e.: is rejection due to the presence of serial correlation, of random effects or of both? @BERA:SOSA:YOON:01 (hereafter BSY) derive locally robust tests both for individual random effects and for first-order serial correlation in residuals as "corrected" versions of the standard LM test (see `plmtest`). While still dependent on normality and homoskedasticity, these are robust to *local* departures from the hypotheses of, respectively, no serial correlation or no random effects. The authors observe that, although suboptimal, these tests may help detecting the right direction of the departure from the null, thus complementing the use of joint tests. Moreover, being based on pooled OLS residuals, the BSY tests are computationally far less demanding than likelihood-based conditional tests. On the other hand, the statistical properties of these "locally corrected" tests are inferior to those of the non-corrected counterparts when the latter are correctly specified. If there is no serial correlation, then the optimal test for random effects is the likelihood-based LM test of Breusch and Godfrey (with refinements by Honda, see `plmtest`), while if there are no random effects the optimal test for serial correlation is, again, Breusch-Godfrey's test^[$LM_3$ in @BALT:LI:95.]. If the presence of a random effect is taken for granted, then the optimal test for serial correlation is the likelihood-based conditional LM test of @BALT:LI:95 (see `pbltest`). The serial correlation version is the default: ```{r pbsytestAR} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ``` The BSY test for random effects is implemented in the one-sided version^[Corresponding to $RSO^*_{\mu}$ in the original paper.], which takes heed that the variance of the random effect must be non-negative: ```{r pbsytestRE} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="re") ``` ### Conditional LM test for AR(1) or MA(1) errors under random effects @BALT:LI:91 and @BALT:LI:95 derive a Lagrange multiplier test for serial correlation in the idiosyncratic component of the errors under (normal, heteroskedastic) random effects. Under the null of serially uncorrelated errors, the test turns out to be identical for both the alternative of AR(1) and MA(1) processes. One- and two-sided versions are provided, the one-sided having power against positive serial correlation only. The two-sided is the default, while for the other one must specify the `alternative` option to `"onesided"`: ```{r pbltest} pbltest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, alternative="onesided") ``` As usual, the LM test statistic is based on residuals from the maximum likelihood estimate of the restricted model (random effects with serially uncorrelated errors). In this case, though, the restricted model cannot be estimated by OLS anymore, therefore the testing function depends on `lme()` in the `nlme` package for estimation of a random effects model by maximum likelihood. For this reason, the test is applicable only to balanced panels. No test has been implemented to date for the symmetric hypothesis of no random effects in a model with errors following an AR(1) process, but an asymptotically equivalent likelihood ratio test is available in the `nlme` package (see Section [plm versus nlme and lme4](#nlme)). ### General serial correlation tests A general testing procedure for serial correlation in fixed effects (FE), random effects (RE) and pooled-OLS panel models alike can be based on considerations in @WOOL:02, 10.7.2. Recall that `plm` model objects are the result of OLS estimation performed on "demeaned" data, where, in the case of individual effects (else symmetric), this means time-demeaning for the FE (`within`) model, quasi-time-demeaning for the RE (`random`) model and original data, with no demeaning at all, for the pooled OLS (`pooling`) model (see Section [software approach](#software-approach)). For the random effects model, @WOOL:02 observes that under the null of homoskedasticity and no serial correlation in the idiosyncratic errors, the residuals from the quasi-demeaned regression must be spherical as well. Else, as the individual effects are wiped out in the demeaning, any remaining serial correlation must be due to the idiosyncratic component. Hence, a simple way of testing for serial correlation is to apply a standard serial correlation test to the quasi-demeaned model. The same applies in a pooled model, w.r.t. the original data. The FE case needs some qualification. It is well-known that if the original model's errors are uncorrelated then FE residuals are negatively serially correlated, with $cor(\hat{u}_{it}, \hat{u}_{is})=-1/(T-1)$ for each $t,s$ (see @WOOL:02 10.5.4). This correlation clearly dies out as T increases, so this kind of AR test is applicable to `within` model objects only for T "sufficiently large"^[Baltagi and Li derive a basically analogous T-asymptotic test for first-order serial correlation in a FE panel model as a Breusch-Godfrey LM test on within residuals (see @BALT:LI:95 par. 2.3 and formula 12). They also observe that the test on within residuals can be used for testing on the RE model, as "the within transformation [time-demeaning, in our terminology] wipes out the individual effects, whether fixed or random". Generalizing the Durbin-Watson test to FE models by applying it to fixed effects residuals is documented in @BHAR:FRAN:NARE:82, a (modified) version for unbalanced and/or non-consecutive panels is implemented in `pbnftest` as is Baltagi-Wu's LBI statistic (for both see @BALT:WU:99).]. On the converse, in short panels the test gets severely biased towards rejection (or, as the induced correlation is negative, towards acceptance in the case of the one-sided DW test with `alternative="greater"`). See below for a serial correlation test applicable to "short" FE panel models. `plm` objects retain the "demeaned" data, so the procedure is straightforward for them. The wrapper functions `pbgtest` and `pdwtest` re-estimate the relevant quasi-demeaned model by OLS and apply, respectively, standard Breusch-Godfrey and Durbin-Watson tests from package `lmtest`: ```{r generalAR} pbgtest(grun.fe, order = 2) ``` The tests share the features of their OLS counterparts, in particular the `pbgtest` allows testing for higher-order serial correlation, which might turn useful, e.g., on quarterly data. Analogously, from the point of view of software, as the functions are simple wrappers towards `bgtest` and `dwtest`, all arguments from the latter two apply and may be passed on through the ellipsis (the `...` argument). ### Wooldridge's test for serial correlation in "short" FE panels For the reasons reported above, under the null of no serial correlation in the errors, the residuals of a FE model must be negatively serially correlated, with $cor(\hat{\epsilon}_{it}, \hat{\epsilon}_{is})=-1/(T-1)$ for each $t,s$. Wooldridge suggests basing a test for this null hypothesis on a pooled regression of FE residuals on themselves, lagged one period: $$\hat{\epsilon}_{i,t}=\alpha + \delta \hat{\epsilon}_{i,t-1} + \eta_{i,t}$$ Rejecting the restriction $\delta = -1/(T-1)$ makes us conclude against the original null of no serial correlation. The building blocks available in `plm` make it easy to construct a function carrying out this procedure: first the FE model is estimated and the residuals retrieved, then they are lagged and a `pooling` AR(1) model is estimated. The test statistic is obtained by applying the above restriction on $\delta$ and supplying a heteroskedasticity- and autocorrelation-consistent covariance matrix (`vcovHC` with the appropriate options, in particular `method="arellano"`)^[see subsection [robust covariance matrix estimation](#robust).]. ```{r pwartest} pwartest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ``` The test is applicable to any FE panel model, and in particular to "short" panels with small $T$ and large $n$. ### Wooldridge's first-difference-based test In the context of the first difference model, @WOOL:02, 10.6.3 proposes a serial correlation test that can also be seen as a specification test to choose the most efficient estimator between fixed effects (`within`) and first difference (`fd`). The starting point is the observation that if the idiosyncratic errors of the original model $u_{it}$ are uncorrelated, the errors of the (first) differenced model^[Here, $e_{it}$ for notational simplicity (and as in Wooldridge): equivalent to $\Delta \epsilon_{it}$ in the general notation of the paper.] $e_{it} \equiv u_{it}-u_{i,t-1}$ will be correlated, with $cor(e_{it}, e_{i,t-1})=-0.5$, while any time-invariant effect, "fixed" or "random", is wiped out in the differencing. So a serial correlation test for models with individual effects of any kind can be based on estimating the model $$\hat{u}_{i,t}= \delta \hat{u}_{i,t-1} + \eta_{i,t}$$ and testing the restriction $\delta = -0.5$, corresponding to the null of no serial correlation. @DRUK:03 provides Monte Carlo evidence of the good empirical properties of the test. On the other extreme (see @WOOL:02 10.6.1), if the differenced errors $e_{it}$ are uncorrelated, as by definition $u_{it} = u_{i,t-1} + e_{it}$, then $u_{it}$ is a random walk. In this latter case, the most efficient estimator is the first difference (`fd`) one; in the former case, it is the fixed effects one (`within`). The function `pwfdtest` allows testing either hypothesis: the default behaviour `h0="fd"` is to test for serial correlation in *first-differenced* errors: ```{r pwfdtest1} pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ``` while specifying `h0="fe"` the null hypothesis becomes no serial correlation in *original* errors, which is similar to the `pwartest`. ```{r pwfdtest2} pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK, h0="fe") ``` Not rejecting one of the two is evidence in favour of using the estimator corresponding to `h0`. Should the truth lie in the middle (both rejected), whichever estimator is chosen will have serially correlated errors: therefore it will be advisable to use the autocorrelation-robust covariance estimators from the subsection [robust covariance matrix estimation](#robust) in inference. ## Tests for cross-sectional dependence Next to the more familiar issue of serial correlation, over the last years a growing body of literature has been dealing with cross-sectional dependence (henceforth: XSD) in panels, which can arise, e.g., if individuals respond to common shocks (as in the literature on *factor models*) or if spatial diffusion processes are present, relating individuals in a way depending on a measure of distance (*spatial models*). The subject is huge, and here we touch only some general aspects of misspecification testing and valid inference. If XSD is present, the consequence is, at a minimum, inefficiency of the usual estimators and invalid inference when using the standard covariance matrix^[This is the case, e.g., if in an unobserved effects model when XSD is due to an unobservable factor structure, with factors that are uncorrelated with the regressors. In this case the within or random estimators are still consistent, although inefficient (see @DEHO:SARA:06).]. The plan is to have in `plm` both misspecification tests to detect XSD and robust covariance matrices to perform valid inference in its presence, like in the serial dependence case. For now, though, only misspecification tests are included. ### CD and LM-type tests for global cross-sectional dependence The function `pcdtest` implements a family of XSD tests which can be applied in different settings, ranging from those where $T$ grows large with $n$ fixed to "short" panels with a big $n$ dimension and a few time periods. All are based on (transformations of--) the product-moment correlation coefficient of a model's residuals, defined as $$ \hat{\rho}_{ij}=\frac{\sum_{t=1}^T \hat{u}_{it} \hat{u}_{jt}}{(\sum_{t=1}^T \hat{u}^2_{it})^{1/2} (\sum_{t=1}^T \hat{u}^2_{jt})^{1/2} } $$ i.e., as averages over the time dimension of pairwise correlation coefficients for each pair of cross-sectional units. The Breusch-Pagan [@BREU:PAGA:80] LM test, based on the squares of $\rho_{ij}$, is valid for $T \rightarrow \infty$ with $n$ fixed; defined as $$LM=\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2$$ where in the case of an unbalanced panel only pairwise complete observations are considered, and $T_{ij}=min(T_i,T_j)$ with $T_i$ being the number of observations for individual $i$; else, if the panel is balanced, $T_{ij}=T$ for each $i,j$. The test is distributed as $\chi^2_{n(n-1)/2}$. It is inappropriate whenever the $n$ dimension is "large". A scaled version, applicable also if $T \rightarrow \infty$ and *then* $n \rightarrow \infty$ (as in some pooled time series contexts), is defined as $$SCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1 )$$ and distributed as a standard normal (see @PESA:04). A bias-corrected scaled version, $BCSCLM$, for the *fixed effect model with individual effects* only is also available which is simply the $SCLM$ with a term correcting for the bias (@BALT:FENG:KAO:12)^[The unbalanced version of this statistic uses max(Tij) for T in the bias-correction term.]. This statistic is also asymptotically distributed as standard normal. $$BCSCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1)-\frac{n}{2(T-1)}$$ Pesaran's (@PESA:04, @PESA:15) $CD$ test $$CD=\sqrt{\frac{2}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} \sqrt{T_{ij}} \hat{\rho}_{ij} )$$ based on $\rho_{ij}$ without squaring (also distributed as a standard normal) is appropriate both in $n$-- and in $T$--asymptotic settings. It has remarkable properties in samples of any practically relevant size and is robust to a variety of settings. The only big drawback is that the test loses power against the alternative of cross-sectional dependence if the latter is due to a factor structure with factor loadings averaging zero, that is, some units react positively to common shocks, others negatively. The default version of the test is `"cd"` yielding Pesaran's $CD$ test. These tests are originally meant to use the residuals of separate estimation of one time-series regression for each cross-sectional unit, so this is the default behaviour of `pcdtest`. ```{r pcdtest1} pcdtest(inv~value+capital, data=Grunfeld) ``` If a different model specification (`within`, `random`, ...) is assumed consistent, one can resort to its residuals for testing^[This is also the only solution when the time dimension's length is insufficient for estimating the heterogeneous model.] by specifying the relevant `model` type. The main argument of this function may be either a model of class `panelmodel` or a `formula` and a `data.frame`; in the second case, unless `model` is set to `NULL`, all usual parameters relative to the estimation of a `plm` model may be passed on. The test is compatible with any consistent `panelmodel` for the data at hand, with any specification of `effect`. E.g., specifying `effect = "time"` or `effect = "twoways"` allows to test for residual cross-sectional dependence after the introduction of time fixed effects to account for common shocks. ```{r pcdtest2} pcdtest(inv~value+capital, data=Grunfeld, model="within") ``` If the time dimension is insufficient and `model=NULL`, the function defaults to estimation of a `within` model and issues a warning. ### CD(p) test for local cross-sectional dependence A *local* variant of the $CD$ test, called $CD(p)$ test [@PESA:04], takes into account an appropriate subset of *neighbouring* cross-sectional units to check the null of no XSD against the alternative of *local* XSD, i.e. dependence between neighbours only. To do so, the pairs of neighbouring units are selected by means of a binary proximity matrix like those used in spatial models. In the original paper, a regular ordering of observations is assumed, so that the $m$-th cross-sectional observation is a neighbour to the $(m-1)$-th and to the $(m+1)$-th. Extending the $CD(p)$ test to irregular lattices, we employ the binary proximity matrix as a selector for discarding the correlation coefficients relative to pairs of observations that are not neighbours in computing the $CD$ statistic. The test is then defined as $$CD=\sqrt{\frac{1}{\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} w(p)_{ij}}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} [w(p)]_{ij} \sqrt{T_{ij}}\hat{\rho}_{ij} )$$ where $[w(p)]_{ij}$ is the $(i,j)$-th element of the $p$-th order proximity matrix, so that if $h,k$ are not neighbours, $[w(p)]_{hk}=0$ and $\hat{\rho}_{hk}$ gets "killed"; this is easily seen to reduce to formula (14) in Pesaran [@PESA:04] for the special case considered in that paper. The same can be applied to the $LM$, $SCLM$, and $BCSCLM$ tests. Therefore, the *local* version of either test can be computed supplying an $n \times n$ matrix (of any kind coercible to `logical`), providing information on whether any pair of observations are neighbours or not, to the `w` argument. If `w` is supplied, only neighbouring pairs will be used in computing the test; else, `w` will default to `NULL` and all observations will be used. The matrix needs not really be binary, so commonly used "row-standardized" matrices can be employed as well: it is enough that neighbouring pairs correspond to nonzero elements in `w` ^[The very comprehensive package `spdep` for spatial dependence analysis (see @BIVA:08) contains features for creating, lagging and manipulating *neighbour list* objects of class `nb`, that can be readily converted to and from proximity matrices by means of the `nb2mat` function. Higher orders of the $CD(p)$ test can be obtained by lagging the corresponding `nb`s through `nblag`.]. ## Panel unit root tests ### Overview of functions for panel unit root testing Below, first an overview is provided which tests are implemented per functions. A theoretical treatment is given for a few of those tests later on. The package `plm` offers several panel unit root tests contained in three functions: - `purtest` (Levin-Lin-Chu test, IPS test, several Fisher-type tests, Hadri's test), - `cipstest` (cross-sectionally augmented IPS test), and - `phansitest` (Simes' test). While `purtest` implements various tests which can be selected via its `test` argument, `cipstest` and `phansitest` are functions for a specific test each. Function `purtest` offers the following tests by setting argument `test` to: - `"levinlin"` (default), for the Levin-Lin-Chu test (@LEVIN:LIN:CHU:02), see below for a theoretical exposition ([Levin-Lin-Chu test](#levinlin))), - `"ips"`, for Im-Pesaran-Shin (IPS) test by @IM:PESAR:SHIN:03, see below for a theoretical exposition ([Im-Pesaran-Shin test](#ips))), - `"madwu"`, is the inverse $\chi^2$ test by @MADDA:WU:99, also called P test by @CHOI:01, - `"Pm"`, is the modified P test proposed by @CHOI:01 for large N, - `"invnormal"`, is the inverse normal test (@CHOI:01), - `"logit"`, is the logit test (@CHOI:01), - `"hadri"`, for Hadri's test (@HADR:00). The tests in `purtest` are often called first generation panel unit root tests as they do assume absence of cross-sectional correlation; all these, except Hadri's test, are based on the estimation of augmented Dickey-Fuller (ADF) regressions for each time series. A statistic is then computed using the t-statistics associated with the lagged variable. I a different manner, the Hadri residual-based LM statistic is the cross-sectional average of individual KPSS statistics (@KWIA:PHIL:SCHM:SHIN:92), standardized by their asymptotic mean and standard deviation. Among the tests in `purtest`, `"madwu"`, `"Pm"`, `"invormal"`, and `"logit"` are Fisher-type tests.^[The individual p-values for the Fisher-type tests are approximated as described in @MACK:96 if the package `urca` (@PFAFF:08) is available, otherwise as described in @MACK:94.] `purtest` returns an object of class `"purtest"` which contains details about the test performed, among them details about the individual regressions/statistics for the test. Associated `summary` and `print.summary` methods can be used to extract/display the additional information. Function `cipstest` implements Pesaran's (@pes07) cross-sectionally augmented version of the Im-Pesaran-Shin panel unit root test and is a so-called second-generation panel unit root test. Function `phansitest` implements the idea of @HANCK:13 to apply Simes' testing approach for intersection of individual hypothesis tests to panel unit root testing, see below for a more thorough treatment of [Simes’ approach for intersecting hypotheses](#phansitest). ### Preliminary results We consider the following model: $$ y_{it} = \delta y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} $$ The unit root hypothesis is $\rho = 1$. The model can be rewritten in difference: $$ \Delta y_{it} = \rho y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} $$ So that the unit-root hypothesis is now $\rho = 0$. Some of the unit-root tests for panel data are based on preliminary results obtained by running the above Augmented Dickey-Fuller (ADF) regression. First, we have to determine the optimal number of lags $p_i$ for each time-series. Several possibilities are available. They all have in common that the maximum number of lags have to be chosen first. Then, $p_i$ can be chosen by using: - the Schwarz information criterion (SIC) (also known as Bayesian information criterion (BIC)), - the Akaike information criterion (AIC), - the Hall's method, which consist in removing the higher lags while they are not significant. The ADF regression is run on $T-p_i-1$ observations for each individual, so that the total number of observations is $n\times \tilde{T}$ where $\tilde{T}=T-p_i-1$ $\bar{p}$ is the average number of lags. Call $e_{i}$ the vector of residuals. Estimate the variance of the $\epsilon_i$ as: $$ \hat{\sigma}_{\epsilon_i}^2 = \frac{\sum_{t=p_i+1}^{T} e_{it}^2}{df_i} $$ ### Levin-Lin-Chu model{#levinlin} Then, as per @LEVIN:LIN:CHU:02, compute artificial regressions of $\Delta y_{it}$ and $y_{it-1}$ on $\Delta y_{it-L}$ and $d_{mt}$ and get the two vectors of residuals $z_{it}$ and $v_{it}$. Standardize these two residuals and run the pooled regression of $z_{it}/\hat{\sigma}_i$ on $v_{it}/\hat{\sigma}_i$ to get $\hat{\rho}$, its standard deviation $\hat{\sigma}({\hat{\rho}})$ and the t-statistic $t_{\hat{\rho}}=\hat{\rho}/\hat{\sigma}({\hat{\rho}})$. Compute the long run variance of $y_i$ : $$ \hat{\sigma}_{yi}^2 = \frac{1}{T-1}\sum_{t=2}^T \Delta y_{it}^2 + 2 \sum_{L=1}^{\bar{K}}w_{\bar{K}L}\left[\frac{1}{T-1}\sum_{t=2+L}^T \Delta y_{it} \Delta y_{it-L}\right] $$ Define $\bar{s}_i$ as the ratio of the long and short term variance and $\bar{s}$ the mean for all the individuals of the sample $$ s_i = \frac{\hat{\sigma}_{yi}}{\hat{\sigma}_{\epsilon_i}} $$ $$ \bar{s} = \frac{\sum_{i=1}^n s_i}{n} $$ $$ t^*_{\rho}=\frac{t_{\rho}- n \bar{T} \bar{s} \hat{\sigma}_{\tilde{\epsilon}}^{-2} \hat{\sigma}({\hat{\rho}}) \mu^*_{m\tilde{T}}}{\sigma^*_{m\tilde{T}}} $$ follows a normal distribution under the null hypothesis of stationarity. $\mu^*_{m\tilde{T}}$ and $\sigma^*_{m\tilde{T}}$ are given in table 2 of the original paper and are also available in the package. An example how the Levin-Lin-Chu test is performed with `purtest` using a lag of 2 and intercept and a time trend as exogenous variables in the ADF regressions is: ```{r levinlin} data("HousePricesUS", package = "pder") lprice <- log(pdata.frame(HousePricesUS)$price) (lev <- purtest(lprice, test = "levinlin", lags = 2, exo = "trend")) summary(lev) ### gives details ``` ### Im-Pesaran-Shin (IPS) test{#ips} This test by @IM:PESAR:SHIN:03 does not require that $\rho$ is the same for all the individuals. The null hypothesis is still that all the series have an unit root, but the alternative is that some may have a unit root and others have different values of $\rho_i <0$. The test is based on the average of the student statistic of the $\rho$ obtained for each individual: $$ \bar{t}=\frac{1}{n}\sum_{i=1}^n t_{\rho i} $$ The statistic is then: $$ z = \frac{\sqrt{n}\left(\bar{t}- E(\bar{t})\right)}{\sqrt{V(\bar{t})}} $$ $\mu^*_{m\tilde{T}}$ and $\sigma^*_{m\tilde{T}}$ are given in table 2 of the original paper and are also available in the package. An example of the IPS test with `purtest` with the same settings as in the previously performed Levin-Lin-Chu test is: ```{r ips} purtest(lprice, test = "ips", lags = 2, exo = "trend") ``` ### Simes' approach: intersecting hypotheses{#phansitest} A different approach to panel unit root testing can be drawn from the general Simes' test for intersection of individual hypothesis tests [@SIMES:86]. @HANCK:13 suggests to apply the approach for panel unit root testing: The tests works by combining p-values from single hypothesis tests (individual unit root tests) with a global (intersected) hypothesis and controls for the multiplicity in testing. Thus, it works "on top" of any panel unit root test which yield a p-value for each individual series. Unlike most other panel unit root tests, this approach allows to discriminate between individuals for which the individual H0 (unit root present for individual series) is rejected/is not rejected and requires a pre-specified significance level. Further, the test is robust versus general patterns of cross-sectional dependence. The function `phansitest` for this test takes as main input object either a numeric containing p-values of individual tests or a `"purtest"` object as produced by function `purtest` which holds a suitable pre-computed panel unit root test (one that produces p-values per individual series). The significance level is set by argument `alpha` (default 5 %). The function's return value is a list with detailed evaluation of the applied Simes test. The associated print method gives a verbal evaluation. The following examples shows both accepted ways of input, the first example replicates @HANCK:13, table 11 (left side), who applied some panel unit root test for a Purchasing Power Parity analysis per country (individual H0 hypotheses per series) to get the individual p-values and then used Simes' approach for testing the global (intersecting) hypothesis for the whole panel. ```{r phansitest1} ### input is numeric (p-values), replicates Hanck (2013), Table 11 (left side) pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050, 0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475) countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France", "Germany","Belgium","U.K.","Brazil","Australia","Netherlands", "Portugal","Canada", "Spain","Denmark","Switzerland","Japan") names(pvals) <- countries h <- phansitest(pvals) print(h) h$rejected # logical indicating the individuals with rejected individual H0 ``` ```{r phansitest2, results='hide'} ### input is a (suitable) purtest object / different example y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu") phansitest(obj, alpha = 0.06) # test with significance level set to 6 % ``` ## Robust covariance matrix estimation{#robust} Robust estimators of the covariance matrix of coefficients are provided, mostly for use in Wald-type tests, and this section provides some basics and examples. A more comprehensive exposition of the theory and the capabilities that come with the plm package is given in @mil17b. `vcovHC` estimates three "flavours" of White's heteroskedasticity-consistent covariance matrix^[See @WHIT:80 and @WHIT:84b.] (known as the *sandwich* estimator). Interestingly, in the context of panel data the most general version also proves consistent vs. serial correlation. All types assume no correlation between errors of different groups while allowing for heteroskedasticity across groups, so that the full covariance matrix of errors is $V=I_n \otimes \Omega_i; i=1,..,n$. As for the *intragroup* error covariance matrix of every single group of observations, `"white1"` allows for general heteroskedasticity but no serial correlation, *i.e.* \begin{equation} (\#eq:omegaW1) \Omega_i= \left[ \begin{array}{c c c c} \sigma_{i1}^2 & \dots & \dots & 0 \\ 0 & \sigma_{i2}^2 & & \vdots \\ \vdots & & \ddots & 0 \\ 0 & ... & ... & \sigma_{iT}^2 \\ \end{array} \right] \end{equation} while `"white2"` is `"white1"` restricted to a common variance inside every group, estimated as $\sigma_i^2=\sum_{t=1}^T{\hat{u}_{it}^2}/T$, so that $\Omega_i=I_T \otimes \sigma_i^2$ (see @GREE:03, 13.7.1--2 and @WOOL:02, 10.7.2; `"arellano"` (see ibid. and the original ref. @AREL:87) allows a fully general structure w.r.t. heteroskedasticity and serial correlation: \begin{equation} (\#eq:omegaArellano) \Omega_i= \left[ \begin{array}{c c c c c} \sigma_{i1}^2 & \sigma_{i1,i2} & \dots & \dots & \sigma_{i1,iT} \\ \sigma_{i2,i1} & \sigma_{i2}^2 & & & \vdots \\ \vdots & & \ddots & & \vdots \\ \vdots & & & \sigma_{iT-1}^2 & \sigma_{iT-1,iT} \\ \sigma_{iT,i1} & \dots & \dots & \sigma_{iT,iT-1} & \sigma_{iT}^2 \\ \end{array} \right] \end{equation} The latter is, as already observed, consistent w.r.t. timewise correlation of the errors, but on the converse, unlike the White 1 and 2 methods, it relies on large $n$ asymptotics with small $T$. The fixed effects case, as already observed in Section [tests of serial correlation](#serialcor) on serial correlation, is complicated by the fact that the demeaning induces serial correlation in the errors. The original White estimator (`"white1"`) turns out to be inconsistent for fixed $T$ as $n$ grows, so in this case it is advisable to use the `"arellano"` version (see @STOC:WATS:08). The errors may be weighted according to the schemes proposed by @MACK:WHIT:85 and @CRIB:04 to improve small-sample performance^[The HC3 and HC4 weighting schemes are computationally expensive and may hit memory limits for $nT$ in the thousands, where on the other hand it makes little sense to apply small sample corrections.]. The main use of `vcovHC` (and the other variance-covariance estimators provided in the package `vcovBK`, `vcovNW`, `vcovDC`, `vcovSCC`) is to pass it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or together with testing functions from the `lmtest` and `car` packages. All of these typically allow passing the `vcov` or `vcov.` parameter either as a matrix or as a function (see also @ZEIL:04). If one is happy with the defaults, it is easiest to pass the function itself^[For `coeftest` set `df = Inf` to have the coefficients' tests be performed with standard normal distribution instead of t distribution as we deal with a random effects model here. For these types of models, the precise distribution of the coefficients estimates is unknown.]: ```{r vcovHC1} re <- plm(inv~value+capital, data = Grunfeld, model = "random") summary(re, vcov = vcovHC) # gives usual summary output but with robust test statistics library("lmtest") coeftest(re, vcovHC, df = Inf) ``` else one may do the covariance computation inside the call, thus passing on a matrix: ```{r vcovHC2, results='hide'} summary(re, vcov = vcovHC(re, method="white2", type="HC3")) coeftest(re, vcovHC(re, method="white2", type="HC3"), df = Inf) ``` For some tests, e.g., for multiple model comparisons by `waldtest`, one should always provide a function^[Joint zero-restriction testing still allows providing the `vcov` of the unrestricted model as a matrix, see the documentation of package `lmtest`.]. In this case, optional parameters are provided as shown below (see also @ZEIL:04, p. 12): ```{r waldtest-vcovHC} waldtest(re, update(re, . ~ . -capital), vcov=function(x) vcovHC(x, method="white2", type="HC3")) ``` Moreover, `linearHypothesis` from package `car` may be used to test for linear restrictions: ```{r car-vcovHC} library("car") linearHypothesis(re, "2*value=capital", vcov. = vcovHC) ``` A specific methods are also provided for `pcce` and `pgmm` objects, for the latter `vcovHC` provides the robust covariance matrix proposed by @WIND:05 for generalized method of moments estimators. # plm versus nlme and lme4{#nlme} The models termed *panel* by the econometricians have counterparts in the statistics literature on *mixed* models (or *hierarchical models*, or *models for longitudinal data*), although there are both differences in jargon and more substantial distinctions. This language inconsistency between the two communities, together with the more complicated general structure of statistical models for longitudinal data and the associated notation in the software, is likely to scare some practicing econometricians away from some potentially useful features of the `R` environment, so it may be useful to provide here a brief reconciliation between the typical panel data specifications used in econometrics and the general framework used in statistics for mixed models^[This discussion does not consider GMM models. One of the basic reasons for econometricians not to choose maximum likelihood methods in estimation is that the strict exogeneity of regressors assumption required for consistency of the ML models reported in the following is often inappropriate in economic settings.]. `R` is particularly strong on mixed models' estimation, thanks to the long-standing `nlme` package (see @PINH:BATE:DEBR:SARK:07) and the more recent `lme4` package, based on S4 classes (see @BATE:07)^[The standard reference on the subject of mixed models in `S`/`R` is @PINH:BATE:00.]. In the following we will refer to the more established `nlme` to give some examples of "econometric" panel models that can be estimated in a likelihood framework, also including some likelihood ratio tests. Some of them are not feasible in `plm` and make a useful complement to the econometric "toolbox" available in `R`. ## Fundamental differences between the two approaches Econometrics deal mostly with non-experimental data. Great emphasis is put on specification procedures and misspecification testing. Model specifications tend therefore to be very simple, while great attention is put on the issues of endogeneity of the regressors, dependence structures in the errors and robustness of the estimators under deviations from normality. The preferred approach is often semi- or non-parametric, and heteroskedasticity-consistent techniques are becoming standard practice both in estimation and testing. For all these reasons, although the maximum likelihood framework is important in testing^[Lagrange Multiplier tests based on the likelihood principle are suitable for testing against more general alternatives on the basis of a maintained model with spherical residuals and find therefore application in testing for departures from the classical hypotheses on the error term. The seminal reference is @BREU:PAGA:80.] and sometimes used in estimation as well, panel model estimation in econometrics is mostly accomplished in the generalized least squares framework based on Aitken's Theorem and, when possible, in its special case OLS, which are free from distributional assumptions (although these kick in at the diagnostic testing stage). On the contrary, longitudinal data models in `nlme` and `lme4` are estimated by (restricted or unrestricted) maximum likelihood. While under normality, homoskedasticity and no serial correlation of the errors OLS are also the maximum likelihood estimator, in all the other cases there are important differences. The econometric GLS approach has closed-form analytical solutions computable by standard linear algebra and, although the latter can sometimes get computationally heavy on the machine, the expressions for the estimators are usually rather simple. ML estimation of longitudinal models, on the contrary, is based on numerical optimization of nonlinear functions without closed-form solutions and is thus dependent on approximations and convergence criteria. For example, the "GLS" functionality in `nlme` is rather different from its "econometric" counterpart. "Feasible GLS" estimation in `plm` is based on a single two-step procedure, in which an inefficient but consistent estimation method (typically OLS) is employed first in order to get a consistent estimate of the errors' covariance matrix, to be used in GLS at the second step; on the converse, "GLS" estimators in `nlme` are based on iteration until convergence of two-step optimization of the relevant likelihood. ## Some false friends The *fixed/random effects* terminology in econometrics is often recognized to be misleading, as both are treated as random variates in modern econometrics (see, e.g., @WOOL:02 10.2.1). It has been recognized since Mundlak's classic paper (@MUND:78) that the fundamental issue is whether the unobserved effects are correlated with the regressors or not. In this last case, they can safely be left in the error term, and the serial correlation they induce is cared for by means of appropriate GLS transformations. On the contrary, in the case of correlation, "fixed effects" methods such as least squares dummy variables or time-demeaning are needed, which explicitly, although inconsistently^[For fixed effects estimation, as the sample grows (on the dimension on which the fixed effects are specified) so does the number of parameters to be estimated. Estimation of individual fixed effects is $T$-- (but not $n$--) consistent, and the opposite.], estimate a group-- (or time--) invariant additional parameter for each group (or time period). Thus, from the point of view of model specification, having *fixed effects* in an econometric model has the meaning of allowing the intercept to vary with group, or time, or both, while the other parameters are generally still assumed to be homogeneous. Having *random effects* means having a group-- (or time--, or both) specific component in the error term. In the mixed models literature, on the contrary, *fixed effect* indicates a parameter that is assumed constant, while *random effects* are parameters that vary randomly around zero according to a joint multivariate normal distribution. So, the FE model in econometrics has no counterpart in the mixed models framework, unless reducing it to OLS on a specification with one dummy for each group (often termed *least squares dummy variables*, or LSDV model) which can trivially be estimated by OLS. The RE model is instead a special case of a mixed model where only the intercept is specified as a random effect, while the "random" type variable coefficients model can be seen as one that has the same regressors in the fixed and random sets. The unrestricted generalized least squares can in turn be seen, in the `nlme` framework, as a standard linear model with a general error covariance structure within the groups and errors uncorrelated across groups. ## A common taxonomy To reconcile the two terminologies, in the following we report the specification of the panel models in `plm` according to the general expression of a mixed model in Laird-Ware form [see the web appendix to @FOX:02] and the `nlme` estimation commands for maximum likelihood estimation of an equivalent specification^[In doing so, we stress that "equivalence" concerns only the specification of the model, and neither the appropriateness nor the relative efficiency of the relevant estimation techniques, which will of course be dependent on the context. Unlike their mixed model counterparts, the specifications in `plm` are, strictly speaking, distribution-free. Nevertheless, for the sake of exposition, in the following we present them in the setting which ensures consistency and efficiency (e.g., we consider the hypothesis of spherical errors part of the specification of pooled OLS and so forth).]. ### The Laird-Ware representation for mixed models A general representation for the linear mixed effects model is given in @LAIR:WARE:82. $$ \begin{array}{rcl} y_{it} & = & \beta_1 x_{1ij} + \dots + \beta_p x_{pij} \\ & & b_1 z_{1ij} + \dots + b_p z_{pij} + \epsilon_{ij} \\ b_{ik} & \sim & N(0,\psi^2_k), \phantom{p} Cov(b_k,b_{k'}) = \psi_{kk'} \\ \epsilon_{ij} & \sim & N(0,\sigma^2 \lambda_{ijj}), \phantom{p} Cov(\epsilon_{ij},\epsilon_{ij'}) = \sigma^2 \lambda_{ijj'} \\ \end{array} $$ where the $x_1, \dots x_p$ are the fixed effects regressors and the $z_1, \dots z_p$ are the random effects regressors, assumed to be normally distributed across groups. The covariance of the random effects coefficients $\psi_{kk'}$ is assumed constant across groups and the covariances between the errors in group $i$, $\sigma^2 \lambda_{ijj'}$, are described by the term $\lambda_{ijj'}$ representing the correlation structure of the errors within each group (e.g., serial correlation over time) scaled by the common error variance $\sigma^2$. ### Pooling and Within The *pooling* specification in `plm` is equivalent to a classical linear model (i.e., no random effects regressor and spherical errors: $b_{iq}=0 \phantom{p} \forall i,q, \phantom{p} \lambda_{ijj}=\sigma^2$ for $j=j'$, $0$ else). The *within* one is the same with the regressors' set augmented by $n-1$ group dummies. There is no point in using `nlme` as parameters can be estimated by OLS which is also ML. ### Random effects In the Laird and Ware notation, the RE specification is a model with only one random effects regressor: the intercept. Formally, $z_{1ij}=1 \phantom{p}\forall i,j, \phantom{p} z_{qij}=0 \phantom{p} \forall i, \forall j, \forall q \neq 1$ $\lambda_{ij}=1$ for $i=j$, $0$ else). The composite error is therefore $u_{ij}=1b_{i1} + \epsilon_{ij}$. Below we report coefficients of Grunfeld's model estimated by GLS and then by ML: ```{r re2} library(nlme) reGLS <- plm(inv~value+capital, data=Grunfeld, model="random") reML <- lme(inv~value+capital, data=Grunfeld, random=~1|firm) coef(reGLS) summary(reML)$coefficients$fixed ``` ### Variable coefficients, "random" Swamy's variable coefficients model [@SWAM:70] has coefficients varying randomly (and independently of each other) around a set of fixed values, so the equivalent specification is $z_{q}=x_{q} \phantom{p} \forall q$, i.e. the fixed effects and the random effects regressors are the same, and $\psi_{kk'}=\sigma_\mu^2 I_N$, and $\lambda_{ijj}=1$, $\lambda_{ijj'}=0$ for $j \neq j'$, that's to say they are not correlated. Estimation of a mixed model with random coefficients on all regressors is rather demanding from the computational side. Some models from our examples fail to converge. The below example is estimated on the Grunfeld data and model with time effects. ```{r vcmrand} vcm <- pvcm(inv~value+capital, data=Grunfeld, model="random", effect="time") vcmML <- lme(inv~value+capital, data=Grunfeld, random=~value+capital|year) coef(vcm) summary(vcmML)$coefficients$fixed ``` ### Variable coefficients, "within" This specification actually entails separate estimation of $T$ different standard linear models, one for each group in the data, so the estimation approach is the same: OLS. In `nlme` this is done by creating an `lmList` object, so that the two models below are equivalent (output suppressed): ```{r vcmfixed} vcmf <- pvcm(inv~value+capital, data=Grunfeld, model="within", effect="time") vcmfML <- lmList(inv~value+capital|year, data=Grunfeld) ``` ### General FGLS The general, or unrestricted, feasible GLS (FGLS), `pggls` in the `plm` nomenclature, is equivalent to a model with no random effects regressors ($b_{iq}=0 \phantom{p} \forall i,q$) and an error covariance structure which is unrestricted within groups apart from the usual requirements. The function for estimating such models with correlation in the errors but no random effects is `gls()`. This very general serial correlation and heteroskedasticity structure is not estimable for the original Grunfeld data, which have more time periods than firms, therefore we restrict them to firms 4 to 6. ```{r gglsre} sGrunfeld <- Grunfeld[Grunfeld$firm %in% 4:6, ] ggls <- pggls(inv~value+capital, data=sGrunfeld, model="pooling") gglsML <- gls(inv~value+capital, data=sGrunfeld, correlation=corSymm(form=~1|year)) coef(ggls) summary(gglsML)$coefficients ``` The *within* case is analogous, with the regressor set augmented by $n-1$ group dummies. ## Some useful "econometric" models in nlme Finally, amongst the many possible specifications estimable with `nlme`, we report a couple cases that might be especially interesting to applied econometricians. ### AR(1) pooling or random effects panel Linear models with groupwise structures of time-dependence^[Take heed that here, in contrast to the usual meaning of serial correlation in time series, we always speak of serial correlation *between the errors of each group*.] may be fitted by `gls()`, specifying the correlation structure in the `correlation` option^[note that the time index is coerced to numeric before the estimation.]: ```{r lmAR1} Grunfeld$year <- as.numeric(as.character(Grunfeld$year)) lmAR1ML <- gls(inv~value+capital,data=Grunfeld, correlation=corAR1(0,form=~year|firm)) ``` and analogously the random effects panel with, e.g., AR(1) errors (see @BALT:05; @BALT:13; @BALT:21, ch. 5), which is a very common specification in econometrics, may be fit by `lme` specifying an additional random intercept: ```{r reAR1} reAR1ML <- lme(inv~value+capital, data=Grunfeld,random=~1|firm, correlation=corAR1(0,form=~year|firm)) ``` The regressors' coefficients and the error's serial correlation coefficient may be retrieved this way: ```{r fetchcoefs} summary(reAR1ML)$coefficients$fixed coef(reAR1ML$modelStruct$corStruct, unconstrained=FALSE) ``` Significance statistics for the regressors' coefficients are to be found in the usual `summary` object, while to get the significance test of the serial correlation coefficient one can do a likelihood ratio test as shown in the following. ### An LR test for serial correlation and one for random effects A likelihood ratio test for serial correlation in the idiosyncratic residuals can be done as a nested models test, by `anova()`, comparing the model with spherical idiosyncratic residuals with the more general alternative featuring AR(1) residuals. The test takes the form of a zero restriction test on the autoregressive parameter. This can be done on pooled or random effects models alike. First we report the simpler case. We already estimated the pooling AR(1) model above. The GLS model without correlation in the residuals is the same as OLS, and one could well use `lm()` for the restricted model. Here we estimate it by `gls()`. ```{r LRar} lmML <- gls(inv~value+capital, data=Grunfeld) anova(lmML, lmAR1ML) ``` The AR(1) test on the random effects model is to be done in much the same way, using the random effects model objects estimated above: ```{r LRarsubRE} anova(reML, reAR1ML) ``` A likelihood ratio test for random effects compares the specifications with and without random effects and spherical idiosyncratic errors: ```{r LRre} anova(lmML, reML) ``` The random effects, AR(1) errors model in turn nests the AR(1) pooling model, therefore a likelihood ratio test for random effects sub AR(1) errors may be carried out, again, by comparing the two autoregressive specifications: ```{r LRresubAR} anova(lmAR1ML, reAR1ML) ``` whence we see that the Grunfeld model specification doesn't seem to need any random effects once we control for serial correlation in the data. # Conclusions{#conclusions} With `plm` we aim at providing a comprehensive package containing the standard functionalities that are needed for the management and the econometric analysis of panel data. In particular, we provide: functions for data transformation; estimators for pooled, random and fixed effects static panel models and variable coefficients models, general GLS for general covariance structures, and generalized method of moments estimators for dynamic panels; specification and diagnostic tests. Instrumental variables estimation is supported. Most estimators allow working with unbalanced panels. While among the different approaches to longitudinal data analysis we take the perspective of the econometrician, the syntax is consistent with the basic linear modeling tools, like the `lm` function. On the input side, `formula` and `data` arguments are used to specify the model to be estimated. Special functions are provided to make writing formulas easier, and the structure of the data is indicated with an `index` argument. On the output side, the model objects (of the new class `panelmodel`) are compatible with the general restriction testing frameworks of packages `lmtest` and `car`. Specialized methods are also provided for the calculation of robust covariance matrices; heteroskedasticity- and correlation-consistent testing is accomplished by passing these on to testing functions, together with a `panelmodel` object. The main functionalities of the package have been illustrated here by applying them on some well-known data sets from the econometric literature. The similarities and differences with the maximum likelihood approach to longitudinal data have also been briefly discussed. # Acknowledgments {-} While retaining responsibility for any error, we thank Jeffrey Wooldridge, Achim Zeileis and three anonymous referees for useful comments. We also acknowledge kind editing assistance by Lisa Benedetti. # Bibliography {-} plm/vignettes/B_plmFunction.Rmd0000644000176200001440000004314314124132276016264 0ustar liggesusers--- title: "Estimation of error components models with the plm function" author: - name: Yves Croissant date: '`r Sys.Date()`' output: rmarkdown::html_vignette bibliography: ../inst/REFERENCES.bib vignette: > %\VignetteIndexEntry{Estimation of error component models with the plm function} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, echo=FALSE} library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` ```{r texreg, echo = FALSE, results = "hide"} library("texreg") extract.plm <- function(model, include.rsquared = TRUE, include.adjrs = TRUE, include.nobs = TRUE, include.ercomp = TRUE, ...) { s <- summary(model, ...) coefficient.names <- rownames(coef(s)) coefficients <- coef(s)[ , 1L] standard.errors <- coef(s)[ , 2L] significance <- coef(s)[ , 4L] rs <- s$r.squared[1L] adj <- s$r.squared[2L] n <- length(model$residuals) gof <- numeric() gof.names <- character() gof.decimal <- logical() if (include.ercomp == TRUE){ if (model$args$model == "random"){ se <- sqrt(ercomp(model)$sigma) gof <- c(gof, se) gof.names <- c(gof.names, paste("s_", names(se), sep = "")) gof.decimal <- c(gof.decimal, rep(TRUE, length(se))) } } if (include.rsquared == TRUE) { gof <- c(gof, rs) gof.names <- c(gof.names, "R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.adjrs == TRUE) { gof <- c(gof, adj) gof.names <- c(gof.names, "Adj.\ R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.nobs == TRUE) { gof <- c(gof, n) gof.names <- c(gof.names, "Num.\ obs.") gof.decimal <- c(gof.decimal, FALSE) } tr <- createTexreg( coef.names = coefficient.names, coef = coefficients, se = standard.errors, pvalues = significance, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal ) return(tr) } setMethod("extract", signature = className("plm", "plm"), definition = extract.plm) ``` `plm` is a very versatile function which enable the estimation of a wide range of error component models. Those models can be written as follows : $$ y_{nt}=\alpha + \beta^\top x_{nt} + \epsilon_{nt} = \alpha + \beta^\top x_{nt} + \eta_n + \mu_t + \nu_{nt} $$ where $n$ and $t$ are the individual and time indexes, $y$ the response, $x$ a vector of covariates, $\alpha$ the overall intercept and $\beta$ the vector of parameters of interest that we are willing to estimate. The error term $\epsilon_{nt}$ is composed of three elements (in the two-way case): - $\eta_n$ is the individual effect, - $\mu_t$ is the time effect, - $\nu_{nt}$ is the idiosyncratic error. # Basic use of `plm` The first two arguments of `plm` are, like for most of the estimation functions of `R` a `formula` which describes the model to be estimated and a `data.frame`. `subset`, `weights`, and `na.action` are also available and have the same behavior as in the `lm` function. Three more main arguments can be set : - `index` helps `plm` to understand the structure of the data : if `NULL`, the first two columns of the data are assumed to contain the individual or the time index. Otherwise, supply the column names of the individual and time index as a character, e.g., use something like `c("firm", "year")` or just `"firm"` if there is no explicit time index. - `effect` indicates the effects that should be taken into account ; this is one of `"individual"`, `"time"`, and `"twoways"`. - `model` indicates the model to be estimated : `"pooling"` is just the OLS estimation (equivalent to a call to `lm`), `"between"` performs the estimation on the individual or time means, `"within"` on the deviations from the individual or/and time mean, `"fd"` on the first differences and `"random"` perform a feasible generalized least squares estimation which takes into account the correlation induced by the presence of individual and/or time effects. The estimation of all but the last model is straightforward, as it requires only the estimation by *OLS* of obvious transformations of the data. The *GLS* model requires more explanation. In most of the cases, the estimation is obtained by quasi-differencing the data from the individual and/or the time means. The coefficients used to perform this quasi-difference depends on estimators of the variance of the components of the error, namely $\sigma^2_\nu$, $\sigma^2_\eta$ in case of individual effects and $\sigma^2_\mu$ in case of time effects. The most common technique used to estimate these variance is to use the following result : $$ \frac{\mbox{E}(\epsilon^\top W \epsilon)}{N(T-1)} = \sigma_\nu^2 $$ and $$ \frac{\mbox{E}(\epsilon^\top B \epsilon)}{N} = T \sigma_\eta^2 + \sigma_\nu^2 $$ where $B$ and $W$ are respectively the matrices that performs the individual (or time) means and the deviations from these means. Consistent estimators can be obtained by replacing the unknown errors by the residuals of a consistent preliminary estimation and by dropping the expecting value operator. Some degree of freedom correction can also be introduced. `plm` calls the general function `ercomp` to estimate the variances. Important arguments to `ercomp` are: - `models` indicates which models are estimated in order to calculate the two quadratic forms ; for example `c("within", "Between")`. Note that when only one model is provided in `models`, this means that the same residuals are used to compute the two quadratic forms. - `dfcor` indicates what kind of degrees of freedom correction is used : if `0`, the quadratic forms are divided by the number of observations, respectively $N\times T$ and $N$ ; if `1`, the numerators of the previous expressions are used ($N\times (T-1)$ and $N$) ; if `2`, the number of estimated parameters in the preliminary estimate $K$ is deducted. Finally, if `3`, the unbiased version is computed, which is based on much more complex computations, which relies on the calculus of the trace of different cross-products which depends on the preliminary models used. - `method` is an alternative to the `models` argument; it is one of : * `"walhus"` (equivalent to setting `models = c("pooling")`), @WALL:HUSS:69, * `"swar"` (equivalent to `models = c("within", "Between")`), @SWAM:AROR:72, * `"amemiya"` (equivalent to `models = c("within")`), @AMEM:71, * `"nerlove"`, which is a specific method which doesn't fit to the quadratic form methodology described above (@NERLO:71) and uses an within model for the variance estimation as well, * `"ht"` is an slightly modified version of `"amemiya"`: when there are time-invariant covariates, the @AMEM:71 estimator of the individual component of the variance under-estimates as the time-invariant covariates disappear in the within regression. In this case, @HAUS:TAYL:81 proposed to regress the estimation of the individual effects on the time-invariant covariates and use the residuals in order to estimate the components of the variance. Note that for `plm`, the arguments are `random.models`, `random.dfcor`, and `random.method` and correspond to arguments `models`, `method`, and `random.dfcor` of function `ercomp` with the same values as above, respectively. To illustrate the use of `plm`, we use examples reproduced in @BALT:13, p. 21; @BALT:21, p. 31, table 2.1 presents EViews' results of the estimation on the `Grunfeld` data set : ```{r grunfeld} library("plm") data("Grunfeld", package = "plm") ols <- plm(inv ~ value + capital, Grunfeld, model = "pooling") between <- update(ols, model = "between") within <- update(ols, model = "within") walhus <- update(ols, model = "random", random.method = "walhus", random.dfcor = 3) amemiya <- update(walhus, random.method = "amemiya") swar <- update(amemiya, random.method = "swar") ``` Note that the `random.dfcor` argument is set to `3`, which means that the unbiased version of the estimation of the error components is used. We use the `texreg` package to present the results : ```{r grunfeldresults, echo = TRUE} library("texreg") screenreg(list(ols = ols, between = between, within = within, walhus = walhus, amemiya = amemiya, swar = swar), digits = 5, omit.coef = "(Intercept)") ``` The estimated variance can be extracted using the `ercomp` function. For example, for the `amemiya` model : ```{r ercompamemiya} ercomp(amemiya) ``` @BALT:13, p. 27; @BALT:21, p. 31 presents the Stata estimation of the Swamy-Arora estimator ; the Swamy-Arora estimator is the same if `random.dfcor` is set to `3` or `2` (the quadratic forms are divided by $\sum_n T_n - K - N$ and by $N - K - 1$), so I don't know what is the behaviour of Stata for the other estimators for which the unbiased estimators differs from the simple one. ```{r produc} data("Produc", package = "plm") PrSwar <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "swar", random.dfcor = 3) summary(PrSwar) ``` # The twoways effect model The two-ways effect model is obtained by setting the `effect` argument to `"twoways"`. @BALT:13 pp. 51-53; @BALT:21, pp. 61-62, tables 3.1-3.3, presents EViews' output for the Grunfeld data set. ```{r grunfeld2ways} Grw <- plm(inv ~ value + capital, Grunfeld, model = "random", effect = "twoways", random.method = "walhus", random.dfcor = 3) Grs <- update(Grw, random.method = "swar") Gra <- update(Grw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Grw, "Swamy-Arora" = Grs, "Amemiya" = Gra), digits = 5) ``` The estimated variance of the time component is negative for the Wallace-Hussain as well as the Swamy-Arora models and `plm` sets it to 0. @BALT:09 pp. 60-62, presents EViews' output for the `Produc` data. ```{r produc2ways} data("Produc", package = "plm") Prw <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "walhus", effect = "twoways", random.dfcor = 3) Prs <- update(Prw, random.method = "swar") Pra <- update(Prw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Prw, "Swamy-Arora" = Prs, "Amemiya" = Pra), digits = 5) ``` # Unbalanced panels Two difficulties arise with unbalanced panels : - There are no obvious denominators for the quadratic forms of the residuals that are used to estimate the components of the variance. The strategy is then to compute the expected value and equate it to the actual quadratic forms. Detailed formula are omitted here, they depend on the preliminary estimator. - For the one-way effect model, the estimator is still obtained by applying *OLS* on demeaned data (the individual **and** the time means are now deducted) for the within model and on quasi-demeaned data for the random effects model ; this is not the case for the two-ways effects model. @BALT:21, @BALT:13, and @BALT:09 present results of the estimation of the @SWAM:AROR:72 model with the `Hedonic` data set. @BALT:13, p. 195; @BALT:21, p. 237, table 9.1, presents the Stata output and @BALT:09, p. 211 presents EViews' output. EViews' Wallace-Hussain estimator is reported in @BALT:09, p. 210. ```{r hedonic} data("Hedonic", package = "plm") form <- mv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + blacks + lstat HedStata <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "between")) HedEviews <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "Between")) HedEviewsWH <- update(HedEviews, random.models = "pooling") screenreg(list(EViews = HedEviews, Stata = HedStata, "Wallace-Hussain" = HedEviewsWH), digits = 5, single.row = TRUE) ``` The difference is due to the fact that Stata uses a between regression on $N$ observations while EViews uses a between regression on $\sum_n T_n$ observations, which are not the same on unbalanced panels. Note the use of between with or without the B capitalized (`"Between"` and `"between"`) in the `random.models` argument. `plm`'s default is to use the between regression with $\sum_n T_n$ observations when setting `model = "random", random.method = "swar"`. The default employed is what the original paper for the unbalanced one-way Swamy-Arora estimator defined (in @BALT:CHAN:94, p. 73). A more detailed analysis of Stata's Swamy-Arora estimation procedure is given by @COTT:2017. # Instrumental variable estimators All of the models presented above may be estimated using instrumental variables (IV). The instruments are specified using two- or three-part formulas, each part being separated by a `|` sign : - the first part contains the covariates, - the second part contains the "double-exogenous" instruments, *i.e.*, variables that can be used twice as instruments, using their within and the between transformation, - the third part contains the "single-exogenous" instruments, *i.e.*, variables for which only the within transformation can be used as instruments, those variables being correlated with the individual effects. The instrumental variables estimator used is indicated with the `inst.method` argument: - `"bvk"`, from @BALE:VARA:87, the default value : in this case, all the instruments are introduced in quasi-differences, using the same transformation as for the response and the covariates, - `"baltagi"`, from @BALT:81, the instruments of the *second* part are introduced twice by using the between and the within transformation and instruments of the *third* part are introduced with only the within transformation, - `"am"`, from @AMEM:MACU:86, in addition to the instrument set of `"baltagi"`, the within transformation of the variables of the *second* part for each period are also included as instruments, - `"bms"`, from @BREU:MIZO:SCHM:89, in addition to the instrument set of `"baltagi"`, the within transformation of the variables of the *second* and the *third* part for each period are included as instruments. The various possible values of the `inst.method` argument are not relevant for fixed effect IV models as there is only one method for this type of IV models but many for random effect IV models. The instrumental variable estimators are illustrated in the following example from @BALT:05, pp. 117/120; @BALT:13, pp. 133/137; @BALT:21, pp. 162/165, tables 7.1, 7.3. ```{r IV} data("Crime", package = "plm") crbalt <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random", inst.method = "baltagi") crbvk <- update(crbalt, inst.method = "bvk") crwth <- update(crbalt, model = "within") crbe <- update(crbalt, model = "between") screenreg(list(FE2SLS = crwth, BE2SLS = crbe, EC2SLS = crbalt, G2SLS = crbvk), single.row = FALSE, digits = 5, omit.coef = "(region)|(year)", reorder.coef = c(1:16, 19, 18, 17)) ``` The Hausman-Taylor model (@HAUS:TAYL:81) may be estimated with the `plm` function by setting argument `random.method = "ht"` and `inst.method = "baltagi"`. The following example is from @BALT:05, p. 130; @BALT:13, pp. 145-7, tables 7.4-7.6; @BALT:21, pp. 174-6 , tables 7.5-7.7. ```{r IV-HT} data("Wages", package = "plm") ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + exp + I(exp^2) + union, data = Wages, index = 595, inst.method = "baltagi", model = "random", random.method = "ht") am <- update(ht, inst.method = "am") bms <- update(ht, inst.method = "bms") screenreg(list("Hausman-Taylor" = ht, "Amemiya-MaCurdy" = am, "Breusch-Mizon-Schmidt" = bms), digits = 5, single.row = FALSE) ``` # Nested error component model This section shows how the nested error component model as per @BALT:SONG:JUNG:01 can be estimated. The model is given by : $$ y_{nt}=\alpha + \beta^\top x_{jnt} + u_{jnt} = \alpha + \beta^\top x_{jnt} + \mu_{j} + \nu_{jn} + \epsilon_{jnt} $$ where $n$ and $t$ are the individual and time indexes and $j$ is the group index in which the individuals are nested. The error $u_{jnt}$ consists of three components : - $\mu_j$ is the group effect, - $\nu_{jn}$ the nested effect of the individual nested in group $j$ - $\epsilon_{jnt}$ is the idiosyncratic error. In the estimated examples below (replication of @BALT:SONG:JUNG:01, p. 378, table 6; @BALT:21, p. 248, table 9.1), states are nested within regions. The group index is given in the 3rd position of the `index` argument to `pdata.frame` or to `plm` directly and `plm`'s argument `effect` is set to `"nested"`: ```{r nestedRE} data("Produc", package = "plm") swar <- plm(form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp, Produc, index = c("state", "year", "region"), model = "random", effect = "nested", random.method = "swar") walhus <- update(swar, random.method = "walhus") amem <- update(swar, random.method = "amemiya") screenreg(list("Swamy-Arora" = swar, "Wallace-Hussain" = walhus, "Amemiya" = amem), digits = 5) ``` # Bibliography plm/vignettes/C_plmModelComponents.Rmd0000644000176200001440000001574314154734502017616 0ustar liggesusers--- title: Model components for fitted models with plm author: - name: Yves Croissant date: '`r Sys.Date()`' output: rmarkdown::html_vignette bibliography: ../inst/REFERENCES.bib vignette: > %\VignetteIndexEntry{Model components for fitted models with plm} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, echo=FALSE} library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` plm tries to follow as close as possible the way models are fitted using `lm`. This relies on the following steps, using the `formula`-`data` with some modifications: - compute internally the `model.frame` by getting the relevant arguments (`formula`, `data`, `subset`, `weights`, `na.action` and `offset`) and the supplementary argument, - extract from the `model.frame` the response `y` (with `pmodel.response`) and the model matrix `X` (with `model.matrix`), - call the (non-exported) estimation function `plm.fit` with `X` and `y` as arguments. Panel data has a special structure which is described by an `index` argument. This argument can be used in the `pdata.frame` function which returns a `pdata.frame` object. A `pdata.frame` can be used as input to the `data` argument of `plm`. If the `data` argument of `plm` is an ordinary `data.frame`, the `index` argument can also be supplied as an argument of `plm`. In this case, the `pdata.frame` function is called internally to transform the data. Next, the `formula`, which is the first and mandatory argument of `plm` is coerced to a `Formula` object. `model.frame` is then called, but with the `data` argument in the first position (a `pdata.frame` object) and the `formula` in the second position. This unusual order of the arguments enables to use a specific `model.frame.pdata.frame` method defined in `plm`. As for the `model.frame.formula` method, a `data.frame` is returned, with a `terms` attribute. Next, the `X` matrix is extracted using `model.matrix`. The usual way to do so is to feed the function with two arguments, a `formula` or a `terms` object and a `data.frame` created with `model.frame`. `lm` uses something like `model.matrix(terms(mf), mf)` where `mf` is a `data.frame` created with `model.frame`. Therefore, `model.matrix` needs actually one argument and not two and we therefore wrote a `model.matrix.pdata.frame` which does the job ; the method first checks that the argument has a `term` attribute, extracts the `terms` (actually the `formula`) and then computes the model's matrix `X`. The response `y` is usually extracted using `model.response`, with a `data.frame` created with `model.frame` as first argument, but it is not generic. We therefore created a generic called `pmodel.response` and provide a `pmodel.response.pdata.frame` method. We illustrate these features using a simplified (in terms of covariates) example with the `SeatBelt` data set: ```{r } library("plm") data("SeatBelt", package = "pder") SeatBelt$occfat <- with(SeatBelt, log(farsocc / (vmtrural + vmturban))) pSB <- pdata.frame(SeatBelt) ``` We start with an OLS (pooling) specification: ```{r } formols <- occfat ~ log(usage) + log(percapin) mfols <- model.frame(pSB, formols) Xols <- model.matrix(mfols) y <- pmodel.response(mfols) coef(lm.fit(Xols, y)) ``` which is equivalent to: ```{r } coef(plm(formols, SeatBelt, model = "pooling")) ``` Next, we use an instrumental variables specification. Variable `usage` is endogenous and instrumented by three variables indicating the law context: `ds`, `dp`, and `dsp`. The model is described using a two-parts formula, the first part of the RHS describing the covariates and the second part the instruments. The following two formulations can be used: ```{r } formiv1 <- occfat ~ log(usage) + log(percapin) | log(percapin) + ds + dp + dsp formiv2 <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp ``` The second formulation has two advantages: - in the common case when a lot of covariates are instruments, these covariates don't need to be indicated in the second RHS part of the formula, - the endogenous variables clearly appear as they are proceeded by a `-` sign in the second RHS part of the formula. The formula is coerced to a `Formula`, using the `Formula` package. `model.matrix.pdata.frame` then internally calls `model.matrix.Formula` in order to extract the covariates and instruments model matrices: ```{r } mfSB1 <- model.frame(pSB, formiv1) X1 <- model.matrix(mfSB1, rhs = 1) W1 <- model.matrix(mfSB1, rhs = 2) head(X1, 3) ; head(W1, 3) ``` For the second (and preferred formulation), the `dot` argument should be set and is passed to the `Formula` methods. `.` has actually two meanings: - all available covariates, - the previous covariates used while updating a formula. which correspond respectively to `dot = "seperate"` (the default) and `dot = "previous"`. See the difference between the following two examples: ```{r } library("Formula") head(model.frame(Formula(formiv2), SeatBelt), 3) head(model.frame(Formula(formiv2), SeatBelt, dot = "previous"), 3) ``` In the first case, all the covariates are returned by `model.frame` as the `.` is understood by default as "everything". In `plm`, the `dot` argument is internally set to `previous` so that the end-user doesn't have to worry about these subtleties. ```{r } mfSB2 <- model.frame(pSB, formiv2) X2 <- model.matrix(mfSB2, rhs = 1) W2 <- model.matrix(mfSB2, rhs = 2) head(X2, 3) ; head(W2, 3) ``` The IV estimator can then be obtained as a 2SLS estimator: First, regress the covariates on the instruments and get the fitted values: ```{r } HX1 <- lm.fit(W1, X1)$fitted.values head(HX1, 3) ``` Next, regress the response on these fitted values: ```{r } coef(lm.fit(HX1, y)) ``` The same can be achieved in one command by using the `formula`-`data` interface with `plm`: ```{r } coef(plm(formiv1, SeatBelt, model = "pooling")) ``` or with the `ivreg` function from package `AER` (or with the newer function `ivreg` in package `ivreg` superseding `AER::ivreg()`): ```{r } coef(AER::ivreg(formiv1, data = SeatBelt)) ``` ```{r eval = FALSE, include = FALSE} X2 <- model.matrix(Formula(form1), mfSB, rhs = 2, dot = "previous") formols <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp form1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + log(precentb) + log(precenth) + log(densrur) + log(densurb) + log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + log(fueltax) + lim65 + lim70p + mlda21 + bac08 form2 <- . ~ . | . - log(usage) + ds + dp +dsp jorm1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + log(precentb) + log(precenth) + log(densrur) + log(densurb) + log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + log(fueltax) + lim65 + lim70p + mlda21 + bac08 | . - log(usage) + ds + dp + dsp jorm2 <- noccfat ~ . | . ``` plm/R/0000755000176200001440000000000014165357232011253 5ustar liggesusersplm/R/test_general.R0000644000176200001440000013255014161142251014045 0ustar liggesusers #' Hausman Test for Panel Models #' #' Specification test for panel models. #' #' The Hausman test (sometimes also called Durbin--Wu--Hausman test) #' is based on the difference of the vectors of coefficients of two #' different models. The `panelmodel` method computes the original #' version of the test based on a quadratic form #' \insertCite{HAUS:78}{plm}. The `formula` method, if #' `method = "chisq"` (default), computes the original version of the #' test based on a quadratic form; if `method ="aux"` then the #' auxiliary-regression-based version as in \insertCite{WOOL:10;textual}{plm}, #' Sec.10.7.3. Only the latter can be robustified by specifying a robust #' covariance estimator as a function through the argument `vcov` (see #' **Examples**). #' #' The `effect` argument is only relevant for the formula method/interface and #' is then applied to both models. For the panelmodel method/interface, the test #' is run with the effects of the already estimated models. #' #' The equivalent tests in the **one-way** case using a between #' model (either "within vs. between" or "random vs. between") #' \insertCite{@see @HAUS:TAYL:81 or @BALT:13 Sec.4.3}{plm} can also #' be performed by `phtest`, but only for `test = "chisq"`, not for #' the regression-based test. NB: These equivalent tests using the #' between model do not extend to the two-ways case. There are, #' however, some other equivalent tests, #' \insertCite{@see @KANG:85 or @BALT:13 Sec.4.3.7}{plm}, #' but those are unsupported by `phtest`. #' #' @aliases phtest #' @param x an object of class `"panelmodel"` or `"formula"`, #' @param x2 an object of class `"panelmodel"` (only for panelmodel method/interface), #' @param model a character vector containing the names of two models #' (length(model) must be 2), #' @param effect a character specifying the effect to be introduced to both models, #' one of `"individual"`, `"time"`, or `"twoways"` (only for formula method), #' @param data a `data.frame`, #' @param method one of `"chisq"` or `"aux"`, #' @param index an optional vector of index variables, #' @param vcov an optional covariance function, #' @param \dots further arguments to be passed on (currently none). #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant, Giovanni Millo #' @references #' #' \insertRef{HAUS:78}{plm} #' #' \insertRef{HAUS:TAYL:81}{plm} #' #' \insertRef{KANG:85}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' \insertRef{BALT:13}{plm} #' #' @keywords htest #' @examples #' #' data("Gasoline", package = "plm") #' form <- lgaspcar ~ lincomep + lrpmg + lcarpcap #' wi <- plm(form, data = Gasoline, model = "within") #' re <- plm(form, data = Gasoline, model = "random") #' phtest(wi, re) #' phtest(form, data = Gasoline) #' phtest(form, data = Gasoline, effect = "time") #' #' # Regression-based Hausman test #' phtest(form, data = Gasoline, method = "aux") #' #' # robust Hausman test with vcov supplied as a function and #' # with additional parameters #' phtest(form, data = Gasoline, method = "aux", vcov = vcovHC) #' phtest(form, data = Gasoline, method = "aux", #' vcov = function(x) vcovHC(x, method="white2", type="HC3")) #' phtest <- function(x,...){ UseMethod("phtest") } #' @rdname phtest #' @export phtest.formula <- function(x, data, model = c("within", "random"), effect = c("individual", "time", "twoways"), method = c("chisq", "aux"), index = NULL, vcov = NULL, ...) { if (length(model) != 2) stop("two models should be indicated in argument 'model'") for (i in 1:2){ model.name <- model[i] if(!(model.name %in% names(model.plm.list))){ stop("model must be one of ", oneof(model.plm.list)) } } effect <- match.arg(effect) switch(match.arg(method), "chisq" = { cl <- match.call(expand.dots = TRUE) cl$model <- model[1L] cl$effect <- effect names(cl)[2L] <- "formula" m <- match(plm.arg, names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("plm") plm.model.1 <- eval(cl, parent.frame()) plm.model.2 <- update(plm.model.1, model = model[2L]) return(phtest(plm.model.1, plm.model.2)) # exit to phtest.panelmodel }, "aux" = { ## some interface checks here if (model[1L] != "within") { stop("Please supply 'within' as first model type") } if (!is.null(vcov) && !is.function(vcov)) stop("argument 'vcov' needs to be a function") ## set pdata.frame if (!inherits(data, "pdata.frame")) data <- pdata.frame(data, index = index) #, ...) row.names(data) <- NULL # reset rownames of original data set (->numbers rownames in clean sequence) to make rownames # comparable for later comparison to obs used in estimation of models (get rid of NA values) # [needed because pmodel.response() and model.matrix() do not retain fancy rownames, but rownames] # calculate FE and RE model fe_mod <- plm(formula = x, data = data, model = model[1L], effect = effect) re_mod <- plm(formula = x, data = data, model = model[2L], effect = effect) ## DEBUG printing: # print(effect) # print(model) # print(paste0("mod1: ", describe(fe_mod, "effect"))) # print(paste0("mod2: ", describe(re_mod, "effect"))) # print(fe_mod) # print(re_mod) reY <- pmodel.response(re_mod) # reX <- model.matrix(re_mod)[ , -1, drop = FALSE] # intercept not needed; drop=F needed to prevent matrix # feX <- model.matrix(fe_mod, cstcovar.rm = TRUE) # from degenerating to vector if only one regressor reX <- model.matrix(re_mod, cstcovar.rm = "intercept") feX <- model.matrix(fe_mod, cstcovar.rm = "all") dimnames(feX)[[2L]] <- paste(dimnames(feX)[[2L]], "tilde", sep=".") ## estimated models could have fewer obs (due dropping of NAs) compared to the original data ## => match original data and observations used in estimated models ## routine adapted from lmtest::bptest commonrownames <- intersect(intersect(intersect(row.names(data), names(reY)), row.names(reX)), row.names(feX)) if (!(all(c(row.names(data) %in% commonrownames, commonrownames %in% row.names(data))))) { data <- data[commonrownames, ] reY <- reY[commonrownames] reX <- reX[commonrownames, ] feX <- feX[commonrownames, ] } # Tests of correct matching of obs (just for safety ...) if(!all.equal(length(reY), nrow(data), nrow(reX), nrow(feX))) stop("number of cases/observations do not match, most likely due to NAs in \"data\"") if(any(c(is.na(names(reY)), is.na(row.names(data)), is.na(row.names(reX)), is.na(row.names(feX))))) stop("one (or more) rowname(s) is (are) NA") if(!all.equal(names(reY), row.names(data), row.names(reX), row.names(feX))) stop("row.names of cases/observations do not match, most likely due to NAs in \"data\"") ## fetch indices here, check pdata ## construct data set and formula for auxiliary regression data <- pdata.frame(cbind(index(data), reY, reX, feX)) auxfm <- as.formula(paste("reY~", paste(dimnames(reX)[[2L]], collapse="+"), "+", paste(dimnames(feX)[[2L]], collapse="+"), sep="")) auxmod <- plm(formula = auxfm, data = data, model = "pooling") nvars <- dim(feX)[[2L]] R <- diag(1, nvars) r <- rep(0, nvars) # here just for clarity of illustration range <- (nvars+2L):(nvars*2L + 1L) omega0 <- vcov(auxmod)[range, range] Rbr <- R %*% coef(auxmod)[range] - r h2t <- as.numeric(crossprod(Rbr, solve(omega0, Rbr))) ph2t <- pchisq(h2t, df = nvars, lower.tail = FALSE) df <- nvars names(df) <- "df" names(h2t) <- "chisq" if(!is.null(vcov)) { vcov <- paste(", vcov: ", paste(deparse(substitute(vcov))), sep="") } haus2 <- list(statistic = h2t, p.value = ph2t, parameter = df, method = paste("Regression-based Hausman test", vcov, sep=""), alternative = "one model is inconsistent", data.name = paste(deparse(substitute(x)))) class(haus2) <- "htest" return(haus2) }) } #' @rdname phtest #' @export phtest.panelmodel <- function(x, x2, ...) { coef.wi <- coef(x) coef.re <- coef(x2) vcov.wi <- vcov(x) vcov.re <- vcov(x2) names.wi <- names(coef.wi) names.re <- names(coef.re) common_coef_names <- names.re[names.re %in% names.wi] coef.h <- common_coef_names[!(common_coef_names %in% "(Intercept)")] # drop intercept if included (relevant when between model input) if(length(coef.h) == 0L) stop("no common coefficients in models") dbeta <- coef.wi[coef.h] - coef.re[coef.h] df <- length(dbeta) dvcov <- vcov.wi[coef.h, coef.h] - vcov.re[coef.h, coef.h] #### BEGIN cater for equivalent test within vs. between # Baltagi (2013), Sec. 4.3, pp. 77, 81 modx <- describe(x, what = "model") modx2 <- describe(x2, what = "model") effx <- describe(x, what = "effect") effx2 <- describe(x2, what = "effect") # Tests with between model do not extend to two-ways case -> give error # There are, however, some equiv. tests with the individual/time between # model, but let's not support them (see Kang (1985), Baltagi (2013), Sec. 4.3.7) if ( (modx == "between" || modx2 == "between") && (effx == "twoways" || effx2 == "twoways")) stop("tests with between model in twoways case not supported") # in case of one-way within vs. between (m3 in Baltagi (2013), pp. 77, 81) # the variances need to be added (not subtracted like in the other cases) if ( (modx == "within" && modx2 == "between") || (modx2 == "within" && modx == "between")) { dvcov <- vcov.wi[coef.h, coef.h] + vcov.re[coef.h, coef.h] } #### END cater for equivalent tests with between model stat <- as.numeric(abs(t(dbeta) %*% solve(dvcov) %*% dbeta)) pval <- pchisq(stat, df = df, lower.tail = FALSE) names(stat) <- "chisq" parameter <- df names(parameter) <- "df" alternative <- "one model is inconsistent" ## DEBUG printing: # print(paste0("mod1: ", describe(x, "effect"))) # print(paste0("mod2: ", describe(x2, "effect"))) res <- list(statistic = stat, p.value = pval, parameter = parameter, method = "Hausman Test", data.name = data.name(x), alternative = alternative) class(res) <- "htest" return(res) } ############## plmtest() ############################################ # For a concise overview with original references, see # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, pp. 68-76 (balanced), pp. 200-203 (unbalanced). # # balanced (original) version of Breusch-Pagan test: # T.S. Breusch & A.R. Pagan (1979), # A Simple Test for Heteroscedasticity and Random Coefficient Variation, # Econometrica 47, pp. 1287-1294 # # unbalanced version: # Baltagi/Li (1990), # A lagrange multiplier test for the error components model with incomplete panels, # Econometric Reviews, 9, pp. 103-107, # pchibarsq: helper function: "p-function" for mixed chisq (also called chi-bar-squared) # used in plmtest(., type = "ghm"), see Baltagi (2013), pp. 71-72, 74, 88, 202-203, 209 # # a reference for the distribution seems to be # Dykstra, R./El Barmi, H., Chi-Bar-Square Distributions, in: Encyclopedia of Statistical Sciences, # DOI: 10.1002/0471667196.ess0265.pub2 pchibarsq <- function(q, df, weights, lower.tail = TRUE, ... ) { # NB: other parameters in dots (...): not checked if valid! (ncp, log, ...) sum(weights * pchisq(q, df = df, lower.tail = lower.tail, ...)) } #' Lagrange FF Multiplier Tests for Panel Models #' #' Test of individual and/or time effects for panel models. #' #' These Lagrange multiplier tests use only the residuals of the #' pooling model. The first argument of this function may be either a #' pooling model of class `plm` or an object of class `formula` #' describing the model. For input within (fixed effects) or random #' effects models, the corresponding pooling model is calculated #' internally first as the tests are based on the residuals of the #' pooling model. #' #' The `"bp"` test for unbalanced panels was derived in #' \insertCite{BALT:LI:90;textual}{plm} #' (1990), the `"kw"` test for unbalanced panels in #' \insertCite{BALT:CHAN:LI:98;textual}{plm}. #' #' The `"ghm"` test and the `"kw"` test were extended to two-way #' effects in \insertCite{BALT:CHAN:LI:92;textual}{plm}. #' #' For a concise overview of all these statistics see #' \insertCite{BALT:03;textual}{plm}, Sec. 4.2, pp. 68--76 (for balanced #' panels) and Sec. 9.5, pp. 200--203 (for unbalanced panels). #' #' @aliases plmtest #' @param x an object of class `"plm"` or a formula of class #' `"formula"`, #' @param data a `data.frame`, #' @param effect a character string indicating which effects are #' tested: individual effects (`"individual"`), time effects #' (`"time"`) or both (`"twoways"`), #' @param type a character string indicating the test to be performed: #' #' - `"honda"` (default) for \insertCite{HOND:85;textual}{plm}, #' - `"bp"` for \insertCite{BREU:PAGA:80;textual}{plm}, #' - `"kw"` for \insertCite{KING:WU:97;textual}{plm}, or #' - `"ghm"` for \insertCite{GOUR:HOLL:MONF:82;textual}{plm} for #' unbalanced panel data sets, the respective unbalanced version #' of the tests are computed, #' #' @param \dots further arguments passed to `plmtest`. #' @return An object of class `"htest"`. #' @note For the King-Wu statistics (`"kw"`), the oneway statistics #' (`"individual"` and `"time"`) coincide with the respective #' Honda statistics (`"honda"`); twoway statistics of `"kw"` and #' `"honda"` differ. #' @export #' @author Yves Croissant (initial implementation), Kevin Tappe #' (generalization to unbalanced panels) #' @seealso [pFtest()] for individual and/or time effects tests based #' on the within model. #' @references #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:LI:90}{plm} #' #' \insertRef{BALT:CHAN:LI:92}{plm} #' #' \insertRef{BALT:CHAN:LI:98}{plm} #' #' \insertRef{BREU:PAGA:80}{plm} #' #' \insertRef{GOUR:HOLL:MONF:82}{plm} #' #' \insertRef{HOND:85}{plm} #' #' \insertRef{KING:WU:97}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' g <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") #' plmtest(g) #' plmtest(g, effect="time") #' plmtest(inv ~ value + capital, data = Grunfeld, type = "honda") #' plmtest(inv ~ value + capital, data = Grunfeld, type = "bp") #' plmtest(inv ~ value + capital, data = Grunfeld, type = "bp", effect = "twoways") #' plmtest(inv ~ value + capital, data = Grunfeld, type = "ghm", effect = "twoways") #' plmtest(inv ~ value + capital, data = Grunfeld, type = "kw", effect = "twoways") #' #' Grunfeld_unbal <- Grunfeld[1:(nrow(Grunfeld)-1), ] # create an unbalanced panel data set #' g_unbal <- plm(inv ~ value + capital, data = Grunfeld_unbal, model = "pooling") #' plmtest(g_unbal) # unbalanced version of test is indicated in output #' plmtest <- function(x, ...){ UseMethod("plmtest") } #' @rdname plmtest #' @export plmtest.plm <- function(x, effect = c("individual", "time", "twoways"), type = c("honda", "bp", "ghm", "kw"), ...) { effect <- match.arg(effect) type <- match.arg(type) if (describe(x, "model") != "pooling") x <- update(x, model = "pooling") pdim <- pdim(x) n <- pdim$nT$n T <- pdim$nT$T N_obs <- pdim$nT$N balanced <- pdim$balanced index <- unclass(attr(model.frame(x), "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] T_i <- pdim$Tint$Ti N_t <- pdim$Tint$nt res <- resid(x) ### calc of parts of test statistic ## # calc. is done w/o using matrix calculation, see, e.g., Baltagi/Li (1990), p. 106 CP.res <- crossprod(res) A1 <- as.numeric(crossprod(tapply(res, id, sum)) / CP.res - 1) # == A1 <- sum(tapply(res,id,sum)^2) / sum(res^2) - 1 A2 <- as.numeric(crossprod(tapply(res, time, sum)) / CP.res - 1) # == A2 <- sum(tapply(res,time,sum)^2) / sum(res^2) - 1 M11 <- sum(T_i ^ 2) M22 <- sum(N_t ^ 2) LM1 <- N_obs * (1 / sqrt(2 * (M11 - N_obs))) * A1 # == sqrt( (((N_obs)^2) / 2) * ( A1^2 / (M11 - N_obs)) ) [except sign due to positive sqrt] LM2 <- N_obs * (1 / sqrt(2 * (M22 - N_obs))) * A2 # == sqrt( (((N_obs)^2) / 2) * ( A2^2 / (M22 - N_obs)) ) [except sign due to positive sqrt] ### END calc of parts of test statistic ## if (effect != "twoways"){ # oneway if (!type %in% c("honda", "bp", "kw")) stop("type must be one of \"honda\", \"bp\" or \"kw\" for a one way model") # kw oneway coincides with honda stat <- if(effect == "individual") LM1 else LM2 stat <- switch(type, honda = c(normal = stat), bp = c(chisq = stat ^ 2), kw = c(normal = stat)) parameter <- switch(type, honda = NULL, bp = c(df = 1), # df = 1 in the oneway case (Baltagi (2013), p. 70) kw = NULL) pval <- switch(type, honda = pnorm(stat, lower.tail = FALSE), # honda oneway ~ N(0,1), alternative is one-sided (Baltagi (2013), p. 71/202) bp = pchisq(stat, df = parameter, lower.tail = FALSE), # df = 1 in the one-way case, alternative is two-sided (Baltagi (2013), p. 70/201) kw = pnorm(stat, lower.tail = FALSE)) # kw oneway ~ N(0,1), alternative is one-sided (Baltagi (2013), p. 71/202) # END oneway } else { # twoways stat <- switch(type, honda = c(normal = (LM1 + LM2) / sqrt(2)), bp = c(chisq = LM1 ^ 2 + LM2 ^ 2), kw = c(normal = (sqrt(M11 - N_obs) / sqrt(M11 + M22 - 2 * N_obs)) * LM1 + (sqrt(M22 - N_obs) / sqrt(M11 + M22 - 2 * N_obs)) * LM2), ghm = c(chibarsq = max(0, LM1) ^ 2 + max(0, LM2) ^ 2)) parameter <- switch(type, honda = NULL, bp = c(df = 2), # df = 2 in the twoway case (Baltagi (2013), p. 70/201) kw = NULL, ghm = c(df0 = 0L, df1 = 1L, df2 = 2L, w0 = 1/4, w1 = 1/2, w2 = 1/4)) # chibarsquared (mixed chisq) has several dfs and weights (Baltagi (2013), p. 72/202) pval <- switch(type, honda = pnorm(stat, lower.tail = FALSE), # honda two-ways ~ N(0,1), alternative is one-sided (Baltagi (2013), p. 71/202) bp = pchisq(stat, df = parameter, lower.tail = FALSE), # is df = 2 in the twoway case, alternative is two-sided (Baltagi (2013), p. 70/201) kw = pnorm(stat, lower.tail = FALSE), # kw twoways ~ N(0,1), alternative is one-sided (Baltagi (2013), p. 71/202) ghm = pchibarsq(stat, df = c(0L, 1L, 2L), weights = c(1/4, 1/2, 1/4), lower.tail = FALSE)) # mixed chisq (also called chi-bar-square), see Baltagi (2013), pp. 71-72, 74, 88, 202-203, 209 } # END twoways method.type <- switch(type, honda = "Honda", bp = "Breusch-Pagan", ghm = "Gourieroux, Holly and Monfort", kw = "King and Wu") method.effect <- switch(effect, id = "individual effects", time = "time effects", twoways = "two-ways effects") balanced.type <- if(balanced) "balanced" else "unbalanced" method <- paste("Lagrange Multiplier Test - ", method.effect, " (", method.type, ") for ", balanced.type, " panels", sep="") if (type %in% c("honda", "kw")) { RVAL <- list(statistic = stat, p.value = pval, method = method, data.name = data.name(x)) } else { # bp, ghm RVAL <- list(statistic = stat, p.value = pval, method = method, parameter = parameter, data.name = data.name(x)) } RVAL$alternative <- "significant effects" # TODO: maybe distinguish b/w one-sided and two-sided alternatives? # (bp: two-sided alt.; all others: one-sided alt.?) class(RVAL) <- "htest" return(RVAL) } #' @rdname plmtest #' @export plmtest.formula <- function(x, data, ..., effect = c("individual", "time", "twoways"), type = c("honda", "bp", "ghm", "kw")) { cl <- match.call(expand.dots = TRUE) cl$model <- "pooling" # plmtest is performed on the pooling model... cl$effect <- NULL # ... and pooling model has no argument effect... cl$type <- NULL # ... and no argument type => see below: pass on args effect and type to plmtest.plm() names(cl)[2L] <- "formula" m <- match(plm.arg, names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("plm") plm.model <- eval(cl, parent.frame()) plmtest(plm.model, effect = effect, type = type) # pass on args effect and type to plmtest.plm() } #' F Test for Individual and/or Time Effects #' #' Test of individual and/or time effects based on the comparison of the #' `within` and the `pooling` model. #' #' For the `plm` method, the argument of this function is two `plm` #' objects, the first being a within model, the second a pooling #' model. The effects tested are either individual, time or twoways, #' depending on the effects introduced in the within model. #' #' @aliases pFtest #' @param x an object of class `"plm"` or of class `"formula"`, #' @param z an object of class `"plm"`, #' @param data a `data.frame`, #' @param \dots further arguments. #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant #' @seealso [plmtest()] for Lagrange multiplier tests of individuals #' and/or time effects. #' @keywords htest #' @examples #' #' data("Grunfeld", package="plm") #' gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") #' gi <- plm(inv ~ value + capital, data = Grunfeld, #' effect = "individual", model = "within") #' gt <- plm(inv ~ value + capital, data = Grunfeld, #' effect = "time", model = "within") #' gd <- plm(inv ~ value + capital, data = Grunfeld, #' effect = "twoways", model = "within") #' pFtest(gi, gp) #' pFtest(gt, gp) #' pFtest(gd, gp) #' pFtest(inv ~ value + capital, data = Grunfeld, effect = "twoways") #' pFtest <- function(x, ...){ UseMethod("pFtest") } #' @rdname pFtest #' @export pFtest.formula <- function(x, data, ...){ cl <- match.call(expand.dots = TRUE) cl$model <- "within" names(cl)[2L] <- "formula" m <- match(plm.arg,names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("plm") plm.within <- eval(cl,parent.frame()) plm.pooling <- update(plm.within, model = "pooling") pFtest(plm.within, plm.pooling, ...) } #' @rdname pFtest #' @export pFtest.plm <- function(x, z, ...){ within <- x pooling <- z ## leave this interface check commented because pkg AER (reverse dependency) has examples that ## use pFtest(within_twoway, within_time) # if (! (describe(x, "model") == "within" && describe(z, "model") == "pooling")) # stop("the two arguments should be a 'within' and a 'pooling' model (in this order)") effect <- describe(x, "effect") df1 <- df.residual(pooling)-df.residual(within) df2 <- df.residual(within) ssrp <- as.numeric(crossprod(residuals(pooling))) ssrw <- as.numeric(crossprod(residuals(within))) stat <- (ssrp-ssrw)/ssrw/df1*df2 names(stat) <- "F" parameter <- c(df1, df2) names(parameter) <- c("df1", "df2") pval <- pf(stat, df1, df2, lower.tail = FALSE) alternative <- "significant effects" res <- list(statistic = stat, p.value = pval, method = paste("F test for ", effect, " effects", sep=""), parameter = parameter, data.name = data.name(x), alternative = alternative) class(res) <- "htest" res } ############## pwaldtest() ############################################ # pwaldtest is used in summary.plm, summary.pht, summary.pgmm to compute the # Chi-square or F statistic, but can be used as a stand-alone test of # joint significance of all slopes # # Short intro (but see associated help file) # arg 'vcov' non-NULL => the robust tests are carried out # arg df2adj == TRUE does finite-sample/cluster adjustment for F tests's df2 # args .df1, .df2 are only there if user wants to do overwriting of dfs (user has final say) # # Chi-sq test for IV models as in Wooldridge (1990), A note on the Lagrange multiplier and F-statistics for two stage least # squares regressions, Economics Letters 34: 151-155. #' Wald-style Chi-square Test and F Test #' #' Wald-style Chi-square test and F test of slope coefficients being #' zero jointly, including robust versions of the tests. #' #' #' `pwaldtest` can be used stand--alone with a plm object, a pvcm object, #' and a pgmm object (for pvcm objects only the 'random' type is valid and no #' further arguments are processed; for pgmm objects only arguments `param` #' and `vcov` are valid). It is also used in #' [summary.plm()] to produce the F statistic and the Chi-square #' statistic for the joint test of coefficients and in [summary.pgmm()]. #' #' `pwaldtest` performs the test if the slope coefficients of a panel #' regression are jointly zero. It does not perform general purpose #' Wald-style tests (for those, see [lmtest::waldtest()] (from package #' \CRANpkg{lmtest}) or [car::linearHypothesis()] (from package #' \CRANpkg{car})). #' #' If a user specified variance-covariance matrix/function is given in #' argument `vcov`, the robust version of the tests are carried out. #' In that case, if the F test is requested (`test = "F"`) and no #' overwriting of the second degrees of freedom parameter is given (by #' supplying argument (`.df2`)), the adjustment of the second degrees #' of freedom parameter is performed by default. The second degrees of #' freedom parameter is adjusted to be the number of unique elements #' of the cluster variable - 1, e. g., the number of individuals minus 1. #' For the degrees of freedom adjustment of the F test in general, #' see e. g. \insertCite{CAME:MILL:15;textual}{plm}, section VII; #' \insertCite{ANDR:GOLS:SCMI:13}{plm}, pp. 126, footnote 4. #' #' The degrees of freedom adjustment requires the vcov object supplied #' or created by a supplied function to carry an attribute called #' "cluster" with a known clustering described as a character (for now #' this could be either `"group"` or `"time"`). The vcovXX functions #' of the package \pkg{plm} provide such an attribute for their #' returned variance--covariance matrices. No adjustment is done for #' unknown descriptions given in the attribute "cluster" or when the #' attribute "cluster" is not present. Robust vcov objects/functions #' from package \CRANpkg{clubSandwich} work as inputs to `pwaldtest`'s #' F test because a they are translated internally to match the needs #' described above. #' #' @aliases pwaldtest #' @param x an estimated model of which the coefficients should be #' tested (usually of class `"plm"`/`"pvcm"`/`"pgmm"`)`, #' @param test a character, indicating the test to be performed, may #' be either `"Chisq"` or `"F"` for the Wald-style #' Chi-square test or F test, respectively, #' @param vcov `NULL` by default; a `matrix` giving a #' variance--covariance matrix or a function which computes such; #' if supplied (non `NULL`), the test is carried out using #' the variance--covariance matrix indicated resulting in a robust #' test, #' @param df2adj logical, only relevant for `test = "F"`, #' indicating whether the adjustment for clustered standard errors #' for the second degrees of freedom parameter should be performed #' (see **Details**, also for further requirements regarding #' the variance--covariance matrix in `vcov` for the #' adjustment to be performed), #' @param .df1 a numeric, used if one wants to overwrite the first #' degrees of freedom parameter in the performed test (usually not #' used), #' @param .df2 a numeric, used if one wants to overwrite the second #' degrees of freedom parameter for the F test (usually not used), #' @param param (for pgmm method only): select the parameters to be tested: #' `"coef"`, `"time"`, or `"all"``. #' @param \dots further arguments (currently none). #' @return An object of class `"htest"`, except for pvcm's within model for which #' a data.frame with results of the Wald chi-square tests and F tests per #' regression is returned. #' @export #' @author Yves Croissant (initial implementation) and Kevin Tappe #' (extensions: vcov argument and F test's df2 adjustment) #' @seealso #' #' [vcovHC()] for an example of the vcovXX functions, a robust #' estimation for the variance--covariance matrix; [summary.plm()] #' @references #' #' \insertRef{WOOL:10}{plm} #' #' \insertRef{ANDR:GOLS:SCMI:13}{plm} #' #' \insertRef{CAME:MILL:15}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' mod_fe <- plm(inv ~ value + capital, data = Grunfeld, model = "within") #' mod_re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") #' pwaldtest(mod_fe, test = "F") #' pwaldtest(mod_re, test = "Chisq") #' #' # with robust vcov (matrix, function) #' pwaldtest(mod_fe, vcov = vcovHC(mod_fe)) #' pwaldtest(mod_fe, vcov = function(x) vcovHC(x, type = "HC3")) #' #' pwaldtest(mod_fe, vcov = vcovHC(mod_fe), df2adj = FALSE) # w/o df2 adjustment #' #' # example without attribute "cluster" in the vcov #' vcov_mat <- vcovHC(mod_fe) #' attr(vcov_mat, "cluster") <- NULL # remove attribute #' pwaldtest(mod_fe, vcov = vcov_mat) # no df2 adjustment performed #' #' pwaldtest <- function(x, ...) { UseMethod("pwaldtest") } #' @rdname pwaldtest #' @export pwaldtest.plm <- function(x, test = c("Chisq", "F"), vcov = NULL, df2adj = (test == "F" && !is.null(vcov) && missing(.df2)), .df1, .df2, ...) { model <- describe(x, "model") test <- match.arg(test) df1 <- if(model == "within") length(coef(x)) else { length(coef(x)) - has.intercept(x) } df2 <- df.residual(x) # tss <- tss(x) # not good for models without intercept # ssr <- deviance(x) # -- " -- vcov_arg <- vcov int <- "(Intercept)" coefs_wo_int <- coef(x)[!(names(coef(x)) %in% int)] if(!length(coefs_wo_int)) stop(paste("No non-intercept regressors in input model 'x',", "cannot perform Wald joint significance test")) # sanity check if (df2adj == TRUE && (is.null(vcov_arg) || test != "F")) { stop("df2adj == TRUE sensible only for robust F test, i.e., test == \"F\" and !is.null(vcov) and missing(.df2)") } # if robust test: prepare robust vcov if (!is.null(vcov_arg)) { if (is.matrix(vcov_arg)) rvcov <- rvcov_orig <- vcov_arg if (is.function(vcov_arg)) rvcov <- rvcov_orig <- vcov_arg(x) rvcov_name <- paste0(", vcov: ", paste0(deparse(substitute(vcov)))) # save "name" for later if (int %in% names(coef(x))) { # drop intercept, if present rvcov <- rvcov_orig[!rownames(rvcov_orig) %in% int, !colnames(rvcov_orig) %in% int] attr(rvcov, which = "cluster") <- attr(rvcov_orig, which = "cluster") # restore dropped 'cluster' attribute } # if robust F test: by default, do finite-sample adjustment for df2 if (df2adj == TRUE && test == "F") { # determine the variable that the clustering is done on by # attribute "cluster" in the vcov (matrix object) # if only one member in cluster: fall back to original df2 if (!is.null(attr(rvcov, which = "cluster"))) { # if supplied vcov is from package "clubSandwich": translate attr "cluster" to fit our code # (use rvcov_orig here for the test as the above dropping of the intercept drops the special classes of rvcov) if (inherits(rvcov_orig, "vcovCR")) rvcov <- trans_clubSandwich_vcov(CSvcov = rvcov, index = attr(model.frame(x), "index")) cluster <- attr(rvcov, which = "cluster") pdim <- pdim(x) df2 <- switch(cluster, group = { if(pdim$nT$n == 1L) df2 else (pdim$nT$n - 1L) }, time = { if(pdim$nT$T == 1L) df2 else (pdim$nT$T - 1L) }, # TODO: what about double clustering? vcovDC? vcovDC identifies itself as attr(obj, "cluster")="group-time") # default: { # warning("unknown/not implemented clustering, no df2 adjustment for finite-samples") df2} ) } else { # no information on clustering found, do not adjust df2 # (other options would be: assume cluster = "group", or fall-back to non robust statistics (set vcov_arg <- NULL)) warning("no attribute 'cluster' in robust vcov found, no finite-sample adjustment for df2") # assuming cluster = \"group\"") # df2 <- as.integer(pdim(x)$nT$n - 1) # assume cluster = "group" } } } # final say: overwrite Dfs if especially supplied if (!missing(.df1)) df1 <- .df1 if (!missing(.df2)) df2 <- .df2 if (test == "Chisq"){ # perform non-robust chisq test if (is.null(vcov_arg)) { names.coefs_wo_int <- names(coefs_wo_int) stat <- as.numeric(crossprod(solve(vcov(x)[names.coefs_wo_int, names.coefs_wo_int], coefs_wo_int), coefs_wo_int)) # stat < - (tss-ssr)/(ssr/df2) # does not produce correct results for unbalanced RE models and (un)balanced IV models names(stat) <- "Chisq" pval <- pchisq(stat, df = df1, lower.tail = FALSE) parameter <- c(df = df1) method <- "Wald test for joint significance" } else { # perform robust chisq test stat <- as.numeric(crossprod(solve(rvcov, coefs_wo_int), coefs_wo_int)) names(stat) <- "Chisq" pval <- pchisq(stat, df = df1, lower.tail = FALSE) parameter <- c(df = df1) method <- paste0("Wald test for joint significance (robust)", rvcov_name) } } if (test == "F"){ if(length(formula(x))[2L] > 1L) stop("test = \"F\" not sensible for IV models") if (is.null(vcov_arg)) { # perform "normal" F test names.coefs_wo_int <- names(coefs_wo_int) stat <- as.numeric(crossprod(solve(vcov(x)[names.coefs_wo_int, names.coefs_wo_int], coefs_wo_int), coefs_wo_int)) / df1 # stat <- (tss-ssr)/ssr*df2/df1 # does not produce correct results for unbalanced RE models names(stat) <- "F" pval <- pf(stat, df1 = df1, df2 = df2, lower.tail = FALSE) parameter <- c(df1 = df1, df2 = df2) method <- "F test for joint significance" } else { # perform robust F test stat <- as.numeric(crossprod(solve(rvcov, coefs_wo_int), coefs_wo_int) / df1) names(stat) <- "F" pval <- pf(stat, df1 = df1, df2 = df2, lower.tail = FALSE) parameter <- c(df1 = df1, df2 = df2) method <- paste0("F test for joint significance (robust)", rvcov_name) } } res <- list(data.name = data.name(x), statistic = stat, parameter = parameter, p.value = pval, method = method, alternative = "at least one coefficient is not null" ) class(res) <- "htest" return(res) } #' @rdname pwaldtest #' @export pwaldtest.pvcm <- function(x, ...) { model <- describe(x, "model") effect <- describe(x, "effect") coefs.no.int <- !names(x$coefficients) %in% "(Intercept)" # logical with non-intercept regressors set to TRUE if(!length(names(x$coefficients)[coefs.no.int])) { # error informatively if only-intercept model (no other regressors) stop(paste("No non-intercept regressors in model(s) of input 'x',", "cannot perform Wald joint significance test(s)")) } if(model == "within") { # for the within case, simply return a data.frame with all test results # of single estimations (per individual or per time period) ii <- switch(effect, "individual" = 1L, "time" = 2L) residl <- split(x$residuals, unclass(index(x))[[ii]]) # vcovs and coefficients w/o intercept vcovl <- lapply(x$vcov, function(x) x[coefs.no.int, coefs.no.int]) coefl <- as.list(data.frame(t(x$coefficients[ , coefs.no.int, drop = FALSE]))) df1 <- ncol(x$coefficients[ , coefs.no.int, drop = FALSE]) # ncol is same df1 for all models (as all models estimate the same coefs) df2 <- lengths(residl) - ncol(x$coefficients) # (any intercept is subtracted) statChisqs <- mapply(FUN = function(v, c) as.numeric(crossprod(solve(v, c), c)), vcovl, coefl) statFs <- statChisqs / df1 pstatChisqs <- pchisq(statChisqs, df = df1, lower.tail = FALSE) pstatFs <- pf(statFs, df1 = df1, df2 = df2, lower.tail = FALSE) stats.pvcm.within <- as.data.frame(cbind("Chisq" = statChisqs, "p(chisq)" = pstatChisqs, "F" = statFs, "p(F)" = pstatFs, "df1" = rep(df1, length(residl)), "df2" = df2)) # early return return(stats.pvcm.within) } ## case: model == "random" coefs_wo_int <- x$coefficients[coefs.no.int] stat <- as.numeric(crossprod(solve(vcov(x)[coefs.no.int, coefs.no.int], coefs_wo_int), coefs_wo_int)) names(stat) <- "Chisq" df1 <- length(coefs_wo_int) pval <- pchisq(stat, df = df1, lower.tail = FALSE) parameter <- c(df = df1) method <- "Wald test for joint significance" res <- list(data.name = data.name(x), statistic = stat, parameter = parameter, p.value = pval, method = method, alternative = "at least one coefficient is not null" ) class(res) <- "htest" return(res) } #' @rdname pwaldtest #' @export pwaldtest.pgmm <- function(x, param = c("coef", "time", "all"), vcov = NULL, ...) { param <- match.arg(param) vcov_supplied <- !is.null(vcov) myvcov <- vcov if (is.null(vcov)) vv <- vcov(x) else if (is.function(vcov)) vv <- myvcov(x) else vv <- myvcov model <- describe(x, "model") effect <- describe(x, "effect") if (param == "time" && effect == "individual") stop("no time dummies in this model") transformation <- describe(x, "transformation") coefficients <- if(model == "onestep") x$coefficients else x$coefficients[[2L]] Ktot <- length(coefficients) Kt <- length(x$args$namest) switch(param, "time" = { start <- Ktot - Kt + if(transformation == "ld") 2 else 1 end <- Ktot }, "coef" = { start <- 1 end <- if (effect == "twoways") Ktot - Kt else Ktot }, "all" = { start <- 1 end <- Ktot }) coef <- coefficients[start:end] vv <- vv[start:end, start:end] stat <- as.numeric(crossprod(coef, crossprod(solve(vv), coef))) names(stat) <- "chisq" parameter <- length(coef) names(parameter) <- "df" pval <- pchisq(stat, df = parameter, lower.tail = FALSE) method <- "Wald test for joint significance" if (vcov_supplied) { rvcov_name <- paste0(", vcov: ", paste0(deparse(substitute(vcov)))) method <- paste0(method, " (robust)", rvcov_name) } wald.pgmm <- list(statistic = stat, p.value = pval, parameter = parameter, method = method, alternative = "at least one coefficient is not null", data.name = data.name(x)) class(wald.pgmm) <- "htest" return(wald.pgmm) } pwaldtest.default <- function(x, ...) { pwaldtest.plm(x, ...) } # trans_clubSandwich_vcov: helper function for pwaldtest() # translate vcov object from package clubSandwich so it is suitable for summary.plm, plm's pwaldtest. # Attribute "cluster" in clubSandwich's vcov objects contains the cluster variable itself. # plm's vcov object also has attribute "cluster" but it contains a character as # information about the cluster dimension (either "group" or "time") # # inputs: # * CSvcov: a vcov as returned by clubSandwich's vcovCR function [class c("vcovCR", "clubSandwich")] # * index: the index belonging to a plm object/model # return value: # * modified CSvcov (substituted attribute "cluster" with suitable character or NULL) trans_clubSandwich_vcov <- function(CSvcov, index) { clustervar <- attr(CSvcov, "cluster") if (!is.null(clustervar)) { if (isTRUE(all.equal(index[[1L]], clustervar))) { attr(CSvcov, "cluster") <- "group" return(CSvcov) } if (isTRUE(all.equal(index[[2L]], clustervar))) { attr(CSvcov, "cluster") <- "time" return(CSvcov) } else { attr(CSvcov, "cluster") <- NULL return(CSvcov) } } warning("no attribute \"cluster\" found in supplied vcov object") return(CSvcov) } #' Test of Poolability #' #' A Chow test for the poolability of the data. #' #' `pooltest` is a *F* test of stability (or Chow test) for the #' coefficients of a panel model. For argument `x`, the estimated #' `plm` object should be a `"pooling"` model or a `"within"` model #' (the default); intercepts are assumed to be identical in the first #' case and different in the second case. #' #' @aliases pooltest #' @param x an object of class `"plm"` for the plm method; an object of #' class `"formula"` for the formula interface, #' @param z an object of class `"pvcm"` obtained with #' `model="within"`, #' @param data a `data.frame`, #' @param \dots further arguments passed to plm. #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant #' @keywords htest #' @examples #' #' data("Gasoline", package = "plm") #' form <- lgaspcar ~ lincomep + lrpmg + lcarpcap #' gasw <- plm(form, data = Gasoline, model = "within") #' gasp <- plm(form, data = Gasoline, model = "pooling") #' gasnp <- pvcm(form, data = Gasoline, model = "within") #' pooltest(gasw, gasnp) #' pooltest(gasp, gasnp) #' #' pooltest(form, data = Gasoline, effect = "individual", model = "within") #' pooltest(form, data = Gasoline, effect = "individual", model = "pooling") #' pooltest <- function(x,...){ UseMethod("pooltest") } #' @rdname pooltest #' @export pooltest.plm <- function(x, z, ...){ rss <- deviance(x) uss <- as.numeric(crossprod(residuals(z))) dlr <- df.residual(x) dlu <- df.residual(z) df1 <- dlr - dlu df2 <- dlu stat <- (rss-uss)/uss*df2/df1 pval <- pf(stat, df1 = df1, df2 = df2, lower.tail = FALSE) parameter <- c(df1 = df1, df2 = df2) names(stat) <- "F" res <- list(statistic = stat, parameter = parameter, p.value = pval, data.name = data.name(x), alternative = "unstability", method = "F statistic") class(res) <- "htest" res } #' @rdname pooltest #' @export pooltest.formula <- function(x, data, ...){ cl <- match.call(expand.dots = TRUE) cl[[1L]] <- as.name("plm") names(cl)[[2L]] <- "formula" if (is.null(cl$effect)) cl$effect <- "individual" plm.model <- eval(cl, parent.frame()) cl[[1L]] <- as.name("pvcm") names(cl)[[2L]] <- "formula" if (is.null(cl$effect)) cl$effect <- "individual" cl$model <- "within" pvcm.model <- eval(cl, parent.frame()) pooltest(plm.model, pvcm.model) } plm/R/is.pconsecutive_pbalanced.R0000644000176200001440000004260714155752700016517 0ustar liggesusers########### is.pconsecutive ############## # little helper function to determine if the time periods of an object are consecutive per id. # By consecutive we mean "consecutive in the numbers", i.e., is.pconsecutive takes the numerical # value of the time variable into account: t, t+1, t+2, ... where t is an integer # # For this, we need as.numeric(as.character(time_var)) where as.character is a crucial part! # Equivalent but more efficient is as.numeric(levels(id_timevar))[as.integer(id_timevar)] # (see R FAQ 7.10 for coercing factors to numeric] # and the coerction of time_var in this manner needs to be meaningful numbers. # # see also in separate file make.pconsecutive.R: # * make.pconsecutive # * make.pbalanced #' Check if time periods are consecutive #' #' This function checks for each individual if its associated time periods are #' consecutive (no "gaps" in time dimension per individual) #' #' (p)data.frame, pseries and estimated panelmodel objects can be tested if #' their time periods are consecutive per individual. For evaluation of #' consecutiveness, the time dimension is interpreted to be numeric, and the #' data are tested for being a regularly spaced sequence with distance 1 #' between the time periods for each individual (for each individual the time #' dimension can be interpreted as sequence t, t+1, t+2, \ldots{} where t is an #' integer). As such, the "numerical content" of the time index variable is #' considered for consecutiveness, not the "physical position" of the various #' observations for an individuals in the (p)data.frame/pseries (it is not #' about "neighbouring" rows). If the object to be evaluated is a pseries or a #' pdata.frame, the time index is coerced from factor via as.character to #' numeric, i.e., the series #' `as.numeric(as.character(index()[[2]]))]` is #' evaluated for gaps. #' #' The default method also works for argument `x` being an arbitrary #' vector (see **Examples**), provided one can supply arguments `id` #' and `time`, which need to ordered as stacked time series. As only #' `id` and `time` are really necessary for the default method to #' evaluate the consecutiveness, `x = NULL` is also possible. However, if #' the vector `x` is also supplied, additional input checking for equality #' of the lengths of `x`, `id` and `time` is performed, which is #' safer. #' #' For the data.frame interface, the data is ordered in the appropriate way #' (stacked time series) before the consecutiveness is evaluated. For the #' pdata.frame and pseries interface, ordering is not performed because both #' data types are already ordered in the appropriate way when created. #' #' Note: Only the presence of the time period itself in the object is tested, #' not if there are any other variables. `NA` values in individual index #' are not examined but silently dropped - In this case, it is not clear which #' individual is meant by id value `NA`, thus no statement about #' consecutiveness of time periods for those "`NA`-individuals" is #' possible. #' #' @name is.pconsecutive #' @aliases is.pconsecutive #' @param x usually, an object of class `pdata.frame`, #' `data.frame`, `pseries`, or an estimated #' `panelmodel`; for the default method `x` can also be #' an arbitrary vector or `NULL`, see **Details**, #' @param na.rm.tindex logical indicating whether any `NA` values #' in the time index are removed before consecutiveness is #' evaluated (defaults to `FALSE`), #' @param index only relevant for `data.frame` interface; if #' `NULL`, the first two columns of the data.frame are #' assumed to be the index variables; if not `NULL`, both #' dimensions ('individual', 'time') need to be specified by #' `index` for `is.pconsecutive` on data frames, for #' further details see [pdata.frame()], #' @param id,time only relevant for default method: vectors specifying #' the id and time dimensions, i. e., a sequence of individual and #' time identifiers, each as stacked time series, #' @param \dots further arguments. #' @return A named `logical` vector (names are those of the #' individuals). The i-th element of the returned vector #' corresponds to the i-th individual. The values of the i-th #' element can be: \item{TRUE}{if the i-th individual has #' consecutive time periods,} \item{FALSE}{if the i-th #' individual has non-consecutive time periods,} #' \item{"NA"}{if there are any NA values in time index of #' the i-th the individual; see also argument `na.rm.tindex` #' to remove those.} #' @export #' @author Kevin Tappe #' @seealso [make.pconsecutive()] to make data consecutive #' (and, as an option, balanced at the same time) and #' [make.pbalanced()] to make data balanced.\cr #' [pdim()] to check the dimensions of a 'pdata.frame' #' (and other objects), [pvar()] to check for individual #' and time variation of a 'pdata.frame' (and other objects), #' [lag()] for lagged (and leading) values of a #' 'pseries' object.\cr #' #' [pseries()], [data.frame()], [pdata.frame()], #' for class 'panelmodel' see [plm()] and [pgmm()]. #' @keywords attribute #' @examples #' #' data("Grunfeld", package = "plm") #' is.pconsecutive(Grunfeld) #' is.pconsecutive(Grunfeld, index=c("firm", "year")) #' #' # delete 2nd row (2nd time period for first individual) #' # -> non consecutive #' Grunfeld_missing_period <- Grunfeld[-2, ] #' is.pconsecutive(Grunfeld_missing_period) #' all(is.pconsecutive(Grunfeld_missing_period)) # FALSE #' #' # delete rows 1 and 2 (1st and 2nd time period for first individual) #' # -> consecutive #' Grunfeld_missing_period_other <- Grunfeld[-c(1,2), ] #' is.pconsecutive(Grunfeld_missing_period_other) # all TRUE #' #' # delete year 1937 (3rd period) for _all_ individuals #' Grunfeld_wo_1937 <- Grunfeld[Grunfeld$year != 1937, ] #' is.pconsecutive(Grunfeld_wo_1937) # all FALSE #' #' # pdata.frame interface #' pGrunfeld <- pdata.frame(Grunfeld) #' pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) #' is.pconsecutive(pGrunfeld) # all TRUE #' is.pconsecutive(pGrunfeld_missing_period) # first FALSE, others TRUE #' #' #' # panelmodel interface (first, estimate some models) #' mod_pGrunfeld <- plm(inv ~ value + capital, data = Grunfeld) #' mod_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = Grunfeld_missing_period) #' #' is.pconsecutive(mod_pGrunfeld) #' is.pconsecutive(mod_pGrunfeld_missing_period) #' #' nobs(mod_pGrunfeld) # 200 #' nobs(mod_pGrunfeld_missing_period) # 199 #' #' #' # pseries interface #' pinv <- pGrunfeld$inv #' pinv_missing_period <- pGrunfeld_missing_period$inv #' #' is.pconsecutive(pinv) #' is.pconsecutive(pinv_missing_period) #' #' # default method for arbitrary vectors or NULL #' inv <- Grunfeld$inv #' inv_missing_period <- Grunfeld_missing_period$inv #' is.pconsecutive(inv, id = Grunfeld$firm, time = Grunfeld$year) #' is.pconsecutive(inv_missing_period, id = Grunfeld_missing_period$firm, #' time = Grunfeld_missing_period$year) #' #' # (not run) demonstrate mismatch lengths of x, id, time #' # is.pconsecutive(x = inv_missing_period, id = Grunfeld$firm, time = Grunfeld$year) #' #' # only id and time are needed for evaluation #' is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) #' is.pconsecutive <- function(x, ...){ UseMethod("is.pconsecutive") } #' @rdname is.pconsecutive #' @export is.pconsecutive.default <- function(x, id, time, na.rm.tindex = FALSE, ...) { # argument 'x' just used for input check (if it is not NULL and is atomic) # input checks if(length(id) != length(time)) stop(paste0("arguments 'id' and 'time' must have same length: length(id): ", length(id), ", length(time) ", length(time))) if(!is.null(x) && is.atomic(x)) { # is.atomic was once is.vector, but is.vector is too strict as a factor is not a vector if(!(length(x) == length(id) && length(x) == length(time) && length(id) == length(time))) stop(paste0("arguments 'x', 'id', 'time' must have same length: length(x): ", length(x), ", length(id): ", length(id), ", length(time): ", length(time))) } # NB: 'time' is assumed to be organised as stacked time series (sorted for each individual) # (successive blocks of individuals, each block being a time series for the respective individual)) # # 'time' is in the correct order if is.pconsecutive.default is called by # is.pconsecutive.pdata.frame or is.pconsecutive.pseries as a pdata.frame (which is sorted) was constructed # in the first place; for data.frame interface the ordering is done in the respective function if(na.rm.tindex) { NA_tindex <- is.na(time) time <- time[!NA_tindex] id <- id[!NA_tindex] } # if time var is factor (as is TRUE for pdata.frames, pseries): # need to convert to numeric, do this by coering to character first (otherwise wrong results!) # see R FAQ 7.10 for coercing factors to numeric: # as.numeric(levels(factor_var))[as.integer(factor_var)] is more efficient than # as.numeric(as.character(factor_var)) if(!is.numeric(time) && is.factor(time)) time <- as.numeric(levels(time))[as.integer(time)] list_id_timevar <- split(time, id, drop = TRUE) res <- vapply(list_id_timevar, function(id_timevar) { if(anyNA(id_timevar)) { NA # return NA if NA found in the time periods for individual } else { begin <- id_timevar[1L] end <- id_timevar[length(id_timevar)] # compare to length(original id_timevar) to find out if times are consecutive (end - begin + 1L) == length(id_timevar) # Alternative way of checking: # consecutive time periods from begin to end (if id_timevar were consecutive) # consecutive <- seq(from = begin, to = end, by = 1) # length(consecutive) == length(id_timevar) } }, FUN.VALUE = TRUE) return(res) } #' @rdname is.pconsecutive #' @export is.pconsecutive.data.frame <- function(x, index = NULL, na.rm.tindex = FALSE, ...){ if (!is.null(index) && length(index) != 2L) stop("if argument 'index' is not NULL, 'index' needs to specify 'individual' and 'time' dimension for is.pconsecutive to work on a data.frame") # if index not provided, assume first two columns to be the index vars index_orig_names <- if(is.null(index)) names(x)[1:2] else index id <- x[ , index_orig_names[1L]] time <- x[ , index_orig_names[2L]] # order as stacked time series (by id and time) first, otherwise default method does not work correctly! ord <- order(id, time) x_ordered <- x[ord, ] id_ordered <- id[ord] time_ordered <- time[ord] # if (!identical(x, x_ordered)) # print("Note: for test of consecutiveness of time periods, the data.frame was ordered by index variables (id, time)") return(is.pconsecutive.default(x_ordered, id_ordered, time_ordered, na.rm.tindex = na.rm.tindex, ...)) } #' @rdname is.pconsecutive #' @export is.pconsecutive.pseries <- function(x, na.rm.tindex = FALSE, ...){ index <- unclass(attr(x, "index")) # unclass for speed return(is.pconsecutive.default(x, index[[1L]], index[[2L]], na.rm.tindex = na.rm.tindex, ...)) } #' @rdname is.pconsecutive #' @export is.pconsecutive.pdata.frame <- function(x, na.rm.tindex = FALSE, ...){ index <- unclass(attr(x, "index")) # unclass for speed return(is.pconsecutive.default(x, index[[1L]], index[[2L]], na.rm.tindex = na.rm.tindex, ...)) } #' @rdname is.pconsecutive #' @export is.pconsecutive.panelmodel <- function(x, na.rm.tindex = FALSE, ...){ index <- unclass(attr(x$model, "index")) # unclass for speed # can determine solely based on indexes: return(is.pconsecutive.default(NULL, index[[1L]], index[[2L]], na.rm.tindex = na.rm.tindex, ...)) } ########### is.pbalanced ############## ### for convenience and to be faster than pdim() for the purpose ### of the determination of balancedness only, because it avoids ### pdim()'s calculations which are unnecessary for balancedness. ### ### copied (and adapted) methods and code from pdim.* ### (only relevant parts to determine balancedness) #' Check if data are balanced #' #' This function checks if the data are balanced, i.e., if each individual has #' the same time periods #' #' Balanced data are data for which each individual has the same time periods. #' The returned values of the `is.pbalanced(object)` methods are identical #' to `pdim(object)$balanced`. `is.pbalanced` is provided as a short #' cut and is faster than `pdim(object)$balanced` because it avoids those #' computations performed by `pdim` which are unnecessary to determine the #' balancedness of the data. #' #' @aliases is.pbalanced #' @param x an object of class `pdata.frame`, `data.frame`, #' `pseries`, `panelmodel`, or `pgmm`, #' @param y (only in default method) the time index variable (2nd index #' variable), #' @param index only relevant for `data.frame` interface; if #' `NULL`, the first two columns of the data.frame are #' assumed to be the index variables; if not `NULL`, both #' dimensions ('individual', 'time') need to be specified by #' `index` as character of length 2 for data frames, for #' further details see [pdata.frame()], #' @param \dots further arguments. #' @return A logical indicating whether the data associated with #' object `x` are balanced (`TRUE`) or not #' (`FALSE`). #' @seealso [punbalancedness()] for two measures of #' unbalancedness, [make.pbalanced()] to make data #' balanced; [is.pconsecutive()] to check if data are #' consecutive; [make.pconsecutive()] to make data #' consecutive (and, optionally, also balanced).\cr #' [pdim()] to check the dimensions of a 'pdata.frame' #' (and other objects), [pvar()] to check for individual #' and time variation of a 'pdata.frame' (and other objects), #' [pseries()], [data.frame()], #' [pdata.frame()]. #' @export #' @keywords attribute #' @examples #' #' # take balanced data and make it unbalanced #' # by deletion of 2nd row (2nd time period for first individual) #' data("Grunfeld", package = "plm") #' Grunfeld_missing_period <- Grunfeld[-2, ] #' is.pbalanced(Grunfeld_missing_period) # check if balanced: FALSE #' pdim(Grunfeld_missing_period)$balanced # same #' #' # pdata.frame interface #' pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) #' is.pbalanced(Grunfeld_missing_period) #' #' # pseries interface #' is.pbalanced(pGrunfeld_missing_period$inv) #' is.pbalanced <- function(x, ...) { UseMethod("is.pbalanced") } #' @rdname is.pbalanced #' @export is.pbalanced.default <- function(x, y, ...) { if (length(x) != length(y)) stop("The length of the two inputs differs\n") x <- x[drop = TRUE] # drop unused factor levels so that table y <- y[drop = TRUE] # gives only needed combinations z <- table(x, y) balanced <- if(any(v <- as.vector(z) == 0L)) FALSE else TRUE if (any(v > 1L)) warning("duplicate couples (id-time)\n") return(balanced) } #' @rdname is.pbalanced #' @export is.pbalanced.data.frame <- function(x, index = NULL, ...) { x <- pdata.frame(x, index) index <- unclass(attr(x, "index")) # unclass for speed return(is.pbalanced(index[[1L]], index[[2L]])) } #' @rdname is.pbalanced #' @export is.pbalanced.pdata.frame <- function(x, ...) { index <- unclass(attr(x, "index")) # unclass for speed return(is.pbalanced(index[[1L]], index[[2L]])) } #' @rdname is.pbalanced #' @export is.pbalanced.pseries <- function(x, ...) { index <- unclass(attr(x, "index")) # unclass for speed return(is.pbalanced(index[[1L]], index[[2L]])) } #' @rdname is.pbalanced #' @export is.pbalanced.pggls <- function(x, ...) { # pggls is also class panelmodel, but take advantage of its pdim attribute return(attr(x, "pdim")$balanced) } #' @rdname is.pbalanced #' @export is.pbalanced.pcce <- function(x, ...) { # pcce is also class panelmodel, but take advantage of its pdim attribute return(attr(x, "pdim")$balanced) } #' @rdname is.pbalanced #' @export is.pbalanced.pmg <- function(x, ...) { # pmg is also class panelmodel, but take advantage of its pdim attribute return(attr(x, "pdim")$balanced) } #' @rdname is.pbalanced #' @export is.pbalanced.pgmm <- function(x, ...) { # pgmm is also class panelmodel, but take advantage of its pdim attribute return(attr(x, "pdim")$balanced) } #' @rdname is.pbalanced #' @export is.pbalanced.panelmodel <- function(x, ...) { x <- model.frame(x) return(is.pbalanced(x)) } plm/R/tool_transformations.R0000644000176200001440000011364214164705300015663 0ustar liggesusers## This file contains the relevant transformations used for panel data, ## namely of course Within and between/Between, but also Sum (useful for ## unbalanced panels). ## They are all generics and have default, pseries and matrix ## methods. The effect argument is an index vector for the default method ## and a character ("individual", "time", "group", "twoways") for the ## pseries method. It can be any of the two for the matrix method (the ## second one only if the matrix argument has an index attribute ## diff, lag and lead methods for pseries are also provided (lead is a ## generic exported by plm, lag and diff being generic exported by ## stats). All of them have a shift argument which can be either "time" ## or "row". #' panel series #' #' A class for panel series for which several useful computations and #' data transformations are available. #' #' The functions `between`, `Between`, `Within`, and `Sum` perform specific #' data transformations, i. e., the between, within, and sum transformation, #' respectively. #' #' `between` returns a vector/matrix containing the individual means (over #' time) with the length of the vector equal to the number of #' individuals (if `effect = "individual"` (default); if `effect = "time"`, #' it returns the time means (over individuals)). `Between` #' duplicates the values and returns a vector/matrix which length/number of rows #' is the number of total observations. `Within` returns a vector/matrix #' containing the values in deviation from the individual means #' (if `effect = "individual"`, from time means if `effect = "time"`), the so #' called demeaned data. `Sum` returns a vector/matrix with sum per individual #' (over time) or the sum per time period (over individuals) with #' `effect = "individual"` or `effect = "time"`, respectively, and has length/ #' number of rows of the total observations (like `Between`). #' #' For `between`, `Between`, `Within`, and `Sum` in presence of NA values it #' can be useful to supply `na.rm = TRUE` as an additional argument to #' keep as many observations as possible in the resulting transformation. #' na.rm is passed on to the mean()/sum() function used by these transformations #' (i.e., it does not remove NAs prior to any processing!), see also #' **Examples**. #' #' @name pseries #' @aliases pseries #' @param x,object a `pseries` or a matrix; or a `summary.pseries` object, #' @param effect for the pseries methods: character string indicating the #' `"individual"`, `"time"`, or `"group"` effect, for `Within` #' `"twoways"` additionally; for non-pseries methods, `effect` is a factor #' specifying the dimension (`"twoways"` is not possible), #' @param idbyrow if `TRUE` in the `as.matrix` method, the lines of #' the matrix are the individuals, #' @param plot,scale,transparency,col,lwd plot arguments, #' @param \dots further arguments, e. g., `na.rm = TRUE` for #' transformation functions like `beetween`, see **Details** #' and **Examples**. #' @return All these functions return an object of class `pseries` or a matrix, #' except:\cr `between`, which returns a numeric vector or a matrix; #' `as.matrix`, which returns a matrix. #' @author Yves Croissant #' @seealso [is.pseries()] to check if an object is a pseries. For #' more functions on class 'pseries' see [lag()], [lead()], #' [diff()] for lagging values, leading values (negative lags) and #' differencing. #' @keywords classes #' @examples #' #' # First, create a pdata.frame #' data("EmplUK", package = "plm") #' Em <- pdata.frame(EmplUK) #' #' # Then extract a series, which becomes additionally a pseries #' z <- Em$output #' class(z) #' #' # obtain the matrix representation #' as.matrix(z) #' #' # compute the between and within transformations #' between(z) #' Within(z) #' #' # Between and Sum replicate the values for each time observation #' Between(z) #' Sum(z) #' #' # between, Between, Within, and Sum transformations on other dimension #' between(z, effect = "time") #' Between(z, effect = "time") #' Within(z, effect = "time") #' Sum(z, effect = "time") #' #' # NA treatment for between, Between, Within, and Sum #' z2 <- z #' z2[length(z2)] <- NA # set last value to NA #' between(z2, na.rm = TRUE) # non-NA value for last individual #' Between(z2, na.rm = TRUE) # only the NA observation is lost #' Within(z2, na.rm = TRUE) # only the NA observation is lost #' Sum(z2, na.rm = TRUE) # only the NA observation is lost #' #' sum(is.na(Between(z2))) # 9 observations lost due to one NA value #' sum(is.na(Between(z2, na.rm = TRUE))) # only the NA observation is lost #' sum(is.na(Within(z2))) # 9 observations lost due to one NA value #' sum(is.na(Within(z2, na.rm = TRUE))) # only the NA observation is lost #' sum(is.na(Sum(z2))) # 9 observations lost due to one NA value #' sum(is.na(Sum(z2, na.rm = TRUE))) # only the NA observation is lost #' NULL #' @rdname pseries #' @export print.pseries <- function(x, ...){ x.orig <- x attr(x, "index") <- NULL attr(x, "class") <- base::setdiff(attr(x, "class"), "pseries") if(length(attr(x, "class")) == 1L && class(x) %in% c("character", "logical", "numeric", "integer", "complex")) { attr(x, "class") <- NULL } print(x, ...) x.orig } #' @rdname pseries #' @export as.matrix.pseries <- function(x, idbyrow = TRUE, ...){ index <- unclass(attr(x, "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] time.names <- levels(time) x <- split(data.frame(x, time), id) x <- lapply(x, function(x){ rownames(x) <- x[ , 2L] x[ , -2L, drop = FALSE] }) x <- lapply(x, function(x){ x <- x[time.names, , drop = FALSE] rownames(x) <- time.names x } ) id.names <- names(x) x <- as.matrix(as.data.frame((x))) colnames(x) <- id.names if(idbyrow) x <- t(x) x } ## plots a panel series by time index ## ## can supply any panel function, e.g., a loess smoother ## > mypanel<-function(x,...) { ## + panel.xyplot(x,...) ## + panel.loess(x, col="red", ...)} ## > ## > plot(pres(mod), panel=mypanel) #' @rdname pseries #' @importFrom lattice xyplot #' @export plot.pseries <- function(x, plot = c("lattice", "superposed"), scale = FALSE, transparency = TRUE, col = "blue", lwd = 1, ...) { if(scale) { scalefun <- function(x) scale(x) } else { scalefun <- function(x) return(x)} nx <- as.numeric(x) ind <- attr(x, "index")[[1L]] tind <- attr(x, "index")[[2L]] # possibly as.numeric(): # activates autom. tick # but loses time labels xdata <- data.frame(nx = nx, ind = ind, tind = tind) switch(match.arg(plot), "lattice" = { ##require(lattice) # make a ggplot2 version xyplot(nx ~ tind | ind, data = xdata, type = "l", col = col, ...) }, "superposed" = { ylim <- c(min(tapply(scalefun(nx), ind, min, na.rm = TRUE)), max(tapply(scalefun(nx), ind, max, na.rm = TRUE))) unind <- unique(ind) nx1 <- nx[ind == unind[1L]] tind1 <- as.numeric(tind[ind == unind[1L]]) ## plot empty plot to provide frame plot(NA, xlim = c(min(as.numeric(tind)), max(as.numeric(tind))), ylim = ylim, xlab = "", ylab = "", xaxt = "n", ...) axis(1, at = as.numeric(unique(tind)), labels = unique(tind)) ## determine lwd and transparency level as a function ## of n if(transparency) { alpha <- 5 / length(unind) col <- heat.colors(1, alpha = alpha) lwd <- length(unind) / 10 } ## plot lines (notice: tind. are factors, so they ## retain the correct labels which would be lost if ## using as.numeric for(i in 1:length(unind)) { nxi <- nx[ind == unind[i]] tindi <- tind[ind == unind[i]] lines(x = tindi, y = scalefun(nxi), col = col, lwd = lwd, ...) } }) } #' @rdname pseries #' @export summary.pseries <- function(object, ...) { if(!inherits(object, c("factor", "logical", "character"))) { index <- unclass(attr(object, "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] Bid <- Between(object, na.rm = TRUE) Btime <- Between(object, effect = "time", na.rm = TRUE) ## res <- structure(c(total = sumsq(object), ## between_id = sumsq(Bid), ## between_time = sumsq(Btime)), ## class = c("summary.pseries", "numeric")) res <- structure(c(total = sum( (na.omit(object) - mean(object, na.rm = TRUE)) ^ 2), between_id = sum( (na.omit(Bid) - mean(Bid, na.rm = TRUE)) ^ 2), between_time = sum( (na.omit(Btime) - mean(Btime, na.rm = TRUE)) ^ 2)), class = c("summary.pseries", "numeric")) } else { class(object) <- setdiff(class(object), c("pseries")) res <- summary(object, ...) class(res) <- c("summary.pseries", class(object), class(res)) } return(res) } #' @rdname pseries #' @export plot.summary.pseries <- function(x, ...){ x <- as.numeric(x) share <- x[-1L]/x[1L] # vec with length == 2 names(share) <- c("id", "time") barplot(share, ...) } #' @rdname pseries #' @export print.summary.pseries <- function(x, ...){ x.orig <- x digits <- getOption("digits") special_treatment_vars <- c("factor", "logical", "character") if(!inherits(x, special_treatment_vars)) { x <- as.numeric(x) share <- x[-1L]/x[1L] # vec with length == 2 names(share) <- c("id", "time") cat(paste("total sum of squares:", signif(x[1L], digits = digits),"\n")) print.default(share, ...) } else { class(x) <- setdiff(class(x), c("summary.pseries", special_treatment_vars)) print(x, ...) } invisible(x.orig) } Tapply <- function(x, ...) { UseMethod("Tapply") } myave <- function(x, ...) { UseMethod("myave") } Tapply.default <- function(x, effect, func, ...) { # argument 'effect' is assumed to be a factor na.x <- is.na(x) uniqval <- tapply(x, effect, func, ...) nms <- attr(uniqval, "dimnames")[[1L]] attr(uniqval, "dimnames") <- attr(uniqval, "dim") <- NULL names(uniqval) <- nms result <- uniqval[as.character(effect)] result[na.x] <- NA return(result) } #' @importFrom stats ave myave.default <- function(x, effect, func, ...) { # argument 'effect' is assumed to be a factor na.x <- is.na(x) res <- ave(x, effect, FUN = function(x) func(x, ...)) names(res) <- as.character(effect) res[na.x] <- NA return(res) } Tapply.pseries <- function(x, effect = c("individual", "time", "group"), func, ...){ effect <- match.arg(effect) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA effect <- switch(effect, "individual"= xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]] ) z <- as.numeric(x) z <- Tapply.default(z, effect, func, ...) attr(z, "index") <- attr(x, "index") # insert original index class(z) <- c("pseries", class(z)) return(z) } myave.pseries <- function(x, effect = c("individual", "time", "group"), func, ...) { effect <- match.arg(effect) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA eff.fac <- switch(effect, "individual"= xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]] ) z <- as.numeric(x) z <- myave.default(z, eff.fac, func, ...) attr(z, "index") <- attr(x, "index") # insert original index class(z) <- c("pseries", class(z)) return(z) } Tapply.matrix <- function(x, effect, func, ...) { # argument 'effect' is assumed to be a factor na.x <- is.na(x) uniqval <- apply(x, 2, tapply, effect, func, ...) result <- uniqval[as.character(effect), , drop = FALSE] result[na.x] <- NA_real_ return(result) } myave.matrix <- function(x, effect, func, ...) { # argument 'effect' is assumed to be a factor na.x <- is.na(x) result <- apply(x, 2, FUN = function(x) ave(x, effect, FUN = function(y) func(y, ...))) rownames(result) <- as.character(effect) result[na.x] <- NA_real_ return(result) } ## non-exported Mean <- function(x) matrix(.colMeans(x, nrow(x), ncol(x)), nrow(x), ncol(x), byrow = TRUE) #' @rdname pseries #' @export Sum <- function(x, ...) { UseMethod("Sum") } #' @rdname pseries #' @export Sum.default <- function(x, effect, ...) { # print("Sum.default(.baseR)") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The Sum function only applies to numeric vectors") # Tapply(x, effect, sum, ...) return(myave(x, droplevels(effect), sum, ...)) } #' @rdname pseries #' @export Sum.pseries <- function(x, effect = c("individual", "time", "group"), ...) { # print("Sum.pseries(.baseR)") # browser() effect <- match.arg(effect) # Tapply(x, effect, sum, ...) # myave.pseries takes care of checking the index for NAs return(myave(x, effect, sum, ...)) } #' @rdname pseries #' @export Sum.matrix <- function(x, effect, ...) { # print("Sum.matrix(.baseR)") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { droplevels(effect) } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a between transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } return(myave(x, eff.fac, sum, ...)) } #' @rdname pseries #' @export Between <- function(x, ...) { UseMethod("Between") } #' @rdname pseries #' @export Between.default <- function(x, effect, ...) { # print("Between.default(.baseR)") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The Between function only applies to numeric vectors") # Tapply(x, effect, mean, ...) return(myave(x, droplevels(effect), mean, ...)) } #' @rdname pseries #' @export Between.pseries <- function(x, effect = c("individual", "time", "group"), ...) { # print("Between.pseries(.baseR)") # browser() effect <- match.arg(effect) # Tapply(x, effect = effect, mean, ...) # myave.pseries takes care of checking the index for NAs return(myave(x, effect = effect, mean, ...)) } #' @rdname pseries #' @export Between.matrix <- function(x, effect, ...) { # print("Between.matrix(.baseR)") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { droplevels(effect) } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a between transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } return(myave.matrix(x, eff.fac, mean, ...)) } #' @rdname pseries #' @export between <- function(x, ...) { UseMethod("between") } #' @rdname pseries #' @export between.default <- function(x, effect, ...) { # print("between.default(.baseR)") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The between function only applies to numeric vectors") # use tapply here as tapply's output is sorted by levels factor effect (unlike ave's output) # difference is only relevant for between (small "b") as data is compressed down to # levels res <- tapply(x, droplevels(effect), mean, ...) nms <- attr(res, "dimnames")[[1L]] attr(res, "dimnames") <- attr(res, "dim") <- NULL names(res) <- nms return(res) } #' @rdname pseries #' @export between.pseries <- function(x, effect = c("individual", "time", "group"), ...) { # print("between.pseries(.baseR)") # browser() effect <- match.arg(effect) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA eff.fac <- switch(effect, "individual" = xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]], ) res <- between.default(x, effect = eff.fac, ...) # data compressed by transformation, so pseries features, esp. index, do not make sense res <- remove_pseries_features(res) return(res) } #' @rdname pseries #' @export between.matrix <- function(x, effect, ...) { # print("between.matrix(.baseR)") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { droplevels(effect) } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a between transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } # use tapply here as tapply's output is sorted by levels factor effect (unlike ave's output) # difference is only relevant for between (small "b") as data is compressed down to # levels res <- apply(x, 2, tapply, eff.fac, mean, ...) return(res) } #' @rdname pseries #' @export Within <- function(x, ...) { UseMethod("Within") } #' @rdname pseries #' @export Within.default <- function(x, effect, ...) { # print("Within.default(.baseR)") # browser() # arg 'effect' is assumed to be a factor # NB: Contrary to the other Within.* methods, Within.default does not handle # twoways effects # TODO: could add support for twoways by supplying a list containing two factors if(!is.numeric(x)) stop("the within function only applies to numeric vectors") return(x - Between(x, droplevels(effect), ...)) } #' @rdname pseries #' @export Within.pseries <- function(x, effect = c("individual", "time", "group", "twoways"), ...) { # print("Within.pseries(.baseR)") # browser() effect <- match.arg(effect) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") result <- x - Between(x, effect, ...) else { if(is.pbalanced(x)) result <- x - Between(x, "individual", ...) - Between(x, "time") + mean(x, ...) else { time <- xindex[[2L]] Dmu <- model.matrix(~ time - 1) attr(Dmu, "index") <- attr(x, "index") # need original index W1 <- Within(x, "individual", ...) WDmu <- Within(Dmu, "individual", ...) W2 <- lm.fit(WDmu, x)$fitted.values result <- W1 - W2 } } return(result) } #' @rdname pseries #' @export Within.matrix <- function(x, effect, ...) { # print("Within.matrix(.baseR)") # browser() if(is.null(xindex <- unclass(attr(x, "index")))) { # unclass for speed # non-index case result <- Within.default(x, effect, ...) # NB: effect is assumed to be a factor; contrary to the other Within.* # methods, Within.default does not handle twoways effects } else { # index case if(effect %in% c("individual", "time", "group")) result <- x - Between(x, effect, ...) if(effect == "twoways") { checkNA.index(xindex) # index may not contain any NA if(is.pbalanced(xindex[[1L]], xindex[[2L]])) { result <- x - Between(x, "individual", ...) - Between(x, "time", ...) + matrix(colMeans(x, ...), nrow = nrow(x), ncol = ncol(x), byrow = TRUE) } else { # unbalanced twoways time <- xindex[[2L]] Dmu <- model.matrix(~ time - 1) attr(Dmu, "index") <- attr(x, "index") # need orig. index here W1 <- Within(x, "individual", ...) WDmu <- Within(Dmu, "individual", ...) W2 <- lm.fit(WDmu, x)$fitted.values result <- W1 - W2 } } } return(result) } ############### LAG and DIFF # # lag/lead/diff for pseries are a wrappers for lagt, leadt, difft (if shift = "time") and # for lagr, leadr, diffr (if shift = "row") # # The "t" and "r" methods are not exported (by intention). # # The "t" methods perform shifting while taking the time period into # account (they "look" at the value in the time dimension). # # The "r" methods perform shifting row-wise (without taking the value # in the time dimension into account). # # Generic needed only for lead (lag and diff generics are already included in base R) #' lag, lead, and diff for panel data #' #' lag, lead, and diff functions for class pseries. #' #' This set of functions perform lagging, leading (lagging in the #' opposite direction), and differencing operations on `pseries` #' objects, i. e., they take the panel structure of the data into #' account by performing the operations per individual. #' #' Argument `shift` controls the shifting of observations to be used #' by methods `lag`, `lead`, and `diff`: #' #' - `shift = "time"` (default): Methods respect the #' numerical value in the time dimension of the index. The time #' dimension needs to be interpretable as a sequence t, t+1, t+2, #' \ldots{} where t is an integer (from a technical viewpoint, #' `as.numeric(as.character(index(your_pdata.frame)[[2]]))` needs to #' result in a meaningful integer). #' #' - `shift = "row": `Methods perform the shifting operation based #' solely on the "physical position" of the observations, #' i.e., neighbouring rows are shifted per individual. The value in the #' time index is not relevant in this case. #' #' For consecutive time periods per individual, a switch of shifting #' behaviour results in no difference. Different return values will #' occur for non-consecutive time periods per individual #' ("holes in time"), see also Examples. #' #' @name lag.plm #' @aliases lag lead diff #' @importFrom stats lag #' @param x a `pseries` object, #' @param k an integer, the number of lags for the `lag` and `lead` #' methods (can also be negative). For the `lag` method, a #' positive (negative) `k` gives lagged (leading) values. For the #' `lead` method, a positive (negative) `k` gives leading (lagged) #' values, thus, `lag(x, k = -1L)` yields the same as `lead(x, k = 1L)`. #' If `k` is an integer with length > 1 (`k = c(k1, k2, ...)`), a #' `matrix` with multiple lagged `pseries` is returned, #' @param lag integer, the number of lags for the `diff` method, can also be of #' length > 1 (see argument `k`) (only non--negative values in #' argument `lag` are allowed for `diff`), #' @param shift character, either `"time"` (default) or `"row"` #' determining how the shifting in the `lag`/`lead`/`diff` #' functions is performed (see Details and Examples). #' @param ... further arguments (currently none evaluated). #' @return #' #' - An object of class `pseries`, if the argument specifying the lag #' has length 1 (argument `k` in functions `lag` and `lead`, #' argument `lag` in function `diff`). #' #' - A matrix containing the various series in its columns, if the #' argument specifying the lag has length > 1. #' #' @note The sign of `k` in `lag.pseries` results in inverse behaviour #' compared to [stats::lag()] and [zoo::lag.zoo()]. #' @author Yves Croissant and Kevin Tappe #' @seealso To check if the time periods are consecutive per #' individual, see [is.pconsecutive()]. #' #' For further function for 'pseries' objects: [between()], #' [Between()], [Within()], [summary.pseries()], #' [print.summary.pseries()], [as.matrix.pseries()]. #' @keywords classes #' @examples #' #' # First, create a pdata.frame #' data("EmplUK", package = "plm") #' Em <- pdata.frame(EmplUK) #' #' # Then extract a series, which becomes additionally a pseries #' z <- Em$output #' class(z) #' #' # compute the first and third lag, and the difference lagged twice #' lag(z) #' lag(z, 3L) #' diff(z, 2L) #' #' # compute negative lags (= leading values) #' lag(z, -1L) #' lead(z, 1L) # same as line above #' identical(lead(z, 1L), lag(z, -1L)) # TRUE #' #' # compute more than one lag and diff at once (matrix returned) #' lag(z, c(1L,2L)) #' diff(z, c(1L,2L)) #' #' ## demonstrate behaviour of shift = "time" vs. shift = "row" #' # delete 2nd time period for first individual (1978 is missing (not NA)): #' Em_hole <- Em[-2L, ] #' is.pconsecutive(Em_hole) # check: non-consecutive for 1st individual now #' #' # original non-consecutive data: #' head(Em_hole$emp, 10) #' # for shift = "time", 1-1979 contains the value of former 1-1977 (2 periods lagged): #' head(lag(Em_hole$emp, k = 2L, shift = "time"), 10L) #' # for shift = "row", 1-1979 contains NA (2 rows lagged (and no entry for 1976): #' head(lag(Em_hole$emp, k = 2L, shift = "row"), 10L) #' NULL #' @rdname lag.plm #' @export lead <- function(x, k = 1L, ...) { UseMethod("lead") } #' @rdname lag.plm #' @exportS3Method #' @export lag lag.pseries <- function(x, k = 1L, shift = c("time", "row"), ...) { shift <- match.arg(shift) res <- if(shift == "time") lagt.pseries(x = x, k = k, ...) else lagr.pseries(x = x, k = k, ...) return(res) } #' @rdname lag.plm #' @export lead.pseries <- function(x, k = 1L, shift = c("time", "row"), ...) { shift <- match.arg(shift) res <- if(shift == "time") leadt.pseries(x = x, k = k, ...) else leadr.pseries(x = x, k = k, ...) return(res) } #' @rdname lag.plm #' @exportS3Method diff.pseries <- function(x, lag = 1L, shift = c("time", "row"), ...) { shift <- match.arg(shift) res <- if(shift == "time") difft.pseries(x = x, lag = lag, ...) else diffr.pseries(x = x, lag = lag, ...) return(res) } ## lagt.pseries lagging taking the time variable into account lagt.pseries <- function(x, k = 1L, ...) { index <- unclass(attr(x, "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] if(length(k) > 1L) { rval <- sapply(k, function(i) alagt(x, i)) colnames(rval) <- k } else { rval <- alagt(x, k) } return(rval) } ## leadt.pseries(x, k) is a wrapper for lagt.pseries(x, -k) leadt.pseries <- function(x, k = 1L, ...) { ret <- lagt.pseries(x, k = -k) if(length(k) > 1L) colnames(ret) <- k return(ret) } ## difft: diff-ing taking the time variable into account difft.pseries <- function(x, lag = 1L, ...){ ## copied/adapted from diffr.pseries except lines which use lagt() ("t") instead of lagr() ("r") islogi <- is.logical(x) if(! (is.numeric(x) || islogi)) stop("diff is only relevant for numeric or logical series") non.int <- vapply(lag, function(l) round(l) != l, FUN.VALUE = TRUE, USE.NAMES = FALSE) if(any(non.int)) stop("Lagging value(s) in 'lag' must be whole-numbered (and non-negative)") # prevent input of negative values, because it will most likely confuse users # what difft would do in this case neg <- vapply(lag, function(l) l < 0L, FUN.VALUE = TRUE, USE.NAMES = FALSE) if(any(neg)) stop("diff is only relevant for non-negative values in 'lag'") lagtx <- lagt.pseries(x, k = lag) # use "time-based" lagging for difft if(is.matrix(lagtx)) { # if 'lagtx' is matrix (case length(lag) > 1): # perform subtraction without pseries feature of 'x', because otherwise # the result would be c("pseries", "matrix") which is not supported res <- as.numeric(x) - lagtx } else { res <- x - lagtx } return(res) } ## alagt: non-exported helper function for lagt (actual work horse), ## performs shifting of observations while respecting the time dimension alagt <- function(x, ak) { if(round(ak) != ak) stop("Lagging value 'k' must be whole-numbered (positive, negative or zero)") if(ak != 0) { index <- unclass(attr(x, "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] # Idea: split times in blocks per individuals and do lagging there # by computation of correct time shifting # need to convert to numeric, do this by coercing to character # first (otherwise wrong results!) # see R FAQ 7.10 for coercing factors to numeric: # as.numeric(levels(factor_var))[as.integer(factor_var)] is # more efficient than # as.numeric(as.character(factor_var)) # YC 2019/08/29 only works if time values can be coerced to ## numeric, ie integers like years. When year is period (ie 5 years), ## values used to be 1950 for the 1950-54 period, time is now a ## factor in the original data.frame with levels "1950-54", ## "1955-59", ... In this case coercing the levels to a numeric gives ## NA so coerce the *factor* to a numeric. levtime <- levels(time) numlevtime <- suppressWarnings(as.numeric(levtime)) if(! anyNA(numlevtime)) time <- as.numeric(levels(time))[as.integer(time)] else time <- as.numeric(time) list_id_timevar <- split(time, id, drop = TRUE) index_lag_ak_all_list <- sapply(list_id_timevar, function(x) match(x - ak, x, incomparables = NA), simplify = FALSE, USE.NAMES = FALSE) # translate block-wise positions to positions in full vector index_lag_ak_all <- unlist(index_lag_ak_all_list, use.names = FALSE) NApos <- is.na(index_lag_ak_all) # save NA positions for later substitute_blockwise <- index_lag_ak_all block_lengths <- vapply(index_lag_ak_all_list, length, FUN.VALUE = 0.0, USE.NAMES = FALSE) # not needed but leave here for illustration: # startpos_block <- cumsum(block_lengths) - block_lengths + 1 # endpos_block <- startpos_block + block_lengths - 1 indexes_blockwise <- unlist(sapply(block_lengths, function(x) seq(from = 1, to = x), simplify = FALSE), use.names = FALSE) orig_pos_x <- seq.int(x) # make vector with indexes for original input new_pos <- orig_pos_x - (indexes_blockwise - substitute_blockwise) # calc. new positions new_pos[NApos] <- orig_pos_x[NApos] # fill NAs with arbitrary values to allow proper subsetting in next step orig_attr <- attributes(x) x <- x[new_pos] # re-arrange according to lagging x[NApos] <- NA # set NAs where necessary attributes(x) <- orig_attr # restore original names and 'pseries' class (lost by subsetting x) } return(x) } # END alagt ## lagr: lagging row-wise lagr.pseries <- function(x, k = 1L, ...) { index <- unclass(attr(x, "index")) # unclass for speed id <- index[[1L]] time <- index[[2L]] # catch the case when an index of pdata.frame shall be lagged # (index variables are always factors) NB: this catches - # unintentionally - also the case when a factor variable is the # same "on the character level" as one of the corresponding index # variables but not the index variable itself # # -> shall we prevent lagging of index variables at all? -> turned # off for now, 2016-03-03 if(is.factor(x)) if # (all(as.character(x) == as.character(id)) | # all(as.character(x)==as.character(time))) stop("Lagged vector # cannot be index.") alagr <- function(x, ak){ if(round(ak) != ak) stop("Lagging value 'k' must be whole-numbered (positive, negative or zero)") if(ak > 0L) { # NB: this code does row-wise shifting # delete first ak observations for each unit isNAtime <- c(rep(TRUE, ak), (diff(as.numeric(time), lag = ak) != ak)) isNAid <- c(rep(TRUE, ak), (diff(as.numeric(id), lag = ak) != 0L)) isNA <- (isNAtime | isNAid) result <- x # copy x first ... result[1:ak] <- NA # ... then make first ak obs NA ... result[(ak+1):length(result)] <- x[1:(length(x)-ak)] # ... shift and ... result[isNA] <- NA # ... make more NAs in between: this way, we keep: all factor levels, names, classes } else if(ak < 0L) { # => compute leading values # delete last |ak| observations for each unit num_time <- as.numeric(time) num_id <- as.numeric(id) isNAtime <- c(c((num_time[1:(length(num_time)+ak)] - num_time[(-ak+1):length(num_time)]) != ak), rep(TRUE, -ak)) isNAid <- c(c((num_id[1:(length(num_id)+ak)] - num_id[(-ak+1):length(num_id)]) != 0L), rep(TRUE, -ak)) isNA <- (isNAtime | isNAid) result <- x # copy x first ... result[(length(result)+ak+1):length(result)] <- NA # ... then make last |ak| obs NA ... result[1:(length(result)+ak)] <- x[(1-ak):(length(x))] # ... shift and ... result[isNA] <- NA # ... make more NAs in between: this way, we keep: all factor levels, names, classes } else { # ak == 0 => nothing to do, return original pseries (no lagging/no leading) result <- x } return(result) } # END function alagr if(length(k) > 1L) { rval <- sapply(k, function(i) alagr(x, i)) colnames(rval) <- k } else { rval <- alagr(x, k) } return(rval) } # leadr.pseries(x, k) is a wrapper for lagr.pseries(x, -k) leadr.pseries <- function(x, k = 1L, ...) { ret <- lagr.pseries(x, k = -k) if(length(k) > 1L) colnames(ret) <- k return(ret) } ## diffr: lagging row-wise diffr.pseries <- function(x, lag = 1L, ...) { islogi <- is.logical(x) if(! (is.numeric(x) || islogi)) stop("diff is only relevant for numeric or logical series") non.int <- vapply(lag, function(l) round(l) != l, FUN.VALUE = TRUE, USE.NAMES = FALSE) if(any(non.int)) stop("Lagging value(s) in 'lag' must be whole-numbered (and non-negative)") # prevent input of negative values, because it will most likely confuse users # what diff would do in this case neg <- vapply(lag, function(l) l < 0L, FUN.VALUE = TRUE, USE.NAMES = FALSE) if(any(neg)) stop("diff is only relevant for non-negative values in 'lag'") lagrx <- lagr.pseries(x, k = lag) if(is.matrix(lagrx)) { # if 'lagrx' is matrix (case length(lag) > 1): # perform subtraction without pseries feature of 'x', because otherwise # the result would be c("pseries", "matrix") which is not supported res <- as.numeric(x) - lagrx } else { res <- x - lagrx } return(res) } ## pdiff is (only) used in model.matrix to calculate the ## model.matrix for FD models, works for effect = "individual" only, ## see model.matrix on how to call pdiff. Result is in order (id, ## time) for both effects ## ## Performs row-wise shifting pdiff <- function(x, effect = c("individual", "time"), has.intercept = FALSE){ # NB: x is assumed to have an index attribute, e.g., a pseries # can check with has.index(x) effect <- match.arg(effect) cond <- as.numeric(unclass(attr(x, "index"))[[1L]]) # unclass for speed n <- if(is.matrix(x)) nrow(x) else length(x) cond <- c(NA, cond[2:n] - cond[1:(n-1)]) # this assumes a certain ordering cond[cond != 0] <- NA if(! is.matrix(x)){ result <- c(NA , x[2:n] - x[1:(n-1)]) result[is.na(cond)] <- NA result <- na.omit(result) } else{ result <- rbind(NA, x[2:n, , drop = FALSE] - x[1:(n-1), , drop = FALSE]) result[is.na(cond), ] <- NA result <- na.omit(result) result <- result[ , apply(result, 2, var) > 1E-12, drop = FALSE] if(has.intercept){ result <- cbind(1, result) colnames(result)[1L] <- "(Intercept)" } } attr(result, "na.action") <- NULL result } plm/R/experimental.R0000644000176200001440000001045214124132276014067 0ustar liggesusersresiduals_overall_exp.plm <- function(x, ...) { #### experimental, non-exported function # residuals_overall.plm: gives the residuals of the "overall"/outer model for all types of plm models. # In the future, this could be integrated with residuals.plm by some argument, e.g., overall = FALSE (default). # see also test file tests/test_residuals_overall_fitted_exp.R # no na.action eval yet model <- describe(x, "model") if (model == "ht") stop("model \"ht\" not (yet?) supported") # for all effects of within models: residuals of (quasi-)demeaned (inner) model # are also the residuals of the "overall" model if (model == "random") { # get untransformed data to calculate overall residuals X <- model.matrix(x, model = "pooling") y <- pmodel.response(x, model = "pooling") # take care of any aliased coefficients: # they are not in x$coefficients but assoc. variables are still present in model.matrix if (any(x$aliased, na.rm = TRUE)) { # na.rm = TRUE because currently, RE tw unbalanced models set aliased differently X <- X[ , !x$aliased, drop = FALSE] } est <- as.numeric(tcrossprod(coef(x), X)) res <- y - est names(res) <- rownames(X) # make residuals a pseries res <- structure(res, index = index(x), class = c("pseries", class(res))) } else { # all plm models except random (and also except ht) res <- residuals(x) } return(res) } residuals_overall_e_exp <- function(object) { ### experimental non-exported function ## residuals of "overall" RE model minus random effects (=e_it) ## e.g.: two-way model: residual_overall_it = random_component_individual_i + random_component_time_t + e_it model <- describe(object, "model") if (model != "random") stop("only for random effect models") obj.eff <- describe(object, "effect") res_ov <- residuals_overall_exp.plm(object) if (obj.eff == "twoways") { res_ov_e <- res_ov - ranef(object, "individual")[index(object, "id")] - ranef(object, "time")[index(object, "time")] } else { res_ov_e <- res_ov - ranef(object)[index(object, if(obj.eff == "individual") "id" else "time")] } names(res_ov_e) <- names(res_ov) return(res_ov_e) } fitted_exp.plm <- function(x, ...) { #### experimental, non-exported function # fitted_exp.plm: gives the fitted values of all types of plm models by subtracting the overall # residuals from the untransformed response variable; does not have # a model argument so it is not as versatile as 'fitted.plm' below. # see also test file tests/test_residuals_overall_fitted_exp.R model <- describe(x, "model") res <- residuals_overall_exp.plm(x) # For "between" and "fd" models, the number of fitted values is not equal to the # number of original observations. Thus, model.frame cannot be used but rather # pmodel.response because it has the right length. However, pmodel.response # shall not be used for the other models because we want the untransformed data. y <- if (model %in% c("between", "fd")) pmodel.response(x) else model.frame(x)[ , 1L] return(y - res) } # check_propagation_correct_class: helper function # Function checks if the class and storage mode (type) of an object match # and corrects its class attribute if not # # A mismatch can occur if a pseries of lower class and type logical or integer # are propagated to higher type by an arithmetic operation as R's arithmetic # operations do not change the first value of class attribute for # c("pseries", "logical/integer"). However, using groupGenerics as wrapper around # pseries objects, this does not happen anymore. # E.g., # x <- c(1L, 2L, 3L) # x + 1.5 # results in class propagation from class "integer" to "numeric" # but not if x is of class c("myclass", "integer") check_propagation_correct_class <- function(x) { # x: a pseries object (usually) if (any((pos <- inherits(x, c("logical" ,"integer", "numeric"), which = TRUE)) > 0)) { pos <- pos[pos > 0] # non-matches in inherits(..., which = TRUE) results in 0 switch(typeof(x), "double" = { attr(x, "class")[pos] <- "numeric" }, "integer" = { attr(x, "class")[pos] <- "integer" }, "complex" = { attr(x, "class")[pos] <- "complex" } ) } return(x) } plm/R/tool_argvalues.R0000644000176200001440000000604214124132276014420 0ustar liggesusers## This file contain named vectors of the acceptable values for different ## arguments used in plm functions. random.method.list <- c(swar = "Swamy-Arora", walhus = "Wallace-Hussain", amemiya = "Amemiya", nerlove = "Nerlove", ht = "Hausman-Taylor") effect.plm.list <- c(individual = "Oneway (individual) effect", time = "Oneway (time) effect", twoways = "Twoways effects", nested = "Nested effects") effect.pvcm.list <- c(individual = "Oneway (individual) effect", time = "Oneway (time) effect") effect.pggls.list <- c(individual = "Oneway (individual) effect", time = "Oneway (time) effect") effect.pgmm.list <- c(individual = "Oneway (individual) effect", twoways = "Twoways effects") model.plm.list <- c(pooling = "Pooling", within = "Within", between = "Between", random = "Random Effect", ht = "Hausman-Taylor", fd = "First-Difference") ht.method.list <- c(ht = "Hausman-Taylor estimator", am = "Amemiya-MaCurdy estimator", bms = "Breusch-Mizon-Schmidt estimator") model.pvcm.list <- c(within = "No-pooling model", random = "Random coefficients model") model.pggls.list <- c(within = "Within FGLS model", random = "General FGLS model", pooling = "General FGLS model", fd = "First-Difference FGLS model") model.pgmm.list <- c(onestep = "One-step model", twosteps = "Two-steps model") model.pgmm.transformation.list <- c(d = "Difference GMM", ld = "System GMM") model.pcce.list <- c(ccemg = "Mean Groups model", ccep = "Pooled model") model.pmg.list <- c(mg = "Mean Groups model", dmg = "Demeaned Mean Groups model", cmg = "Common Correlated Effects Mean Groups model") inst.method.list <- c(bvk = "Balestra-Varadharajan-Krishnakumar", baltagi = "Baltagi", am = "Amemiya-MaCurdy", bms = "Breusch-Mizon-Schmidt") robust.list <- c(white1 = "White 1", white2 = "White 2", arellano = "Arellano") weights.list <- c(HC0 = "HC0", HC1 = "HC1", HC2 = "HC2", HC3 = "HC3", HC4 = "HC4") oneof <- function(x){ x <- names(x) last <- x[length(x)] x <- x[-length(x)] x <- paste(x,collapse=", ") x <- paste(x,last,sep=" and ") x } plm.arg <- c("formula", "data", "subset", "weights", "na.action", "effect", "model", "instruments", "random.method", "inst.method", "index") plm/R/tool_model.extract.R0000644000176200001440000003532514164674046015220 0ustar liggesusers# model.frame method for pdata.frame ; the formula argument must be a # pdata.frame and the data argument must be a formula, which is quite # esoteric, but consistent with the argument list of # model.frame.Formula which is latter called. #' model.frame and model.matrix for panel data #' #' Methods to create model frame and model matrix for panel data. #' #' The `lhs` and `rhs` arguments are inherited from `Formula`, see #' there for more details.\cr The `model.frame` methods return a #' `pdata.frame` object suitable as an input to plm's #' `model.matrix`.\cr The `model.matrix` methods builds a model matrix #' with transformations performed as specified by the `model` and #' `effect` arguments (and `theta` if `model = "random"` is #' requested), in this case the supplied `data` argument should be a #' model frame created by plm's `model.frame` method. If not, it is #' tried to construct the model frame from the data. Constructing the #' model frame first ensures proper `NA` handling, see **Examples**. #' #' @name model.frame.pdata.frame #' @param object,formula an object of class `"pdata.frame"` or an #' estimated model object of class `"plm"`, #' @param x a `model.frame` #' @param data a `formula`, see **Details**, #' @param effect the effects introduced in the model, one of #' `"individual"`, `"time"`, `"twoways"` or `"nested"`, #' @param model one of `"pooling"`, `"within"`, `"Sum"`, `"Between"`, #' `"between"`, `"random",` `"fd"` and `"ht"`, #' @param theta the parameter for the transformation if `model = #' "random"`, #' @param cstcovar.rm remove the constant columns, one of `"none", #' "intercept", "covariates", "all")`, #' @param lhs inherited from package [Formula::Formula()] (see #' there), #' @param rhs inherited from package [Formula::Formula()] (see #' there), #' @param dot inherited from package [Formula::Formula()] (see #' there), #' @param \dots further arguments. #' @return The `model.frame` methods return a `pdata.frame`.\cr The #' `model.matrix` methods return a `matrix`. #' @author Yves Croissant #' @seealso [pmodel.response()] for (transformed) response #' variable.\cr [Formula::Formula()] from package `Formula`, #' especially for the `lhs` and `rhs` arguments. #' @keywords classes #' @examples #' #' # First, make a pdata.frame #' data("Grunfeld", package = "plm") #' pGrunfeld <- pdata.frame(Grunfeld) #' #' # then make a model frame from a formula and a pdata.frame ##pform <- pFormula(inv ~ value + capital) ##mf <- model.frame(pform, data = pGrunfeld) #' form <- inv ~ value #' mf <- model.frame(pGrunfeld, form) #' #' # then construct the (transformed) model matrix (design matrix) #' # from model frame ##modmat <- model.matrix(pform, data = mf, model = "within") #' modmat <- model.matrix(mf, model = "within") #' #' ## retrieve model frame and model matrix from an estimated plm object ## #fe_model <- plm(pform, data = pGrunfeld, model = "within") #' fe_model <- plm(form, data = pGrunfeld, model = "within") #' model.frame(fe_model) #' model.matrix(fe_model) #' #' # same as constructed before #' all.equal(mf, model.frame(fe_model), check.attributes = FALSE) # TRUE #' all.equal(modmat, model.matrix(fe_model), check.attributes = FALSE) # TRUE #' NULL #' @rdname model.frame.pdata.frame #' @export model.frame.pdata.frame <- function(formula, data = NULL, ..., lhs = NULL, rhs = NULL, dot = "previous"){ pdata <- formula formula <- as.Formula(data) if (is.null(rhs)) rhs <- 1:(length(formula)[2L]) if (is.null(lhs)) lhs <- if(length(formula)[1L] > 0L) 1 else 0 index <- attr(pdata, "index") mf <- model.frame(formula, as.data.frame(pdata, row.names = FALSE), ..., # NB need row.names = FALSE to ensure mf has integer sequence as row names lhs = lhs, rhs = rhs, dot = dot) index <- index[as.numeric(rownames(mf)), ] # reduce index down to rows left in model frame checkNA.index(index) # check for NAs in model.frame's index and error if any index <- droplevels(index) class(index) <- c("pindex", "data.frame") structure(mf, index = index, formula = formula, class = c("pdata.frame", class(mf))) } #' @rdname model.frame.pdata.frame #' @export formula.pdata.frame <- function(x, ...){ if (is.null(attr(x, "terms"))) stop("formula expect a model.frame and not an ordinary pdata.frame") attr(x, "formula") } #' @rdname model.frame.pdata.frame #' @export model.matrix.plm <- function(object, ...){ dots <- list(...) model <- if(is.null(dots$model)) describe(object, "model") else dots$model effect <- if(is.null(dots$effect)) describe(object, "effect") else dots$effect rhs <- if(is.null(dots$rhs)) 1 else dots$rhs cstcovar.rm <- dots$cstcovar.rm formula <- formula(object) data <- model.frame(object) if (model != "random"){ model.matrix(data, model = model, effect = effect, rhs = rhs, cstcovar.rm = cstcovar.rm) } else{ theta <- ercomp(object)$theta model.matrix(data, model = model, effect = effect, theta = theta, rhs = rhs, cstcovar.rm = cstcovar.rm) } } #' @rdname model.frame.pdata.frame #' @export model.matrix.pdata.frame <- function(object, model = c("pooling", "within", "Between", "Sum", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways", "nested"), rhs = 1, theta = NULL, cstcovar.rm = NULL, ...){ if (is.null(attr(object, "terms"))) stop("model.matrix expects a model.frame and not an ordinary pdata.frame") model <- match.arg(model) effect <- match.arg(effect) formula <- attr(object, "formula") data <- object has.intercept <- has.intercept(formula, rhs = rhs) # relevant defaults for cstcovar.rm if(is.null(cstcovar.rm)) cstcovar.rm <- if(model == "within") "intercept" else "none" balanced <- is.pbalanced(data) X <- model.matrix(as.Formula(formula), data = data, rhs = rhs, dot = "previous", ...) # check for infinite or NA values and exit if there are some if(any(! is.finite(X))) stop(paste("model matrix or response contains non-finite", "values (NA/NaN/Inf/-Inf)")) X.assi <- attr(X, "assign") X.contr <- attr(X, "contrasts") X.contr <- X.contr[ ! vapply(X.contr, is.null, FUN.VALUE = TRUE, USE.NAMES = FALSE) ] index <- index(data) attr(X, "index") <- index if(effect == "twoways" && model %in% c("between", "fd")) stop("twoways effect only relevant for within, random, and pooling models") if(model == "within") X <- Within(X, effect) if(model == "Sum") X <- Sum(X, effect) if(model == "Between") X <- Between(X, effect) if(model == "between") X <- between(X, effect) if(model == "mean") X <- Mean(X) if(model == "fd") X <- pdiff(X, effect = "individual", has.intercept = has.intercept) if(model == "random"){ if(is.null(theta)) stop("a theta argument must be provided for model = \"random\"") if(effect %in% c("time", "individual")) X <- X - theta * Between(X, effect) if(effect == "nested") X <- X - theta$id * Between(X, "individual") - theta$gp * Between(X, "group") if(effect == "twoways" && balanced) X <- X - theta$id * Between(X, "individual") - theta$time * Between(X, "time") + theta$total * Mean(X) ## TODO: case unbalanced twoways not treated here. Catch and error gracefully? # if (effect == "twoways" && !balanced) stop("two-way unbalanced case not implemented in model.matrix.pdata.frame") } if(cstcovar.rm == "intercept"){ posintercept <- match("(Intercept)", colnames(X)) if (! is.na(posintercept)) X <- X[ , - posintercept, drop = FALSE] } if(cstcovar.rm %in% c("covariates", "all")){ cols <- apply(X, 2, is.constant) cstcol <- names(cols)[cols] posintercept <- match("(Intercept)", cstcol) cstintercept <- if(is.na(posintercept)) FALSE else TRUE zeroint <- if(cstintercept && max(X[ , posintercept]) < sqrt(.Machine$double.eps)) TRUE else FALSE if(length(cstcol) > 0L){ if((cstcovar.rm == "covariates" || !zeroint) && cstintercept) cstcol <- cstcol[- posintercept] if(length(cstcol) > 0L){ X <- X[ , - match(cstcol, colnames(X)), drop = FALSE] attr(X, "constant") <- cstcol } } } structure(X, assign = X.assi, contrasts = X.contr, index = index) } #' A function to extract the model.response #' #' pmodel.response has several methods to conveniently extract the #' response of several objects. #' #' The model response is extracted from a `pdata.frame` (where the #' response must reside in the first column; this is the case for a #' model frame), a `pFormula` + `data` or a `plm` object, and the #' transformation specified by `effect` and `model` is applied to #' it.\cr Constructing the model frame first ensures proper `NA` #' handling and the response being placed in the first column, see #' also **Examples** for usage. #' #' @aliases pmodel.response #' @param object an object of class `"plm"`, or a formula of #' class `"Formula"`, #' @param data a `data.frame` #' @param \dots further arguments. #' @return A pseries except if model responses' of a `"between"` #' or `"fd"` model as these models "compress" the data (the number #' of observations used in estimation is smaller than the original #' data due to the specific transformation). A numeric is returned #' for the `"between"` and `"fd"` model. #' @export #' @author Yves Croissant #' @seealso `plm`'s [model.matrix()] for (transformed) #' model matrix and the corresponding [model.frame()] #' method to construct a model frame. #' @keywords manip #' @examples #' #' # First, make a pdata.frame #' data("Grunfeld", package = "plm") #' pGrunfeld <- pdata.frame(Grunfeld) #' #' # then make a model frame from a pFormula and a pdata.frame #' #' #' form <- inv ~ value + capital #' mf <- model.frame(pGrunfeld, form) #' # construct (transformed) response of the within model #' resp <- pmodel.response(form, data = mf, model = "within", effect = "individual") #' # retrieve (transformed) response directly from model frame #' resp_mf <- pmodel.response(mf, model = "within", effect = "individual") #' #' # retrieve (transformed) response from a plm object, i.e., an estimated model #' fe_model <- plm(form, data = pGrunfeld, model = "within") #' pmodel.response(fe_model) #' #' # same as constructed before #' all.equal(resp, pmodel.response(fe_model), check.attributes = FALSE) # TRUE #' pmodel.response <- function(object, ...) { UseMethod("pmodel.response") } #' @rdname pmodel.response #' @export pmodel.response.plm <- function(object, ...){ y <- model.response(model.frame(object)) dots <- list(...) model <- if(is.null(dots$model)) describe(object, "model") else dots$model effect <- if(is.null(dots$effect)) describe(object, "effect") else dots$effect theta <- if(is.null(dots$theta)) { if(describe(object, "model") == "random") ercomp(object)$theta else NULL } else dots$theta ptransform(y, model = model, effect = effect, theta = theta) } #' @rdname pmodel.response #' @export pmodel.response.data.frame <- function(object, ...){ dots <- list(...) if(is.null(attr(object, "terms"))) stop("not a model.frame") model <- if(is.null(dots$model)) "pooling" else dots$model effect <- if(is.null(dots$effect)) "individual" else dots$effect theta <- if(is.null(dots$theta)) NULL else dots$theta y <- model.response(object) ptransform(y, model = model, effect = effect, theta = theta) } # deprecated #' @rdname pmodel.response #' @export pmodel.response.formula <- function(object, data, ...){ dots <- list(...) if(is.null(data)) stop("the data argument is mandatory") if(! inherits(data, "pdata.frame")) stop("the data argument must be a pdata.frame") if(is.null(attr(data, "terms"))) data <- model.frame(data, object) model <- dots$model effect <- dots$effect theta <- dots$theta if(is.null(model)) model <- "pooling" if(is.null(effect)) effect <- "individual" if(model == "random" && is.null(theta)) stop("the theta argument is mandatory for model = \"random\"") y <- model.response(data) ptransform(y, model = model, effect = effect, theta = theta) } ptransform <- function(x, model = NULL, effect = NULL, theta = NULL, ...){ # NB: ptransform (and hence pmodel.response) does not handle the random 2-way unbalanced case if(model == "pooling") return(x) # early exit if(effect == "twoways" && model %in% c("between", "fd")) stop("twoways effect only relevant for within, random, and pooling models") if(model == "within") x <- Within(x, effect) if(model == "between") x <- between(x, effect) if(model == "Between") x <- Between(x, effect) if(model == "fd") x <- pdiff(x, "individual") if(model == "random") { balanced <- is.pbalanced(x) # need to check this right here as long as x is a pseries if(is.null(theta)) stop("a theta argument must be provided") if(effect %in% c("time", "individual")) x <- x - theta * Between(x, effect) if(effect == "nested") x <- x - theta$id * Between(x, "individual") - theta$gp * Between(x, "group") if(effect == "twoways" && balanced) x <- x - theta$id * Between(x, "individual") - theta$time * Between(x, "time") + theta$total * mean(x) ## TODO: could catch non-treated RE unbalanced twoways case to error gracefully: # if (effect == "twoways" && !balanced) warning("two-way unbalanced case not implemented in ptransform") } # between and fd models "compress" the data, thus an index does not make # sense for those, but add to all others (incl. Between (capital B)) x <- if(model %in% c("between", "fd")) x else structure(x, index = index(x), class = unique(c("pseries", class(x)))) return(x) } plm/R/tool_ranfixef.R0000644000176200001440000006670714154734502014252 0ustar liggesusers## Compute the individual and/or time effects for panel model. plm ## methods for the fixef and ranef generics of the nlme ## package. print, summary and print.summary methods are provided for ## fixef objects. ## The within_intercept.plm function computes the overall intercept of ## within fitted models. #' @title #' Extract the Fixed Effects #' #' @description #' Function to extract the fixed effects from a `plm` object and #' associated summary method. #' #' @details #' Function `fixef` calculates the fixed effects and returns an object #' of class `c("fixef", "numeric")`. By setting the `type` argument, #' the fixed effects may be returned in levels (`"level"`), as #' deviations from the first value of the index (`"dfirst"`), or as #' deviations from the overall mean (`"dmean"`). If the argument #' `vcov` was specified, the standard errors (stored as attribute "se" #' in the return value) are the respective robust standard errors. #' For two-way fixed-effect models, argument `effect` controls which #' of the fixed effects are to be extracted: `"individual"`, `"time"`, or #' the sum of individual and time effects (`"twoways"`). #' NB: See **Examples** for how the sum of effects can be split in an individual #' and a time component. #' For one-way models, the effects of the model are extracted and the #' argument `effect` is disrespected. #' #' The associated `summary` method returns an extended object of class #' `c("summary.fixef", "matrix")` with more information (see sections #' **Value** and **Examples**). #' #' References with formulae (except for the two-ways unbalanced case) #' are, e.g., \insertCite{GREE:12;textual}{plm}, Ch. 11.4.4, p. 364, #' formulae (11-25); \insertCite{WOOL:10;textual}{plm}, Ch. 10.5.3, #' pp. 308-309, formula (10.58). #' @name fixef.plm #' @aliases fixef #' @param x,object an object of class `"plm"`, an object of class #' `"fixef"` for the `print` and the `summary` method, #' @param effect one of `"individual"`, `"time"`, or `"twoways"`, only relevant in #' case of two--ways effects models (where it defaults to `"individual"`), #' @param vcov a variance--covariance matrix furnished by the user or #' a function to calculate one (see **Examples**), #' @param type one of `"level"`, `"dfirst"`, or `"dmean"`, #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param \dots further arguments. #' @return For function `fixef`, an object of class `c("fixef", "numeric")` #' is returned: It is a numeric vector containing #' the fixed effects with attribute `se` which contains the #' standard errors. There are two further attributes: attribute #' `type` contains the chosen type (the value of argument `type` #' as a character); attribute `df.residual` holds the residual #' degrees of freedom (integer) from the fixed effects model (plm #' object) on which `fixef` was run. For the two-way unbalanced case, only #' attribute `type` is added. #' #' For function `summary.fixef`, an object of class #' `c("summary.fixef", "matrix")` is returned: It is a matrix with four #' columns in this order: the estimated fixed effects, their standard #' errors and associated t--values and p--values. #' For the two-ways unbalanced case, the matrix contains only the estimates. #' The type of the fixed effects and the standard errors in the #' summary.fixef object correspond to was requested in the `fixef` #' function by arguments `type` and `vcov`, respectively. #' #' @author Yves Croissant #' @seealso [within_intercept()] for the overall intercept of fixed #' effect models along its standard error, [plm()] for plm objects #' and within models (= fixed effects models) in general. See #' [ranef()] to extract the random effects from a random effects #' model. #' @references \insertAllCited{} #' @keywords regression #' @examples #' #' data("Grunfeld", package = "plm") #' gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") #' fixef(gi) #' summary(fixef(gi)) #' summary(fixef(gi))[ , c("Estimate", "Pr(>|t|)")] # only estimates and p-values #' #' # relationship of type = "dmean" and "level" and overall intercept #' fx_level <- fixef(gi, type = "level") #' fx_dmean <- fixef(gi, type = "dmean") #' overallint <- within_intercept(gi) #' all.equal(overallint + fx_dmean, fx_level, check.attributes = FALSE) # TRUE #' #' # extract time effects in a twoways effects model #' gi_tw <- plm(inv ~ value + capital, data = Grunfeld, #' model = "within", effect = "twoways") #' fixef(gi_tw, effect = "time") #' #' # with supplied variance-covariance matrix as matrix, function, #' # and function with additional arguments #' fx_level_robust1 <- fixef(gi, vcov = vcovHC(gi)) #' fx_level_robust2 <- fixef(gi, vcov = vcovHC) #' fx_level_robust3 <- fixef(gi, vcov = function(x) vcovHC(x, method = "white2")) #' summary(fx_level_robust1) # gives fixed effects, robust SEs, t- and p-values #' #' # calc. fitted values of oneway within model: #' fixefs <- fixef(gi)[index(gi, which = "id")] #' fitted_by_hand <- fixefs + gi$coefficients["value"] * gi$model$value + #' gi$coefficients["capital"] * gi$model$capital #' #' # calc. fittes values of twoway unbalanced within model via effects: #' gtw_u <- plm(inv ~ value + capital, data = Grunfeld[-200, ], effect = "twoways") #' yhat <- as.numeric(gtw_u$model[ , 1] - gtw_u$residuals) # reference #' pred_beta <- as.numeric(tcrossprod(coef(gtw_u), as.matrix(gtw_u$model[ , -1]))) #' pred_effs <- as.numeric(fixef(gtw_u, "twoways")) # sum of ind and time effects #' all.equal(pred_effs + pred_beta, yhat) # TRUE #' #' # Splits of summed up individual and time effects: #' # use one "level" and one "dfirst" #' ii <- index(gtw_u)[[1L]]; it <- index(gtw_u)[[2L]] #' eff_id_dfirst <- c(0, as.numeric(fixef(gtw_u, "individual", "dfirst")))[ii] #' eff_ti_dfirst <- c(0, as.numeric(fixef(gtw_u, "time", "dfirst")))[it] #' eff_id_level <- as.numeric(fixef(gtw_u, "individual"))[ii] #' eff_ti_level <- as.numeric(fixef(gtw_u, "time"))[it] #' #' all.equal(pred_effs, eff_id_level + eff_ti_dfirst) # TRUE #' all.equal(pred_effs, eff_id_dfirst + eff_ti_level) # TRUE #' #' @importFrom nlme fixef #' @export fixef NULL #' @rdname fixef.plm #' @importFrom stats weighted.mean #' @export fixef.plm <- function(object, effect = NULL, type = c("level", "dfirst", "dmean"), vcov = NULL, ...){ model.effect <- describe(object, "effect") if(is.null(effect)){ # default for twoway model to individual effect effect <- switch(model.effect, "individual" = "individual", "time" = "time", "twoways" = "individual") } else{ if(model.effect != "twoways" && model.effect != effect) stop("wrong effect argument") if(!effect %in% c("individual", "time", "twoways")) stop("wrong effect argument") } type <- match.arg(type) if(!is.null(object$call)){ if(describe(object, "model") != "within") stop("fixef is relevant only for within models") } formula <- formula(object) data <- model.frame(object) pdim <- pdim(object) # the between model may contain time independent variables, the # within model doesn't. So select the relevant elements using nw # (names of the within variables) nw <- names(coef(object)) # For procedure to get the individual/time effects by multiplying the within # estimates with the between-ed data, see, e.g.: # Wooldridge (2010), Econometric Analysis of Cross Section and Panel Data, 2nd ed., # Ch. 10.5.3, pp. 308-309, formula (10.58) # Greene (2012), Econometric Analysis, # Ch. 11.4.4, p. 364, formulae (11-25) # # NB: These textbook formulae do not give the correct results in the two-ways unbalanced case, # all other cases (twoways/balanced; oneway(ind/time)/balanced/unbalanced) are correct # for these formulae. if(model.effect != "twoways") { Xb <- model.matrix(data, rhs = 1, model = "between", effect = effect) yb <- pmodel.response(data, model = "between", effect = effect) fixef <- yb - as.vector(crossprod(t(Xb[ , nw, drop = FALSE]), coef(object))) # use robust vcov if supplied if (! is.null(vcov)) { if (is.matrix(vcov)) vcov <- vcov[nw, nw] if (is.function(vcov)) vcov <- vcov(object)[nw, nw] } else { vcov <- vcov(object)[nw, nw] } nother <- switch(effect, "individual" = pdim$Tint$Ti, "time" = pdim$Tint$nt) s2 <- deviance(object) / df.residual(object) if (type != "dfirst") { sefixef <- sqrt(s2 / nother + apply(Xb[, nw, drop = FALSE], 1, function(x) t(x) %*% vcov %*% x)) } else { Xb <- t(t(Xb[-1, ]) - Xb[1L, ]) sefixef <- sqrt(s2 * (1 / nother[-1] + 1 / nother[1])+ apply(Xb[, nw, drop = FALSE], 1, function(x) t(x) %*% vcov %*% x)) } res <- switch(type, "level" = fixef, "dfirst" = fixef[2:length(fixef)] - fixef[1L], "dmean" = (fixef - weighted.mean(fixef, w = nother))) res <- structure(res, se = sefixef, class = c("fixef", "numeric"), type = type, df.residual = df.residual(object)) } else { ## case model.effect == "twoways" ## * two-way balanced/unbalanced model for all effects beta.data <- as.numeric(tcrossprod(coef(object), model.matrix(object, model = "pooling")[ , nw, drop = FALSE])) yhat <- object$model[ , 1L] - object$residuals tw.fixef.lvl <- yhat - beta.data # sum of both effects in levels idx <- switch(effect, "individual" = 1L, "time" = 2L, "twoways" = NA_integer_) # needed for weighted.mean below -> leads to no weights indexl <- unclass(index(object)) # unclass to list for speed if(effect %in% c("individual", "time")) { other.eff <- switch(effect, "individual" = "time", "time" = "individual") other.idx <- switch(effect, "individual" = 2L, "time" = 1L) Xb <- model.matrix(data, rhs = 1, model = "between", effect = other.eff) yb <- pmodel.response(data, model = "between", effect = other.eff) other.fixef.lvl <- yb - as.vector(crossprod(t(Xb[ , nw, drop = FALSE]), coef(object))) ## other dfirst other.fixef.dfirst <- other.fixef.lvl - other.fixef.lvl[1L] tw.fixef.lvl <- tw.fixef.lvl - other.fixef.dfirst[indexl[[other.idx]]] tw.fixef.lvl <- tw.fixef.lvl[!duplicated(indexl[[idx]])] names(tw.fixef.lvl) <- pdim[["panel.names"]][[idx]] } else { # effect = "twoways": everything already computed, just set names names(tw.fixef.lvl) <- paste0(pdim[["panel.names"]][[1L]][indexl[[1L]]], "-", pdim[["panel.names"]][[2L]][indexl[[2L]]]) } res <- switch(type, "level" = tw.fixef.lvl, "dfirst" = tw.fixef.lvl[2:length(tw.fixef.lvl)] - tw.fixef.lvl[1L], "dmean" = { if(pdim$balanced || effect == "twoways") { tw.fixef.lvl - mean(tw.fixef.lvl) } else { tw.fixef.lvl - weighted.mean(tw.fixef.lvl, w = pdim$Tint[[idx]]) }}) res <- structure(res, se = NULL, class = c("fixef", "numeric"), type = type, df.residual = NULL) } res } #' @rdname fixef.plm #' @export print.fixef <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ x.orig <- x # prevent attributes from being printed attr(x, "se") <- attr(x, "type") <- attr(x, "class") <- attr(x, "df.residual") <- attr(x, "index") <- NULL print.default(x, digits, width, ...) invisible(x.orig) } #' @rdname fixef.plm #' @export summary.fixef <- function(object, ...) { # for 2-way unbalanced, there are currently no further attributes -> skip construction res <- if(!is.null(attr(object, "se"))) { se <- attr(object, "se") df.res <- attr(object, "df.residual") tvalue <- (object) / se # was: res <- cbind(object, se, zvalue, (1 - pnorm(abs(zvalue))) * 2) res <- cbind(object, se, tvalue, (2 * pt(abs(tvalue), df = df.res, lower.tail = FALSE))) # see for distribution and degrees of freedom # Greene (2003, 5th ed.), p. 288 (formula 13-7) # = Greene (2012, 7th ed.), pp. 361-362 (formula 11-19) colnames(res) <- c("Estimate", "Std. Error", "t-value", "Pr(>|t|)") class(res) <- c("summary.fixef", "matrix") attr(res, "type") <- attr(object, "type") attr(res, "df.residual") <- df.res res } else { matrix(object, dimnames = list(names(object), "Estimate")) } res } #' @rdname fixef.plm #' @export print.summary.fixef <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ printCoefmat(x, digits = digits) invisible(x) } #' @rdname fixef.plm #' @export fixef.pggls <- fixef.plm #' Extract the Random Effects #' #' Function to calculate the random effects from a `plm` object #' (random effects model). #' #' Function `ranef` calculates the random effects of a fitted random #' effects model. For one-way models, the effects of the estimated #' model are extracted (either individual or time effects). For #' two-way models, extracting the individual effects is the default #' (both, argument `effect = NULL` and `effect = "individual"` will #' give individual effects). Time effects can be extracted by setting #' `effect = "time"`. #' #' Not all random effect model types are supported (yet?). #' #' @param object an object of class `"plm"`, needs to be a fitted #' random effects model, #' @param effect `NULL`, `"individual"`, or `"time"`, the effects to #' be extracted, see **Details**, #' @param \dots further arguments (currently not used). #' @return A named numeric with the random effects per dimension #' (individual or time). #' @name ranef.plm #' @aliases ranef #' @importFrom nlme ranef #' @export ranef #' @author Kevin Tappe #' @seealso [fixef()] to extract the fixed effects from a fixed #' effects model (within model). #' @keywords regression #' @examples #' #' data("Grunfeld", package = "plm") #' m1 <- plm(inv ~ value + capital, data = Grunfeld, model = "random") #' ranef(m1) # individual random effects #' #' # compare to random effects by ML estimation via lme from package nlme #' library(nlme) #' m2 <- lme(inv ~ value + capital, random = ~1|firm, data = Grunfeld) #' cbind("plm" = ranef(m1), "lme" = unname(ranef(m2))) #' #' # two-ways RE model, calculate individual and time random effects #' data("Cigar", package = "plm") #' tw <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "twoways") #' ranef(tw) # individual random effects #' ranef(tw, effect = "time") # time random effects #' NULL #' @rdname ranef.plm #' @export ranef.plm <- function(object, effect = NULL, ...) { # TODO: # Check if the same procedure can be applied to # * unbalanced two-way case (for now: implemented the same way, but not entirely sure) # * random IV models # * nested random effect models model <- describe(object, "model") obj.effect <- describe(object, "effect") balanced <- is.pbalanced(object) if(model != "random") stop("only applicable to random effect models") # TODO: Are random effects for nested models and IV models calculated the same way? # Be defensive here and error for such models. if(obj.effect == "nested") stop("nested random effect models are not supported (yet?)") if(length(object$formula)[2L] >= 2L) stop("ranef: IV models not supported (yet?)") if(!is.null(effect) && !(effect %in% c("individual", "time"))) stop("argument 'effect' must be NULL, \"individual\", or \"time\"") if(obj.effect != "twoways" && !is.null(effect) && effect != obj.effect) stop(paste0("for one-way models, argument \"effect\" must be NULL or match the effect introduced in model estimation")) # default effect is the model's effect # for two-ways RE models: set default to effect = "individual" if(obj.effect == "twoways" && is.null(effect)) effect <- "individual" if(is.null(effect)) effect <- obj.effect erc <- ercomp(object) # extract theta, but depending on model/effect, it is adjusted/overwritten later theta <- unlist(erc["theta"], use.names = FALSE) # res <- object$residuals # gives residuals of quasi-demeaned model res <- residuals_overall_exp.plm(object) # but need RE residuals of overall model if(!inherits(res, "pseries")) { # just make sure we have a pseries for the following between() to work attr(res, "index") <- index(object$model) class(res) <- c("pseries", class(res)) } # mean_res <- Between(res, effect = effect) # has length == # observations mean_res <- between(res, effect = effect) # but need length == # individuals if(obj.effect == "twoways" && balanced) { theta <- switch(effect, "individual" = theta[1L], "time" = theta[2L]) } if(obj.effect == "twoways" && !balanced) { theta <- erc[["theta"]][[if(effect == "individual") "id" else "time"]] } if(!balanced) { # in the unbalanced cases, ercomp[["theta"]] is full length (# obs) # -> reduce to per id/time select <- switch(effect, "individual" = !duplicated(index(object$model)[1L]), "time" = !duplicated(index(object$model)[2L])) theta <- theta[select] } # calculate random effects: # This formula works (at least) for: # balanced one-way (is symmetric for individual/time) # unbalanced one-way (symmetric) is also caught by this line as theta is reduced before # balanced two-way case (symmetric) raneffects <- (1 - (1 - theta)^2) * mean_res names(raneffects) <- names(mean_res) return(raneffects) } #' 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 #' #' The (somewhat artificial) intercept for within models (fixed #' effects models) was made popular by Stata of StataCorp #' \insertCite{@see @GOUL:13}{plm}, EViews of IHS, and gretl #' \insertCite{@see @GRETL:2021, p. 200-201, listing 23.1}{plm}, see for #' treatment in the literature, #' e.g., \insertCite{GREE:12;textual}{plm}, Ch. 11.4.4, p. 364. It can #' be considered an overall intercept in the within model framework #' and is the weighted mean of fixed effects (see **Examples** for the #' relationship). #' #' `within_intercept` estimates a new model which is #' computationally more demanding than just taking the weighted #' mean. However, with `within_intercept` one also gets the #' associated standard error and it is possible to get an overall #' intercept for twoway fixed effect models. #' #' Users can set argument `vcov` to a function to calculate a #' specific (robust) variance--covariance matrix and get the #' respective (robust) standard error for the overall intercept, #' e.g., the function [vcovHC()], see examples for #' usage. Note: The argument `vcov` must be a function, not a #' matrix, because the model to calculate the overall intercept for #' the within model is different from the within model itself. #' #' If argument `return.model = TRUE` is set, the full model object is returned, #' while in the default case only the intercept is returned. #' #' @aliases within_intercept #' @param object object of class `plm` which must be a within #' model (fixed effects model), #' @param vcov if not `NULL` (default), a function to calculate a #' user defined variance--covariance matrix (function for robust #' vcov), only used if `return.model = FALSE`, #' @param return.model a logical to indicate whether only the overall intercept #' (`FALSE` is default) or a full model object (`TRUE`) is to be returned, #' @param \dots further arguments (currently none). #' @return Depending on argument `return.model`: If `FALSE` (default), a named #' `numeric` of length one: The overall intercept for the estimated within model #' along attribute "se" which contains the standard error for the intercept. #' If `return.model = TRUE`, the full model object, a within model with the #' overall intercept (NB: the model identifies itself as a pooling model, e.g., #' in summary()). #' #' @export #' @author Kevin Tappe #' @seealso [fixef()] to extract the fixed effects of a within model. #' @references #' #' \insertAllCited{} #' #' @keywords attribute #' @examples #' data("Hedonic", package = "plm") #' mod_fe <- plm(mv ~ age + crim, data = Hedonic, index = "townid") #' overallint <- within_intercept(mod_fe) #' attr(overallint, "se") # standard error #' #' # overall intercept is the weighted mean of fixed effects in the #' # one-way case #' weighted.mean(fixef(mod_fe), pdim(mod_fe)$Tint$Ti) #' #' ### relationship of type="dmean", "level" and within_intercept #' ## one-way balanced case #' data("Grunfeld", package = "plm") #' gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") #' fx_level <- fixef(gi, type = "level") #' fx_dmean <- fixef(gi, type = "dmean") #' overallint <- within_intercept(gi) #' all.equal(overallint + fx_dmean, fx_level, check.attributes = FALSE) # TRUE #' ## two-ways unbalanced case #' gtw_u <- plm(inv ~ value + capital, data = Grunfeld[-200, ], effect = "twoways") #' int_tw_u <- within_intercept(gtw_u) #' fx_dmean_tw_i_u <- fixef(gtw_u, type = "dmean", effect = "individual")[index(gtw_u)[[1L]]] #' fx_dmean_tw_t_u <- fixef(gtw_u, type = "dmean", effect = "time")[index(gtw_u)[[2L]]] #' fx_level_tw_u <- as.numeric(fixef(gtw_u, "twoways", "level")) #' fx_level_tw_u2 <- int_tw_u + fx_dmean_tw_i_u + fx_dmean_tw_t_u #' all.equal(fx_level_tw_u, fx_level_tw_u2, check.attributes = FALSE) # TRUE #' #' ## overall intercept with robust standard error #' within_intercept(gi, vcov = function(x) vcovHC(x, method="arellano", type="HC0")) #' #' ## have a model returned #' mod_fe_int <- within_intercept(gi, return.model = TRUE) #' summary(mod_fe_int) #' # replicates Stata's robust standard errors #' summary(mod_fe_int, vcvov = function(x) vcovHC(x, type = "sss")) # within_intercept <- function(object, ...) { UseMethod("within_intercept") } # Note: The name of the function (within_intercept) with an underscore does not # follow the regular naming scheme where one would expect a dot (within.intercept). # Due to the S3 class system, calling the function within.intercept would result in # a name clash as we have a function called 'within' and in this case the S3 # system interprets '.intercept' as a class called 'intercept'. # Note: return value of within_intercept is related to return values of fixef.plm, # see tests/test_within_intercept.R #' @rdname within_intercept #' @export within_intercept.plm <- function(object, vcov = NULL, return.model = FALSE, ...) { if(!inherits(object, "plm")) stop("input 'object' needs to be a \"within\" model estimated by plm()") if(length(object$formula)[2L] >= 2L) stop("within_intercept: IV models not supported (yet?)") model <- describe(object, what = "model") effect <- describe(object, what = "effect") if(model != "within") stop("input 'object' needs to be a \"within\" model estimated by plm(..., model = \"within\", ...)") # vcov must be a function, because the auxiliary model estimated to get the # overall intercept next to its standard errors is different from # the FE model for which the intercept is estimated, e.g., dimensions # of vcov differ for FE and for auxiliary model. if(!is.null(vcov)) { if(is.matrix(vcov)) stop("for within_intercept, 'vcov' may not be of class 'matrix', it must be supplied as a function, e.g., vcov = function(x) vcovHC(x)") if(!is.function(vcov)) stop("for within_intercept, argument 'vcov' must be a function, e.g., vcov = function(x) vcovHC(x)") } index <- attr(object$model, which = "index") # Transformation to get the overall intercept is: # demean groupwise and add back grand mean of each variable, then run OLS mf <- model.frame(object) withinY <- pmodel.response(object) # returns the response specific to the 'effect' of the est. FE model object meanY <- mean(mf[ , 1L]) # mean of original data's response transY <- withinY + meanY withinM <- model.matrix(object) # returns the model.matrix specific to the 'effect' of the est. FE model object M <- model.matrix(mf, cstcovar.rm = "all") M <- M[ , colnames(M) %in% colnames(withinM), drop = FALSE] # just to be sure: should be same columns meansM <- colMeans(M) transM <- t(t(withinM) + meansM) # estimation by lm() # data <- data.frame(cbind(transY, transM)) # auxreg <- lm(data) # summary(auxreg) # estimation by plm() - to apply robust vcov function if supplied # NB: this changes variable names slightly (data.frame uses make.names to, e.g., get rid of parentheses in variable names) data <- pdata.frame(data.frame(cbind(index, transY, transM)), drop.index = TRUE) form <- as.formula(paste0(names(data)[1L], "~", paste(names(data)[-1L], collapse = "+"))) auxreg <- plm(form, data = data, model = "pooling") # degrees of freedom correction due to FE transformation for "normal" vcov [copied over from plm.fit] pdim <- pdim(index) card.fixef <- switch(effect, "individual" = pdim$nT$n, "time" = pdim$nT$T, "twoways" = pdim$nT$n + pdim$nT$T - 1L) df <- df.residual(auxreg) - card.fixef + 1L # just for within_intercept: here we need '+1' to correct for the intercept vcov_mat <- vcov(auxreg) vcov_mat <- vcov_mat * df.residual(auxreg) / df auxreg$vcov <- vcov_mat # plug in new vcov (adjusted "normal" vcov) in auxiliary model res <- if(!return.model) { #### return only intercept with SE as attribute ## in case of robust vcov, which is supplied by a function ## no adjustment to the robust vcov is necessary if(is.function(vcov)) vcov_mat <- vcov(auxreg) # robust vcov as supplied by a function intercept <- auxreg[["coefficients"]]["(Intercept)"] attr(intercept, which = "se") <- sqrt(vcov_mat[1L, 1L]) names(intercept) <- "(overall_intercept)" intercept } else { ### return model if(!is.null(vcov)) warning("argument 'vcov' is non-NULL and is ignored as 'return.model = TRUE' is set") auxreg } return(res) } # END within_intercept.plm plm/R/est_pi.R0000644000176200001440000003222514162674455012673 0ustar liggesusers #' Angrist and Newey's version of Chamberlain test for fixed effects #' #' Angrist and Newey's version of the Chamberlain test #' #' Angrist and Newey's test is based on the results of the artifactual #' regression of the within residuals on the covariates for all the #' periods. #' #' @aliases aneweytest #' @param formula a symbolic description for the model to be estimated, #' @param data a `data.frame`, #' @param subset see [lm()], #' @param na.action see [lm()], #' @param index the indexes, #' @param \dots further arguments. #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant #' @references #' \insertRef{ANGR:NEWE:91}{plm} #' #' @seealso [piest()] for Chamberlain's test #' @keywords htest #' @examples #' #' data("RiceFarms", package = "plm") #' aneweytest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") #' aneweytest <- function(formula, data, subset, na.action, index = NULL, ...){ # NB: code fails for unbalanced data -> is Angrist and Newey's test only for balanced data? # unbalanced case is currently caught and a message is printed mf <- match.call() # compute the model.frame using plm with model = NA mf[[1L]] <- as.name("plm") mf$model <- NA data <- eval(mf, parent.frame()) # estimate the within model without instrument and extract the fixed # effects formula <- as.Formula(formula) mf$formula <- formula(formula, rhs = 1) index <- index(data) id <- index[[1L]] time <- index[[2L]] periods <- unique(time) pdim <- pdim(data) T <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N Ti <- pdim$Tint$Ti balanced <- pdim$balanced if(!balanced) stop("'aneweytest' not implemented for unbalanced data") ht <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "effect", "model", "inst.method", "restict.matrix", "restrict.rhs", "index"), names(ht), 0) ht <- ht[c(1L, m)] ht[[1L]] <- as.name("plm") ht$model <- "within" ht$effect <- "individual" ht <- eval(ht, parent.frame()) .resid <- split(resid(ht), time) # extract the covariates (no intercept), and isolate time-invariant covariates X <- model.matrix(data, model = "pooling", rhs = 1, lhs = 1)[ , -1, drop = FALSE] cst <- attr(model.matrix(data, model = "within", rhs = 1, lhs = 1), "constant") # get constant columns and remove the intercept if (length(cst) > 0L) cst <- cst[- match("(Intercept)", cst)] if (length(cst) > 0L){ vr <- colnames(X)[!(colnames(X) %in% cst)] Z <- X[ , cst, drop = FALSE] X <- X[ , vr, drop = FALSE] Kz <- ncol(Z) namesZ <- colnames(Z) } else { Z <- NULL Kz <- 0 namesZ <- NULL } Kx <- ncol(X) # time-demean and split by period: attr(X, "index") <- index X <- Within(X, effect ="time") X <- lapply(as.list(periods), function(x) X[time == x, , drop = FALSE]) # put column names for split matrices in X: for (i in 1:(length(periods))){ colnames(X[[i]]) <- paste(colnames(X[[i]]), periods[i], sep = ".") } if (!is.null(Z)){ Z <- Z[time == periods[1], , drop = FALSE] Z <- t(t(Z) - .colMeans(Z, nrow(Z), ncol(Z))) # TODO: could use Within() framework } XX <- cbind(Reduce("cbind", X), Z) # compute the unconstrained estimates # NA-freeness guaranteed by model frame construction, so can use lm.fit # (non-collinearity is not catered for but code errors anywayif collinearity # is present a bit later) # was: LMS <- lapply(.resid, function(x) lm(x ~ XX - 1)) LMS <- lapply(.resid, function(x) lm.fit(XX, x)) YTOT <- vapply(.resid, function(x) crossprod(x), FUN.VALUE = 0.0, USE.NAMES = FALSE) DEV <- vapply(LMS, function(x) crossprod(x$residuals), FUN.VALUE = 0.0, USE.NAMES = FALSE) stat <- c("chisq" = sum(1 - DEV / YTOT) * (n - ncol(XX))) df <- c("df" = (T ^ 2 - T - 1) * Kx) aneweytest <- structure(list(statistic = stat, parameter = df, method = "Angrist and Newey's test of within model", p.value = pchisq(stat, df = df, lower.tail = FALSE), alternative = "within specification does not apply", data.name = paste(deparse(formula))), class = "htest") aneweytest } #' Chamberlain estimator and test for fixed effects #' #' General estimator useful for testing the within specification #' #' The Chamberlain method consists in using the covariates of all the #' periods as regressors. It allows to test the within specification. #' #' @aliases piest #' @param formula a symbolic description for the model to be estimated, #' @param object,x an object of class `"piest"` and of class `"summary.piest"` #' for the print method of summary for piest objects, #' @param data a `data.frame`, #' @param subset see [lm()], #' @param na.action see [lm()], #' @param index the indexes, #' @param robust logical, if `FALSE`, the error is assumed to be spherical, #' if `TRUE`, a robust estimation of the covariance matrix is computed, #' @param \dots further arguments. #' @return An object of class `"piest"`. #' @export #' @author Yves Croissant #' @references #' #' \insertRef{CHAM:82}{plm} #' #' @seealso [aneweytest()] #' @keywords htest #' @examples #' #' data("RiceFarms", package = "plm") #' pirice <- piest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") #' summary(pirice) #' piest <- function(formula, data, subset, na.action, index = NULL, robust = TRUE, ...){ # NB: code fails for unbalanced data -> is Chamberlain's test only for balanced data? # unbalanced case is currently caught and a message is printed cl <- match.call(expand.dots = TRUE) mf <- match.call() # compute the model.frame using plm with model = NA mf[[1L]] <- as.name("plm") mf$model <- NA data <- eval(mf, parent.frame()) # estimate the within model without instrument and extract the fixed # effects formula <- as.Formula(formula) mf$formula <- formula(formula, rhs = 1) index <- index(data) id <- index[[1L]] time <- index[[2L]] pdim <- pdim(data) balanced <- pdim$balanced T <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N Ti <- pdim$Tint$Ti if(!balanced) stop("'piest' not implemented for unbalanced data") # extract the response, time-demean and split by period y <- pmodel.response(data, model = "pooling", effect = "individual") Y <- Within(y, "time") Y <- split(Y, time) # extract the covariates, and isolate time-invariant covariates X <- model.matrix(data, model = "pooling", rhs = 1, lhs = 1)[ , -1, drop = FALSE] cst <- attr(model.matrix(data, model = "within", rhs = 1, lhs = 1), "constant") # get constant columns and remove the intercept if (length(cst) > 0L) cst <- cst[- match("(Intercept)", cst)] if (length(cst) > 0L){ vr <- colnames(X)[!(colnames(X) %in% cst)] Z <- X[ , cst, drop = FALSE] X <- X[ , vr, drop = FALSE] Kz <- ncol(Z) namesZ <- colnames(Z) } else { Z <- NULL Kz <- 0 namesZ <- NULL } Kx <- ncol(X) namesX <- colnames(X) # time-demean X and split by period: attr(X, "index") <- index X <- Within(X, effect ="time") periods <- unique(time) X <- lapply(as.list(periods), function(x) X[time == x, , drop = FALSE]) # put columnnames for split matrices in X: for (i in 1:(length(periods))){ colnames(X[[i]]) <- paste(colnames(X[[i]]), periods[i], sep = ".") } if (!is.null(Z)){ Z <- Z[time == periods[1L], , drop = FALSE] Z <- t(t(Z) - .colMeans(Z, nrow(Z), ncol(Z))) # TODO: can use Within() framework } XX <- cbind(Reduce("cbind", X), Z) # compute the unconstrained estimates # NA-freeness guaranteed by model frame construction, so can use lm.fit # (non-collinearity is not cared for but code error if collinearity is # present anyway a bit later) # was: LMS <- lapply(Y, function(x) lm(x ~ XX - 1)) LMS <- lapply(Y, function(x) lm.fit(XX, x)) # compute the empirical covariance of the covariates Sxxm1 <- solve(crossprod(XX) / n) # compute the residuals matrix .resid <- sapply(LMS, resid) # extract the pi vector of unconstrained estimates pi <- unlist(lapply(LMS, coef), use.names = FALSE) if(robust) { Omega <- lapply(seq_len(n), function(i) tcrossprod(.resid[i, ]) %x% (Sxxm1 %*% tcrossprod(XX[i, ]) %*% Sxxm1)) Omega <- Reduce("+", Omega) / n } else { Omega <- (crossprod(.resid) / n) %x% Sxxm1 } # construct the matrix of linear restrictions R | R x theta = pi R <- matrix(0, T * (T * Kx + Kz), (T + 1) * Kx + Kz) for (i in 1:Kx){ R[ ((1:T) - 1) * (Kx * T + Kz) + (Kx * (1:T - 1)) + i , i] <- 1 } if (Kz > 0){ for (i in 1:Kz){ R[ (Kx * T) + (1:T - 1) * (Kx * T + Kz) + i, Kx + i] <- 1 } } for (i in 1:(Kx * T)){ R[((1:T) - 1) * (Kx * T + Kz) + i , Kx + Kz + i] <- 1 } solve_Omega <- solve(Omega) A <- solve(t(R) %*% solve_Omega %*% R) .coef <- as.numeric(A %*% t(R) %*% solve_Omega %*% as.numeric(pi)) # .coef <- as.numeric(solve(t(R) %*% R) %*% t(R) %*% as.numeric(pi)) namescoef <- if(Kz > 0) c(namesX, namesZ, colnames(XX)[- c(ncol(XX) - 0:(Kz-1))]) else c(namesX, namesZ, colnames(XX)) names(.coef) <- rownames(A) <- colnames(A) <- namescoef resb <- as.numeric(R %*% .coef) - as.numeric(pi) piconst <- matrix(R %*% .coef, ncol = T) OOmega <- Omega ## TODO: OOmega is never used .resid <- matrix(unlist(Y, use.names = FALSE), ncol = length(Y)) - XX %*% piconst if(TRUE){ ## TODO: this is always TRUE...! if(robust) { ## and Omega is calc. again, with a ## new .resid input but with same lapply-construct Omega <- lapply(seq_len(n), function(i) tcrossprod(.resid[i, ]) %x% (Sxxm1 %*% tcrossprod(XX[i, ]) %*% Sxxm1)) Omega <- Reduce("+", Omega) / n } else { Omega <- (crossprod(.resid) / n) %x% Sxxm1 } } A <- solve(t(R) %*% solve(Omega) %*% R) stat <- c("chisq" = n * resb %*% solve(Omega) %*% resb) df <- c("df" = Kx * (T ^ 2 - T - 1)) ## TODO: df is overwritten in next line...?! df <- c("df" = length(pi) - length(.coef)) pitest <- list(statistic = stat, parameter = df, method = "Chamberlain's pi test", p.value = pchisq(stat, df = df, lower.tail = FALSE), alternative = "within specification does not apply", data.name = paste(deparse(formula)) ) structure(list(coefficients = .coef, pi = pi, daub = resb, vcov = A / n, formula = formula, R = R, model = data, pitest = structure(pitest, class = "htest"), Omega = Omega, moments = resb, call = cl), class = c("piest", "panelmodel")) } #' @rdname piest #' @export print.piest <- function(x, ...) print(x$pitest, ...) #' @rdname piest #' @export summary.piest <- function(object,...){ # construct the table of coefficients std.err <- sqrt(diag(vcov(object))) b <- coefficients(object) z <- b / std.err p <- 2 * pnorm(abs(z), lower.tail = FALSE) object$coefficients <- cbind("Estimate" = b, "Std. Error" = std.err, "z-value" = z, "Pr(>|z|)" = p) class(object) <- c("summary.piest", "piest", "panelmodel") object } #' @rdname piest #' @param digits number of digits for printed output, #' @param width the maximum length of the lines in the printed output, #' @export print.summary.piest <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ...){ if(is.null(subset)) printCoefmat(coef(x), digits = digits, ...) else printCoefmat(coef(x)[subset, , drop = FALSE], digits = digits, ...) print(x$pitest, ...) invisible(x) } plm/R/est_vcm.R0000644000176200001440000003444614124132276013043 0ustar liggesusers#' Variable Coefficients Models for Panel Data #' #' Estimators for random and fixed effects models with variable coefficients. #' #' `pvcm` estimates variable coefficients models. Individual or time #' effects are introduced, respectively, if `effect = "individual"` #' (default) or `effect = "time"`. #' #' Coefficients are assumed to be fixed if `model = "within"`, i.e., separate #' pooled OLS models are estimated per individual (`effect = "individual"`) #' or per time period (`effect = "time"`). Coefficients are assumed to be #' random if `model = "random"` and the model by #' \insertCite{SWAM:70;textual}{plm} is estimated. It is a generalized least #' squares model which uses the results of the previous model. #' #' @aliases pvcm #' @param formula a symbolic description for the model to be estimated, #' @param object,x an object of class `"pvcm"`, #' @param data a `data.frame`, #' @param subset see `lm`, #' @param na.action see `lm`, #' @param effect the effects introduced in the model: one of #' `"individual"`, `"time"`, #' @param model one of `"within"`, `"random"`, #' @param index the indexes, see [pdata.frame()], #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param \dots further arguments. #' @return An object of class `c("pvcm", "panelmodel")`, which has the #' following elements: #' #' \item{coefficients}{the vector (or the data frame for fixed #' effects) of coefficients,} #' #' \item{residuals}{the vector of #' residuals,} #' #' \item{fitted.values}{the vector of fitted values,} #' #' \item{vcov}{the covariance matrix of the coefficients (a list for #' fixed effects model (`model = "within"`)),} #' #' \item{df.residual}{degrees of freedom of the residuals,} #' #' \item{model}{a data frame containing the variables used for the #' estimation,} #' #' \item{call}{the call,} \item{Delta}{the estimation of the #' covariance matrix of the coefficients (random effect models only),} #' #' \item{std.error}{a data frame containing standard errors for all #' coefficients for each individual (within models only).} #' #' `pvcm` objects have `print`, `summary` and `print.summary` methods. #' #' @export #' @author Yves Croissant #' @references #' #' \insertRef{SWAM:70}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' zw <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") #' zr <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") #' #' ## replicate Greene (2012), p. 419, table 11.14 #' summary(pvcm(log(gsp) ~ log(pc) + log(hwy) + log(water) + log(util) + log(emp) + unemp, #' data = Produc, model = "random")) #' #' \dontrun{ #' # replicate Swamy (1970), p. 166, table 5.2 #' data(Grunfeld, package = "AER") # 11 firm Grunfeld data needed from package AER #' gw <- pvcm(invest ~ value + capital, data = Grunfeld, index = c("firm", "year")) #' } #' #' pvcm <- function(formula, data, subset ,na.action, effect = c("individual", "time"), model = c("within", "random"), index = NULL, ...){ effect <- match.arg(effect) model.name <- match.arg(model) data.name <- paste(deparse(substitute(data))) cl <- match.call(expand.dots = TRUE) mf <- match.call() mf[[1L]] <- as.name("plm") mf$model <- NA data <- eval(mf, parent.frame()) result <- switch(model.name, "within" = pvcm.within(formula, data, effect), "random" = pvcm.random(formula, data, effect) ) class(result) <- c("pvcm", "panelmodel") result$call <- cl result$args <- list(model = model, effect = effect) result } pvcm.within <- function(formula, data, effect){ index <- attr(data, "index") id <- index[[1L]] time <- index[[2L]] pdim <- pdim(data) if (effect == "time"){ cond <- time other <- id card.cond <- pdim$nT$T } else{ cond <- id other <- time card.cond <- pdim$nT$n } ml <- split(data, cond) nr <- vapply(ml, function(x) dim(x)[1L] > 0, FUN.VALUE = TRUE) # == sapply(ml, function(x) dim(x)[1L]) > 0 ml <- ml[nr] attr(ml, "index") <- index ols <- lapply(ml, function(x){ X <- model.matrix(x) if (nrow(X) <= ncol(X)) stop("insufficient number of observations") y <- pmodel.response(x) r <- lm(y ~ X - 1, model = FALSE) nc <- colnames(model.frame(r)$X) names(r$coefficients) <- nc r }) # extract coefficients: coef <- matrix(unlist(lapply(ols, coef)), nrow = length(ols), byrow = TRUE) # was: as.data.frame(t(sapply(ols, coef)))... dimnames(coef)[1:2] <- list(names(ols), names(coef(ols[[1L]]))) # ... but that code errored with intercept-only model coef <- as.data.frame(coef) # extract residuals and make pseries: residuals <- unlist(lapply(ols, residuals)) residuals <- add_pseries_features(residuals, index) # extract standard errors: vcov <- lapply(ols, vcov) std <- matrix(unlist(lapply(vcov, function(x) sqrt(diag(x)))), nrow = length(ols), byrow = TRUE) # was: as.data.frame(t(sapply(vcov, function(x) sqrt(diag(x))))) dimnames(std)[1:2] <- list(names(vcov), colnames(vcov[[1L]])) # ... but this code errored with intercept-only model std <- as.data.frame(std) ssr <- as.numeric(crossprod(residuals)) y <- unlist(lapply(ml, function(x) x[ , 1L])) fitted.values <- y - residuals tss <- tss(y) df.resid <- pdim$nT$N - card.cond * ncol(coef) nopool <- list(coefficients = coef, residuals = residuals, fitted.values = fitted.values, vcov = vcov, df.residual = df.resid, model = data, std.error = std) nopool } pvcm.random <- function(formula, data, effect){ interc <- has.intercept(formula) index <- index(data) id <- index[[1L]] time <- index[[2L]] pdim <- pdim(data) N <- nrow(data) if (effect == "time"){ cond <- time other <- id card.cond <- pdim$nT$T } else{ cond <- id other <- time card.cond <- pdim$nT$n } ml <- split(data, cond) nr <- vapply(ml, function(x) dim(x)[1L] > 0, FUN.VALUE = TRUE) # == sapply(ml, function(x) dim(x)[1L]) > 0 ml <- ml[nr] attr(ml, "index") <- index ols <- lapply(ml, function(x){ X <- model.matrix(formula, x) if (nrow(X) <= ncol(X)) stop("insufficient number of observations") y <- pmodel.response(x) r <- lm(y ~ X - 1, model = FALSE) nc <- colnames(model.frame(r)$X) names(r$coefficients) <- nc r }) # matrix of coefficients coefm <- matrix(unlist(lapply(ols, coef)), nrow = length(ols), byrow = TRUE) dimnames(coefm)[1:2] <- list(names(ols), names(coef(ols[[1]]))) # number of covariates K <- ncol(coefm) - has.intercept(formula) # check for NA coefficients coefna <- is.na(coefm) # list of model matrices X <- lapply(ols, model.matrix) # same without the covariates with NA coefficients Xna <- lapply(seq_len(nrow(coefm)), function(i) X[[i]][ , !coefna[i, ]]) # TODO: Xna is used nowhere!? # list of model responses y <- lapply(ols, function(x) model.response(model.frame(x))) # compute a list of XpX^-1 matrices, with 0 for lines/columns with # NA coefficients xpxm1 <- lapply(seq_len(card.cond), function(i){ z <- matrix(0, ncol(coefm), ncol(coefm), dimnames = list(colnames(coefm), colnames(coefm))) z[!coefna[i, ], !coefna[i, ]] <- solve(crossprod(X[[i]][!coefna[i, ], !coefna[i, ]])) z }) # compute the mean of the parameters coefb <- colMeans(coefm, na.rm = TRUE) # insert the mean values in place of NA coefficients (if any) if(any(coefna)) coefm <- apply(coefm, 2, function(x){x[is.na(x)] <- mean(x, na.rm = TRUE); x}) # D1: compute the first part of the variance matrix coef.mb <- t(coefm) - coefb D1 <- tcrossprod(coef.mb, coef.mb / (card.cond - 1)) # TODO: this fails if only 1 individual, catch this corner case w/ informative error msg? # D2: compute the second part of the variance matrix sigi <- vapply(ols, function(x) deviance(x) / df.residual(x), FUN.VALUE = 0.0) D2 <- Reduce("+", lapply(seq_len(card.cond), function(i) sigi[i] * xpxm1[[i]])) / card.cond # if D1-D2 semi-definite positive, use it, otherwise use D1 eig <- prod(eigen(D1 - D2)$values >= 0) Delta <- if(eig) { D1 - D2 } else D1 # compute the Omega matrix for each individual Omegan <- lapply(seq_len(card.cond), function(i) sigi[i] * diag(nrow(X[[i]])) + X[[i]] %*% Delta %*% t(X[[i]])) # compute X'Omega X and X'Omega y for each individual XyOmXy <- lapply(seq_len(card.cond), function(i){ Xn <- X[[i]][ , !coefna[i, ]] ## TODO: check if drop = FALSE needed (also in other extractions) yn <- y[[i]] # pre-allocate matrices XnXn <- matrix(0, ncol(coefm), ncol(coefm), dimnames = list(colnames(coefm), colnames(coefm))) Xnyn <- matrix(0, ncol(coefm), 1L, dimnames = list(colnames(coefm), "y")) solve_Omegan_i <- solve(Omegan[[i]]) CP.tXn.solve_Omegan_i <- crossprod(Xn, solve_Omegan_i) XnXn[!coefna[i, ], !coefna[i, ]] <- CP.tXn.solve_Omegan_i %*% Xn # == t(Xn) %*% solve(Omegan[[i]]) %*% Xn Xnyn[!coefna[i, ], ] <- CP.tXn.solve_Omegan_i %*% yn # == t(Xn) %*% solve(Omegan[[i]]) %*% yn list("XnXn" = XnXn, "Xnyn" = Xnyn) }) # Compute coefficients # extract and reduce XnXn (pos 1 in list's element) and Xnyn (pos 2) # position-wise extraction is faster than name-based extraction XpXm1 <- solve(Reduce("+", vapply(XyOmXy, "[", 1L, FUN.VALUE = list(length(XyOmXy))))) beta <- XpXm1 %*% Reduce("+", vapply(XyOmXy, "[", 2L, FUN.VALUE = list(length(XyOmXy)))) beta.names <- rownames(beta) beta <- as.numeric(beta) names(beta) <- beta.names weightsn <- lapply(seq_len(card.cond), function(i){ # YC2019/30/08 #old # vcovn <- vcov(ols[[i]]) # Deltan <- Delta[! coefna[i,], ! coefna[i,]] # wn <- solve(vcovn + Deltan) #new vcovn <- vcov(ols[[i]]) wn <- solve((vcovn + Delta)[!coefna[i, ], !coefna[i, ]]) z <- matrix(0, nrow = ncol(coefm), ncol = ncol(coefm), dimnames = list(colnames(coefm), colnames(coefm))) z[!coefna[i, ], !coefna[i, ]] <- wn z } ) V <- solve(Reduce("+", weightsn)) weightsn <- lapply(weightsn, function(x) V %*% x) ## TODO: should "Beta" be called "beta"? Beta <- Reduce("+", lapply(seq_len(card.cond), function(i) weightsn[[i]] %*% coefm[i, ])) Beta.names <- rownames(Beta) Beta <- as.numeric(Beta) names(Beta) <- Beta.names XpXm1 <- V y <- pmodel.response(data) X <- model.matrix(data) fit <- as.numeric(tcrossprod(beta, X)) res <- y - fit df.resid <- N - ncol(coefm) list(coefficients = beta, residuals = res, fitted.values = fit, vcov = XpXm1, df.residual = df.resid, model = data, Delta = Delta) } #' @rdname pvcm #' @export summary.pvcm <- function(object, ...) { model <- describe(object, "model") if (model == "random") { coef_wo_int <- object$coefficients[!(names(coef(object)) %in% "(Intercept)")] int.only <- !length(coef_wo_int) object$waldstatistic <- if(!int.only) pwaldtest(object) else NULL std.err <- sqrt(diag(vcov(object))) b <- object$coefficients z <- b / std.err p <- 2 * pnorm(abs(z), lower.tail = FALSE) coef <- cbind(b, std.err, z, p) colnames(coef) <- c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") object$coefficients <- coef } object$ssr <- deviance(object) object$tss <- tss(unlist(model.frame(object))) object$rsqr <- 1 - object$ssr / object$tss class(object) <- c("summary.pvcm", "pvcm") return(object) } #' @rdname pvcm #' @export print.summary.pvcm <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...) { effect <- describe(x, "effect") formula <- formula(x) model <- describe(x, "model") cat(paste(effect.pvcm.list[effect], " ", sep = "")) cat(paste(model.pvcm.list[model], "\n", sep = "")) cat("\nCall:\n") print(x$call) cat("\n") print(pdim(model.frame(x))) cat("\nResiduals:\n") print(sumres(x)) if (model == "random") { cat("\nEstimated mean of the coefficients:\n") printCoefmat(x$coefficients, digits = digits) cat("\nEstimated variance of the coefficients:\n") print(x$Delta, digits = digits) } if (model == "within") { cat("\nCoefficients:\n") print(summary(x$coefficients)) } cat("\n") cat(paste0("Total Sum of Squares: ", signif(x$tss, digits), "\n")) cat(paste0("Residual Sum of Squares: ", signif(x$ssr, digits), "\n")) cat(paste0("Multiple R-Squared: ", signif(x$rsqr, digits), "\n")) if (model == "random" && !is.null(waldstat <- x$waldstatistic)) { cat(paste0("Chisq: ", signif(waldstat$statistic), " on ", waldstat$parameter, " DF, p-value: ", format.pval(waldstat$p.value, digits = digits), "\n")) } invisible(x) } plm/R/deprecated.R0000644000176200001440000006765214175460121013507 0ustar liggesusers#' Deprecated functions of plm #' #' `dynformula`, `pht`, `plm.data`, and `pvcovHC` are #' deprecated functions which could be removed from \pkg{plm} in a near future. #' #' `dynformula` was used to construct a dynamic formula which was the #' first argument of `pgmm`. `pgmm` uses now multi-part formulas. #' #' `pht` estimates the Hausman-Taylor model, which can now be estimated #' using the more general `plm` function. #' #' `plm.data` is replaced by `pdata.frame`. #' #' `pvcovHC` is replaced by `vcovHC`. #' #' `detect_lin_dep` was renamed to `detect.lindep`. #' #' @name plm-deprecated #' @aliases detect_lin_dep #' @param formula a formula, #' @param lag.form a list containing the lag structure of each variable in the #' formula, #' @param diff.form a vector (or a list) of logical values indicating whether #' variables should be differenced, #' @param log.form a vector (or a list) of logical values indicating whether #' variables should be in logarithms. #' @param object,x an object of class `"plm"`, #' @param data a `data.frame`, #' @param \dots further arguments. #' @param indexes a vector (of length one or two) indicating the (individual #' and time) indexes (see Details); #' @param lhs see Formula #' @param rhs see Formula #' @param model see plm #' @param effect see plm #' @param theta the parameter of transformation for the random effect model #' @param cstcovar.rm remove the constant columns or not #' NULL #' @rdname plm-deprecated #' @export pvcovHC <- function(x, ...){ .Deprecated(new = "pvcovHC", msg = "'pvcovHC' is deprecated, use 'vcovHC' instead for same functionality", old = "vcovHC") UseMethod("vcovHC") } # plm.data() is now deprecated (since February 2017). Need to keep it in package # for backward compatibility of users' code out there and packages, especially # for package 'systemfit' (systemfit supports pdata.frame since 2017-03-09 but # plm.data can be used there as well).. # # While plm.data() was a 'full function' once, it now is now using # pdata.frame() and re-works the properties of the "plm.dim" objects # original created by the 'full' plm.data() function. The 'full' # plm.data() function is kept non-exported as plm.data_depr_orig due # to reference and testing (see tests/test_plm.data.R) #' @rdname plm-deprecated #' @export plm.data <- function(x, indexes = NULL) { .Deprecated(new = "pdata.frame", msg = "use of 'plm.data' is discouraged, better use 'pdata.frame' instead", old = "plm.data") # the class "plm.dim" (which plm.data creates) deviates from class "pdata.frame": # * always contains the indexes (in first two columns (id, time)) # * does not have fancy rownames # * always coerces strings to factors # * does not have index attribute # * leaves in constant columns (albeit the 'full' implementation printed a msg about dropping those ...) # # -> call pdata.frame accordingly and adjust afterwards orig_col_order <- colnames(x) x <- pdata.frame(x, index = indexes, drop.index = FALSE, row.names = FALSE, stringsAsFactors = TRUE, replace.non.finite = TRUE, drop.NA.series = TRUE, drop.const.series = FALSE) # determine position and names of index vars in pdata.frame pos_indexes <- pos.index(x) names_indexes <- names(pos_indexes) # cannot take from arg 'indexes' as it could be only the index for id # the class "plm.dim" does not have the index attribute -> remove attr(x, "index") <- NULL # remove class 'pdata.frame' to prevent any dispatching of special methods on object x 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) x <- x[ , c(names_indexes, setdiff(orig_col_order, names_indexes))] # set class class(x) <- c("plm.dim", "data.frame") return(x) } ### pht lev2var <- function(x, ...){ # takes a data.frame and returns a vector of variable names, the # names of the vector being the names of the effect is.fact <- sapply(x, is.factor) if (sum(is.fact) > 0L){ not.fact <- names(x)[!is.fact] names(not.fact) <- not.fact x <- x[is.fact] wl <- lapply(x,levels) # nl is the number of levels for each factor nl <- sapply(wl,length) # nf is a vector of length equal to the total number of levels # containing the name of the factor nf <- rep(names(nl),nl) result <- unlist(wl) names(result) <- nf result <- paste(names(result), result, sep = "") names(nf) <- result c(nf, not.fact) } else{ z <- names(x) names(z) <- z z } } #' Hausman--Taylor Estimator for Panel Data #' #' The Hausman--Taylor estimator is an instrumental variable estimator without #' external instruments (function deprecated). #' #' `pht` estimates panels models using the Hausman--Taylor estimator, #' Amemiya--MaCurdy estimator, or Breusch--Mizon--Schmidt estimator, depending #' on the argument `model`. The model is specified as a two--part formula, #' the second part containing the exogenous variables. #' #' @aliases pht #' @param formula a symbolic description for the model to be #' estimated, #' @param object,x an object of class `"plm"`, #' @param data a `data.frame`, #' @param subset see [lm()] for `"plm"`, a character or #' numeric vector indicating a subset of the table of coefficient #' to be printed for `"print.summary.plm"`, #' @param na.action see [lm()], #' @param model one of `"ht"` for Hausman--Taylor, `"am"` #' for Amemiya--MaCurdy and `"bms"` for #' Breusch--Mizon--Schmidt, #' @param index the indexes, #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param \dots further arguments. #' @return An object of class `c("pht", "plm", "panelmodel")`. #' #' A `"pht"` object contains the same elements as `plm` #' object, with a further argument called `varlist` which #' describes the typology of the variables. It has `summary` and #' `print.summary` methods. #' #' @note The function `pht` is deprecated. Please use function `plm` #' to estimate Taylor--Hausman models like this with a three-part #' formula as shown in the example:\cr `plm(, #' random.method = "ht", model = "random", inst.method = #' "baltagi")`. The Amemiya--MaCurdy estimator and the #' Breusch--Mizon--Schmidt estimator is computed likewise with #' `plm`. #' @export #' @author Yves Croissant #' @references #' #' \insertCite{AMEM:MACU:86}{plm} #' #' \insertCite{BALT:13}{plm} #' #' \insertCite{BREU:MIZO:SCHM:89}{plm} #' #' \insertCite{HAUS:TAYL:81}{plm} #' #' @keywords regression #' @examples #' #' ## replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 #' ## preferred way with plm() #' data("Wages", package = "plm") #' ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + #' bluecol + ind + union + sex + black + ed | #' bluecol + south + smsa + ind + sex + black | #' wks + married + union + exp + I(exp ^ 2), #' data = Wages, index = 595, #' random.method = "ht", model = "random", inst.method = "baltagi") #' summary(ht) #' #' am <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + #' bluecol + ind + union + sex + black + ed | #' bluecol + south + smsa + ind + sex + black | #' wks + married + union + exp + I(exp ^ 2), #' data = Wages, index = 595, #' random.method = "ht", model = "random", inst.method = "am") #' summary(am) #' #' ## deprecated way with pht() for HT #' #ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + #' # bluecol + ind + union + sex + black + ed | #' # sex + black + bluecol + south + smsa + ind, #' # data = Wages, model = "ht", index = 595) #' #summary(ht) #' # deprecated way with pht() for AM #' #am <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + #' # bluecol + ind + union + sex + black + ed | #' # sex + black + bluecol + south + smsa + ind, #' # data = Wages, model = "am", index = 595) #' #summary(am) #' #' pht <- function(formula, data, subset, na.action, model = c("ht", "am", "bms"), index = NULL, ...){ .Deprecated(old = "pht", msg = paste0("uses of 'pht()' and 'plm(., model = \"ht\")' are discouraged, ", "better use 'plm(., model = \"random\", random.method = \"ht\", ", "inst.method = \"baltagi\"/\"am\"/\"bms\")' for Hausman-Taylor, ", "Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator")) cl <- match.call(expand.dots = TRUE) mf <- match.call() model <- match.arg(model) # compute the model.frame using plm with model = NA mf[[1L]] <- as.name("plm") mf$model <- NA data <- eval(mf, parent.frame()) # estimate the within model without instrument and extract the fixed # effects formula <- Formula(formula) if (length(formula)[2L] == 1L) stop("a list of exogenous variables should be provided") mf$model = "within" mf$formula <- formula(formula, rhs = 1) within <- eval(mf, parent.frame()) fixef <- fixef(within) id <- index(data, "id") time <- index(data, "time") pdim <- pdim(data) balanced <- pdim$balanced T <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N Ti <- pdim$Tint$Ti # get the typology of the variables X <- model.matrix(data, rhs = 1, model = "within", cstcovar.rm = "all") W <- model.matrix(data, rhs = 2, model = "within", cstcovar.rm = "all") exo.all <- colnames(W) all.all <- colnames(X) edo.all <- all.all[!(all.all %in% exo.all)] all.cst <- attr(X, "constant") exo.cst <- attr(W, "constant") if("(Intercept)" %in% all.cst) all.cst <- setdiff(all.cst, "(Intercept)") if("(Intercept)" %in% exo.cst) exo.cst <- setdiff(exo.cst, "(Intercept)") exo.var <- exo.all[!(exo.all %in% exo.cst)] edo.cst <- all.cst[!(all.cst %in% exo.cst)] edo.var <- edo.all[!(edo.all %in% edo.cst)] if (length(edo.cst) > length(exo.var)){ stop(" The number of endogenous time-invariant variables is greater than the number of exogenous time varying variables\n") } X <- model.matrix(data, model = "pooling", rhs = 1, lhs = 1) if (length(exo.var) > 0L) XV <- X[ , exo.var, drop = FALSE] else XV <- NULL if (length(edo.var) > 0L) NV <- X[ , edo.var, drop = FALSE] else NV <- NULL if (length(exo.cst) > 0L) XC <- X[ , exo.cst, drop = FALSE] else XC <- NULL if (length(edo.cst) > 0L) NC <- X[ , edo.cst, drop = FALSE] else NC <- NULL if (length(all.cst) != 0L) zo <- twosls(fixef[as.character(id)], cbind(XC, NC), cbind(XC, XV), TRUE) else zo <- lm(fixef ~ 1) sigma2 <- list() sigma2$one <- 0 sigma2$idios <- deviance(within)/ (N - n) sigma2$one <- deviance(zo) / n if(balanced){ sigma2$id <- (sigma2$one - sigma2$idios)/ T theta <- 1 - sqrt(sigma2$idios / sigma2$one) } else{ # for unbalanced data, the harmonic mean of the Ti's is used ; why ?? barT <- n / sum(1 / Ti) sigma2$id <- (sigma2$one - sigma2$idios) / barT theta <- 1 - sqrt(sigma2$idios / (sigma2$idios + Ti * sigma2$id)) theta <- theta[as.character(id)] } estec <- structure(list(sigma2 = sigma2, theta = theta), class = "ercomp", balanced = balanced, effect = "individual") y <- pmodel.response(data, model = "random", effect = "individual", theta = theta) X <- model.matrix(data, model = "random", effect = "individual", theta = theta) within.inst <- model.matrix(data, model = "within") if (model == "ht"){ between.inst <- model.matrix(data, model = "Between", rhs = 2)[ , exo.var, drop = FALSE] W <- cbind(within.inst, XC, between.inst) } if (model == "am"){ Vx <- model.matrix(data, model = "pooling", rhs = 2)[ , exo.var, drop = FALSE] if (balanced){ # Plus rapide mais pas robuste au non cylindre Vxstar <- Reduce("cbind", lapply(seq_len(ncol(Vx)), function(x) matrix(Vx[ , x], ncol = T, byrow = TRUE)[rep(1:n, each = T), ])) } else{ Xs <- lapply(seq_len(ncol(Vx)), function(x) structure(Vx[, x], index = index(data), class = c("pseries", class(Vx[, x])))) Vx2 <- Reduce("cbind", lapply(Xs, as.matrix)) Vxstar <- Vx2[rep(1:n, times = Ti), ] Vxstar[is.na(Vxstar)] <- 0 } W <- cbind(within.inst, XC, Vxstar) } if (model == "bms"){ between.inst <- model.matrix(data, model = "Between", rhs = 2)[ , exo.var, drop = FALSE] Vx <- within.inst if (balanced){ # Plus rapide mais pas robuste au non cylindre Vxstar <- Reduce("cbind", lapply(seq_len(ncol(Vx)), function(x) matrix(Vx[ , x], ncol = T, byrow = TRUE)[rep(1:n, each = T), ])) } else{ Xs <- lapply(seq_len(ncol(Vx)), function(x) structure(Vx[, x], index = index(data), class = c("pseries", class(Vx[, x])))) Vx2 <- Reduce("cbind", lapply(Xs, as.matrix)) Vxstar <- Vx2[rep(1:n, times = Ti), ] Vxstar[is.na(Vxstar)] <- 0 } W <- cbind(within.inst, XC, between.inst, Vxstar) } result <- twosls(y, X, W) K <- length(data) ve <- lev2var(data) varlist <- list(xv = unique(ve[exo.var]), nv = unique(ve[edo.var]), xc = unique(ve[exo.cst[exo.cst != "(Intercept)"]]), nc = unique(ve[edo.cst]) ) varlist <- lapply(varlist, function(x){ names(x) <- NULL; x}) result <- list(coefficients = coef(result), vcov = vcov(result), residuals = resid(result), df.residual = df.residual(result), formula = formula, model = data, varlist = varlist, ercomp = estec, call = cl, args = list(model = "ht", ht.method = model)) names(result$coefficients) <- colnames(result$vcov) <- rownames(result$vcov) <- colnames(X) class(result) <- c("pht", "plm", "panelmodel") result } #' @rdname pht #' @export summary.pht <- function(object, ...){ object$fstatistic <- pwaldtest(object, test = "Chisq") # construct the table of coefficients std.err <- sqrt(diag(vcov(object))) b <- coefficients(object) z <- b/std.err p <- 2*pnorm(abs(z), lower.tail = FALSE) object$coefficients <- cbind("Estimate" = b, "Std. Error" = std.err, "z-value" = z, "Pr(>|z|)" = p) class(object) <- c("summary.pht", "pht", "plm", "panelmodel") object } #' @rdname pht #' @export print.summary.pht <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ...){ formula <- formula(x) has.instruments <- (length(formula)[2L] >= 2L) effect <- describe(x, "effect") model <- describe(x, "model") ht.method <- describe(x, "ht.method") cat(paste(effect.plm.list[effect]," ", sep = "")) cat(paste(model.plm.list[model]," Model", sep = ""), "\n") cat(paste("(", ht.method.list[ht.method], ")", sep = ""), "\n") cat("\nCall:\n") print(x$call) # cat("\nTime-Varying Variables: ") names.xv <- paste(x$varlist$xv, collapse=", ") names.nv <- paste(x$varlist$nv, collapse=", ") names.xc <- paste(x$varlist$xc, collapse=", ") names.nc <- paste(x$varlist$nc, collapse=", ") cat(paste("\nT.V. exo : ", names.xv,"\n", sep = "")) cat(paste("T.V. endo : ", names.nv,"\n", sep = "")) # cat("Time-Invariant Variables: ") cat(paste("T.I. exo : ", names.xc, "\n", sep= "")) cat(paste("T.I. endo : ", names.nc, "\n", sep= "")) cat("\n") pdim <- pdim(x) print(pdim) cat("\nEffects:\n") print(x$ercomp) cat("\nResiduals:\n") save.digits <- unlist(options(digits = digits)) on.exit(options(digits = save.digits)) print(sumres(x)) cat("\nCoefficients:\n") if (is.null(subset)) printCoefmat(coef(x), digits = digits) else printCoefmat(coef(x)[subset, , drop = FALSE], digits = digits) cat("\n") cat(paste("Total Sum of Squares: ", signif(tss(x), digits), "\n", sep = "")) cat(paste("Residual Sum of Squares: ", signif(deviance(x),digits), "\n", sep = "")) # cat(paste("Multiple R-Squared: ",signif(x$rsq,digits),"\n",sep="")) fstat <- x$fstatistic if (names(fstat$statistic) == "F"){ cat(paste("F-statistic: ",signif(fstat$statistic), " on ",fstat$parameter["df1"]," and ",fstat$parameter["df2"], " DF, p-value: ",format.pval(fstat$p.value,digits=digits),"\n",sep="")) } else{ cat(paste("Chisq: ", signif(fstat$statistic), " on ", fstat$parameter, " DF, p-value: ", format.pval(fstat$p.value,digits=digits), "\n", sep="")) } invisible(x) } ## dynformula sumres <- function(x){ sr <- summary(unclass(resid(x))) srm <- sr["Mean"] if (abs(srm) < 1e-10){ sr <- sr[c(1:3, 5:6)] } sr } create.list <- function(alist, K, has.int, has.resp, endog, exo, default){ # if alist is NULL, create a list of 0 if (is.null(alist)) alist <- rep(list(default), K+has.resp) # if alist is not a list, coerce it if (!is.list(alist)) alist <- list(alist) if (!is.null(names(alist))){ # case where (at least) some elements are named nam <- names(alist) # vector of names of elements oalist <- alist # copy of the alist provided notnullname <- nam[nam != ""] if (any (nam == "")){ # case where one element is unnamed, and therefore is the default unnamed <- which(nam == "") if (length(unnamed) > 1L) stop("Only one unnamed element is admitted") default <- alist[[unnamed]] } else{ # case where there are no unnamed elements, the default is 0 default <- default } alist <- rep(list(default), K+has.resp) names(alist) <- c(endog, exo) alist[notnullname] <- oalist[notnullname] } else{ # case where there are no names, in this case the relevant length is # whether 1 or K+1 if (length(alist) == 1L) alist <- rep(alist, c(K+has.resp)) else if (!length(alist) %in% c(K+has.resp)) stop("irrelevant length for alist") } names(alist) <- c(endog,exo) alist } write.lags <- function(name, lags, diff){ lags <- switch(length(lags), "1" = c(0, lags), "2" = sort(lags), stop("lags should be of length 1 or 2\n") ) lag.string <- ifelse(diff, "diff", "lag") chlag <- c() if (lags[2L] != 0L){ lags <- lags[1L]:lags[2L] for (i in lags){ if (i == 0L){ if (diff) chlag <- c(chlag, paste("diff(",name,")")) else chlag <- c(chlag,name) } else{ ichar <- paste(i) chlag <- c(chlag, paste(lag.string,"(",name,",",i,")",sep="")) } } ret <- paste(chlag, collapse="+") } else{ if (diff) chlag <- paste("diff(",name,")") else chlag <- name ret <- chlag } ret } #' @rdname plm-deprecated #' @export dynformula <- function(formula, lag.form = NULL, diff.form = NULL, log.form = NULL) { .Deprecated(msg = "use of 'dynformula()' is deprecated, use a multi-part formula instead", old = "dynformula") # for backward compatibility, accept a list argument and coerce it # to a vector if (!is.null(diff.form) && !is.list(diff.form)) diff.form <- as.list(diff.form) if (!is.null(log.form) && !is.list(log.form)) log.form <- as.list(log.form) # exo / endog are the names of the variable # has.int has.resp TRUE if the formula has an intercept and a response # K is the number of exogenous variables exo <- attr(terms(formula), "term.labels") has.int <- attr(terms(formula), "intercept") == 1 if(length(formula) == 3L){ endog <- deparse(formula[[2L]]) has.resp <- TRUE } else{ endog <- NULL has.resp <- FALSE } K <- length(exo) # use the create.list function to create the lists with the relevant # default values lag.form <- create.list(lag.form, K, has.int, has.resp, endog, exo, 0) diff.form <- unlist(create.list(diff.form, K, has.int, has.resp, endog, exo, FALSE)) log.form <- unlist(create.list(log.form, K, has.int, has.resp, endog, exo, FALSE)) structure(formula, class = c("dynformula", "formula"), lag = lag.form, diff = diff.form, log = log.form, var = c(endog,exo)) } #' @rdname plm-deprecated #' @export formula.dynformula <- function(x, ...){ log.form <- attr(x, "log") lag.form <- attr(x, "lag") diff.form <- attr(x, "diff") has.resp <- length(x) == 3L exo <- attr(x, "var") if (has.resp){ endog <- exo[1L] exo <- exo[-1L] } has.int <- attr(terms(x), "intercept") == 1 chexo <- c() if (has.resp){ if (log.form[1L]) endog <- paste("log(", endog, ")", sep = "") if (diff.form[1L]) endog <- paste("diff(", endog, ")", sep = "") if ( length(lag.form[[1L]]) == 1L && lag.form[[1L]] != 0L) lag.form[[1L]] <- c(1, lag.form[[1L]]) if (!(length(lag.form[[1L]]) == 1L && lag.form[[1L]] == 0L)) chexo <- c(chexo, write.lags(endog, lag.form[[1L]], diff.form[1L])) } for (i in exo){ lag.formi <- lag.form[[i]] diff.formi <- diff.form[i] if (log.form[[i]]) i <- paste("log(",i,")", sep = "") chexo <- c(chexo, write.lags(i, lag.formi, diff.formi)) } chexo <- paste(chexo, collapse = "+") formod <- if(has.resp) { as.formula(paste(endog, "~", chexo, sep = "")) } else { as.formula(paste("~", chexo, sep = "")) } if (!has.int) formod <- update(formod, . ~ . -1) formod } #' @rdname plm-deprecated #' @export print.dynformula <- function(x, ...){ print(formula(x), ...) } #' @rdname plm-deprecated #' @export pFormula <- function(object) { .Deprecated(msg = paste0("class 'pFormula' is deprecated, simply use class", "'Formula'. 'pFormula' will be removed very soon!"), old = "pFormula", new = "Formula") stopifnot(inherits(object, "formula")) if (!inherits(object, "Formula")){ object <- Formula(object) } class(object) <- unique(c("pFormula", class(object))) object } #' @rdname plm-deprecated #' @export as.Formula.pFormula <- function(x, ...){ class(x) <- setdiff(class(x), "pFormula") x } ## pFormula stuff, usefull for cquad #' @rdname plm-deprecated #' @export as.Formula.pFormula <- function(x, ...){ class(x) <- setdiff(class(x), "pFormula") x } #' @rdname plm-deprecated #' @export model.frame.pFormula <- function(formula, data, ..., lhs = NULL, rhs = NULL){ if (is.null(rhs)) rhs <- 1:(length(formula)[2L]) if (is.null(lhs)) lhs <- if(length(formula)[1L] > 0L) 1 else 0 index <- attr(data, "index") mf <- model.frame(as.Formula(formula), as.data.frame(data), ..., rhs = rhs) index <- index[as.numeric(rownames(mf)), ] index <- droplevels(index) class(index) <- c("pindex", "data.frame") structure(mf, index = index, class = c("pdata.frame", class(mf))) } #' @rdname plm-deprecated #' @export model.matrix.pFormula <- function(object, data, model = c("pooling", "within", "Between", "Sum", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways", "nested"), rhs = 1, theta = NULL, cstcovar.rm = NULL, ...){ model <- match.arg(model) effect <- match.arg(effect) formula <- object has.intercept <- has.intercept(formula, rhs = rhs) # relevant defaults for cstcovar.rm if (is.null(cstcovar.rm)) cstcovar.rm <- ifelse(model == "within", "intercept", "none") balanced <- is.pbalanced(data) # check if inputted data is a model.frame, if not convert it to # model.frame (important for NA handling of the original data when # model.matrix.pFormula is called directly) As there is no own # class for a model.frame, check if the 'terms' attribute is # present (this mimics what lm does to detect a model.frame) if (is.null(attr(data, "terms"))) data <- model.frame.pFormula(pFormula(formula), data) # this goes to Formula::model.matrix.Formula: X <- model.matrix(as.Formula(formula), rhs = rhs, data = data, ...) # check for infinite or NA values and exit if there are some if(any(! is.finite(X))) stop(paste("model matrix or response contains non-finite", "values (NA/NaN/Inf/-Inf)")) X.assi <- attr(X, "assign") X.contr <- attr(X, "contrasts") X.contr <- X.contr[ ! sapply(X.contr, is.null) ] index <- index(data) checkNA.index(index) # check for NAs in model.frame's index and error if any attr(X, "index") <- index if (effect == "twoways" && model %in% c("between", "fd")) stop("twoways effect only relevant for within, random and pooling models") if (model == "within") X <- Within(X, effect) if (model == "Sum") X <- Sum(X, effect) if (model == "Between") X <- Between(X, effect) if (model == "between") X <- between(X, effect) if (model == "mean") X <- Mean(X) if (model == "fd") X <- pdiff(X, effect = "individual", has.intercept = has.intercept) if (model == "random"){ if (is.null(theta)) stop("a theta argument should be provided") if (effect %in% c("time", "individual")) X <- X - theta * Between(X, effect) if (effect == "nested") X <- X - theta$id * Between(X, "individual") - theta$gp * Between(X, "group") if (effect == "twoways" && balanced) X <- X - theta$id * Between(X, "individual") - theta$time * Between(X, "time") + theta$total * Mean(X) } if (cstcovar.rm == "intercept"){ posintercept <- match("(Intercept)", colnames(X)) if (! is.na(posintercept)) X <- X[ , - posintercept, drop = FALSE] } if (cstcovar.rm %in% c("covariates", "all")){ cols <- apply(X, 2, is.constant) cstcol <- names(cols)[cols] posintercept <- match("(Intercept)", cstcol) cstintercept <- if(is.na(posintercept)) FALSE else TRUE zeroint <- if(cstintercept && max(X[, posintercept]) < sqrt(.Machine$double.eps)) TRUE else FALSE if (length(cstcol) > 0L){ if ((cstcovar.rm == "covariates" || !zeroint) && cstintercept) cstcol <- cstcol[- posintercept] if (length(cstcol) > 0L){ X <- X[, - match(cstcol, colnames(X)), drop = FALSE] attr(X, "constant") <- cstcol } } } structure(X, assign = X.assi, contrasts = X.contr, index = index) } plm/R/est_gmm.R0000644000176200001440000011473614154734502013042 0ustar liggesusers#' Generalized Method of Moments (GMM) Estimation for Panel Data #' #' Generalized method of moments estimation for static or dynamic #' models with panel data. #' #' #' `pgmm` estimates a model for panel data with a generalized method #' of moments (GMM) estimator. The description of the model to #' estimate is provided with a multi--part formula which is (or which #' is coerced to) a `Formula` object. The first right--hand side part #' describes the covariates. The second one, which is mandatory, #' describes the GMM instruments. The third one, which is optional, #' describes the 'normal' instruments. By default, all the variables #' of the model which are not used as GMM instruments are used as #' normal instruments with the same lag structure as the one specified #' in the model. #' #' `y~lag(y, 1:2)+lag(x1, 0:1)+lag(x2, 0:2) | lag(y, 2:99)` is similar to #' #' `y~lag(y, 1:2)+lag(x1, 0:1)+lag(x2, 0:2) | lag(y, 2:99) | lag(x1, #' 0:1)+lag(x2, 0:2)` #' #' and indicates that all lags from 2 of `y` are used #' as GMM instruments. #' #' `transformation` indicates how the model should be transformed for #' the estimation. `"d"` gives the "difference GMM" model #' \insertCite{@see @AREL:BOND:91}{plm}, `"ld"` the "system GMM" model #' \insertCite{@see @BLUN:BOND:98}{plm}. #' #' `pgmm` is an attempt to adapt GMM estimators available within the #' DPD library for GAUSS \insertCite{@see @AREL:BOND:98}{plm} and Ox #' \insertCite{@see @DOOR:AREL:BOND:12}{plm} and within the xtabond2 #' library for Stata \insertCite{@see @ROOD:09}{plm}. #' #' @aliases pgmm #' @param formula a symbolic description for the model to be #' estimated. The preferred interface is now to indicate a #' multi--part formula, the first two parts describing the #' covariates and the GMM instruments and, if any, the third part #' the 'normal' instruments, #' @param object,x an object of class `"pgmm"`, #' @param data a `data.frame` (neither factors nor character vectors #' will be accepted in `data.frame`), #' @param subset see [lm()], #' @param na.action see [lm()], #' @param effect the effects introduced in the model, one of #' `"twoways"` (the default) or `"individual"`, #' @param model one of `"onestep"` (the default) or `"twosteps"`, #' @param collapse if `TRUE`, the GMM instruments are collapsed (default is #' `FALSE`), #' @param lost.ts the number of lost time series: if `NULL`, this is #' automatically computed. Otherwise, it can be defined by the #' user as a numeric vector of length 1 or 2. The first element is #' the number of lost time series in the model in difference, the #' second one in the model in level. If the second element is #' missing, it is set to the first one minus one, #' @param transformation the kind of transformation to apply to the #' model: either `"d"` (the default value) for the #' "difference GMM" model or `"ld"` for the "system GMM" model, #' @param fsm the matrix for the one step estimator: one of `"I"` #' (identity matrix) or `"G"` (\eqn{=D'D} where \eqn{D} is the #' first--difference operator) if `transformation="d"`, one of #' `"GI"` or `"full"` if `transformation="ld"`, # TODO: fms = NULL (default)/"full"/"GI" not explained; arg fsm is not evaluated at all #' @param index the indexes, #' @param \dots further arguments. #' @param robust for pgmm's summary method: if `TRUE` (default), robust inference #' is performed in the summary, #' @param time.dummies for pgmm's summary method: if `TRUE`, the estimated #' coefficients of time dummies are present in the table of coefficients; #' default is `FALSE`, thus time dummies are dropped in summary's coefficient #' table (argument is only meaningful if there are time dummies in the model, #' i.e., only for `effect = "twoways"`), #' @param digits digits, #' @param width the maximum length of the lines in the print output. #' @return An object of class `c("pgmm","panelmodel")`, which has the #' following elements: #' #' \item{coefficients}{the vector (or the list for fixed effects) of #' coefficients,} #' \item{residuals}{the list of residuals for each individual,} #' \item{vcov}{the covariance matrix of the coefficients,} #' \item{fitted.values}{the vector of fitted values,} #' \item{df.residual}{degrees of freedom of the residuals,} #' \item{model}{a list containing the variables used for the #' estimation for each individual,} #' \item{W}{a list containing the instruments for each individual (a matrix per #' list element) (two lists in case of system GMM,} # TODO: not correct W does not contain two lists for system GMM #' \item{A1}{the weighting matrix for the one--step estimator,} #' \item{A2}{the weighting matrix for the two--steps estimator,} #' \item{call}{the call.} #' #' In addition, it has attribute `"pdim"` which contains the pdim object for #' model. #' #' It has `print`, `summary` and `print.summary` methods. #' @author Yves Croissant #' @export #' @importFrom MASS ginv #' @seealso #' #' [sargan()] for the Hansen--Sargan test and [mtest()] for #' Arellano--Bond's test of serial correlation. [dynformula()] for #' dynamic formulas (deprecated). #' @references #' #' \insertAllCited{} #' #' @keywords regression #' @examples #' #' data("EmplUK", package = "plm") #' #' ## Arellano and Bond (1991), table 4 col. b #' z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) #' + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), #' data = EmplUK, effect = "twoways", model = "twosteps") #' summary(z1, robust = FALSE) #' #' ## Blundell and Bond (1998) table 4 (cf. DPD for OX p. 12 col. 4) #' z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + #' lag(log(capital), 0:1) | lag(log(emp), 2:99) + #' lag(log(wage), 2:99) + lag(log(capital), 2:99), #' data = EmplUK, effect = "twoways", model = "onestep", #' transformation = "ld") #' summary(z2, robust = TRUE) #' #' \dontrun{ #' ## Same with the old formula or dynformula interface #' ## Arellano and Bond (1991), table 4, col. b #' z1 <- pgmm(log(emp) ~ log(wage) + log(capital) + log(output), #' lag.form = list(2,1,0,1), data = EmplUK, #' effect = "twoways", model = "twosteps", #' gmm.inst = ~log(emp), lag.gmm = list(c(2,99))) #' summary(z1, robust = FALSE) #' #' ## Blundell and Bond (1998) table 4 (cf DPD for OX p. 12 col. 4) #' z2 <- pgmm(dynformula(log(emp) ~ log(wage) + log(capital), list(1,1,1)), #' data = EmplUK, effect = "twoways", model = "onestep", #' gmm.inst = ~log(emp) + log(wage) + log(capital), #' lag.gmm = c(2,99), transformation = "ld") #' summary(z2, robust = TRUE) #' } #' pgmm <- function(formula, data, subset, na.action, effect = c("twoways", "individual"), model = c("onestep", "twosteps"), collapse = FALSE, # TODO: collapse does not seem to be assumed a locigal in the code below but rahter a character vector lost.ts = NULL, transformation = c("d", "ld"), fsm = NULL, # TODO: argument 'fsm' is not evaluated, index = NULL, ...) { # yX : response / covariates, W : gmm instruments, Z : normal # instruments, V : time dummies # cl <- match.call(expand.dots = FALSE) cl <- match.call(expand.dots = TRUE) effect <- match.arg(effect) model <- match.arg(model) transformation <- match.arg(transformation) namesV <- NULL ################################################################# ##### 1. Backward compatibility with the old formula / dynformula ##### interface ################################################################# if (inherits(formula, "dynformula") || length(Formula(formula))[2L] == 1L){ if (!inherits(formula, "dynformula")){ formula <- match.call(expand.dots = TRUE) m <- match(c("formula", "lag.form", "diff.form", "log.form"),names(formula),0) formula <- formula[c(1L, m)] formula[[1L]] <- as.name("dynformula") formula <- cl$formula <- eval(formula, parent.frame()) } response.name <- paste(deparse(formula[[2L]])) main.lags <- attr(formula, "lag") if (length(main.lags[[1L]]) == 1L && main.lags[[1L]] > 1L) main.lags[[1L]] <- c(1L, main.lags[[1L]]) main.lags[2:length(main.lags)] <- lapply(main.lags[2:length(main.lags)], function(x){ if (length(x) == 1L && x != 0) x <- c(0, x) x }) main.form <- dynterms2formula(main.lags, response.name) dots <- list(...) gmm.inst <- dots$gmm.inst lag.gmm <- dots$lag.gmm instruments <- dots$instruments gmm.form <- dynformula(gmm.inst, lag.form = lag.gmm) gmm.lags <- attr(gmm.form, "lag") gmm.lags <- lapply(gmm.lags, function(x) min(x):max(x)) gmm.form <- dynterms2formula(gmm.lags) formula <- as.Formula(main.form, gmm.form) } ################################################################# ##### 2. Extract the response/covariates, the gmm instruments and ##### the "normal" instruments, as a named list containing the lag ##### structure ################################################################# x <- formula if (!inherits(x, "Formula")) x <- Formula(formula) # gmm instruments : named list with the lags, names being the variables gmm.form <- formula(x, rhs = 2, lhs = 0) gmm.lags <- dynterms(gmm.form) cardW <- length(gmm.lags) if (is.null(names(collapse))){ if (length(collapse) == 1L){ collapse <- as.vector(rep(collapse, cardW), mode = "list") } else{ if (length(collapse) != cardW) stop("the 'collapse' vector has a wrong length") } names(collapse) <- names(gmm.lags) } else{ if (any(! (names(collapse) %in% names(gmm.lags)))) stop("unknown names in the 'collapse' vector") else{ bcollapse <- as.vector(rep(FALSE, cardW), mode = "list") names(bcollapse) <- names(gmm.lags) bcollapse[names(collapse)] <- collapse collapse <- bcollapse } } # covariates : named list with the lags, names being the variables main.form <- formula(x, rhs = 1, lhs = 1) main.lags <- dynterms(main.form) # Three possibilities for 'normal' instruments : # 1. the third part of the formula describes them # 2. all variables not used as gmm are normal instruments # 3. all variables are gmm instruments and therefore, there are no # normal instruments except maybe time dummies # the third part of the formula (if any) deals with the 'normal' instruments if (length(x)[2L] == 3L){ normal.instruments <- TRUE inst.form <- formula(x, rhs = 3, lhs = 0) # the . - x1 + x2 syntax is allowed, in this case update with the first part inst.form <- update(main.form, inst.form) inst.form <- formula(Formula(inst.form), lhs = 0) inst.lags <- dynterms(inst.form) } else{ # the default 'normal' instruments is the subset of covariates # which are not used as gmm instruments iv <- names(main.lags)[! names(main.lags) %in% names(gmm.lags)] inst.lags <- main.lags[iv] # generate the formula for 'normal' instruments if (length(inst.lags) > 0L){ normal.instruments <- TRUE inst.form <- dynterms2formula(inst.lags) } else{ # the case where there are no normal instruments : set inst.form # and inst.lags to NULL normal.instruments <- FALSE inst.form <- NULL inst.lags <- NULL } } ################################################################# ##### 3. How many time series are lost ################################################################# if (!is.null(lost.ts)){ if (!is.numeric(lost.ts)) stop("argument 'lost.ts' should be numeric") lost.ts <- as.numeric(lost.ts) if (!(length(lost.ts) %in% c(1L, 2L))) stop("argument 'lost.ts' should be of length 1 or 2") TL1 <- lost.ts[1L] TL2 <- if(length(lost.ts) == 1L) { TL1 - 1 } else lost.ts[2L] } else{ # How many time series are lost? May be the maximum number of lags # of any covariates + 1 because of first - differencing or the # largest minimum lag for any gmm or normal instruments # min or max to select the number of lost time series? gmm.minlag <- min(unlist(gmm.lags, use.names = FALSE)) # was (==): min(sapply(gmm.lags, min)) inst.maxlag <- if (!is.null(inst.lags)) max(unlist(inst.lags, use.names = FALSE)) else 0 # was (==): max(sapply(inst.lags, max)) else 0 main.maxlag <- max(unlist(main.lags, use.names = FALSE)) # was (==): max(sapply(main.lags, max)) TL1 <- max(main.maxlag + 1, inst.maxlag + 1, gmm.minlag) TL2 <- max(main.maxlag, inst.maxlag, gmm.minlag - 1) # if TL2 = 0 (no lags), one observation is lost anyway because of # the differentiation of the lag instruments TL1 <- max(main.maxlag + 1, gmm.minlag) ## TODO: TL1, TL2 calc. twice and prev. result overwritten!?! TL2 <- max(main.maxlag, gmm.minlag - 1) } ################################################################# ##### 4. Compute the model frame which contains the ##### response/covariates, the gmm instruments and the 'normal' ##### instruments without the lags ################################################################# gmm.form <- as.formula(paste("~", paste(names(gmm.lags), collapse = "+"))) if (!is.null(inst.form)) Form <- as.Formula(main.form, gmm.form, inst.form) else Form <- as.Formula(main.form, gmm.form) mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "index"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("plm") mf$model <- NA mf$formula <- Form mf$na.action <- "na.pass" mf$subset <- NULL data <- eval(mf, parent.frame()) index <- index(data) pdim <- pdim(data) N <- pdim$nT$n T <- pdim$nT$T balanced <- pdim$balanced # if the data is unbalanced, "balance" the data if (!balanced){ un.id <- sort(unique(index(data, "id"))) un.time <- sort(unique(index(data, "time"))) rownames(data) <- paste(index(data, "id"), index(data, "time"), sep = ".") allRows <- as.character(t(outer(un.id, un.time, paste, sep = "."))) data <- data[allRows, ] rownames(data) <- allRows index <- data.frame(id = rep(un.id, each = length(un.time)), time = rep(un.time, length(un.id)), row.names = rownames(data)) class(index) <- c("pindex", "data.frame") attr(data, "index") <- index } ################################################################# ##### 5. Get the response/covariates matrix yX, the gmm instruments ##### matrix W and the normal instruments matrix inst, split by ##### individuals ################################################################# attr(data, "formula") <- formula(main.form) yX <- extract.data(data) names.coef <- colnames(yX[[1L]])[-1L] if (normal.instruments){ attr(data, "formula") <- inst.form Z <- extract.data(data) } else Z <- NULL attr(data, "formula") <- gmm.form W <- extract.data(data, as.matrix = FALSE) ################################################################# ##### 6. Create the matrix of response/covariates, gmm instruments ##### and normal instruments for the diff model ################################################################# # create the matrix of gmm instruments for every individual W1 <- lapply(W, function(x){ u <- mapply(makegmm, x, gmm.lags, TL1, collapse, SIMPLIFY = FALSE) u <- matrix(unlist(u), nrow = nrow(u[[1L]])) u } ) # differentiate the matrix of response/covariates (and of normal # instruments if any) and remove T1 - 1 time series (xd is already # differenced) yX1 <- lapply(yX, function(x){ xd <- diff(x) xd <- xd[- c(1:(TL1 - 1)), , drop = FALSE] xd } ) if (normal.instruments){ Z1 <- lapply(Z, function(x){ xd <- diff(x) xd <- xd[- c(1:(TL1 - 1)), , drop = FALSE] xd } ) } ################################################################# ##### 7. In case of system gmm, create the matrix of ##### response/covariates, gmm instruments and normal instruments ##### for the level model and merge with the diff model ################################################################# if (transformation == "ld"){ W2 <- lapply(W, function(x){ u <- mapply(makeW2, x, collapse, SIMPLIFY = FALSE) # the matrix of instruments in difference has T - 2 # rows if one time series is lost (there are no gmm # instruments for t = 2 but there is a moment # condition with the intercept. In this case, a row # of 0 should be added. Otherwise, the number of # rows is just T - TL2 nrow.ud <- if(TL2 == 1L) { T - 2 } else { T - TL2 } u <- matrix(unlist(u), nrow = nrow.ud) if (TL2 == 1) u <- rbind(0, u) u } ) # remove the relevant number of time series for data in level yX2 <- lapply(yX, function(x){ x <- x[- c(0:TL2), , drop = FALSE] x } ) if (normal.instruments){ Z2 <- lapply(Z, function(x){x <- x[- c(0:TL2), , drop = FALSE]; x}) } } ################################################################# ##### 8. Add time dummies if effect = "twoways" ################################################################# if (effect == "twoways"){ namesV <- levels(index(data, which = "time")) if (transformation == "d"){ V1 <- td.model.diff <- diff(diag(1, T - TL1 + 1))[, -1] namesV <- namesV[- c(0:(TL1))] } else{ td <- cbind(1, rbind(0, diag(1, T - 1))) # remove as many columns and rows as there are lost time series # in level (the difference of position between rows and columns # is due to the fact that the first column of td is the # intercept and should be kept anyway V2 <- td[- c(1:TL2), - c(2:(2 + TL2 - 1))] V1 <- diff(V2) namesV <- c("(Intercept)", namesV[- c(0:TL2 + 1)]) } for (i in 1:N){ yX1[[i]] <- cbind(yX1[[i]], V1) if (transformation == "d"){ W1[[i]] <- cbind(W1[[i]], V1) } else{ W2[[i]] <- cbind(W2[[i]], V2) yX2[[i]] <- cbind(yX2[[i]], V2) } } } # A QAD fix for the bug in mtest for ld model without time.dummies if (effect == "individual" && transformation == "ld"){ namesV <- levels(index(data, which = "time")) namesV <- c("(Intercept)", namesV[-c(0:TL2 + 1)]) } ################################################################# ##### 9. In case of unbalanced data, replace NA's by 0 and overwrite ##### rows for missing time series with 0 ################################################################# for (i in 1:N){ narows <- apply(yX1[[i]], 1, function(z) anyNA(z)) yX1[[i]][narows, ] <- 0 W1[[i]][is.na(W1[[i]])] <- 0 W1[[i]][narows, ] <- 0 if (normal.instruments){ Z1[[i]][is.na(Z1[[i]])] <- 0 Z1[[i]][narows, ] <- 0 } if (transformation == "ld"){ narows <- apply(yX2[[i]], 1, function(z) anyNA(z)) yX2[[i]][narows, ] <- 0 W2[[i]][is.na(W2[[i]])] <- 0 W2[[i]][narows, ] <- 0 if (normal.instruments){ Z2[[i]][is.na(Z2[[i]])] <- 0 Z2[[i]][narows, ] <- 0 } } } ################################################################# ##### 10. In case of sys gmm, bdiag or rbind the diff and level ##### matrices ################################################################# if (transformation == "ld"){ for (i in 1:N){ W1[[i]] <- bdiag(W1[[i]], W2[[i]]) yX1[[i]] <- rbind(yX1[[i]], yX2[[i]]) if (normal.instruments) Z1[[i]] <- bdiag(Z1[[i]], Z2[[i]]) } } if (normal.instruments){ for (i in 1:N) W1[[i]] <- cbind(W1[[i]], Z1[[i]]) } ################################################################# ##### 11. Compute the estimator ################################################################# W <- W1 yX <- yX1 # Compute the first step matrices if (transformation == "d") A1 <- tcrossprod(diff(diag(1, T - TL1 + 1))) if (transformation == "ld") A1 <- FSM(T - TL2, "full") # TODO: always uses "full" but man page tells otherwise # compute the estimator ## WX <- mapply(function(x, y) crossprod(x, y), W, yX, SIMPLIFY = FALSE) ## WX <- Reduce("+", WX) ## zerolines <- which(apply(WX, 1, function(z) sum(abs(z))) == 0) ## for (i in 1:N) W[[i]] <- W[[i]][, - zerolines] WX <- mapply(function(x, y) crossprod(x, y), W, yX, SIMPLIFY = FALSE) Wy <- lapply(WX, function(x) x[ , 1L]) WX <- lapply(WX, function(x) x[ , -1L, drop = FALSE]) A1 <- lapply(W, function(x) crossprod(t(crossprod(x, A1)), x)) A1 <- Reduce("+", A1) minevA1 <- min(eigen(A1)$values) eps <- 1E-9 A1 <- if(minevA1 < eps){ warning("the first-step matrix is singular, a general inverse is used") ginv(A1) } else solve(A1) A1 <- A1 * length(W) WX <- Reduce("+", WX) Wy <- Reduce("+", Wy) t.CP.WX.A1 <- t(crossprod(WX, A1)) B1 <- solve(crossprod(WX, t.CP.WX.A1)) Y1 <- crossprod(t.CP.WX.A1, Wy) coefficients <- as.numeric(crossprod(B1, Y1)) if (effect == "twoways") names.coef <- c(names.coef, namesV) names(coefficients) <- names.coef residuals <- lapply(yX, function(x) as.vector(x[ , 1L] - crossprod(t(x[ , -1L, drop = FALSE]), coefficients))) outresid <- lapply(residuals, function(x) outer(x, x)) A2 <- mapply(function(x, y) crossprod(t(crossprod(x, y)), x), W, outresid, SIMPLIFY = FALSE) A2 <- Reduce("+", A2) minevA2 <- min(eigen(A2)$values) A2 <- if (minevA2 < eps) { warning("the second-step matrix is singular, a general inverse is used") ginv(A2) } else solve(A2) if (model == "twosteps") { coef1s <- coefficients t.CP.WX.A2 <- t(crossprod(WX, A2)) Y2 <- crossprod(t.CP.WX.A2, Wy) B2 <- solve(crossprod(WX, t.CP.WX.A2)) coefficients <- as.numeric(crossprod(B2, Y2)) names(coefficients) <- names.coef # calc. residuals with coefs from 2nd step residuals <- lapply(yX, function(x){ nz <- rownames(x) z <- as.vector(x[ , 1L] - crossprod(t(x[ , -1L, drop = FALSE]), coefficients)) names(z) <- nz z}) vcov <- B2 } else vcov <- B1 rownames(vcov) <- colnames(vcov) <- names.coef # TODO: yX does not contain the original data (but first-diff-ed data) -> fitted.values not what you would expect fitted.values <- mapply(function(x, y) x[ , 1L] - y, yX, residuals) # fitted.values <- data[ , 1L] - unlist(residuals) # in 'data' is original data, but obs lost due to diff-ing are not dropped -> format incompatible if(model == "twosteps") coefficients <- list(coef1s, coefficients) args <- list(model = model, effect = effect, transformation = transformation, # collapse = collapse, # TODO: this would give a list of instruments, not the logical collapse as arg input namest = namesV) result <- list(coefficients = coefficients, residuals = residuals, # is a list (but documentation said for a long time 'vector'), mtest() and sargan() expect a list vcov = vcov, fitted.values = fitted.values, # df.residual = df.residual, # TODO: df.residual is not defined here, hence the function 'df.residual' is attached by this model = yX, W = W, A1 = A1, A2 = A2, call = cl, args = args) result <- structure(result, class = c("pgmm", "panelmodel"), pdim = pdim) result } dynterms <- function(x){ trms.lab <- attr(terms(x), "term.labels") result <- getvar(trms.lab) nv <- names(result) dn <- names(table(nv))[table(nv) > 1] un <- names(table(nv))[table(nv) == 1] resu <- result[un] for (i in dn){ v <- sort(unique(unlist(result[nv == i]))) names(v) <- NULL resu[[i]] <- v } resu } getvar <- function(x){ x <- as.list(x) result <- lapply(x, function(y){ deb <- as.numeric(gregexpr("lag\\(", y)[[1L]]) if (deb == -1){ lags <- 0 avar <- y } else{ # inspar <- substr(y, deb + 2, nchar(y) - 1) inspar <- substr(y, deb + 4, nchar(y) - 1) coma <- as.numeric(gregexpr(",", inspar)[[1L]][1L]) if (coma == -1){ endvar <- nchar(inspar) lags <- 1 } else{ endvar <- coma - 1 lags <- substr(inspar, coma + 1, nchar(inspar)) lags <- eval(parse(text = lags)) } avar <- substr(inspar, 1, endvar) } list(avar, lags) } ) nres <- sapply(result, function(x) x[[1L]]) result <- lapply(result, function(x) x[[2L]]) names(result) <- nres result } dynterms2formula <- function(x, response.name = NULL){ result <- character(0) for (i in 1:length(x)){ theinst <- x[[i]] # if the first element is zero, write the variable without lag and # drop the 0 from the vector if (theinst[1L] == 0){ at <- names(x)[i] theinst <- theinst[-1L] } else{ at <- character(0) } # if there are still some lags, write them if (length(theinst) > 0L){ if (length(theinst) > 1L){ at <- c(at, paste("lag(", names(x)[i], ",c(", paste(theinst, collapse = ","), "))", sep ="")) } else{ at <- c(at, paste("lag(", names(x)[i], ",", theinst, ")", sep ="")) } } result <- c(result, at) } if (is.null(response.name)) as.formula(paste("~", paste(result, collapse = "+"))) else as.formula(paste(response.name, "~", paste(result, collapse = "+"))) } extract.data <- function(data, as.matrix = TRUE){ # the previous version is *very* slow because : # 1. split works wrong on pdata.frame # 2. model.matrix is lapplied ! form <- attr(data, "formula") trms <- terms(form) has.response <- attr(trms, 'response') == 1 has.intercept <- attr(trms, 'intercept') == 1 if (has.intercept == 1){ # Formula is unable to update formulas with no lhs form <- Formula(update(formula(form), ~ . -1)) # form <- update(form, ~. -1) } index <- attr(data, "index") X <- model.matrix(form, data) if (has.response){ X <- cbind(data[[1L]], X) colnames(X)[1L] <- deparse(trms[[2L]]) } data <- split(as.data.frame(X), index[[1L]]) time <- split(index[[2L]], index[[1L]]) data <- mapply( function(x, y){ rownames(x) <- y if (as.matrix) x <- as.matrix(x) x } , data, time, SIMPLIFY = FALSE) data } G <- function(t){ G <- matrix(0, t, t) for (i in 1:(t-1)){ G[i, i] <- 2 G[i, i+1] <- -1 G[i+1, i] <- -1 } G[t, t] <- 2 G } FD <- function(t){ FD <- Id(t)[-1L, ] for (i in 1:(t-1)){ FD[i, i] <- -1 } FD } Id <- function(t){ diag(1, t) } FSM <- function(t, fsm){ switch(fsm, "I" = Id(t), "G" = G(t), "GI" = bdiag(G(t-1), Id(t)), "full" = rbind(cbind(G(t-1), FD(t)), cbind(t(FD(t)), Id(t))) ) } makegmm <- function(x, g, TL1, collapse = FALSE){ T <- length(x) rg <- range(g) z <- as.list((TL1 + 1):T) x <- lapply(z, function(y) x[max(1, y - rg[2L]):(y - rg[1L])]) if (collapse) { x <- lapply(x, rev) m <- matrix(0, T - TL1, min(T - rg[1L], rg[2L]+1-rg[1L])) for (y in 1:length(x)){ m[y, 1:length(x[[y]])] <- x[[y]]} result <- m } else { lx <- vapply(x, length, FUN.VALUE = 0.0) n <- length(x) lxc <- cumsum(lx) before <- c(0, lxc[-n]) after <- lxc[n] - lx - before result <- t(mapply(function(x, y, z) c(rep(0, y), x, rep(0, z)), x, before, after, SIMPLIFY = TRUE)) } result } makeW2 <-function (x, collapse = FALSE){ if(collapse) { diff(x[-c(length(x))]) } else { diag(diff(x[-c(length(x))])) } } #' @rdname pgmm #' @export coef.pgmm <- function(object,...){ model <- describe(object, "model") if(model == "onestep") object$coefficients else object$coefficients[[2L]] } #' @rdname pgmm #' @export summary.pgmm <- function(object, robust = TRUE, time.dummies = FALSE, ...) { model <- describe(object, "model") effect <- describe(object, "effect") transformation <- describe(object, "transformation") vv <- if(robust) vcovHC(object) else vcov(object) K <- if(model == "onestep") length(object$coefficients) else length(object$coefficients[[2L]]) object$sargan <- sargan(object, "twosteps") object$m1 <- mtest(object, order = 1, vcov = vv) # TODO: catch case when order = 2 is not feasible due to too few data object$m2 <- mtest(object, order = 2, vcov = vv) object$wald.coef <- pwaldtest(object, param = "coef", vcov = vv) if(effect == "twoways") object$wald.td <- pwaldtest(object, param = "time", vcov = vv) Kt <- length(object$args$namest) rowsel <- if(!time.dummies && effect == "twoways") -c((K - Kt + 1):K) else 1:K std.err <- sqrt(diag(vv)) b <- coef(object) z <- b / std.err p <- 2 * pnorm(abs(z), lower.tail = FALSE) coefficients <- cbind(b, std.err, z, p) colnames(coefficients) <- c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") object$coefficients <- coefficients[rowsel, , drop = FALSE] class(object) <- "summary.pgmm" object } #' Arellano--Bond Test of Serial Correlation #' #' Test of serial correlation for models estimated by GMM #' #' The Arellano--Bond test is a test of correlation based on the residuals of #' the estimation. By default, the computation is done with the standard #' covariance matrix of the coefficients. A robust estimator of this #' covariance matrix can be supplied with the `vcov` argument. #' #' @param object an object of class `"pgmm"`, #' @param order integer: the order of the serial correlation, #' @param vcov a matrix of covariance for the coefficients or a function to #' compute it, #' @param \dots further arguments (currently unused). #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant #' @seealso [pgmm()] #' @references #' #' \insertCite{AREL:BOND:91}{plm} #' #' @keywords htest #' @examples #' #' data("EmplUK", package = "plm") #' ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + #' lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), #' data = EmplUK, effect = "twoways", model = "twosteps") #' mtest(ar, order = 1L) #' mtest(ar, order = 2L, vcov = vcovHC) #' mtest <- function(object, ...) { UseMethod("mtest") } #' @rdname mtest #' @export mtest.pgmm <- function(object, order = 1L, vcov = NULL, ...) { if (!inherits(object, "pgmm")) stop("argument 'object' needs to be class 'pgmm'") myvcov <- vcov if (is.null(vcov)) vv <- vcov(object) else if (is.function(vcov)) vv <- myvcov(object) else vv <- myvcov model <- describe(object, "model") transformation <- describe(object, "transformation") Kt <- length(object$args$namest) switch(transformation, "d" = { resid <- object$residuals residl <- lapply(resid, function(x) c(rep(0, order), x[1:(length(x) - order)])) }, "ld" = { resid <- lapply(object$residuals, function(x) c(x[-c(Kt:(2 * Kt + 1))], rep(0, Kt))) residl <- lapply(object$residuals, function(x) c(rep(0, order), x[1:(Kt - order - 1)], rep(0, Kt))) }) X <- lapply(object$model, function(x) x[ , -1L, drop = FALSE]) W <- object$W A <- if(model == "onestep") object$A1 else object$A2 EVE <- Reduce("+", mapply(function(x, y) t(y) %*% x %*% t(x) %*% y, resid, residl, SIMPLIFY = FALSE)) EX <- Reduce("+", mapply(crossprod, residl, X, SIMPLIFY = FALSE)) XZ <- Reduce("+", mapply(crossprod, W, X, SIMPLIFY = FALSE)) ZVE <- Reduce("+", mapply(function(x, y, z) t(x) %*% y %*% t(y) %*% z, W, resid, residl, SIMPLIFY = FALSE)) denom <- EVE - 2 * EX %*% vcov(object) %*% t(XZ) %*% A %*% ZVE + EX %*% vv %*% t(EX) num <- Reduce("+", mapply(crossprod, resid, residl, SIMPLIFY = FALSE)) stat <- num / sqrt(denom) names(stat) <- "normal" if(!is.null(vcov)) vcov <- paste0(", vcov: ", deparse(substitute(vcov))) method <- paste0("Arellano-Bond autocorrelation test of degree ", order, vcov) pval <- 2 * pnorm(abs(stat), lower.tail = FALSE) mtest <- list(statistic = stat, p.value = pval, alternative = "autocorrelation present", method = method, data.name = data.name(object)) class(mtest) <- "htest" mtest } #' @rdname pgmm #' @export print.summary.pgmm <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...) { model <- describe(x, "model") transformation <- describe(x, "transformation") effect <- describe(x, "effect") pdim <- attr(x, "pdim") formula <- x$call$formula model.text <- paste(effect.pgmm.list[effect], model.pgmm.list[model], model.pgmm.transformation.list[transformation], sep = " ") cat(paste(model.text, "\n")) ## TODO: add info about collapse argument in printed output cat("\nCall:\n") print(x$call) cat("\n") print(pdim) ntot <- sum(unlist(x$residuals, use.names = FALSE) != 0) ninst <- dim(x$W[[1L]])[2L] cat("\nNumber of Observations Used:", ntot, sep = " ") # cat("\nNumber of Instruments Used: ", ninst, "\n", sep ="") # TODO: more checks, then activate printing cat("\nResiduals:\n") print(summary(unlist(residuals(x), use.names = FALSE))) cat("\nCoefficients:\n") printCoefmat(x$coefficients, digits = digits) cat("\nSargan test: ", names(x$sargan$statistic), "(", x$sargan$parameter, ") = ", x$sargan$statistic, " (p-value = ", format.pval(x$sargan$p.value,digits=digits), ")\n", sep = "") cat("Autocorrelation test (1): ", names(x$m1$statistic), " = ", x$m1$statistic, " (p-value = ", format.pval(x$m1$p.value, digits = digits), ")\n", sep = "") cat("Autocorrelation test (2): ", names(x$m2$statistic), " = ", x$m2$statistic, " (p-value = ", format.pval(x$m2$p.value,digits=digits), ")\n", sep = "") cat("Wald test for coefficients: ", names(x$wald.coef$statistic), "(",x$wald.coef$parameter,") = ", x$wald.coef$statistic, " (p-value = ", format.pval(x$wald.coef$p.value, digits = digits), ")\n", sep = "") if(effect == "twoways") { cat("Wald test for time dummies: ", names(x$wald.td$statistic), "(", x$wald.td$parameter, ") = ", x$wald.td$statistic, " (p-value = ", format.pval(x$wald.td$p.value, digits = digits), ")\n", sep = "") } invisible(x) } #' Hansen--Sargan Test of Overidentifying Restrictions #' #' A test of overidentifying restrictions for models estimated by GMM. #' #' The Hansen--Sargan test ("J test") calculates the quadratic form of the moment #' restrictions that is minimized while computing the GMM estimator. It follows #' asymptotically a chi-square distribution with number of degrees of freedom #' equal to the difference between the number of moment conditions and the #' number of coefficients. #' #' @param object an object of class `"pgmm"`, #' @param weights the weighting matrix to be used for the computation of the #' test. #' @return An object of class `"htest"`. #' @export #' @author Yves Croissant #' @seealso [pgmm()] #' @references #' #' \insertCite{HANS:82}{plm} #' #' \insertCite{SARG:58}{plm} #' #' @keywords htest #' @examples #' #' data("EmplUK", package = "plm") #' ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + #' lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), #' data = EmplUK, effect = "twoways", model = "twosteps") #' sargan(ar) #' sargan <- function(object, weights = c("twosteps", "onestep")) { if (!inherits(object, "pgmm")) stop("argument 'object' needs to be class 'pgmm'") weights <- match.arg(weights) model <- describe(object, "model") Ktot <- if(model == "onestep") length(object$coefficients) else length(object$coefficients[[2L]]) z <- as.numeric(Reduce("+", mapply(crossprod, object$W, object$residuals, SIMPLIFY = FALSE))) p <- ncol(object$W[[1L]]) A <- if(weights == "onestep") object$A1 else object$A2 stat <- as.numeric(tcrossprod(z, crossprod(z, A))) parameter <- p - Ktot names(parameter) <- "df" names(stat) <- "chisq" method <- "Sargan test" pval <- pchisq(stat, df = parameter, lower.tail = FALSE) sargan <- list(statistic = stat, p.value = pval, parameter = parameter, method = method, alternative = "overidentifying restrictions not valid", data.name = data.name(object)) class(sargan) <- "htest" sargan } plm/R/est_plm.list.R0000644000176200001440000002536714124132276014022 0ustar liggesusersplm.list <- function(formula, data, subset, na.action, effect = c("individual", "time", "twoways"), model = c("within", "random", "ht", "between", "pooling", "fd"), random.method = NULL, #c("swar", "walhus", "amemiya", "nerlove", "ht"), inst.method = c("bvk", "baltagi"), restrict.matrix = NULL, restrict.rhs = NULL, index = NULL, ...){ sysplm <- match.call(expand.dots = FALSE) if (!inherits(data, "pdata.frame")){ odataname <- substitute(data) data <- pdata.frame(data, index) sysplm$data <- data } names.eq <- names(formula) # run plm for each equation of the list, store the results in a # list plm.models <- function(sysplm, amodel, ...){ formulas <- sysplm$formula L <- length(formulas) - 1 models <- vector(mode = "list", length = L) for (l in 2:(L+1)){ aformula <- formulas[[l]] if (is.name(aformula)) aformula <- eval(aformula, parent.frame()) else aformula <- as.formula(formulas[[l]]) sysplm$formula <- aformula sysplm[[1L]] <- as.name("plm") sysplm$model <- amodel # a new pb, plm on every equation fails because of the restrict.matrix argument sysplm$restrict.matrix <- NULL models[[l-1]] <- eval(sysplm, parent.frame()) } models } # Extract the model matrix and the response and transform them in # order to get iid errors using a furnished matrix of covariance of # the raw errors BIG <- function(X, y, W, Omega){ S <- chol(Omega) N <- length(y[[1L]]) if (!is.null(W)) BIGW <- c() BIGX <- c() BIGy <- c() L <- nrow(S) for (l in 1:L){ rowBIGy <- rep(0, N) rowBIGX <- c() if (!is.null(W)) rowBIGW <- c() for (m in 1:L){ rowBIGX <- cbind(rowBIGX, t(solve(S))[l, m] * X[[m]]) if (!is.null(W)) rowBIGW <- cbind(rowBIGW, t(S)[l, m] * W[[m]]) rowBIGy <- rowBIGy + t(solve(S))[l, m] * y[[m]] } BIGX <- rbind(BIGX, rowBIGX) if (!is.null(W)) BIGW <- rbind(BIGW, rowBIGW) BIGy <- c(BIGy, rowBIGy) } if (!is.null(W)) return(structure(list(X = BIGX, y = BIGy, W = BIGW), class = "BIG")) else return(structure(list(X = BIGX, y = BIGy), class = "BIG")) } # take a list of unconstrained models and a restriction matrix and # return a list containing the coefficients, the vcov and the # residuals of the constrained model ; qad version which deals with # lists of plm models or with models fitted by mylm (which have X, y # and W slots) systemlm <- function(object, restrict.matrix, restrict.rhs){ if (class(object) == "list"){ Ucoef <- Reduce("c", lapply(object, coef)) Uvcov <- Reduce("bdiag", lapply(object, vcov)) X <- Reduce("bdiag", lapply(object, model.matrix)) y <- Reduce("c", lapply(object, pmodel.response)) } else{ Ucoef <- coef(object) Uvcov <- vcov(object) X <- object$X y <- object$y } if (!is.null(restrict.matrix)){ R <- restrict.matrix if (is.null(restrict.rhs)) restrict.rhs <- rep(0, nrow(restrict.matrix)) XpXm1 <- solve(crossprod(X)) Q <- XpXm1 %*% t(R) %*% solve(R %*% XpXm1 %*% t(R)) Ccoef <- as.numeric(Ucoef - Q %*% (R %*% Ucoef - restrict.rhs)) names(Ccoef) <- names(Ucoef) Cvcov <- Uvcov - Q %*% R %*% Uvcov Cresid <- y - X %*% Ccoef structure(list(coefficients = Ccoef, vcov = Cvcov, residuals = Cresid), class = "basiclm") } else{ .resid <- Reduce("c", lapply(object, resid)) structure(list(coefficents = Ucoef, vcov = Uvcov, residuals = .resid), class = "basiclm") } } models <- plm.models(sysplm, amodel = model, random.method = "kinla") #TODO NB: "kinla" does not seem to be supported anymore... L <- length(models) sys <- systemlm(models, restrict.matrix = restrict.matrix, restrict.rhs = restrict.rhs) Instruments <- sapply(models, function(x) length(formula(x))[2L]) > 1L # Get the residuals and compute the consistent estimation of the # covariance matrix of the residuals : Note that if there are # restrictions, the "restricted" residuals are used ; for random # effect models, two covariance matrices must be computed if (model == "random"){ resid.pooling <- Reduce("cbind", lapply(models, function(x) resid(x, model = "pooling"))) id <- index(models[[1L]])[[1L]] pdim <- pdim(models[[1L]]) T <- pdim$nT$T N <- pdim$nT$n .fixef <- apply(resid.pooling, 2, tapply, id, mean) resid.within <- resid.pooling - .fixef[as.character(id),] Omega.nu <- crossprod(resid.within)/(N * (T - 1)) Omega.eta <- crossprod(.fixef) / (N - 1) colnames(Omega.nu) <- rownames(Omega.nu) <- colnames(Omega.eta) <- rownames(Omega.eta) <- names.eq Omega.1 <- Omega.nu + T * Omega.eta Omega <- list(id = Omega.eta, idios = Omega.nu) phi <- 1 - sqrt(diag(Omega.nu)/diag(Omega.1)) XW <- lapply(models, function(x) model.matrix(x, model = "within")) intercepts <- lapply(models, has.intercept) XB <- lapply(models, function(x) model.matrix(x, model = "Between")) yW <- lapply(models, function(x) pmodel.response(x, model = "within")) yB <- lapply(models, function(x) pmodel.response(x, model = "Between")) if (Instruments[1L]){ WW <- lapply(models, function(x){ if (length(formula(x))[2L] == 3L) rhss = c(2, 3) else rhss = 2 model.matrix(model.frame(x), rhs = rhss, model = "within") } ) WB <- lapply(models, function(x) model.matrix(model.frame(x), rhs = 2, model = "Between")) } else WW <- WB <- NULL coefnames <- lapply(XB, colnames) BIGW <- BIG(XW, yW, WW, Omega.nu) BIGB <- BIG(XB, yB, WB, Omega.1) y <- BIGW$y + BIGB$y X <- BIGB$X # Attention, pb lorsque noms de colonnes duppliques !! # X[, colnames(BIGW$X)] <- X[, colnames(BIGW$X)] + BIGW$X # version provisoire : emplacement des constantes intercepts <- c(1, cumsum(sapply(XB, ncol))[-length(XB)]+1) X[, - intercepts] <- X[, - intercepts] + BIGW$X m <- mylm(y, X, cbind(BIGW$W, BIGB$W)) } else{ .resid <- matrix(sys$residuals, ncol = length(models)) Omega <- crossprod(.resid) / nrow(.resid) colnames(Omega) <- rownames(Omega) <- names.eq X <- lapply(models, model.matrix) y <- lapply(models, pmodel.response) if (Instruments[1L]) W <- lapply(models, function(x){ if (length(formula(x))[2L] == 3L) rhss = c(2, 3) else rhss = 2 model.matrix(model.frame(x), rhs = rhss) } ) else W <- NULL coefnames <- lapply(X, colnames) BIGT <- BIG(X, y, W, Omega) X <- BIGT$X m <- with(BIGT, mylm(y, X, W)) } if (!is.null(restrict.matrix)){ m <- systemlm(m, restrict.matrix = restrict.matrix, restrict.rhs = restrict.rhs) } m$model <- data m$coefnames <- coefnames m$df.residual <- length(resid(m)) - length(coef(m)) m$vcovsys <- Omega m$formula <- formula sysplm$data <- odataname m$call <- sysplm args <- list(model = model, effect = effect, random.method = random.method) m$args <- args class(m) <- c("plm.list", "plm", "panelmodel", "lm") return(m) } #' @rdname summary.plm #' @export summary.plm.list <- function(object, ...){ class(object) <- setdiff(class(object), "plm.list") formulas <- eval(object$call$formula) eqnames <- names(formulas) L <- length(object$coefnames) Ks <- c(0, cumsum(sapply(object$coefnames, length))) models <- vector(mode = "list", length = L) if (is.null(object$vcov)){ coefTable <- coef(summary(object)) } else{ std.err <- sqrt(diag(object$vcov)) b <- coefficients(object) z <- b / std.err p <- 2 * pt(abs(z), df = object$df.residual, lower.tail = FALSE) coefTable <- cbind("Estimate" = b, "Std. Error" = std.err, "t-value" = z, "Pr(>|t|)" = p) } for (l in 1:L){ models[[l]] <- coefTable[(Ks[l] + 1):Ks[l + 1] , ] } names(models) <- eqnames object$models <- models object$coefficients <- coefTable class(object) <- c("summary.plm.list", class(object)) object } #' @rdname summary.plm #' @export coef.summary.plm.list <- function(object, eq = NULL, ...){ if (is.null(eq)) object$coefficients else object$models[[eq]] } #' @rdname summary.plm #' @export print.summary.plm.list <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ effect <- describe(x, "effect") model <- describe(x, "model") cat(paste(effect.plm.list[effect]," ",sep="")) cat(paste(model.plm.list[model]," Model",sep="")) if (model=="random"){ ercomp <- describe(x, "random.method") cat(paste(" \n (", random.method.list[ercomp], "'s transformation)\n", sep="")) } else{ cat("\n") } cat("Call:\n") print(x$call) cat("\n") print(pdim(x)) cat("\nEffects:\n\n") cat(" Estimated standard deviations of the error\n") if (model == "random"){ sd <- rbind(id = sqrt(diag(x$vcovsys$id)), idios = sqrt(diag(x$vcovsys$idios))) print(sd, digits = digits) cat("\n") cat(" Estimated correlation matrix of the individual effects\n") corid <- x$vcovsys$id / tcrossprod(sd[1L, ]) corid[upper.tri(corid)] <- NA print(corid, digits = digits, na.print = ".") cat("\n") cat(" Estimated correlation matrix of the idiosyncratic effects\n") coridios <- x$vcovsys$idios / tcrossprod(sd[2L, ]) coridios[upper.tri(coridios)] <- NA print(coridios, digits = digits, na.print = ".") } else{ sd <- sqrt(diag(x$vcovsys)) print(sd, digits = digits) cat("\n") cat("\nEstimated correlation matrix of the errors\n") corer <- x$vcovsys / tcrossprod(sd) corer[upper.tri(corer)] <- NA print(corer, digits = digits, na.print = ".") cat("\n") } for (l in 1:length(x$models)){ cat(paste("\n - ", names(x$models)[l], "\n", sep = "")) printCoefmat(x$models[[l]], digits = digits) } invisible(x) } #' @rdname plm #' @export print.plm.list <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"),...){ cat("\nModel Formulas:\n") for (l in 1:length(formula(x))){ cat(paste(names(formula(x))[l], " : ", deparse(formula(x)[[l]]), "\n", sep = "")) } cat("\nCoefficients:\n") print(coef(x),digits = digits) cat("\n") invisible(x) } plm/R/tool_transformations_collapse.R0000644000176200001440000007735714155651602017566 0ustar liggesusers## Structural changes made to plm's original data transformation functions ## need to be mimicked in the *.collapse(.*) versions and vice versa. ## 1) Give the base-R version of the functions defined in tool_transformations.R ## a new name (*.baseR). ## 2) Implement wrapper switched which call the *.baseR or *.collapse versions ## based on the option plm.fast (a logical, can be set via R's regular option ## mechanism: options("plm.fast" = TRUE). ## ad 1) new name for base R functions defined in tool_transformations.R Sum.default.baseR <- plm:::Sum.default Sum.pseries.baseR <- plm:::Sum.pseries Sum.matrix.baseR <- plm:::Sum.matrix between.default.baseR <- plm:::between.default between.pseries.baseR <- plm:::between.pseries between.matrix.baseR <- plm:::between.matrix Between.default.baseR <- plm:::Between.default Between.pseries.baseR <- plm:::Between.pseries Between.matrix.baseR <- plm:::Between.matrix Within.default.baseR <- plm:::Within.default Within.pseries.baseR <- plm:::Within.pseries Within.matrix.baseR <- plm:::Within.matrix pseriesfy.baseR <- plm:::pseriesfy # ... in tool_pdata.frame.R: ## ad 2) implement wrapper switches #### Sum wrapper switches #### Sum.default <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Sum.default.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Sum.default.collapse(x, effect, ...) } } Sum.pseries <- function(x, effect = c("individual", "time", "group"), ...) { if(!isTRUE(getOption("plm.fast"))) { Sum.pseries.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Sum.pseries.collapse(x, effect, ...) } } Sum.matrix <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Sum.matrix.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Sum.matrix.collapse(x, effect, ...) } } #### Between wrapper switches #### Between.default <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Between.default.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Between.default.collapse(x, effect, ...) } } Between.pseries <- function(x, effect = c("individual", "time", "group"), ...) { if(!isTRUE(getOption("plm.fast"))) { Between.pseries.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Between.pseries.collapse(x, effect, ...) } } Between.matrix <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Between.matrix.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Between.matrix.collapse(x, effect, ...) } } #### between wrapper switches #### between.default <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { between.default.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) between.default.collapse(x, effect, ...) } } between.pseries <- function(x, effect = c("individual", "time", "group"), ...) { if(!isTRUE(getOption("plm.fast"))) { between.pseries.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) between.pseries.collapse(x, effect, ...) } } between.matrix <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { between.matrix.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) between.matrix.collapse(x, effect, ...) } } #### Within wrapper switches #### Within.default <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Within.default.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) Within.default.collapse(x, effect, ...) } } Within.pseries <- function(x, effect = c("individual", "time", "group", "twoways"), ...) { if(!isTRUE(getOption("plm.fast"))) { Within.pseries.baseR(x, effect, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) if(is.null(getOption("plm.fast.pkg.FE.tw"))) options("plm.fast.pkg.FE.tw" = "collapse") switch(getOption("plm.fast.pkg.FE.tw"), "collapse" = Within.pseries.collapse( x, effect, ...), # collapse only, "fixest" = Within.pseries.collapse.fixest(x, effect, ...), # collapse for 1-way FE + fixest for 2-way FE, "lfe" = Within.pseries.collapse.lfe( x, effect, ...), # collapse for 1-way FE + lfe for 2-way FE, stop("unknown value of option 'plm.fast.pkg.FE.tw'")) } } Within.matrix <- function(x, effect, ...) { if(!isTRUE(getOption("plm.fast"))) { Within.matrix.baseR(x, effect, ...) } else { if (!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) if(is.null(getOption("plm.fast.pkg.FE.tw"))) options("plm.fast.pkg.FE.tw" = "collapse") switch(getOption("plm.fast.pkg.FE.tw"), "collapse" = Within.matrix.collapse( x, effect, ...), # collapse only, "fixest" = Within.matrix.collapse.fixest(x, effect, ...), # collapse for 1-way FE + fixest for 2-way FE, "lfe" = Within.matrix.collapse.lfe( x, effect, ...), # collapse for 1-way FE + lfe for 2-way FE, stop("unknown value of option 'plm.fast.pkg.FE.tw'")) } } #### Sum #### Sum.default.collapse <- function(x, effect, ...) { # print("Sum.default.collapse") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The Sum function only applies to numeric vectors") # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm res <- collapse::fsum(x, g = effect, w = NULL, na.rm = na.rm, TRA = "replace") names(res) <- as.character(effect) return(res) } Sum.pseries.collapse <- function(x, effect = c("individual", "time", "group"), ...) { # print("Sum.pseries.collapse") # browser() effect <- match.arg(effect) # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA eff.fac <- xindex[[eff.no]] res <- collapse::fsum(x, g = eff.fac, w = NULL, na.rm = na.rm, TRA = "replace") names(res) <- as.character(eff.fac) res <- add_pseries_features(res, attr(x, "index")) return(res) } Sum.matrix.collapse <- function(x, effect, ...) { # print("Sum.matrix.collapse") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { effect } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a Sum transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm res <- collapse::fsum(x, g = eff.fac, w = NULL, na.rm = na.rm, drop = FALSE, TRA = "replace") rownames(res) <- as.character(eff.fac) attr(res, "index") <- NULL return(res) } #### B/between #### # Need separate implementations of Between.pseries and between.pseries due to different NA handling Between.default.collapse <- function(x, effect, ...) { # print("Between.default.collapse") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The Between function only applies to numeric vectors") # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm nms <- as.character(effect) res <- collapse::fbetween(x, g = effect, w = NULL, na.rm = na.rm) names(res) <- nms return(res) } between.default.collapse <- function(x, effect, ...) { # print("between.default.collapse") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("The Between function only applies to numeric vectors") # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm res <- collapse::fbetween(x, g = effect, w = NULL, na.rm = na.rm, fill = TRUE) keep <- !duplicated(effect) res <- res[keep] names(res) <- as.character(effect[keep]) # bring into factor level order (not order as appears in orig. data) lvl <- levels(collapse::fdroplevels(effect)) res <- res[lvl] return(res) } Between.pseries.collapse <- function(x, effect = c("individual", "time", "group"), ...) { # print("Between.pseries.collapse") # browser() # translate arguments effect <- match.arg(effect) # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA nms <- as.character(xindex[[eff.no]]) na.x <- is.na(x) # must be fill = TRUE [to catch case when 1 obs of an individual is NA (otherwise result could contain non-intended NA)] res <- collapse::fbetween(x, effect = eff.no, w = NULL, na.rm = na.rm, fill = TRUE) names(res) <- nms res[na.x] <- NA return(res) } between.pseries.collapse <- function(x, effect = c("individual", "time", "group"), ...) { # print("between.pseries.collapse") # browser() effect <- match.arg(effect) # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA i <- xindex[[eff.no]] # must be fill = TRUE [to catch case when 1 obs of an individual is NA # (otherwise result could contain non-intended NA)] res <- collapse::fbetween(x, effect = eff.no, w = NULL, na.rm = na.rm, fill = TRUE) res <- remove_pseries_features(res) keep <- !duplicated(i) res <- res[keep] names(res) <- as.character(i[keep]) # bring into factor level order (not order as appears in orig. data) lvl <- levels(collapse::fdroplevels(i)) res <- res[lvl] return(res) } Between.matrix.collapse <- function(x, effect, ...) { # print("Between.matrix.collapse") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { effect } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a between transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm na.x <- is.na(x) res <- collapse::fbetween(x, g = eff.fac, w = NULL, na.rm = na.rm, fill = TRUE) attr(res, "index") <- NULL rownames(res) <- as.character(eff.fac) res[na.x] <- NA return(res) } between.matrix.collapse <- function(x, effect, ...) { # print("between.matrix.collapse") # browser() # if no index attribute, argument 'effect' is assumed to be a factor eff.fac <- if(is.null(xindex <- attr(x, "index"))) { effect } else { if(!is.character(effect) && length(effect) > 1L) stop("for matrices with index attributes, the effect argument must be a character") if(! effect %in% c("individual", "time", "group")) stop("irrelevant effect for a between transformation") eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA xindex[[eff.no]] } # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm res <- collapse::fbetween(x, g = eff.fac, w = NULL, na.rm = na.rm, fill = TRUE) rownames(res) <- as.character(eff.fac) # compress data to number of unique individuals (or time periods) res <- res[!duplicated(eff.fac), , drop = FALSE] # bring into factor level order (not order as appears in orig. data) lvl <- levels(collapse::fdroplevels(eff.fac)) res <- res[lvl, , drop = FALSE] return(res) } #### Within #### # Within - default Within.default.collapse <- function(x, effect, ...) { # print("Within.default.collapse") # browser() # argument 'effect' is assumed to be a factor if(!is.numeric(x)) stop("the within function only applies to numeric vectors") # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm res <- collapse::fwithin(x, g = effect, w = NULL, na.rm = na.rm) # =(plm)= res <- x - Between(x, effect, ...) names(res) <- as.character(effect) return(res) } Within.pseries.collapse <- function(x, effect = c("individual", "time", "group", "twoways"), ...) { # print("Within.pseries.collapse") # browser() effect <- match.arg(effect) # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") { eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) res <- collapse::fwithin(x, effect = eff.no, w = NULL, na.rm = na.rm, mean = 0) } else { eff.ind.fac <- xindex[[1L]] eff.time.fac <- xindex[[2L]] if(is.pbalanced(eff.ind.fac, eff.time.fac)) { # effect = "twoways" - balanced res <- collapse::fwithin( x, effect = 1L, w = NULL, na.rm = na.rm, mean = "overall.mean") - collapse::fbetween(x, effect = 2L, w = NULL, na.rm = na.rm, fill = TRUE) # =(plm)= res <- x - Between(x, "individual", ...) - Between(x, "time", ...) + mean(x, ...) } else { # effect = "twoways" - unbalanced Dmu <- model.matrix(~ eff.time.fac - 1) W1 <- collapse::fwithin(x, effect = 1L, w = NULL, na.rm = na.rm, mean = 0) # pseries interface WDmu <- collapse::fwithin(Dmu, g = eff.ind.fac, w = NULL, na.rm = na.rm, mean = 0) # matrix interface W2 <- lm.fit(WDmu, x)$fitted.values res <- W1 - W2 } } return(res) } Within.matrix.collapse <- function(x, effect, ...) { # print("Within.matrix.collapse") # browser() # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm if(is.null(xindex <- attr(x, "index"))) { # non-index case, 'effect' needs to be a factor result <- collapse::fwithin(x, g = effect, w = NULL, na.rm = na.rm) } else { # index case xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") { eff.fac <- switch(effect, "individual" = xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]], stop("unknown value of argument 'effect'")) result <- collapse::fwithin(x, g = eff.fac, w = NULL, na.rm = na.rm, mean = 0) # =(plm)= result <- x - Between(x, effect) } else { # effect = "twoways" eff.ind.fac <- xindex[[1L]] eff.time.fac <- xindex[[2L]] if(is.pbalanced(eff.ind.fac, eff.time.fac)) { # balanced twoways result <- collapse::fwithin( x, g = eff.ind.fac, w = NULL, na.rm = na.rm, mean = "overall.mean") - collapse::fbetween(x, g = eff.time.fac, w = NULL, na.rm = na.rm, fill = TRUE) # =(plm)= result <- x - Between(x, "individual", ...) - Between(x, "time", ...) + # matrix(colMeans(x, ...), nrow = nrow(x), ncol = ncol(x), byrow = TRUE) } else { # unbalanced twoways # as factor is used twice below, make it a collapse::GRP object -> should give some speed-up eff.ind.fac <- collapse::GRP(eff.ind.fac, group.sizes = FALSE, return.groups = FALSE, call = FALSE) Dmu <- model.matrix(~ eff.time.fac - 1) W1 <- collapse::fwithin(x, g = eff.ind.fac, w = NULL, na.rm = na.rm, mean = 0) WDmu <- collapse::fwithin(Dmu, g = eff.ind.fac, w = NULL, na.rm = na.rm, mean = 0) W2 <- lm.fit(WDmu, x)$fitted.values result <- W1 - W2 } } } return(result) } #### These functions use collpase::fhdwithin (using internally fixest::demean) #### or lfe::demeanlist respectively, for #### the 2-way within transformation which are dramatically faster than #### the implementation via separate collapse::fwithin calls (due to the special #### algorithms used to partial out the fixed effects) Within.pseries.collapse.fixest <- function(x, effect = c("individual", "time", "group", "twoways"), ...) { # print("Within.pseries.collapse.fixest") # browser() effect <- match.arg(effect) # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm xindex <- unclass(attr(x, "index")) # unclass for speed checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") { eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) # in 1-way case fwithin seems faster than fhdwithin, so keep 1-way and 2-way # cases separated res <- collapse::fwithin(x, effect = eff.no, w = NULL, na.rm = na.rm, mean = 0) } else { # effect = "twoways" # dispatches to pseries method res <- collapse::fhdwithin(x, effect = 1:2, w = NULL, na.rm = na.rm) } return(res) } Within.matrix.collapse.fixest <- function(x, effect, ...) { # print("Within.matrix.collapse.fixest") # browser() # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm if(is.null(xindex <- attr(x, "index"))) { # non-index case, 'effect' needs to be a factor result <- collapse::fwithin(x, g = effect, w = NULL, na.rm = na.rm) } else { # index case xindex <- unclass(xindex) # unclass for speed checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") { eff.fac <- switch(effect, "individual" = xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]], stop("unknown value of argument 'effect'")) ## result <- collapse::fhdwithin(x, eff.fac) # needs pkg fixest # --> for one-way effect, this seems slower than collapse::fwithin result <- collapse::fwithin(x, g = eff.fac, w = NULL, na.rm = na.rm, mean = 0) # =(plm)= result <- x - Between(x, effect) } else { # effect = "twoways" # no need to distinguish between balanced/unbalanced # as this is fully handled by collapse::fhdwithin() # collapse::fhdwithin needs pkg fixest as it uses fixest::demean result <- collapse::fhdwithin(x, fl = xindex[1:2], w = NULL, na.rm = na.rm) } } return(result) } Within.pseries.collapse.lfe <- function(x, effect = c("individual", "time", "group", "twoways"), ...) { # print("Within.pseries.collapse.lfe") # browser() effect <- match.arg(effect) xindex <- unclass(attr(x, "index")) checkNA.index(xindex) # index may not contain any NA # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm if(effect != "twoways") { eff.no <- switch(effect, "individual" = 1L, "time" = 2L, "group" = 3L, stop("unknown value of argument 'effect'")) # collapse::fwithin is faster in 1-ways case than lfe::demanlist, so # keep cases separated res <- collapse::fwithin(x, effect = eff.no, w = NULL, na.rm = na.rm, mean = 0) } else { # effect = "twoways" # no need to distinguish between balanced/unbalanced # as this is fully handled by lfe::dmeanlist() res <- unlist(lfe::demeanlist(x, fl = xindex[1:2], na.rm = na.rm)) res <- add_pseries_features(res, attr(x, "index")) # index needs to be a proper pindex here! } return(res) } Within.matrix.collapse.lfe <- function(x, effect, ...) { # print("Within.matrix.collapse.lfe") # browser() # check for presence of na.rm in dots, if not present set to FALSE na.rm <- if(missing(...) || is.null(na.rm <- list(...)$na.rm)) FALSE else na.rm if(is.null(xindex <- attr(x, "index"))) { # non-index case, 'effect' needs to be a factor result <- collapse::fwithin(x, g = effect, w = NULL, na.rm = na.rm) } else { # index case xindex <- unclass(xindex) checkNA.index(xindex) # index may not contain any NA if(effect != "twoways") { eff.fac <- switch(effect, "individual" = xindex[[1L]], "time" = xindex[[2L]], "group" = xindex[[3L]], stop("unknown value of argument 'effect'")) # collapse::fwithin is faster in 1-ways case than lfe::demanlist, so # keep cases separated result <- collapse::fwithin(x, g = eff.fac, w = NULL, na.rm = na.rm, mean = 0) # =(plm)= result <- x - Between(x, effect) } else { # effect = "twoways" # no need to distinguish between balanced/unbalanced # as this is fully handled by lfe::dmeanlist() # # lfe::demeanlist (lfe vers. 2.8-6) return value for matrix input is # inconsistent / depends on value of argument na.rm, # see https://github.com/sgaure/lfe/issues/50. result <- lfe::demeanlist(x, fl = xindex[1:2], na.rm = na.rm) if(is.list(result)) result <- result[[1L]] attr(result, "index") <- attr(x, "index") # index needs to be a proper pindex here! } } return(result) } #### wrapper for pseriesfy #### # both pseriesfy functions are in file tool_pdata.frame.R pseriesfy <- function(x, ...) { if(!isTRUE(getOption("plm.fast"))) { pseriesfy.baseR(x, ...) } else { if(!isTRUE(getOption("plm.fast.pkg.collapse"))) stop(txt.no.collapse, call. = FALSE) pseriesfy.collapse(x, ...) } } .onAttach <- function(libname, pkgname) { options("plm.fast" = TRUE) # since 2.6: needs pkg collapse as hard dependency # determine when pkg plm is attached whether pkg collapse, fixest, and lfe are # available and set (non-documented) options, which packages are available. # These options are used to determine in the wrappers if fast mode can be used # and if the speed up by fixest or lfe for the 2-way FE case can be used. avail.collapse <- requireNamespace("collapse", quietly = TRUE) avail.fixest <- requireNamespace("fixest", quietly = TRUE) avail.lfe <- requireNamespace("lfe", quietly = TRUE) if(avail.collapse) { options("plm.fast.pkg.collapse" = TRUE) options("plm.fast.pkg.FE.tw" = "collapse") # fixest wins over lfe if(avail.fixest) { options("plm.fast.pkg.FE.tw" = "fixest") } else { if(avail.lfe) { options("plm.fast.pkg.FE.tw" = "lfe") } } } else options("plm.fast.pkg.collapse" = FALSE) } #' Option to Switch On/Off Fast Data Transformations #' #' A significant speed up can be gained by using fast (panel) data transformation #' functions from package `collapse`. #' An additional significant speed up for the two-way fixed effects case can be #' achieved if package `fixest` or `lfe` is installed (package `collapse` #' needs to be installed for the fast mode in any case). #' #' @details By default, this speed up is enabled. #' Option `plm.fast` can be used to enable/disable the speed up. The option is #' evaluated prior to execution of supported transformations (see below), so #' `option("plm.fast" = TRUE)` enables the speed up while #' `option("plm.fast" = FALSE)` disables the speed up. #' #' To have it always switched off, put `options("plm.fast" = FALSE)` in your #' .Rprofile file. #' #' See **Examples** for how to use the option and for a benchmarking example. #' #' For long, package `plm` used base R implementations and R-based code. The #' package `collapse` provides fast data transformation functions written #' in C/C++, among them some especially suitable for panel data. #' Having package `collapse` installed is a requirement for the speed up, so #' this package is a hard dependency for package `plm`. #' #' Availability of packages `fixest` and `lfe` is checked for once when #' package plm is attached and the additional speed up for the two-way fixed #' effect case is enabled automatically (`fixest` wins over `lfe`), #' given one of the packages is detected and `options("plm.fast" = TRUE)` #' (default) is set. If so, the packages' fast algorithms to partial out fixed #' effects are #' used (`fixest::demean` (via `collapse::fhdwithin`), #' `lfe::demeanlist`). Both packages are 'Suggests' dependencies. #' #' Users might experience neglectable numerical differences between enabled and #' disabled fast mode and base R implementation, depending on the platform and #' the additional packages installed. #' #' Currently, these basic functions benefit from the speed-up, used as building #' blocks in most model estimation functions, e.g., in `plm` (more functions are #' under investigation): #' \itemize{ #' \item between, #' \item Between, #' \item Sum, #' \item Within, #' \item pseriesfy. #' } #' #' @name plm.fast #' @importFrom collapse fhdwithin fwithin fbetween dapply fdroplevels #' @keywords sysdata manip #' @examples #' \dontrun{ #' ### A benchmark of plm without and with speed-up #' library("plm") #' library("collapse") #' library("microbenchmark") #' rm(list = ls()) #' data("wlddev", package = "collapse") #' form <- LIFEEX ~ PCGDP + GINI #' #' # produce big data set (taken from collapse's vignette) #' wlddevsmall <- get_vars(wlddev, c("iso3c","year","OECD","PCGDP","LIFEEX","GINI","ODA")) #' wlddevsmall$iso3c <- as.character(wlddevsmall$iso3c) #' data <- replicate(100, wlddevsmall, simplify = FALSE) #' rm(wlddevsmall) #' uniquify <- function(x, i) { #' x$iso3c <- paste0(x$iso3c, i) #' x #' } #' data <- unlist2d(Map(uniquify, data, as.list(1:100)), idcols = FALSE) #' data <- pdata.frame(data, index = c("iso3c", "year")) #' pdim(data) # Balanced Panel: n = 21600, T = 59, N = 1274400 // but many NAs #' # data <- na.omit(data) #' # pdim(data) # Unbalanced Panel: n = 13300, T = 1-31, N = 93900 #' #' times <- 1 # no. of repetitions for benchmark - this takes quite long! #' #' onewayFE <- microbenchmark( #' {options("plm.fast" = FALSE); plm(form, data = data, model = "within")}, #' {options("plm.fast" = TRUE); plm(form, data = data, model = "within")}, #' times = times, unit = "relative") #' #' summary(onewayFE) #' #' ## two-ways FE benchmark requires pkg fixest and lfe #' ## (End-users shall only set option plm.fast. Option plm.fast.pkg.FE.tw shall #' ## _not_ be set by the end-user, it is determined automatically when pkg plm #' ## is attached; however, it needs to be set explicitly in this example for the #' ## benchmark.) #' if(requireNamespace("fixest", quietly = TRUE) && #' requireNamespace("lfe", quietly = TRUE)) { #' #' twowayFE <- microbenchmark( #' {options("plm.fast" = FALSE); #' plm(form, data = data, model = "within", effect = "twoways")}, #' {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "collapse"); #' plm(form, data = data, model = "within", effect = "twoways")}, #' {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "fixest"); #' plm(form, data = data, model = "within", effect = "twoways")}, #' {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "lfe"); #' plm(form, data = data, model = "within", effect = "twoways")}, #' times = times, unit = "relative") #' #' summary(twowayFE) #' } #' #' onewayRE <- microbenchmark( #' {options("plm.fast" = FALSE); plm(form, data = data, model = "random")}, #' {options("plm.fast" = TRUE); plm(form, data = data, model = "random")}, #' times = times, unit = "relative") #' #' summary(onewayRE) #' #' twowayRE <- microbenchmark( #' {options("plm.fast" = FALSE); plm(form, data = data, model = "random", effect = "twoways")}, #' {options("plm.fast" = TRUE); plm(form, data = data, model = "random", effect = "twoways")}, #' times = times, unit = "relative") #' #' summary(twowayRE) #' } NULL txt.no.collapse <- paste0("options(\"plm.fast\") is set to TRUE but package 'collapse' ", "is not available which is needed for fast data transformation functions. ", "Either set 'options(\"plm.fast\" = FALSE)' or install the ", "missing package, e.g., with 'install.packages(\"collapse\")'. \n", "Having additionally package 'fixest' or 'lfe' installed ", "will speed up the two-way fixed effect case further. \n", "Availability of packages is determined only when ", "plm is attached, so restart R/reload plm when mentioned ", "packages have been installed.") plm/R/tool_misc.R0000644000176200001440000007324014162657155013400 0ustar liggesusers## Function that are used in more than on place in plm (or likely to be used in more than one place in the future) ## - trace : calculate trace of a matrix (used in ercomp()) ## - is.constant : check if a numeric vector or columns of a matrix is constant ## - bdiag : takes matrices as argument and returns the block-diagonal matrix (used in pgmm and plm.list) ## - mylm : inner fitting func based on stats::lm with matrix inputs (used in plm.fit) ## - my.lm.fit : like the barebone stats::lm.fit but with some extra information (e.g., SEs, sigma) used in purtest ## - twosls : computes the 2SLS estimator (used in plm and ercomp) ## - data.name : used in a lot tests to generate the 'data.name' entry for htest objects from the model object's call$formula ## - has.intercept : tests the presence of an intercept ## - pres : extract model residuals as pseries (used in several estimation functions) ## - punbalancedness : measures for the unbalancedness of panel data ## - myvar : calculates variance with NA removal, checks if input is constant (also for factor and character) ## - pvar : checks if input varies in individual / time dimension ## - make.dummies : create a contrast-coded dummy matrix from a factor trace <- function(x) sum(diag(x)) is.constant <- function(x) (max(x) - min(x)) < sqrt(.Machine$double.eps) bdiag <- function(...){ ## non-exported if (nargs() == 1L) x <- as.list(...) else x <- list(...) n <- length(x) if(n == 0L) return(NULL) x <- lapply(x, function(y) if(length(y)) as.matrix(y) else stop("Zero-length component in x")) d <- array(unlist(lapply(x, dim)), c(2, n)) rr <- d[1L, ] cc <- d[2L, ] rsum <- sum(rr) csum <- sum(cc) out <- array(0, c(rsum, csum)) ind <- array(0, c(4, n)) rcum <- cumsum(rr) ccum <- cumsum(cc) ind[1, -1] <- rcum[-n] ind[2, ] <- rcum ind[3, -1] <- ccum[-n] ind[4, ] <- ccum imat <- array(1:(rsum * csum), c(rsum, csum)) iuse <- apply(ind, 2, function(y, imat) imat[(y[1L]+1):y[2L], (y[3L]+1):y[4L]], imat = imat) iuse <- as.vector(unlist(iuse)) out[iuse] <- unlist(x) return(out) } # mylm is used in plm.fit() mylm <- function(y, X, W = NULL) { ## non-exported names.X <- colnames(X) result <- if(is.null(W)) lm(y ~ X - 1) else twosls(y, X, W) if(any(na.coef <- is.na(result$coefficients))) { ## for debug purpose: # warning("Coefficient(s) '", paste((names.X)[na.coef], collapse = ", "), #"' could not be estimated and is (are) dropped.") X <- X[ , !na.coef, drop = FALSE] if(dim(X)[2L] == 0L) stop(paste("estimation not possible: all coefficients", "omitted from estimation due to aliasing")) ## re-estimate without the columns which resulted previously in NA-coefficients result <- if(is.null(W)) lm(y ~ X - 1) else twosls(y, X, W) } result$vcov <- vcov(result) result$X <- X result$y <- y result$W <- W # aliased is an element of summary.lm-objects: # since plm drops aliased coefs, store this info in plm object # NB: this only sets coefs to NA that are detected/set to NA by mylm()/lm.fit(); # covariates dropped earlier by model.matrix( , cstcovar.rm) are not included here anymore result$aliased <- na.coef names(result$aliased) <- names.X names(result$coefficients) <- colnames(result$vcov) <- rownames(result$vcov) <- colnames(X) result } # my.lm.fit is used in purtest() my.lm.fit <- function(X, y, dfcor = TRUE, ...){ reg <- lm.fit(X, y) ## 'as' summary method for lm.fit p <- reg$rank Qr <- reg$qr n <- NROW(Qr$qr) rdf <- n - p p1 <- 1L:p r <- reg$residuals rss <- as.numeric(crossprod(r)) resvar <- if (dfcor) rss/rdf else rss/n sigma <- sqrt(resvar) R <- chol2inv(Qr$qr[p1, p1, drop = FALSE]) thecoef <- reg$coefficients[Qr$pivot[p1]] #[lags+1] these <- sigma * sqrt(diag(R)) #[lags+1]) list(coef = thecoef, se = these, sigma = sigma, rss = rss, n = n, K = p, rdf = rdf) } #' @importFrom stats .lm.fit twosls <- function(y, X, W, intercept = FALSE, lm.type = "lm"){ ## non-exported # Return value can be controlled by argument lm.type. Often, a full lm model # is needed for further processing but can select one of the fast but less # rich objects produced by lm.fit or .lm.fit (the latter does not contain, e.g., # fitted.values and is to be used very carefully (e.g., coefs not in input order)). # As NA/NaN/(+/-)Inf-freeness needs to be guaranteed when functions call # twosls(), so can use lm.fit to calc. Xhat. Xhat <- lm.fit(cbind(1, W), X)$fitted.values # old: Xhat <- lm(X ~ W)$fitted.values if(!is.matrix(Xhat)) { # ensure Xhat is a matrix Xhat <- matrix(Xhat, ncol = 1L) colnames(Xhat) <- colnames(X) } if(intercept) { model <- switch(lm.type, "lm" = lm(y ~ Xhat), "lm.fit" = lm.fit(cbind(1, Xhat), y), ".lm.fit" = .lm.fit(cbind(1, Xhat), y)) yhat <- as.vector(crossprod(t(cbind(1, X)), coef(model))) } else{ model <- switch(lm.type, "lm" = lm(y ~ Xhat - 1), "lm.fit" = lm.fit(Xhat, y), ".lm.fit" = .lm.fit(Xhat, y)) yhat <- as.vector(crossprod(t(X), coef(model))) } model$residuals <- y - yhat model } data.name <- function(x) { ## non-exported, used in various tests data.name <- paste(deparse(x$call$formula)) if (length(data.name) > 1L) paste(data.name[1L], "...") else data.name } ##### has.intercept methods ##### #' Check for the presence of an intercept in a formula or in a fitted #' model #' #' The presence of an intercept is checked using the formula which is #' either provided as the argument of the function or extracted from #' a fitted model. #' #' @param object a `formula`, a `Formula` or a fitted model (of class #' `plm` or `panelmodel`), #' @param rhs an integer (length > 1 is possible), indicating the parts of right #' hand sides of the formula to be evaluated for the presence of an #' intercept or NULL for all parts of the right hand side #' (relevant for the `Formula` and the `plm` methods) #' @param \dots further arguments. #' #' @return a logical #' @export has.intercept <- function(object, ...) { UseMethod("has.intercept") } #' @rdname has.intercept #' @export has.intercept.default <- function(object, ...) { has.intercept(formula(object), ...) } #' @rdname has.intercept #' @export has.intercept.formula <- function(object, ...) { attr(terms(object), "intercept") == 1L } #' @rdname has.intercept #' @export has.intercept.Formula <- function(object, rhs = NULL, ...) { ## NOTE: returns a logical vector of the necessary length ## (which might be > 1) if (is.null(rhs)) rhs <- 1:length(attr(object, "rhs")) res <- sapply(rhs, function(x) { aform <- formula(object, lhs = 0, rhs = x) # expand the dot if any in all the parts except the first if (x > 1L) aform <- update(formula(object, lhs = 0, rhs = 1), aform) has.intercept(aform) }) return(res) } #' @rdname has.intercept #' @export has.intercept.panelmodel <- function(object, ...) { object <- attr(model.frame(object), "formula") has.intercept(object) } #' @rdname has.intercept #' @export has.intercept.plm <- function(object, rhs = 1L, ...) { has.intercept(formula(object), rhs = rhs, ...) } pres <- function(x) { # pres.panelmodel ## extracts model residuals as pseries ## not necessary for plm models as residuals.plm returns a pseries, ## but used in residuals.pggls, residuals.pcce, residuals.pmg ## extract indices xindex <- unclass(attr(x$model, "index")) # unclass for speed groupind <- xindex[[1L]] timeind <- xindex[[2L]] # fix to allow operation with pggls, pmg # [TODO: one day, make this cleaner; with the describe framework?] if (!is.null(x$args$model)) maybe_fd <- x$args$model if (!is.null(attr(x, "pmodel")$model.name)) maybe_fd <- attr(x, "pmodel")$model.name # this line is currently needed to detect pggls models ## Achim's fix: reduce id and time index to accommodate first-differences model's number of observations if(exists("maybe_fd") && maybe_fd == "fd") { groupi <- as.numeric(groupind) ## make vector =1 on first obs in each group, 0 elsewhere selector <- groupi - c(0, groupi[-length(groupi)]) selector[1L] <- 1 # the first must always be 1 ## eliminate first obs in time for each group groupind <- groupind[!selector] timeind <- timeind[!selector] } resdata <- data.frame(ee = x$residuals, ind = groupind, tind = timeind) pee <- pdata.frame(resdata, index = c("ind", "tind")) pres <- pee$ee return(pres) } # punbalancedness: measures for unbalancedness of a panel data set as # defined in Ahrens/Pincus (1981), p. 228 (gamma and # nu) and for nested panel structures as in Baltagi/Song/Jung (2001), pp. 368-369 . # # Ahrens/Pincus (1981), On Two Measures of Unbalancedness in a One-Way Model # and Their Relation to Efficiency, Biometrical Journal, Vol. 23, pp. 227-235. # # Baltagi/Song/Jung (2001), The unbalanced nested error component regression model, # Journal of Econometrics, Vol. 101, pp. 357-381 #' Measures for Unbalancedness of Panel Data #' #' This function reports unbalancedness measures for panel data as #' defined in \insertCite{AHRE:PINC:81;textual}{plm} and #' \insertCite{BALT:SONG:JUNG:01;textual}{plm}. #' #' `punbalancedness` returns measures for the unbalancedness of a #' panel data set. #' #' - For two-dimensional data:\cr The two measures of #' \insertCite{AHRE:PINC:81;textual}{plm} are calculated, called #' "gamma" (\eqn{\gamma}) and "nu" (\eqn{\nu}). #' #' If the panel data are balanced, both measures equal 1. The more #' "unbalanced" the panel data, the lower the measures (but > 0). The #' upper and lower bounds as given in \insertCite{AHRE:PINC:81;textual}{plm} #' are:\cr #' \eqn{0 < \gamma, \nu \le 1}, and for \eqn{\nu} more precisely #' \eqn{\frac{1}{n} < \nu \le 1}{1/n < \nu \le 1}, with \eqn{n} being #' the number of individuals (as in `pdim(x)$nT$n`). #' #' - For nested panel data (meaning including a grouping variable):\cr #' The extension of the above measures by #' \insertCite{BALT:SONG:JUNG:01;textual}{plm}, p. 368, are #' calculated:\cr #' #' - c1: measure of subgroup (individual) unbalancedness, #' - c2: measure of time unbalancedness, #' - c3: measure of group unbalancedness due to each group size. #' #' Values are 1 if the data are balanced and become smaller as the #' data become more unbalanced. #' #' #' An application of the measure "gamma" is found in e. g. #' \insertCite{BALT:SONG:JUNG:01;textual}{plm}, pp. 488-491, and #' \insertCite{BALT:CHAN:94;textual}{plm}, pp. 78--87, where it is #' used to measure the unbalancedness of various unbalanced data sets #' used for Monte Carlo simulation studies. Measures c1, c2, c3 are #' used for similar purposes in #' \insertCite{BALT:SONG:JUNG:01;textual}{plm}. #' #' In the two-dimensional case, `punbalancedness` uses output of #' [pdim()] to calculate the two unbalancedness measures, so inputs to #' `punbalancedness` can be whatever `pdim` works on. `pdim` returns #' detailed information about the number of individuals and time #' observations (see [pdim()]). #' #' @param x a `panelmodel`, a `data.frame`, or a `pdata.frame` object, #' @param index only relevant for `data.frame` interface, for details #' see [pdata.frame()], #' @param \dots further arguments. #' @return A named numeric containing either two or three entries, #' depending on the panel structure inputted: #' #' - For the two-dimensional panel structure, the entries are called #' `gamma` and `nu`, #' #' - For a nested panel structure, the entries are called `c1`, `c2`, #' `c3`. #' #' @note Calling `punbalancedness` on an estimated `panelmodel` object #' and on the corresponding `(p)data.frame` used for this #' estimation does not necessarily yield the same result (true #' also for `pdim`). When called on an estimated `panelmodel`, the #' number of observations (individual, time) actually used for #' model estimation are taken into account. When called on a #' `(p)data.frame`, the rows in the `(p)data.frame` are #' considered, disregarding any `NA` values in the dependent or #' independent variable(s) which would be dropped during model #' estimation. #' @export #' @author Kevin Tappe #' @seealso [nobs()], [pdim()], [pdata.frame()] #' @references #' #' \insertRef{AHRE:PINC:81}{plm} #' #' \insertRef{BALT:CHAN:94}{plm} #' #' \insertRef{BALT:SONG:JUNG:01}{plm} #' #' \insertRef{BALT:SONG:JUNG:02}{plm} #' #' @keywords attribute #' @examples #' #' # Grunfeld is a balanced panel, Hedonic is an unbalanced panel #' data(list=c("Grunfeld", "Hedonic"), package="plm") #' #' # Grunfeld has individual and time index in first two columns #' punbalancedness(Grunfeld) # c(1,1) indicates balanced panel #' pdim(Grunfeld)$balanced # TRUE #' #' # Hedonic has individual index in column "townid" (in last column) #' punbalancedness(Hedonic, index="townid") # c(0.472, 0.519) #' pdim(Hedonic, index="townid")$balanced # FALSE #' #' # punbalancedness on estimated models #' plm_mod_pool <- plm(inv ~ value + capital, data = Grunfeld) #' punbalancedness(plm_mod_pool) #' #' plm_mod_fe <- plm(inv ~ value + capital, data = Grunfeld[1:99, ], model = "within") #' punbalancedness(plm_mod_fe) #' #' # replicate results for panel data design no. 1 in Ahrens/Pincus (1981), p. 234 #' ind_d1 <- c(1,1,1,2,2,2,3,3,3,3,3,4,4,4,4,4,4,4,5,5,5,5,5,5,5) #' time_d1 <- c(1,2,3,1,2,3,1,2,3,4,5,1,2,3,4,5,6,7,1,2,3,4,5,6,7) #' df_d1 <- data.frame(individual = ind_d1, time = time_d1) #' punbalancedness(df_d1) # c(0.868, 0.887) #' #' # example for a nested panel structure with a third index variable #' # specifying a group (states are grouped by region) and without grouping #' data("Produc", package = "plm") #' punbalancedness(Produc, index = c("state", "year", "region")) #' punbalancedness(Produc, index = c("state", "year")) #' #' @rdname punbalancedness #' @export punbalancedness <- function(x, ...) { UseMethod("punbalancedness") } punbalancedness.default <- function(x, ...) { ii <- index(x) if(!is.index(ii)) stop("no valid index found for input object 'x'") if (ncol(ii) == 2L) { ## original Ahrens/Pincus (1981) pdim <- pdim(x, ...) N <- pdim$nT$n # no. of individuals Totalobs <- pdim$nT$N # no. of total observations Ti <- pdim$Tint$Ti Tavg <- sum(Ti)/N r1 <- N / (Tavg * sum(1/Ti)) r2 <- 1 / (N * (sum( (Ti/Totalobs)^2))) result <- c(gamma = r1, nu = r2) } else { if (ncol(ii) == 3L) { ## extension to nested model with additional group variable ## Baltagi/Song/Jung (2001), pp. 368-369 ii <- unclass(ii) # unclass for speed ids <- ii[[1L]] tss <- ii[[2L]] gps <- ii[[3L]] Tis <- unique(data.frame(tss, gps)) Tis <- table(Tis$gps) # no of max time periods per group Nis <- unique(data.frame(ids, gps)) Nis <- table(Nis$gps) # no of individuals per group M <- length(unique(gps)) # no of unique groups Nbar <- sum(Nis)/M Tbar <- sum(Tis)/M c1 <- M / (Nbar * sum(1/Nis)) c2 <- M / (Tbar * sum(1/Tis)) c3 <- M / (sum(Nis * Tis)/M * sum(1/(Nis*Tis))) result <- (c(c1 = c1, c2 = c2, c3 = c3)) } else stop(paste0("unsupported number of dimensions: ", ncol(ii))) } return(result) } #' @rdname punbalancedness #' @export punbalancedness.pdata.frame <- function(x, ...) { punbalancedness.default(x, ...) } #' @rdname punbalancedness #' @export punbalancedness.data.frame <- function(x, index = NULL, ...) { x <- pdata.frame(x, index = index, ...) punbalancedness.default(x, ...) } #' @rdname punbalancedness #' @export punbalancedness.panelmodel <- function(x, ...) { punbalancedness.default(x, ...) } myvar <- function(x){ ## non-exported x.na <- is.na(x) if(anyNA(x.na)) x <- x[!x.na] n <- length(x) if(n <= 1L) { if(n == 0L) z <- NA if(n == 1L) z <- 0 } else { z <- if(!(is.factor(x) || is.character(x))) var(x) else !all(duplicated(x)[-1L]) } z } #' Check for Cross-Sectional and Time Variation #' #' This function checks for each variable of a panel if it varies #' cross-sectionally and over time. #' #' For (p)data.frame and matrix interface: All-`NA` columns are removed #' prior to calculation of variation due to coercing to pdata.frame #' first. #' #' @aliases pvar #' @param x a `(p)data.frame` or a `matrix`, #' @param index see [pdata.frame()], #' @param \dots further arguments. #' @return An object of class `pvar` containing the following #' elements: #' #' \item{id.variation}{a logical vector with `TRUE` values if the #' variable has individual variation, `FALSE` if not,} #' #' \item{time.variation}{a logical vector with `TRUE` values if the #' variable has time variation, `FALSE` if not,} #' #' \item{id.variation_anyNA}{a logical vector with `TRUE` values if #' the variable has at least one individual-time combination with all #' `NA` values in the individual dimension for at least one time period, #' `FALSE` if not,} #' #' \item{time.variation_anyNA}{a logical vector with `TRUE` values if #' the variable has at least one individual-time combination with all #' `NA` values in the time dimension for at least one individual, #' `FALSE` if not.} #' #' @note `pvar` can be time consuming for ``big'' panels. As a fast alternative #' [collapse::varying()] from package \CRANpkg{collapse} could be used. #' @export #' @author Yves Croissant #' @seealso [pdim()] to check the dimensions of a 'pdata.frame' (and #' other objects), #' @keywords attribute #' @examples #' #' #' # Gasoline contains two variables which are individual and time #' # indexes and are the first two variables #' data("Gasoline", package = "plm") #' pvar(Gasoline) #' #' # Hedonic is an unbalanced panel, townid is the individual index; #' # the drop.index argument is passed to pdata.frame #' data("Hedonic", package = "plm") #' pvar(Hedonic, "townid", drop.index = TRUE) #' #' # same using pdata.frame #' Hed <- pdata.frame(Hedonic, "townid", drop.index = TRUE) #' pvar(Hed) #' #' # Gasoline with pvar's matrix interface #' Gasoline_mat <- as.matrix(Gasoline) #' pvar(Gasoline_mat) #' pvar(Gasoline_mat, index=c("country", "year")) #' pvar <- function(x, ...){ UseMethod("pvar") } pvar.default <- function(x, id, time, ...){ name.var <- names(x) len <- length(x) time.variation <- rep(TRUE, len) id.variation <- rep(TRUE, len) time.variation_anyNA <- rep(FALSE, len) id.variation_anyNA <- rep(FALSE, len) lid <- split(x, id) # these split() functions seem particularly slow ltime <- split(x, time) if(is.list(x)){ if(len == 1L){ # time variation temp_time.var <- sapply(lid, function(x) sapply(x, myvar)) temp_time.var_sumNoVar <- sum(temp_time.var == 0, na.rm = TRUE) # number of non-varying id-time comb. (without all NA groups) temp_time.var_sumNA <- sum(is.na(temp_time.var)) # number of all-NA groups temp_time.varResult <- temp_time.var_sumNoVar + temp_time.var_sumNA time.variation <- temp_time.varResult != length(lid) # no variation if (no. non-varying + no. all-NA) == number of groups time.variation_anyNA <- temp_time.var_sumNA > 0 # indicates if at least one id-time comb is all NA # id variation temp_id.var <- sapply(ltime, function(x) sapply(x, myvar)) temp_id.var_sumNoVar <- sum(temp_id.var == 0, na.rm = TRUE) temp_id.var_sumNA <- sum(is.na(temp_id.var)) temp_id.varResult <- temp_id.var_sumNoVar + temp_id.var_sumNA id.variation <- temp_id.varResult != length(ltime) id.variation_anyNA <- temp_id.var_sumNA > 0 } else{ # time variation temp_time.var <- sapply(lid, function(x) sapply(x, myvar)) temp_time.var_sumNoVar <- apply(temp_time.var == 0, 1, sum, na.rm = TRUE) temp_time.var_sumNA <- apply(is.na(temp_time.var), 1, sum) temp_time.varResult <- temp_time.var_sumNoVar + temp_time.var_sumNA time.variation <- temp_time.varResult != length(lid) time.variation_anyNA <- temp_time.var_sumNA > 0 # id variation temp_id.var <- sapply(ltime, function(x) sapply(x, myvar)) temp_id.var_sumNoVar <- apply(temp_id.var == 0, 1, sum, na.rm = TRUE) temp_id.var_sumNA <- apply(is.na(temp_id.var), 1, sum) temp_id.varResult <- temp_id.var_sumNoVar + temp_id.var_sumNA id.variation <- temp_id.varResult != length(ltime) id.variation_anyNA <- temp_id.var_sumNA > 0 } } else{ # not a list (not a data.frame, pdata.frame) - try our best for that unknown data structure # time variation temp_time.var <- sapply(lid, function(x) sapply(x, myvar)) temp_time.var_sumNoVar <- sum(temp_time.var == 0, na.rm = TRUE) temp_time.var_sumNA <- sum(is.na(temp_time.var)) temp_time.varResult <- temp_time.var_sumNoVar + temp_time.var_sumNA time.variation <- temp_time.varResult != length(lid) time.variation_anyNA <- temp_time.var_sumNA > 0 # id variation temp_id.var <- sapply(ltime, function(x) sapply(x, myvar)) temp_id.var_sumNoVar <- sum(temp_id.var == 0, na.rm = TRUE) temp_id.var_sumNA <- sum(is.na(temp_id.var)) temp_id.varResult <- temp_id.var_sumNoVar + temp_id.var_sumNA id.variation <- temp_id.varResult != length(ltime) id.variation_anyNA <- temp_id.var_sumNA > 0 } # make 'pvar' object names(id.variation) <- names(time.variation) <- names(id.variation_anyNA) <- names(time.variation_anyNA) <- name.var dim.var <- list(id.variation = id.variation, time.variation = time.variation, id.variation_anyNA = id.variation_anyNA, time.variation_anyNA = time.variation_anyNA) class(dim.var) <- "pvar" return(dim.var) } #' @rdname pvar #' @export pvar.matrix <- function(x, index = NULL, ...){ x <- pdata.frame(as.data.frame(x), index, ...) pvar(x) } #' @rdname pvar #' @export pvar.data.frame <- function(x, index = NULL, ...){ x <- pdata.frame(x, index, ...) pvar(x) } #' @rdname pvar #' @export pvar.pdata.frame <- function(x, ...){ index <- unclass(attr(x, "index")) # unclass for speed pvar.default(x, index[[1L]], index[[2L]]) } #' @rdname pvar #' @export pvar.pseries <- function(x, ...){ # use drop.index = TRUE so that the index columns' # variations are not evaluated: pdfx <- pseries2pdataframe(x, drop.index = TRUE) pvar.pdata.frame(pdfx) } #' @rdname pvar #' @export print.pvar <- function(x, ...){ varnames <- names(x$time.variation) if(any(!x$time.variation)){ var <- varnames[x$time.variation == FALSE] # if (!is.null(y)) var <- var[-which(var==y$id)] if(length(var)!=0) cat(paste("no time variation: ", paste(var,collapse=" "),"\n")) } if(any(!x$id.variation)){ var <- varnames[x$id.variation == FALSE] # if (!is.null(y)) var <- var[-which(var==y$time)] if(length(var)!=0) cat(paste("no individual variation:", paste(var,collapse=" "),"\n")) } # any individual-time combinations all NA? if(any(x$time.variation_anyNA)){ var_anyNA <- varnames[x$time.variation_anyNA] if(length(var_anyNA)!=0) cat(paste("all NA in time dimension for at least one individual: ", paste(var_anyNA,collapse=" "),"\n")) } if(any(x$id.variation_anyNA)){ var_anyNA <- varnames[x$id.variation_anyNA] if(length(var_anyNA)!=0) cat(paste("all NA in ind. dimension for at least one time period:", paste(var_anyNA,collapse=" "),"\n")) } invisible(x) } #' Create a Dummy Matrix #' #' Contrast-coded dummy matrix created from a factor #' #' This function creates a matrix of dummies from the levels of a factor. #' In model estimations, it is usually preferable to not create the dummy matrix #' prior to estimation but to simply specify a factor in the formula and let the #' estimation function handle the creation of the dummies. #' #' This function is merely a convenience wrapper around `stats::contr.treatment` #' to ease the dummy matrix creation process shall the dummy matrix be explicitly #' required. See Examples for a use case in LSDV (least squares dummy variable) #' model estimation. #' #' The default method uses a factor as main input (or something coercible to a #' factor) to derive the dummy matrix from. Methods for data frame and pdata.frame #' are available as well and have the additional argument `col` to specify the #' the column from which the dummies are created; both methods merge the dummy #' matrix to the data frame/pdata.frame yielding a ready-to-use data set. #' See also Examples for use cases. #' #' @param x a factor from which the dummies are created (x is coerced to #' factor if not yet a factor) for the default method or a data #' data frame/pdata.frame for the respective method. #' @param base integer or character, specifies the reference level (base), if #' integer it refers to position in `levels(x)`, if character the name #' of a level, #' @param base.add logical, if `TRUE` the reference level (base) is added #' to the return value as first column, if `FALSE` the reference #' level is not included. #' @param col character (only for the data frame and pdata.frame methods), to #' specify the column which is used to derive the dummies from, #' @param \dots further arguments. #' #' @return For the default method, a matrix containing the contrast-coded dummies, #' dimensions are n x n where `n = length(levels(x))` if argument #' `base.add = TRUE` or `n = length(levels(x)-1)` if `base.add = FALSE`; #' for the data frame and pdata.frame method, a data frame or pdata.frame, #' respectively, with the dummies appropriately merged to the input as #' last columns (column names are derived from the name of the column #' used to create the dummies and its levels). #' @author Kevin Tappe #' @importFrom stats contr.treatment #' @export #' @seealso [stats::contr.treatment()], [stats::contrasts()] #' @keywords manip #' @examples #' library(plm) #' data("Grunfeld", package = "plm") #' Grunfeld <- Grunfeld[1:100, ] # reduce data set (down to 5 firms) #' #' ## default method #' make.dummies(Grunfeld$firm) # gives 5 x 5 matrix (5 firms, base level incl.) #' make.dummies(Grunfeld$firm, base = 2L, base.add = FALSE) # gives 5 x 4 matrix #' #' ## data frame method #' Grun.dummies <- make.dummies(Grunfeld, col = "firm") #' #' ## pdata.frame method #' pGrun <- pdata.frame(Grunfeld) #' pGrun.dummies <- make.dummies(pGrun, col = "firm") #' #' ## Model estimation: #' ## estimate within model (individual/firm effects) and LSDV models (firm dummies) #' # within model: #' plm(inv ~ value + capital, data = pGrun, model = "within") #' #' ## LSDV with user-created dummies by make.dummies: #' form_dummies <- paste0("firm", c(1:5), collapse = "+") #' form_dummies <- formula(paste0("inv ~ value + capital + ", form_dummies)) #' plm(form_dummies, data = pGrun.dummies, model = "pooling") # last dummy is dropped #' #' # LSDV via factor(year) -> let estimation function generate dummies: #' plm(inv ~ value + capital + factor(firm), data = pGrun, model = "pooling") make.dummies <- function(x, ...){ UseMethod("make.dummies") } #' @rdname make.dummies #' @export make.dummies.default <- function(x, base = 1L, base.add = TRUE, ...) { stopifnot(is.numeric(base) || is.character(base)) if(is.numeric(base)) if(round(base) != base) stop("Argument 'ref' specified as numeric but is not integer") if(!is.factor(x)) x <- factor(x) lvl <- levels(x) if(is.character(base)) { pos <- match(base, lvl) if(is.na(pos)) stop(paste0("argument 'ref' specified as character but value \"", base, "\", is not in levels(x)")) base <- pos } dummies <- contr.treatment(lvl, base = base) # if requested, add reference level to dummy matrix in 1st position if(base.add) { lvl.base <- levels(x)[base] dummies <- cbind(c(1, rep(0, NROW(dummies)-1)), dummies) colnames(dummies) <- c(lvl.base, colnames(dummies)[-1L]) } dummies # is a matrix } #' @rdname make.dummies #' @export make.dummies.data.frame <- function(x, col, base = 1L, base.add = TRUE, ...) { stopifnot(inherits(col, "character")) dum.mat <- make.dummies.default(x[ , col], base, base.add) # dummy matrix colnames(dum.mat) <- paste0(col, colnames(dum.mat)) dum.df <- data.frame(cbind("merge.col" = rownames(dum.mat), dum.mat)) merge(x, dum.df, by.x = col, by.y = "merge.col", sort = FALSE) } #' @rdname make.dummies #' @export make.dummies.pdata.frame <- function(x, col, base = 1L, base.add = TRUE, ...) { stopifnot(inherits(col, "character")) # idx.pos <- pos.index(x) # drop.idx <- anyNA(idx.pos) idx <- attr(x, "index") res <- make.dummies.data.frame(x, col, base, base.add) # add back pdata.frame features (assumption is: merge did not change order of original data.frame) attr(res, "index") <- idx class(res) <- c("pdata.frame", class(res)) res } plm/R/est_ldv.R0000644000176200001440000004107714175444435013052 0ustar liggesusers#' Panel estimators for limited dependent variables #' #' Fixed and random effects estimators for truncated or censored #' limited dependent variable #' #' `pldv` computes two kinds of models: a LSQ/LAD estimator for the #' first-difference model (`model = "fd"`) and a maximum likelihood estimator #' with an assumed normal distribution for the individual effects #' (`model = "random"` or `"pooling"`). #' #' For maximum-likelihood estimations, `pldv` uses internally function #' [maxLik::maxLik()] (from package \CRANpkg{maxLik}). #' #' @aliases pldv #' @param formula a symbolic description for the model to be #' estimated, #' @param data a `data.frame`, #' @param subset see `lm`, #' @param weights see `lm`, #' @param na.action see `lm`, #' @param model one of `"fd"`, `"random"`, or `"pooling"`, #' @param index the indexes, see [pdata.frame()], #' @param R the number of points for the gaussian quadrature, #' @param start a vector of starting values, #' @param lower the lower bound for the censored/truncated dependent #' variable, #' @param upper the upper bound for the censored/truncated dependent #' variable, #' @param objfun the objective function for the fixed effect model (`model = "fd"`, #' irrelevant for other values of the `model` argument ): #' one of `"lsq"` for least squares (minimise sum of squares of the residuals) #' and `"lad"` for least absolute deviations (minimise sum of absolute values #' of the residuals), #' @param sample `"cens"` for a censored (tobit-like) sample, #' `"trunc"` for a truncated sample, #' @param \dots further arguments. #' @return For `model = "fd"`, an object of class `c("plm", "panelmodel")`, for #' `model = "random"` and `model = "pooling"` an object of class `c("maxLik", "maxim")`. #' #' @export #' @importFrom maxLik maxLik #' @author Yves Croissant #' @references #' #' \insertRef{HONO:92}{plm} #' #' @keywords regression #' @examples #' ## as these examples take a bit of time, do not run them automatically #' \dontrun{ #' data("Donors", package = "pder") #' library("plm") #' pDonors <- pdata.frame(Donors, index = "id") #' #' # replicate Landry/Lange/List/Price/Rupp (2010), online appendix, table 5a, models A and B #' modA <- pldv(donation ~ treatment + prcontr, data = pDonors, #' model = "random", method = "bfgs") #' summary(modA) #' modB <- pldv(donation ~ treatment * prcontr - prcontr, data = pDonors, #' model = "random", method = "bfgs") #' summary(modB) #' } #' # # TODO: check if argument method = "bfgs" is needed in example (and why) # -> seems strange as it is no direct argument of pldv pldv <- function(formula, data, subset, weights, na.action, model = c("fd", "random", "pooling"), index = NULL, R = 20, start = NULL, lower = 0, upper = +Inf, objfun = c("lsq", "lad"), sample = c("cens", "trunc"), ...){ ## Due to the eval() construct with maxLik::maxLik we import maxLik::maxLik ## and re-export it via NAMESPACE as plm::maxLik with a minimal documentation ## pointing to the original documentation. ## This way, we can keep the flexibility of eval() [evaluate in parent frame] ## and can lessen the dependency burden by placing pkg maxLik in 'Imports' ## rather than 'Depends' in DESCRIPTION. # use the plm interface to compute the model.frame sample <- match.arg(sample) model <- match.arg(model) cl <- match.call() mf <- match.call(expand.dots = FALSE) mf <- cl m <- match(c("formula", "data", "subset", "weights", "na.action", "index"), names(mf), 0) mf <- mf[c(1L, m)] mf$model <- NA mf[[1L]] <- as.name("plm") mf <- eval(mf, parent.frame()) formula <- attr(mf, "formula") # extract the relevant arguments for maxLik maxl <- cl m <- match(c("print.level", "ftol", "tol", "reltol", "gradtol", "steptol", "lambdatol", "qrtol", "iterlim", "fixed", "activePar", "method"), names(maxl), 0) maxl <- maxl[c(1L, m)] maxl[[1L]] <- as.name("maxLik") # The within model -> Bo Honore (1992) if (model == "fd"){ objfun <- match.arg(objfun) # create a data.frame containing y_t and y_{t-1} y <- as.character(formula[[2L]]) y <- mf[[y]] ly <- c(NA, y[1:(length(y) - 1)]) id <- as.integer(index(mf, "id")) lid <- c(NA, id[1:(nrow(mf) - 1)]) keep <- id == lid keep[1L] <- FALSE Y <- data.frame(y, ly) Y <- Y[keep, ] yt <- Y$y ytm1 <- Y$ly # create the matrix of first differenced covariates X <- model.matrix(mf, model = "fd") start <- rep(.1, ncol(X)) names(start) <- colnames(X) if (sample == "trunc"){ if (objfun == "lad") fm <- function(x) abs(x) if (objfun == "lsq") fm <- function(x) x ^ 2 psi <- function(a1, a2, b){ fm( (a2 <= b) * a1 + (b > - a1 & b < a2) * (a2 - a1 - b) + (a1 <= - b) * a2 ) } } if (sample == "cens"){ if (objfun == "lad"){ psi <- function(a1, a2, b){ (a1 <= pmax(0, - b) & a2 <= pmax(0, b)) * 0 + (! (a1 <= pmax(0, - b) & a2 <= pmax(0, b)) ) * abs(a2 - a1 - b) } } if (objfun == "lsq"){ psi <- function(a1, a2, b){ (a2 <= b) * (a1 ^ 2 - 2 * a1 * (a2 - b)) + (b > - a1 & b < a2) * (a2 - a1 - b) ^ 2 + (a1 <= - b) * (a2 ^ 2 - 2 * a2 * (b + a1)) } } } BO <- function(param){ bdx <- as.numeric(X %*% param) lnl <- - psi(ytm1, yt, bdx) selobs <- (bdx > - ytm1 & bdx < yt) if (objfun == "lsq" && sample == "cens"){ attr(lnl, "gradient") <- - ( (ytm1 > - bdx & yt > bdx) * (- 2 * (yt - ytm1 - bdx)) + (ytm1 > - bdx & yt < bdx) * ( 2 * ytm1) + (ytm1 < - bdx & yt > bdx) * (- 2 * yt) ) * X attr(lnl, "hessian") <- - crossprod( (ytm1 > - bdx & yt > bdx) * X) } lnl } maxl[c("logLik", "start")] <- list(BO, start) result <- eval(maxl, parent.frame()) if (objfun == "lsq" && sample == "cens"){ bdx <- as.numeric((crossprod(t(X), coef(result)))) V4 <- yt ^ 2 * (bdx <= - ytm1) + ytm1 ^ 2 * (yt <= bdx) + (yt - ytm1 - bdx) ^ 2 * (bdx > - ytm1 & bdx < yt) V4 <- crossprod(X, V4 * X) / length(V4) T4 <- crossprod((bdx > - ytm1 & bdx < yt) * X, X) / length(V4) solve_T4 <- solve(T4) vcov <- solve_T4 %*% V4 %*% solve_T4 result$vcov <- V4 } if (is.null(result$vcov)) result$vcov <- solve(- result$hessian) resid <- yt - as.numeric(crossprod(t(X), coef(result))) result <- list(coefficients = coef(result), vcov = result$vcov, formula = formula, model = mf, df.residual = nrow(X) - ncol(X), residuals = resid, args = list(model = "fd", effect = "individual"), call = cl) class(result) <- c("plm", "panelmodel") } else{ # model != "fd" => cases model = "random" / "pooling" # old pglm stuff for the pooling and the random model, with # update to allow upper and lower bonds X <- model.matrix(mf, rhs = 1, model = "pooling", effect = "individual") if (ncol(X) == 0L) stop("empty model") y <- pmodel.response(mf, model = "pooling", effect = "individual") id <- attr(mf, "index")[[1L]] # The following is the only instance of statmod::gauss.quad, so check for # the package's availability. (We placed 'statmod' in 'Suggests' rather # than 'Imports' so that it is not an absolutely required dependency.) ## Procedure for pkg check for pkg in 'Suggests' as recommended in ## Wickham, R packages (http://r-pkgs.had.co.nz/description.html). if (!requireNamespace("statmod", quietly = TRUE)) { stop(paste("Function 'gauss.quad' from package 'statmod' needed for this function to work.", "Please install it, e.g., with 'install.packages(\"statmod\")"), call. = FALSE) } # compute the nodes and the weights for the gaussian quadrature rn <- statmod::gauss.quad(R, kind = 'hermite') # compute the starting values ls <- length(start) if (model == "pooling"){ K <- ncol(X) if (! ls %in% c(0, K + 1)) stop("irrelevant length for the start vector") if (ls == 0L){ m <- match(c("formula", "data", "subset", "na.action"), names(cl), 0) lmcl <- cl[c(1,m)] lmcl[[1L]] <- as.name("lm") lmcl <- eval(lmcl, parent.frame()) # eval stats::lm() sig2 <- deviance(lmcl) / df.residual(lmcl) sigma <- sqrt(sig2) start <- c(coef(lmcl), sd.nu = sigma) } } else{ # case model != "pooling" and != "fd" => model ="random" if (ls <= 1L){ startcl <- cl startcl$model <- "pooling" startcl$method <- "bfgs" pglmest <- eval(startcl, parent.frame()) # eval pldv() with updated args thestart <- coef(pglmest) if (ls == 1L){ start <- c(thestart, start) } else{ # case ls = 0 resid <- y - as.numeric(tcrossprod(X, t(coef(pglmest)[1:ncol(X)]))) eta <- tapply(resid, id, mean)[as.character(id)] nu <- resid - eta start <- c(thestart[1:ncol(X)], sd.nu = sd(nu), sd.eta = sd(eta)) } } } # call to maxLik with the relevant arguments argschar <- function(args){ paste(as.character(names(args)), as.character(args), sep= "=", collapse= ",") } args <- list(param = "start", y = "y", X = "X", id = "id", model = "model", rn = "rn", lower = lower, upper = upper) thefunc <- paste("function(start) lnl.tobit", "(", argschar(args), ")", sep = "") maxl$logLik <- eval(parse(text = thefunc)) maxl$start <- start result <- eval(maxl, parent.frame()) result[c('call', 'args', 'model')] <- list(cl, args, data) } # end cases model = "random" / "pooling" result } lnl.tobit <- function(param, y, X, id, lower = 0, upper = +Inf, model = "pooling", rn = NULL){ compute.gradient <- TRUE compute.hessian <- FALSE mills <- function(x) exp(dnorm(x, log = TRUE) - pnorm(x, log.p = TRUE)) O <- length(y) K <- ncol(X) beta <- param[1L:K] sigma <- param[K + 1L] Xb <- as.numeric(crossprod(t(X), beta)) YLO <- (y == lower) YUT <- (y > lower) & (y < upper) YUP <- y == upper if (model == "random"){ R <- length(rn$nodes) seta <- param[K + 2L] } else seta <- 0 f <- function(i = NA){ result <- numeric(length = length(y)) z <- if(is.na(i)) 0 else rn$nodes[i] e <- (y - Xb - sqrt(2) * seta * z) / sigma result[YLO] <- pnorm( e[YLO], log.p = TRUE) result[YUT] <- dnorm( e[YUT], log = TRUE) - log(sigma) result[YUP] <- pnorm(- e[YUP], log.p = TRUE) result } g <- function(i = NA){ z <- if(is.na(i)) 0 else rn$nodes[i] e <- (y - Xb - sqrt(2) * seta * z) / sigma mz <- mills(e) mmz <- mills(- e) gradi <- matrix(0, nrow = nrow(X), ncol = ncol(X) + 1L) gradi[YLO, 1L:K] <- - mz[YLO] * X[YLO, , drop = FALSE] gradi[YLO, K + 1L] <- - e[YLO] * mz[YLO] gradi[YUT, 1L:K] <- e[YUT] * X[YUT, , drop = FALSE] gradi[YUT, K + 1L] <- - (1 - e[YUT] ^ 2) gradi[YUP, 1L:K] <- mmz[YUP] * X[YUP, , drop = FALSE] gradi[YUP, K + 1L] <- e[YUP] * mmz[YUP] if (! is.na(i)){ gradi <- cbind(gradi, NA) gradi[YLO, K + 2L] <- - mz[YLO] * sqrt(2) * z gradi[YUT, K + 2L] <- e[YUT] * sqrt(2) * z gradi[YUP, K + 2L] < - mmz[YUP] * sqrt(2) * z } gradi / sigma } h <- function(i = NA, pwnt = NULL){ if (is.na(i)){ z <- 0 seta <- 0 pw <- 1 } else{ z <- rn$nodes[i] pw <- pwnt[[i]] } e <- (y - Xb - sqrt(2) * seta * z) / sigma mz <- mills(e) mmz <- mills(- e) hbb <- hbs <- hss <- numeric(length = nrow(X)) # pre-allocate hbb[YLO] <- - (e[YLO] + mz[YLO]) * mz[YLO] hbs[YLO] <- mz[YLO] * (1 - (e[YLO] + mz[YLO]) * e[YLO]) hss[YLO] <- e[YLO] * mz[YLO] * (2 - (e[YLO] + mz[YLO]) * e[YLO]) hbb[YUT] <- - 1 hbs[YUT] <- - 2 * e[YUT] hss[YUT] <- (1 - 3 * e[YUT] ^ 2) hbb[YUP] <- - (- e[YUP] + mmz[YUP]) * mmz[YUP] hbs[YUP] <- - mmz[YUP] * (1 + (mmz[YUP] - e[YUP]) * e[YUP]) hss[YUP] <- - e[YUP] * mmz[YUP] * (2 + (mmz[YUP] - e[YUP]) * e[YUP]) hbb <- crossprod(hbb * X * pw, X) hbs <- apply(hbs * X * pw, 2, sum) # TODO: can use colSums -> faster hss <- sum(hss * pw) H <- rbind(cbind(hbb, hbs), c(hbs, hss)) if (! is.na(i)){ hba <- hsa <- haa <- numeric(length = nrow(X)) hba[YLO] <- - (e[YLO] + mz[YLO]) * mz[YLO] * sqrt(2) * z hsa[YLO] <- mz[YLO] * sqrt(2) * z * (1 - (e[YLO] + mz[YLO]) * e[YLO]) haa[YLO] <- - (e[YLO] + mz[YLO]) * mz[YLO] * 2 * z ^ 2 hba[YUT] <- - sqrt(2) * z hsa[YUT] <- - 2 * sqrt(2) * z * e[YUT] haa[YUT] <- - 2 * z ^ 2 hba[YUP] <- - (- e[YUP] + mmz[YUP]) * mmz[YUP] * sqrt(2) * z hsa[YUP] <- - mmz[YUP] * sqrt(2) * z * (1 + (- e[YUP] + mmz[YUP]) * e[YUP]) haa[YUP] <- - (- e[YUP] + mmz[YUP]) * mmz[YUP] * 2 * z ^ 2 hba <- apply(hba * X * pw, 2, sum) # TODO: can use colSums -> faster haa <- sum(haa * pw) hsa <- sum(hsa * pw) H <- rbind(cbind(H, c(hba, hsa)), c(hba, hsa, haa)) } H / sigma ^ 2 } if (model == "pooling"){ lnL <- sum(f(i = NA)) if (compute.gradient) attr(lnL, "gradient") <- g(i = NA) if (compute.hessian) attr(lnL, "hessian") <- h(i = NA) } if (model == "random"){ lnPntr <- lapply(1:R, function(i) f(i = i)) lnPnr <- lapply(lnPntr, function(x){ result <- tapply(x, id, sum) ids <- names(result) result <- as.numeric(result) names(result) <- ids result } ) lnPn <- lapply(1:R, function(i) rn$weights[i] * exp(lnPnr[[i]])) lnPn <- log(Reduce("+", lnPn)) - 0.5 * log(pi) lnL <- sum(lnPn) if (compute.gradient || compute.hessian){ glnPnr <- lapply(1:R, function(i) g(i = i)) pwn <- lapply(1:R, function(i) exp(lnPnr[[i]] - lnPn)) pwnt <- lapply(1:R, function(i) pwn[[i]][as.character(id)]) glnPnr2 <- lapply(1:R, function(i) rn$weights[i] * pwnt[[i]] * glnPnr[[i]]) gradi <- Reduce("+", glnPnr2) / sqrt(pi) attr(lnL, "gradient") <- gradi } if (compute.hessian){ hlnPnr <- lapply(1:R, function(i) h(i = i, pwnt = pwnt)) daub <- lapply(1:R, function(i) apply(glnPnr[[i]], 2, tapply, id, sum) * pwn[[i]] * rn$weights[i]) daub <- Reduce("+", daub) / sqrt(pi) DD1 <- - crossprod(daub) DD2 <- lapply(1:R, function(i) rn$weights[i] * hlnPnr[[i]]) DD2 <- Reduce("+", DD2) / sqrt(pi) DD3 <- lapply(1:R, function(i) rn$weights[i] * crossprod(sqrt(pwn[[i]]) * apply(glnPnr[[i]], 2, tapply, id, sum))) DD3 <- Reduce("+", DD3) / sqrt(pi) H <- (DD1 + DD2 + DD3) attr(lnL, "hessian") <- H } } lnL } plm/R/est_mg.R0000644000176200001440000003122414155651544012660 0ustar liggesusers ## Mean Group estimator ## ref. Coakley, Fuertes and Smith 2004 ## ## This version 10: ## added R2 = 1-var(resid)/var(y) as a measure of fit ## from version 9: ## fixed residuals ## output matrix of individual coefficients as 'indcoef' aptly named ## NB the effect of including a trend is exactly the same as for ## including as.numeric() in the model specification ## Yet it is cleaner unless some automatic treatment of group invariant ## variates is added for the CCE case (where else any group invariant ## becomes perfectly collinear with the ybar, Xbar and gives NAs in coefs. ## Moreover, if the panel is unbalanced then for some i the trend becomes ## (3,4,5, ...) instead of (1,2,3, ...); the difference is absorbed by ## the individual intercept, and *the group intercept* changes. ## TODO: see last point above: treatment of invariants ## TODO: see how to estimate the intercept in cmg, dmg ## TODO: manage models without intercept in cmg, dmg ## TODO: output single coefs (see how the structure of pvcm is) ## needed for standalone operation: #plm <- plm:::plm #pdim <- plm:::pdim #model.matrix.plm <- plm:::model.matrix.plm #pmodel.response <- plm:::pmodel.response.plm #' Mean Groups (MG), Demeaned MG and CCE MG estimators #' #' Mean Groups (MG), Demeaned MG (DMG) and Common Correlated Effects #' MG (CCEMG) estimators for heterogeneous panel models, possibly with #' common factors (CCEMG) #' #' `pmg` is a function for the estimation of linear panel models with #' heterogeneous coefficients by various Mean Groups estimators. Setting #' argument `model = "mg"` specifies the standard Mean Groups estimator, based on the #' average of individual time series regressions. If `model = "dmg"` #' the data are demeaned cross-sectionally, which is believed to #' reduce the influence of common factors (and is akin to what is done #' in homogeneous panels when `model = "within"` and `effect = "time"`). #' Lastly, if `model = "cmg"` the CCEMG estimator is #' employed which is consistent under the hypothesis of #' unobserved common factors and idiosyncratic factor loadings; it #' works by augmenting the model by cross-sectional averages of the #' dependent variable and regressors in order to account for the #' common factors, and adding individual intercepts and possibly #' trends. #' #' @aliases pmg #' @param formula a symbolic description of the model to be estimated, #' @param object,x an object of class `pmg`, #' @param data a `data.frame`, #' @param subset see [lm()], #' @param na.action see [lm()], #' @param model one of `"mg"`, `"cmg"`, or `"dmg"`, #' @param index the indexes, see [pdata.frame()], #' @param trend logical specifying whether an individual-specific #' trend has to be included, #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param \dots further arguments. #' #' @return An object of class `c("pmg", "panelmodel")` containing: #' \item{coefficients}{the vector of coefficients,} #' \item{residuals}{the vector of residuals,} #' \item{fitted.values}{the vector of fitted values,} #' \item{vcov}{the covariance matrix of the coefficients,} #' \item{df.residual}{degrees of freedom of the residuals,} #' \item{model}{a data.frame containing the variables used for the #' estimation,} #' \item{r.squared}{numeric, the R squared,} #' \item{call}{the call,} #' \item{indcoef}{the matrix of individual coefficients from #' separate time series regressions.} #' @export #' @author Giovanni Millo #' @references #' #' \insertRef{PESA:06}{plm} #' #' @keywords regression #' @examples #' data("Produc", package = "plm") #' ## Mean Groups estimator #' mgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) #' summary(mgmod) #' #' ## demeaned Mean Groups #' dmgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "dmg") #' summary(dmgmod) #' #' ## Common Correlated Effects Mean Groups #' ccemgmod <- pmg(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "cmg") #' summary(ccemgmod) pmg <- function(formula, data, subset, na.action, model = c("mg", "cmg", "dmg"), index = NULL, trend = FALSE, ...) { ## same as pggls but for effect, fixed at "individual" for compatibility ## ind for id, tind for time, k for K, coefnam for coef.names effect <- "individual" ## record call etc. model <- match.arg(model) model.name <- model data.name <- paste(deparse(substitute(data))) cl <- match.call() plm.model <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "effect", "model", "index"), names(plm.model), 0) plm.model <- plm.model[c(1L, m)] plm.model[[1L]] <- as.name("plm") ## change the 'model' in call plm.model$model <- "pooling" ## evaluates the call, modified with model = "pooling", inside the ## parent frame resulting in the pooling model on formula, data plm.model <- eval(plm.model, parent.frame()) mf <- model.frame(plm.model) index <- unclass(attr(mf, "index")) # unclass for speed ind <- index[[1L]] ## individual index tind <- index[[2L]] ## time index ## set dimension variables pdim <- pdim(plm.model) balanced <- pdim$balanced nt <- pdim$Tint$nt Ti <- pdim$Tint$Ti T. <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N ## set index names time.names <- pdim$panel.names$time.names id.names <- pdim$panel.names$id.names coef.names <- names(coef(plm.model)) ## number of coefficients k <- length(coef.names) ## model data X <- model.matrix(plm.model) y <- model.response(mf) ## det. *minimum* group numerosity t <- min(Ti) # == min(tapply(X[ , 1], ind, length)) ## check min. t numerosity ## NB it is also possible to allow estimation if there *is* one group ## with t large enough and average on coefficients removing NAs ## Here we choose the explicit way: let estimation fail if we lose df ## but a warning would do... if(t < (k+1)) stop("Insufficient number of time periods") ## one regression for each group i in 1..n ## and retrieve coefficients putting them into a matrix ## (might be unbalanced => t1!=t2 but we don't care as long ## as min(t)>k+1) ## "pre-allocate" coefficients matrix for the n models kt <- if (trend) 1L else 0L tcoef <- matrix(data = NA_real_, nrow = k+kt, ncol = n) tres <- vector("list", n) switch(model, "mg" = { ## for each x-sect. i = 1..n unind <- unique(ind) for(i in 1:n) { tX <- X[ind == unind[i], ] ty <- y[ind == unind[i]] if(trend) tX <- cbind(tX, 1:(dim(tX)[[1L]])) tfit <- lm.fit(tX, ty) tcoef[ , i] <- tfit$coefficients tres[[i]] <- tfit$residuals } ## 'trend' always comes last if(trend) coef.names <- c(coef.names, "trend") ## adjust k k <- length(coef.names) }, "cmg" = { ## between-periods transformation (take means over groups for each t) Xm <- Between(X, effect = "time", na.rm = TRUE) ym <- as.numeric(Between(y, effect = "time", na.rm = TRUE)) augX <- cbind(X, ym, Xm[ , -1L, drop = FALSE]) ## allow for extended coef vector tcoef0 <- matrix(data = NA_real_, nrow = 2*k+kt, ncol = n) ## for each x-sect. i = 1..n estimate (over t) an augmented model ## y_it = alpha_i + beta_i*X_it + c1_i*my_t + c2_i*mX_t + err_it unind <- unique(ind) for(i in 1:n) { taugX <- augX[ind == unind[i], ] # TODO: check if this kind of extractions need drop = FALSE for corner cases ty <- y[ind == unind[i]] if(trend) taugX <- cbind(taugX, 1:(dim(taugX)[[1L]])) tfit <- lm.fit(taugX, ty) tcoef0[ , i] <- tfit$coefficients tres[[i]] <- tfit$residuals } tcoef <- tcoef0[1:k, ] tcoef.bar <- tcoef0[-(1:k), ] coef.names.bar <- c("y.bar", paste(coef.names[-1L], ".bar", sep="")) ## 'trend' always comes last if(trend) coef.names.bar <- c(coef.names.bar, "trend") ## output complete coefs tcoef <- tcoef0 coef.names <- c(coef.names, coef.names.bar) ## adjust k k <- length(coef.names) ## TODO: adjust model formula etc. (else breaks waldtest, update, ...) }, "dmg" = { ## time-demean demX <- Within(X, effect = "time", na.rm = TRUE) demX[ , 1L] <- 1 # put back intercept lost by within transformation demy <- as.numeric(Within(y, effect = "time", na.rm = TRUE)) ## for each x-sect. i=1..n estimate (over t) a demeaned model ## (y_it-my_t) = alpha_i + beta_i*(X_it-mX_t) + err_it unind <- unique(ind) for (i in 1:n) { tdemX <- demX[ind == unind[i], ] tdemy <- demy[ind == unind[i]] if(trend) tdemX <- cbind(tdemX, 1:(dim(tdemX)[[1L]])) tfit <- lm.fit(tdemX, tdemy) tcoef[ , i] <- tfit$coefficients tres[[i]] <- tfit$residuals } ## 'trend' always comes last if(trend) coef.names <- c(coef.names, "trend") ## adjust k k <- length(coef.names) }) ## coefs are averages across individual regressions coef <- rowMeans(tcoef) # == apply(tcoef, 1, mean) ## make matrix of cross-products of demeaned individual coefficients coefmat <- array(data = NA_real_, dim = c(k, k, n)) demcoef <- tcoef - coef # gets recycled n times by column for (i in 1:n) coefmat[ , , i] <- outer(demcoef[ , i], demcoef[ , i]) ## summing over the n-dimension of the array we get the ## covariance matrix of coefs vcov <- rowSums(coefmat, dims = 2L) / (n*(n-1)) # == apply(coefmat, 1:2, sum) / (n*(n-1)) but rowSums(., dims = 2L)-construct is way faster ######### na.omit = T in apply was the big problem!! ## code as in pggls, only difference is here there is no 'sigma' residuals <- unlist(tres) ##was: as.vector(y) - as.vector(crossprod(t(X), coef[1:(dim(X)[[2]])])) df.residual <- nrow(X) - ncol(X) fitted.values <- y - residuals ## R2 as 1-var(res)/var(y); ## originally (HPY 3.14) adjusted by *(T.-1)/(T.-2*k0-2) ## but here k has expanded to include ybar, Xbar, (trend) r2 <- 1-var(residuals)/var(y)*(T.-1)/(T.-k-1) names(coef) <- rownames(vcov) <- colnames(vcov) <- coef.names dimnames(tcoef) <- list(coef.names, id.names) pmodel <- list(model.name = model.name) mgmod <- list(coefficients = coef, residuals = residuals, fitted.values = fitted.values, vcov = vcov, df.residual = df.residual, r.squared = r2, model = mf, indcoef = tcoef, formula = formula, call = cl) mgmod <- structure(mgmod, pdim = pdim, pmodel = pmodel) class(mgmod) <- c("pmg", "panelmodel") mgmod } #' @rdname pmg #' @export summary.pmg <- function(object, ...){ std.err <- sqrt(diag(object$vcov)) b <- object$coefficients z <- b/std.err p <- 2*pnorm(abs(z), lower.tail = FALSE) CoefTable <- cbind(b, std.err, z, p) colnames(CoefTable) <- c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") object$CoefTable <- CoefTable y <- object$model[[1L]] object$tss <- tss(y) object$ssr <- as.numeric(crossprod(residuals(object))) object$rsqr <- 1-object$ssr/object$tss class(object) <- c("summary.pmg") return(object) } #' @rdname pmg #' @export print.summary.pmg <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ pmodel <- attr(x, "pmodel") pdim <- attr(x, "pdim") cat(paste(model.pmg.list[pmodel$model.name], "\n", sep="")) cat("\nCall:\n") print(x$call) cat("\n") print(pdim) cat("\nResiduals:\n") print(sumres(x)) # was until rev. 1178: print(summary(unlist(residuals(x)))) cat("\nCoefficients:\n") printCoefmat(x$CoefTable, digits = digits) cat(paste("Total Sum of Squares: ", signif(x$tss, digits), "\n", sep="")) cat(paste("Residual Sum of Squares: ", signif(x$ssr, digits), "\n", sep="")) cat(paste("Multiple R-squared: ", signif(x$rsqr, digits), "\n", sep="")) invisible(x) } #' @rdname pmg #' @export residuals.pmg <- function(object, ...) { return(pres(object)) } plm/R/test_cd.R0000644000176200001440000006122714124132276013025 0ustar liggesusers ############## Pesaran's CD test and Breusch/Pagan LM Test (also scaled) ############### ## Pesaran's CD test for cross-sectional dependence in panel data models ## (and Breusch and Pagan's LM and scaled LM) ## ref. Pesaran, General diagnostic tests..., CESifo WP 1229, 2004 ## In case K+1>T the group-specific model is not estimable; ## as in Greene 11.7.2, formula (11.23) we use the group-specific residuals ## of a consistent estimator. This may be pooled OLS, RE, FE. Here the ## default is set to FE. ## Note that the test can be performed on the results of plm objects with ## any kind of effects: having "time" effects means checking for ## xs-dependence *after* introducing time dummies. ## In principle, the test can be performed on the results of *any* ## panelmodel object. Some issues remain regarding standardization of ## model output: some missing pieces are, e.g., the 'model$indexes' ## in ggls. ''fd'' models are also not compatible because of indexes ## keeping the original timespan, while data lose the first period. ## production version, generic and based on plm ## version 11: added test = "bcsclm" ## ## version 10: ## substantial optimization for speed, now fast (few seconds) on N=3000 ## all methods pass on a pseries to pcdres() ## make toy example #dati <- data.frame(ind=rep(1:7, 4), time=rep(1:4, each=7), x=rnorm(28), # group=rep(c(1,1,2,2,2,3,3), 4)) #pdati <- pdata.frame(dati) #' Tests of cross-section dependence for panel models #' #' Pesaran's CD or Breusch--Pagan's LM (local or global) tests for cross #' sectional dependence in panel models #' #' These tests are originally meant to use the residuals of separate #' estimation of one time--series regression for each cross-sectional #' unit in order to check for cross--sectional dependence (`model = NULL`). #' If a different model specification (`model = "within"`, `"random"`, #' \ldots{}) is assumed consistent, one can resort to its residuals for #' testing (which is common, e.g., when the time dimension's length is #' insufficient for estimating the heterogeneous model). #' #' If the time #' dimension is insufficient and `model = NULL`, the function defaults #' to estimation of a `within` model and issues a warning. The main #' argument of this function may be either a model of class #' `panelmodel` or a `formula` and `data frame`; in the second case, #' unless `model` is set to `NULL`, all usual parameters relative to #' the estimation of a `plm` model may be passed on. The test is #' compatible with any consistent `panelmodel` for the data at hand, #' with any specification of `effect` (except for `test = "bcsclm"` which #' requires a within model with either individual or two-ways effect). #' E.g., specifying `effect = "time"` or `effect = "twoways"` allows #' to test for residual cross-sectional dependence after the introduction #' of time fixed effects to account for common shocks. #' #' A **local** version of either test can be computed by supplying a #' proximity matrix (elements coercible to `logical`) with argument #' `w` which provides information on whether any pair of individuals #' are neighbours or not. If `w` is supplied, only neighbouring pairs #' will be used in computing the test; else, `w` will default to #' `NULL` and all observations will be used. The matrix need not be #' binary, so commonly used "row--standardized" matrices can be #' employed as well. `nb` objects from \CRANpkg{spdep} must instead be #' transformed into matrices by \CRANpkg{spdep}'s function `nb2mat` #' before using. #' #' The methods implemented are suitable also for unbalanced panels. #' #' Pesaran's CD test (`test="cd"`), Breusch and Pagan's LM test #' (`test="lm"`), and its scaled version (`test="sclm"`) are all #' described in \insertCite{PESA:04;textual}{plm} (and complemented by #' Pesaran (2005)). The bias-corrected scaled test (`test="bcsclm"`) #' is due to \insertCite{BALT:FENG:KAO:12}{plm} and only valid for #' within models including the individual effect (it's unbalanced #' version uses max(Tij) for T) in the bias-correction term). #' \insertCite{BREU:PAGA:80;textual}{plm} is the original source for #' the LM test. #' #' The test on a `pseries` is the same as a test on a pooled #' regression model of that variable on a constant, i.e., #' `pcdtest(some_pseries)` is equivalent to `pcdtest(plm(some_var ~ 1, #' data = some_pdata.frame, model = "pooling")` and also equivalent to #' `pcdtest(some_var ~ 1, data = some_data)`, where `some_var` is #' the variable name in the data which corresponds to `some_pseries`. #' #' @aliases pcdtest #' @param x an object of class `formula`, `panelmodel`, or `pseries` #' (depending on the respective interface) describing the model to #' be tested, #' @param data a `data.frame`, #' @param index an optional numerical index, if `NULL`, the first two #' columns of the data.frame provided in argument `data` are #' assumed to be the index variables; for further details see #' [pdata.frame()], #' @param model an optional character string indicating which type of #' model to estimate; if left to `NULL`, the original #' heterogeneous specification of Pesaran is used, #' @param test the type of test statistic to be returned. One of #' \itemize{ \item `"cd"` for Pesaran's CD statistic, \item `"lm"` #' for Breusch and Pagan's original LM statistic, \item `"sclm"` #' for the scaled version of Breusch and Pagan's LM statistic, #' \item `"bcsclm"` for the bias-corrected scaled version of #' Breusch and Pagan's LM statistic, \item `"rho"` for the average #' correlation coefficient, \item `"absrho"` for the average #' absolute correlation coefficient,} #' @param w either `NULL` (default) for the global tests or -- for the #' local versions of the statistics -- a `n x n` `matrix` #' describing proximity between individuals, with \eqn{w_ij = a} #' where \eqn{a} is any number such that `as.logical(a)==TRUE`, if #' \eqn{i,j} are neighbours, \eqn{0} or any number \eqn{b} such #' that `as.logical(b)==FALSE` elsewhere. Only the lower #' triangular part (without diagonal) of `w` after coercing by #' `as.logical()` is evaluated for neighbouring information (but #' `w` can be symmetric). See also **Details** and #' **Examples**, #' @param \dots further arguments to be passed on for model estimation to `plm`, #' such as `effect` or `random.method`. #' @return An object of class `"htest"`. #' @export #' @references #' #' \insertRef{BALT:FENG:KAO:12}{plm} #' #' \insertRef{BREU:PAGA:80}{plm} #' #' \insertRef{PESA:04}{plm} #' #' \insertRef{PESA:15}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' ## test on heterogeneous model (separate time series regressions) #' pcdtest(inv ~ value + capital, data = Grunfeld, #' index = c("firm", "year")) #' #' ## test on two-way fixed effects homogeneous model #' pcdtest(inv ~ value + capital, data = Grunfeld, model = "within", #' effect = "twoways", index = c("firm", "year")) #' #' ## test on panelmodel object #' g <- plm(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) #' pcdtest(g) #' #' ## scaled LM test #' pcdtest(g, test = "sclm") #' #' ## test on pseries #' pGrunfeld <- pdata.frame(Grunfeld) #' pcdtest(pGrunfeld$value) #' #' ## local test #' ## define neighbours for individual 2: 1, 3, 4, 5 in lower triangular matrix #' w <- matrix(0, ncol= 10, nrow=10) #' w[2,1] <- w[3,2] <- w[4,2] <- w[5,2] <- 1 #' pcdtest(g, w = w) #' pcdtest <- function(x, ...) { UseMethod("pcdtest") } ## this formula method here only for adding "rho" and "absrho" ## arguments #' @rdname pcdtest #' @export pcdtest.formula <- function(x, data, index = NULL, model = NULL, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ...) { #data <- pdata.frame(data, index = index) test <- match.arg(test) if(test == "bcsclm" && (is.null(model) || model != "within")) stop("for test = 'bcsclm', set argument model = 'within'") # evaluate formula in parent frame cl <- match.call(expand.dots = TRUE) cl$model <- if(test != "bcsclm") "pooling" else "within" if(test == "bcsclm") { # check args model and effect for test = "bcsclm" if(is.null(cl$effect)) cl$effect <- "individual" # make default within model is individual within eff <- isTRUE(cl$effect == "individual" || cl$effect == "twoways") if(model != "within" || !eff) stop("for test = 'bcsclm', requirement is model = \"within\" and effect = \"individual\" or \"twoways\"") } names(cl)[2L] <- "formula" m <- match(plm.arg, names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("plm") mymod <- eval(cl, parent.frame()) # mymod is either "pooling" or "within" (the latter iff for test = "bcsclm") hetero.spec <- if(is.null(model)) TRUE else FALSE if(hetero.spec && min(pdim(mymod)$Tint$Ti) < length(mymod$coefficients)+1) { warning("Insufficient number of observations in time to estimate heterogeneous model: using within residuals", call. = FALSE) hetero.spec <- FALSE model <- "within" } ind0 <- attr(model.frame(mymod), "index") tind <- as.numeric(ind0[[2L]]) ind <- as.numeric(ind0[[1L]]) if(hetero.spec) { ## estimate individual normal regressions one by one ## (original heterogeneous specification of Pesaran) X <- model.matrix(mymod) y <- model.response(model.frame(mymod)) unind <- unique(ind) n <- length(unind) ti.res <- vector("list", n) ind.res <- vector("list", n) tind.res <- vector("list", n) for (i in 1:n) { tX <- X[ind == unind[i], , drop = FALSE] ty <- y[ind == unind[i]] res.i <- lm.fit(tX, ty)$residuals ti.res[[i]] <- res.i names(ti.res[[i]]) <- tind[ind == unind[i]] ind.res[[i]] <- rep(i, length(res.i)) tind.res[[i]] <- tind[ind == unind[i]] } ## make pseries of (all) residuals resdata <- data.frame(ee = unlist(ti.res, use.names = FALSE), ind = unlist(ind.res, use.names = FALSE), tind = unlist(tind.res, use.names = FALSE)) pee <- pdata.frame(resdata, index = c("ind", "tind")) tres <- pee$ee } else { # else case is one of: # a) insufficient number of observations for heterogen. spec. or # b) model specified when function was called (incl. case test = "bcsclm") if(test != "bcsclm") { # Estimate the model specified originally in function call or due to # forced model switch to within model by insufficient number of # observations for heterogen. spec. # (for test = "bcsclm" it is ensured that a within model was already # estimated -> no need to estimate again a within model) cl$model <- model mymod <- eval(cl, parent.frame()) } tres <- resid(mymod) unind <- unique(ind) n <- length(unind) t <- min(pdim(mymod)$Tint$Ti) nT <- length(ind) k <- length(mymod$coefficients) } return(pcdres(tres = tres, n = n, w = w, form = paste(deparse(x)), test = test)) } ## panelmodel method: just fetch resid (as a pseries) and hand over to pcdres #' @rdname pcdtest #' @export pcdtest.panelmodel <- function(x, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ...) { test <- match.arg(test) model <- describe(x, "model") effect <- describe(x, "effect") eff <- (effect == "individual" || effect == "twoways") if (test == "bcsclm") if (model != "within" || !eff) stop("for test = 'bcsclm', model x must be a within individual or twoways model") tres <- resid(x) index <- attr(model.frame(x), "index") #tind <- as.numeric(index[[2L]]) ind <- as.numeric(index[[1L]]) unind <- unique(ind) n <- length(unind) #t <- pdim(x)$Tint$Ti #nT <- length(ind) #k <- length(x$coefficients) return(pcdres(tres = tres, n = n, w = w, form = paste(deparse(x$formula)), test = test)) } #' @rdname pcdtest #' @export pcdtest.pseries <- function(x, test = c("cd", "sclm", "bcsclm", "lm", "rho", "absrho"), w = NULL, ...) { ## calculates local or global CD test on a pseries 'x' just as it ## would on model residuals ## important difference here: a pseries _can_ have NAs # input check if (!inherits(x, "pseries")) stop("input 'x' needs to be of class \"pseries\"") form <- paste(deparse(substitute(x))) pos.na <- is.na(x) if (any(pos.na)) { x <- subset_pseries(x, !pos.na) # TODO: use [.pseries (pseries subsetting) once implemented warning("NA values encountered in input and removed") if (length(x) == 0L) stop("input is empty after removal of NA values") } ## get indices tind <- as.numeric(attr(x, "index")[[2L]]) ind <- as.numeric(attr(x, "index")[[1L]]) ## det. number of groups and df unind <- unique(ind) n <- length(unind) tres <- x ## "pre-allocate" an empty list of length n #tres <- vector("list", n) ## use model residuals, group by group ## list of n: ## t_i residuals for each x-sect. 1..n #for(i in 1:n) { # # remove NAs # xnonna <- !is.na(x[ind==unind[i]]) # tres[[i]] <- x[ind==unind[i]][xnonna] # ## name resids after the time index # names(tres[[i]]) <- tind[ind==unind[i]][xnonna] # } return(pcdres(tres = tres, n = n, w = w, form = form, test = match.arg(test))) } pcdres <- function(tres, n, w, form, test) { # 'form' is a character describing the formula (not a formula object!) # and goes into htest_object$data.name ## Take model residuals as pseries, and calc. test ## (from here on, what's needed for rho_ij is ok) ## this function is the modulus calculating the test, ## to be called from pcdtest.formula, ## pcdtest.panelmodel or pcdtest.pseries ## now (since v10) tres is the pseries of model residuals ## calc matrix of all possible pairwise corr. ## coeffs. (200x speedup from using cor()) wideres <- t(preshape(tres, na.rm = FALSE)) rho <- cor(wideres, use = "pairwise.complete.obs") ## find length of intersecting pairs ## fast method, times down 200x data.res <- data.frame(time = attr(tres, "index")[[2L]], indiv = attr(tres, "index")[[1L]]) ## tabulate which obs in time for each ind are !na presence.tab <- table(data.res) ## calculate t.ij t.ij <- crossprod(presence.tab) # input check if (!is.null(w)) { dims.w <- dim(w) if(dims.w[1L] != n || dims.w[2L] != n) stop(paste0("matrix 'w' describing proximity of individuals has wrong dimensions: ", "should be ", n, " x ", n, " (no. of individuals) but is ", dims.w[1L], " x ", dims.w[2L])) } ## begin features for local test #################### ## higher orders omitted for now, use wlag() explicitly ## if global test, set all elements in w to 1 if(is.null(w)) { w <- matrix(1, ncol = n, nrow = n) dep <- "" } else { dep <- "local" } ## make (binary) selector matrix based on the contiguity matrix w ## and extracting elements corresponding to ones in the lower triangle ## excluding the diagonal ## transform in logicals (0=FALSE, else=TRUE: no need to worry ## about row-std. matrices) selector.mat <- matrix(as.logical(w), ncol = n) ## some sanity checks for 'w' (not perfect sanity, but helps) if (sum(selector.mat[lower.tri(selector.mat, diag = FALSE)]) == 0) { stop(paste0("no neighbouring individuals defined in proximity matrix 'w'; ", "only lower triangular part of 'w' (w/o diagonal) is evaluated")) } else { if (sum(selector.mat[upper.tri(selector.mat, diag = FALSE)]) != 0) { if (!isSymmetric((unname(selector.mat)))) { # unname needed to ignore rownames and colnames stop(paste0("proximity matrix 'w' is ambiguous: upper and lower triangular part ", "define different neighbours (it is sufficient to provide information ", "about neighbours only in the lower triangluar part of 'w'")) } } } ## if no intersection or only 1 shared period of e_it and e_jt ## => exclude from calculation and issue a warning. ## In general, length(m.ij) gives the number of shared periods by indiviudals i, j ## Thus, non intersecting pairs are indicated by length(m.ij) == 0 (t.ij[i,j] == 0) no.one.intersect <- (t.ij <= 1) if (any(no.one.intersect, na.rm = TRUE)) { # t.ij is a lower triangular matrix: do not divide by 2 to get the number of non-intersecting pairs! number.of.non.one.intersecting.pairs <- sum(no.one.intersect, na.rm = TRUE) number.of.total.pairs <- (n*(n-1))/2 share.on.one.intersect.pairs <- number.of.non.one.intersecting.pairs / number.of.total.pairs * 100 warning(paste("Some pairs of individuals (", signif(share.on.one.intersect.pairs, digits = 2), " percent) do not have any or just one time period in common and have been omitted from calculation", sep="")) selector.mat[no.one.intersect] <- FALSE } ## set upper tri and diagonal to FALSE selector.mat[upper.tri(selector.mat, diag = TRUE)] <- FALSE ## number of elements in selector.mat ## elem.num = 2*(N*(N-1)) in Pesaran (2004), formulae (6), (7), (31), ... elem.num <- sum(selector.mat) ## end features for local test ###################### ## Breusch-Pagan or Pesaran statistic for cross-sectional dependence, ## robust vs. unbalanced panels: switch(test, lm = { CDstat <- sum((t.ij*rho^2)[selector.mat]) pCD <- pchisq(CDstat, df = elem.num, lower.tail = FALSE) names(CDstat) <- "chisq" parm <- elem.num names(parm) <- "df" testname <- "Breusch-Pagan LM test" }, sclm = { CDstat <- sqrt(1/(2*elem.num))*sum((t.ij*rho^2-1)[selector.mat]) pCD <- 2*pnorm(abs(CDstat), lower.tail = FALSE) names(CDstat) <- "z" parm <- NULL testname <- "Scaled LM test" }, bcsclm = { # Baltagi/Feng/Kao (2012), formula (11) # (unbalanced case as sclm + in bias correction as EViews: max(T_ij) instead of T) CDstat <- sqrt(1/(2*elem.num))*sum((t.ij*rho^2-1)[selector.mat]) - (n/(2*(max(t.ij)-1))) pCD <- 2*pnorm(abs(CDstat), lower.tail = FALSE) names(CDstat) <- "z" parm <- NULL testname <- "Bias-corrected Scaled LM test" }, cd = { # (Pesaran (2004), formula (31)) CDstat <- sqrt(1/elem.num)*sum((sqrt(t.ij)*rho)[selector.mat]) pCD <- 2*pnorm(abs(CDstat), lower.tail = FALSE) names(CDstat) <- "z" parm <- NULL testname <- "Pesaran CD test" }, rho = { CDstat <- sum(rho[selector.mat])/elem.num pCD <- NULL names(CDstat) <- "rho" parm <- NULL testname <- "Average correlation coefficient" }, absrho = { CDstat <- sum(abs(rho)[selector.mat])/elem.num pCD <- NULL names(CDstat) <- "|rho|" parm <- NULL testname <- "Average absolute correlation coefficient" }) ##(insert usual htest features) RVAL <- list(statistic = CDstat, parameter = parm, method = paste(testname, "for", dep, "cross-sectional dependence in panels"), alternative = "cross-sectional dependence", p.value = pCD, data.name = form) class(RVAL) <- "htest" return(RVAL) } preshape <- function(x, na.rm = TRUE, ...) { ## reshapes pseries, ## e.g., of residuals from a panelmodel, ## in wide form inames <- names(attr(x, "index")) mres <- reshape(cbind(as.vector(x), attr(x, "index")), direction = "wide", timevar = inames[2L], idvar = inames[1L]) ## drop ind in first column mres <- mres[ , -1L, drop = FALSE] ## reorder columns (may be scrambled depending on first ## available obs in unbalanced panels) mres <- mres[ , order(dimnames(mres)[[2L]])] ## if requested, drop columns (time periods) with NAs if(na.rm) { na.cols <- vapply(mres, FUN = anyNA, FUN.VALUE = TRUE, USE.NAMES = FALSE) if(sum(na.cols) > 0L) mres <- mres[ , !na.cols] } return(mres) } #' Cross--sectional correlation matrix #' #' Computes the cross--sectional correlation matrix #' #' #' @param x an object of class `pseries` #' @param grouping grouping variable, #' @param groupnames a character vector of group names, #' @param value to complete, #' @param \dots further arguments. #' @return A matrix with average correlation coefficients within a group #' (diagonal) and between groups (off-diagonal). #' @export #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' pGrunfeld <- pdata.frame(Grunfeld) #' grp <- c(rep(1, 100), rep(2, 50), rep(3, 50)) # make 3 groups #' cortab(pGrunfeld$value, grouping = grp, groupnames = c("A", "B", "C")) #' cortab <- function(x, grouping, groupnames = NULL, value = "statistic", ...) { ## makes matrix containing within (diagonal) and between (off-diagonal) ## correlation ## needs a pseries and a groupings vector of **same length** ## would use a better naming, and also passing a char or factor as ## grouping index ## x must be a pseries if(!inherits(x, "pseries")) stop("First argument must be a pseries") if(length(x) != length(grouping)) stop("arguments 'x' and 'grouping' must have same length") fullind <- as.numeric(attr(x, "index")[ , 1L]) ids <- unique(fullind) n <- length(ids) regs <- 1:length(unique(grouping)) if(!(is.numeric(grouping))) grouping <- as.numeric(as.factor(grouping)) idnames <- as.character(ids) if(is.null(groupnames)) { groupnames <- as.character(unique(grouping)) } ## make matrices of between-regions correlations ## (includes within correlation on diagonal) ## for each pair of regions (nb: no duplicates, e.g., 3.1 but not 1.3) ## make w<1.n>: for(h in 1:length(regs)) { for(k in 1:h) { statew <- matrix(0, ncol = n, nrow = n) ## make statew for cor. between h and k for(i in 1:n) { ## get first region (all values equal, so take first one) ireg <- grouping[fullind == ids[i]][1L] if(ireg == h) { for(j in 1:n) { jreg <- grouping[fullind == ids[j]][1L] if(jreg == k) statew[i, j] <- 1 } } } if(h!=k) statew <- statew + t(statew) ## just for debugging reasons: dimnames(statew) <- list(idnames, idnames) ## eliminate self.correlation of states if i=j diag(statew) <- 0 ## not needed: pcdtest seems to do this by construction eval(parse(text=paste("w", h, ".", k, " <- statew", sep=""))) } } ## notice: without the line ## '' if(i!=j) statew <- statew + t(statew) '' ## all wn.n matrices would have values only on one half (upper ## or lower triangle) ## make generic table of regions' within and between correlation ## argument: a pseries #YC regnames is undefined, so is myw tab.g <- function(x, regs, regnames, test="rho", value) { myw <- 0 tabg <- matrix(NA, ncol=length(regs), nrow=length(regs)) for(i in 1:length(regs)) { for(j in 1:i) { ## take appropriate w matrix eval(parse(text = paste("myw<-w", i, ".", j, sep = ""))) tabg[i, j] <- pcdtest(x, test = "rho", w = myw)[[value]] } } dimnames(tabg) <- list(groupnames, groupnames) return(tabg) } regnames <- "" mytab <- tab.g(x, regs = regs, regnames = regnames, test = "rho", value = value) return(mytab) } plm/R/est_cce.R0000644000176200001440000004546614164772477013035 0ustar liggesusers## Common Correlated Effects Pooled/MG estimators ## ref. Holly, Pesaran and Yamagata JoE 158 (2010) ## (also Kapetanios, Pesaran and Yamagata JoE 2010) ## CCEP and CCEMG together in the same SW framework ## based on generalized FEs ## this version 6: includes both defactored (cce) and raw (standard) residuals, ## leaving to a special residuals.pcce method the choice of which to retrieve ## NB the effect of including a trend is exactly the same as for ## including as.numeric() in the model specification ## If the panel is unbalanced, though, then for some i the trend becomes ## (3,4,5, ...) instead of (1,2,3, ...); the difference is absorbed by ## the individual intercept, and *the group intercept* changes. ## needed for standalone operation: #plm <- plm:::plm #pdim <- plm:::pdim #model.matrix.plm <- plm:::model.matrix.plm #pmodel.response.plm <- plm:::pmodel.response.plm #tss <- plm:::tss #' Common Correlated Effects estimators #' #' Common Correlated Effects Mean Groups (CCEMG) and Pooled (CCEP) #' estimators for panel data with common factors (balanced or #' unbalanced) #' #' `pcce` is a function for the estimation of linear panel models by #' the Common Correlated Effects Mean Groups or Pooled estimator, #' consistent under the hypothesis of unobserved common factors and #' idiosyncratic factor loadings. The CCE estimator works by #' augmenting the model by cross-sectional averages of the dependent #' variable and regressors in order to account for the common factors, #' and adding individual intercepts and possibly trends. #' #' @aliases pcce #' @param formula a symbolic description of the model to be estimated, #' @param object,x an object of class `"pcce"`, #' @param data a `data.frame`, #' @param subset see `lm`, #' @param na.action see `lm`, #' @param model one of `"mg"`, `"p"`, selects Mean Groups vs. Pooled #' CCE model, #' @param index the indexes, see [pdata.frame()], #' @param trend logical specifying whether an individual-specific #' trend has to be included, #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param type one of `"defactored"` or `"standard"`, #' @param vcov a variance-covariance matrix furnished by the user or a function to calculate one, #' @param \dots further arguments. #' @return An object of class `c("pcce", "panelmodel")` containing: #' \item{coefficients}{the vector of coefficients,} #' \item{residuals}{the vector of (defactored) residuals,} #' \item{stdres}{the vector of (raw) residuals,} #' \item{tr.model}{the transformed data after projection on H,} #' \item{fitted.values}{the vector of fitted values,} #' \item{vcov}{the covariance matrix of the coefficients,} #' \item{df.residual}{degrees of freedom of the residuals,} #' \item{model}{a data.frame containing the variables used for the #' estimation,} #' \item{call}{the call,} #' \item{indcoef}{the matrix of individual coefficients from #' separate time series regressions,} #' \item{r.squared}{numeric, the R squared.} #' @export #' @importFrom MASS ginv #' @author Giovanni Millo #' @references #' #' \insertRef{kappesyam11}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' ccepmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="p") #' summary(ccepmod) #' summary(ccepmod, vcov = vcovHC) # use argument vcov for robust std. errors #' #' ccemgmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="mg") #' summary(ccemgmod) #' pcce <- function (formula, data, subset, na.action, model = c("mg", "p"), #residuals = c("defactored", "standard"), index = NULL, trend = FALSE, ...) { ## Create a Formula object if necessary (from plm) if (!inherits(formula, "Formula")) formula <- as.Formula(formula) ## same as pggls but for effect, fixed at "individual" for compatibility ## ind for id, tind for time, k for K, coefnam for coef.names effect <- "individual" ## record call etc. model <- match.arg(model) model.name <- paste("cce", model, sep="") data.name <- paste(deparse(substitute(data))) cl <- match.call() plm.model <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "effect", "model", "index"), names(plm.model), 0) plm.model <- plm.model[c(1L, m)] plm.model[[1L]] <- as.name("plm") ## change the 'model' in call plm.model$model <- "pooling" ## evaluates the call, modified with model = "pooling", inside the ## parent frame resulting in the pooling model on formula, data plm.model <- eval(plm.model, parent.frame()) mf <- model.frame(plm.model) index <- unclass(attr(mf, "index")) # unclass for speed ind <- index[[1L]] ## individual index tind <- index[[2L]] ## time index ## set dimension variables pdim <- pdim(plm.model) balanced <- pdim$balanced nt <- pdim$Tint$nt Ti <- pdim$Tint$Ti T. <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N ## set index names time.names <- pdim$panel.names$time.names id.names <- pdim$panel.names$id.names coef.names <- names(coef(plm.model)) ## number of coefficients k <- length(coef.names) ## model data X <- model.matrix(plm.model) y <- model.response(mf) ## det. *minimum* group numerosity t <- min(Ti) # == min(tapply(X[ , 1], ind, length)) ## check min. t numerosity ## NB it is also possible to allow estimation if there *is* one group ## with t large enough and average on coefficients removing NAs ## Here we choose the explicit way: let estimation fail if we lose df ## but a warning would do... if(t < (k+1)) stop("Insufficient number of time periods") ## one regression for each group i in 1..n ## and retrieve coefficients putting them into a matrix ## (might be unbalanced => t1 != t2 but we don't care as long ## as min(t) > k+1) ## subtract intercept from parms number and names has.int <- attr(terms(plm.model), "intercept") if(has.int) { k <- k - 1 coef.names <- coef.names[-1L] } ## "pre-allocate" coefficients matrix for the n models tcoef <- matrix(NA_real_, nrow = k, ncol = n) ## pre-allocate residuals lists for individual regressions ## (lists allow for unbalanced panels) cceres <- vector("list", n) stdres <- vector("list", n) ## CCE by-group estimation ## must put the intercept into the group-invariant part!! ## so first drop it from X if(has.int) { X <- X[ , -1L, drop = FALSE] } ## group-invariant part, goes in Hhat ## between-periods transformation (take means over groups for each t) Xm <- Between(X, effect = tind, na.rm = TRUE) ym <- as.numeric(Between(y, effect = "time", na.rm = TRUE)) Hhat <- if(has.int) cbind(ym, Xm, 1L) else cbind(ym, Xm) ## prepare XMX, XMy arrays XMX <- array(data = NA_real_, dim = c(k, k, n)) XMy <- array(data = NA_real_, dim = c(k, 1L, n)) ## hence calc. beta_i anyway because of vcov ## for each x-sect. i=1..n estimate (over t) the CCE for every TS ## as in KPY, eq. 15 unind <- unique(ind) for(i in 1:n) { tX <- X[ind == unind[i], , drop = FALSE] ty <- y[ind == unind[i]] tHhat <- Hhat[ind == unind[i], , drop = FALSE] ## if 'trend' then augment the xs-invariant component if(trend) tHhat <- cbind(tHhat, 1:(dim(tHhat)[[1L]])) ## NB tHat, tMhat should be i-invariant tMhat <- diag(1, length(ty)) - tHhat %*% solve(crossprod(tHhat), t(tHhat)) CP.tXtMhat <- crossprod(tX, tMhat) tXMX <- tcrossprod(CP.tXtMhat, t(tX)) tXMy <- tcrossprod(CP.tXtMhat, t(ty)) ## XMX_i, XMy_i XMX[ , , i] <- tXMX XMy[ , , i] <- tXMy ## single CCE coefficients tb <- ginv(tXMX) %*% tXMy #solve(tXMX, tXMy) ## USED A GENERALIZED INVERSE HERE BECAUSE OF PBs WITH ECM SPECS ## Notice remark in Pesaran (2006, p.977, between (27) and (28)) ## that XMX.i is invariant to the choice of a g-inverse for H'H tcoef[ , i] <- tb ## cce (defactored) residuals as M_i(y_i - X_i * bCCEMG_i) tytXtb <- ty - tcrossprod(tX, t(tb)) cceres[[i]] <- tcrossprod(tMhat, t(tytXtb)) ## std. (raw) residuals as y_i - X_i * bCCEMG_i - a_i ta <- mean(ty - tX) stdres[[i]] <- tytXtb - ta } ## module for making transformed data My, MX for vcovHC use ## (NB M is symmetric) ## Some redundancy because this might be moved to model.matrix.pcce ## initialize tX1 <- X[ind == unind[1L], , drop = FALSE] ty1 <- y[ind == unind[1L]] tHhat1 <- Hhat[ind == unind[1L], , drop = FALSE] ## if 'trend' then augment the xs-invariant component if(trend) tHhat1 <- cbind(tHhat1, 1:(dim(tHhat)[[1L]])) ## NB tHat, tMhat should be i-invariant (but beware of unbalanced) tMhat1 <- diag(1, length(ty1)) - tHhat1 %*% solve(crossprod(tHhat1), t(tHhat1)) MX <- crossprod(tMhat1, tX1) My <- crossprod(tMhat1, ty1) for(i in 2:n) { tX <- X[ind == unind[i], , drop = FALSE] ty <- y[ind == unind[i]] tHhat <- Hhat[ind == unind[i], , drop = FALSE] ## if 'trend' then augment the xs-invariant component if(trend) tHhat <- cbind(tHhat, 1:(dim(tHhat)[[1L]])) ## NB tHat, tMhat should be i-invariant tMhat <- diag(1, length(ty)) - tHhat %*% solve(crossprod(tHhat), t(tHhat)) tMX <- crossprod(tMhat, tX) tMy <- crossprod(tMhat, ty) MX <- rbind(MX, tMX) My <- c(My, tMy) } ## checks ## MX <<- MX ## My <<- My ## ALT: ## MXa <<- kronecker(diag(n), tMhat1) %*% X ## Mya <<- kronecker(diag(n), tMhat1) %*% y ## very same result, less efficient ## end data module ## CCEMG coefs are averages across individual regressions ## (here: coefs of xs-variants only!) coefmg <- rowMeans(tcoef) # was: apply(tcoef, 1, mean) ## make matrix of cross-products of demeaned individual coefficients Rmat <- array(data = NA_real_, dim = c(k, k, n)) ## make b_i - b_CCEMG demcoef <- tcoef - coefmg # coefmg gets recycled n times by column ## calc. coef and vcov according to model switch(model, "mg" = { ## assign beta CCEMG coef <- coefmg for(i in 1:n) Rmat[ , , i] <- outer(demcoef[ , i], demcoef[ , i]) vcov <- 1/(n*(n-1)) * rowSums(Rmat, dims = 2L) # == 1/(n*(n-1)) * apply(Rmat, 1:2, sum), but rowSums(., dims = 2L)-construct is way faster }, "p" = { ## calc beta_CCEP sXMX <- rowSums(XMX, dims = 2L) # == apply(XMX, 1:2, sum), but rowSums(., dims = 2L)-construct is way faster sXMy <- rowSums(XMy, dims = 2L) # == apply(XMy, 1:2, sum), but rowSums(., dims = 2L)-construct is way faster coef <- solve(sXMX, sXMy) ## calc CCEP covariance: psi.star <- 1/N * sXMX for(i in 1:n) Rmat[ , , i] <- XMX[ , , i] %*% outer(demcoef[ , i], demcoef[ , i]) %*% XMX[ , , i] ## summing over the n-dimension of the array we get the ## covariance matrix of coefs R.star <- 1/(n-1) * rowSums(Rmat, dims = 2L) * 1/(t^2) # rowSums(Rmat, dims = 2L) faster than == apply(Rmat, 1:2, sum) Sigmap.star <- solve(psi.star, R.star) %*% solve(psi.star) vcov <- Sigmap.star/n ## calc CCEP residuals both defactored and raw for(i in 1:n) { ## must redo all this because needs b_CCEP, which is ## not known at by-groups step tX <- X[ind == unind[i], , drop = FALSE] ty <- y[ind == unind[i]] tHhat <- Hhat[ind == unind[i], , drop = FALSE] ## if 'trend' then augment the xs-invariant component if(trend) tHhat <- cbind(tHhat, 1:(dim(tHhat)[[1L]])) ## NB tHat, tMhat should be i-invariant (but for the ## group size if unbalanced) tMhat <- diag(1, length(ty)) - tHhat %*% solve(crossprod(tHhat), t(tHhat)) ## cce residuals as M_i(y_i - X_i * bCCEP) tytXcoef <- ty - tcrossprod(tX, t(coef)) cceres[[i]] <- tcrossprod(tMhat, t(tytXcoef)) ## std. (raw) residuals as y_i - X_i * bCCEMG_i - a_i ta <- mean(ty - tX) stdres[[i]] <- tytXcoef - ta } }) ## calc. measures of fit according to model type switch(model, "mg" = { ## R2 as in HPY 2010: sigma2ccemg = average (over n) of variances ## of defactored residuals ## (for unbalanced panels, each variance is correctly normalized ## by group dimension T.i) ## ## If balanced, would simply be ## sum(unlist(cceres)^2)/(n*(T.-2*k-2)) ## pre-allocate list for individual CCEMG residual variances sigma2cce.i <- vector("list", n) ## average variance of defactored residuals sigma2ccemg as in ## Holly, Pesaran and Yamagata, (3.14) for(i in 1:n) { sigma2cce.i[[i]] <- crossprod(cceres[[i]])* 1/(length(cceres[[i]])-2*k-2) } sigma2cce <- 1/n*sum(unlist(sigma2cce.i, use.names = FALSE)) }, "p" = { ## variance of defactored residuals sigma2ccep as in Holly, ## Pesaran and Yamagata, (3.15) sigma2cce <- 1/(n*(T.-k-2)-k)* sum(vapply(cceres, crossprod, FUN.VALUE = 0.0, USE.NAMES = FALSE)) ## is the same as sum(unlist(cceres)^2) }) ## calc. overall R2, CCEMG or CCEP depending on 'model' sigma2.i <- vector("list", n) for(i in 1:n) { ty <- y[ind == unind[i]] sigma2.i[[i]] <- as.numeric(crossprod((ty-mean(ty))))/(length(ty)-1) } sigma2y <- mean(unlist(sigma2.i, use.names = FALSE)) r2cce <- 1 - sigma2cce/sigma2y ## allow outputting different types of residuals stdres <- unlist(stdres) residuals <- unlist(cceres) ## add transformed data (for now a simple list) tr.model <- list(y = My, X = MX) ## so that if the model is ccepmod, ## > lm(ccepmod$tr.model[["y"]] ~ ccepmod$tr.model[["X"]]-1) ## reproduces the model results ## Final model object: ## code as in pggls, differences: ## - here there is no 'sigma' ## - there are two types of residuals ## - transformed data My, MX are included for vcovHC usage df.residual <- nrow(X) - ncol(X) fitted.values <- y - residuals coef <- as.numeric(coef) names(coef) <- rownames(vcov) <- colnames(vcov) <- coef.names dimnames(tcoef) <- list(coef.names, id.names) pmodel <- list(model.name = model.name) pccemod <- list(coefficients = coef, residuals = residuals, stdres = stdres, tr.model = tr.model, fitted.values = fitted.values, vcov = vcov, df.residual = df.residual, model = mf, indcoef = tcoef, r.squared = r2cce, #cceres = as.vector(cceres), #ccemgres = as.vector(ccemgres), formula = formula, call = cl) pccemod <- structure(pccemod, pdim = pdim, pmodel = pmodel) class(pccemod) <- c("pcce", "panelmodel") pccemod } #' @rdname pcce #' @export summary.pcce <- function(object, vcov = NULL, ...){ vcov_arg <- vcov std.err <- if (!is.null(vcov_arg)) { if (is.matrix(vcov_arg)) rvcov <- vcov_arg if (is.function(vcov_arg)) rvcov <- vcov_arg(object) sqrt(diag(rvcov)) } else { sqrt(diag(stats::vcov(object))) } b <- object$coefficients z <- b/std.err p <- 2*pnorm(abs(z), lower.tail = FALSE) CoefTable <- cbind(b, std.err, z, p) colnames(CoefTable) <- c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") object$CoefTable <- CoefTable y <- object$model[[1L]] object$tss <- tss(y) object$ssr <- as.numeric(crossprod(residuals(object))) object$rsqr <- object$r.squared #1-object$ssr/object$tss ## add some info to summary.pcce object # robust vcov (next to "normal" vcov) if (!is.null(vcov_arg)) { object$rvcov <- rvcov rvcov.name <- paste0(deparse(substitute(vcov))) attr(object$rvcov, which = "rvcov.name") <- rvcov.name } class(object) <- c("summary.pcce") return(object) } #' @rdname pcce #' @export print.summary.pcce <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ pmodel <- attr(x, "pmodel") pdim <- attr(x, "pdim") cat("Common Correlated Effects ") cat(paste(model.pcce.list[pmodel$model.name], "\n", sep = "")) if (!is.null(x$rvcov)) { cat("\nNote: Coefficient variance-covariance matrix supplied: ", attr(x$rvcov, which = "rvcov.name"), "\n", sep = "") } cat("\nCall:\n") print(x$call) cat("\n") print(pdim) cat("\nResiduals:\n") print(sumres(x)) # was until rev. 1178: print(summary(unlist(residuals(x)))) cat("\nCoefficients:\n") printCoefmat(x$CoefTable, digits = digits) cat(paste("Total Sum of Squares: ", signif(x$tss, digits), "\n", sep="")) cat(paste("Residual Sum of Squares: ", signif(x$ssr, digits), "\n", sep="")) cat(paste("HPY R-squared: ", signif(x$rsqr, digits), "\n", sep="")) invisible(x) } #' @rdname pcce #' @export residuals.pcce <- function(object, type = c("defactored", "standard"), ...) { ## special resid() method for pcce: allows to extract either ## defactored residuals (default) or raw residuals defres <- pres(object) switch(match.arg(type), "standard" = { ## add panel features and names from 'defres' residuals <- add_pseries_features(object$stdres, index(defres)) names(residuals) <- names(defres) }, "defactored" = { residuals <- defres } ) return(residuals) } #' @rdname pcce #' @export model.matrix.pcce <- function(object, ...) { object$tr.model$X } #' @rdname pcce #' @export pmodel.response.pcce <- function(object, ...) { object$tr.model$y } plm/R/tool_vcovG.R0000644000176200001440000013763414164672712013537 0ustar liggesusers #' Driscoll and Kraay (1998) Robust Covariance Matrix Estimator #' #' Nonparametric robust covariance matrix estimators *a la #' Driscoll and Kraay* for panel models with cross-sectional #' *and* serial correlation. #' #' `vcovSCC` is a function for estimating a robust covariance matrix #' of parameters for a panel model according to the #' \insertCite{DRIS:KRAA:98;textual}{plm} method, which is consistent #' with cross--sectional and serial correlation in a T-asymptotic #' setting and irrespective of the N dimension. The use with random #' effects models is undocumented. #' #' Weighting schemes specified by `type` are analogous to those in #' [sandwich::vcovHC()] in package \CRANpkg{sandwich} and are #' justified theoretically (although in the context of the standard #' linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and #' \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}). #' #' The main use of `vcovSCC` (and the other variance-covariance estimators #' provided in the package `vcovHC`, `vcovBK`, `vcovNW`, `vcovDC`) is to pass #' it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or #' together with testing functions from the `lmtest` and `car` packages. All of #' these typically allow passing the `vcov` or `vcov.` parameter either as a #' matrix or as a function, e.g., for Wald--type testing: argument `vcov.` to #' `coeftest()`, argument `vcov` to `waldtest()` and other methods in the #' \CRANpkg{lmtest} package; and argument `vcov.` to #' `linearHypothesis()` in the \CRANpkg{car} package (see the #' examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. #' #' @aliases vcovSCC #' @param x an object of class `"plm"` or `"pcce"` #' @param type the weighting scheme used, one of `"HC0"`, `"sss"`, #' `"HC1"`, `"HC2"`, `"HC3"`, `"HC4"`, see Details, #' @param cluster switch for vcovG; set at `"time"` here, #' @param maxlag either `NULL` or a positive integer specifying the #' maximum lag order before truncation #' @param inner the function to be applied to the residuals inside the #' sandwich: `"cluster"` for SCC, `"white"` for Newey-West, #' (`"diagavg"` for compatibility reasons) #' @param wj weighting function to be applied to lagged terms, #' @param \dots further arguments #' @return An object of class `"matrix"` containing the estimate of #' the covariance matrix of coefficients. #' @export #' @author Giovanni Millo, partially ported from Daniel Hoechle's #' (2007) Stata code #' @seealso [sandwich::vcovHC()] from the \CRANpkg{sandwich} #' package for weighting schemes (`type` argument). #' @references #' #' \insertRef{CRIB:04}{plm} #' #' \insertRef{DRIS:KRAA:98}{plm} #' #' \insertRef{HOEC:07}{plm} #' #' \insertRef{MACK:WHIT:85}{plm} #' #' \insertRef{ZEIL:04}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package="plm") #' zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") #' ## as function input to plm's summary method (with and without additional arguments): #' summary(zz, vcov = vcovSCC) #' summary(zz, vcov = function(x) vcovSCC(x, method="arellano", type="HC1")) #' ## standard coefficient significance test #' library(lmtest) #' coeftest(zz) #' ## SCC robust significance test, default #' coeftest(zz, vcov.=vcovSCC) #' ## idem with parameters, pass vcov as a function argument #' coeftest(zz, vcov.=function(x) vcovSCC(x, type="HC1", maxlag=4)) #' ## joint restriction test #' waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovSCC) #' \dontrun{ #' ## test of hyp.: 2*log(pc)=log(emp) #' library(car) #' linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovSCC) #' } vcovSCC <- function(x, ...){ UseMethod("vcovSCC") } #' Newey and West (1987) Robust Covariance Matrix Estimator #' #' Nonparametric robust covariance matrix estimators *a la Newey #' and West* for panel models with serial correlation. #' #' `vcovNW` is a function for estimating a robust covariance matrix of #' parameters for a panel model according to the #' \insertCite{NEWE:WEST:87;textual}{plm} method. The function works #' as a restriction of the \insertCite{DRIS:KRAA:98;textual}{plm} covariance (see #' [vcovSCC()]) to no cross--sectional correlation. #' #' Weighting schemes specified by `type` are analogous to those in #' [sandwich::vcovHC()] in package \CRANpkg{sandwich} and are #' justified theoretically (although in the context of the standard #' linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and #' \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. #' #' The main use of `vcovNW` (and the other variance-covariance estimators #' provided in the package `vcovHC`, `vcovBK`, `vcovDC`, `vcovSCC`) is to pass #' it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or #' together with testing functions from the `lmtest` and `car` packages. All of #' these typically allow passing the `vcov` or `vcov.` parameter either as a #' matrix or as a function, e.g., for Wald--type testing: argument `vcov.` to #' `coeftest()`, argument `vcov` to `waldtest()` and other methods in the #' \CRANpkg{lmtest} package; and argument `vcov.` to #' `linearHypothesis()` in the \CRANpkg{car} package (see the #' examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. #' #' @aliases vcovNW #' @param x an object of class `"plm"` or `"pcce"` #' @param type the weighting scheme used, one of `"HC0"`, `"sss"`, #' `"HC1"`, `"HC2"`, `"HC3"`, `"HC4"`, see Details, #' @param maxlag either `NULL` or a positive integer specifying the #' maximum lag order before truncation #' @param wj weighting function to be applied to lagged terms, #' @param \dots further arguments #' @return An object of class `"matrix"` containing the estimate of #' the covariance matrix of coefficients. #' @export #' @author Giovanni Millo #' @seealso [sandwich::vcovHC()] from the \CRANpkg{sandwich} package #' for weighting schemes (`type` argument). #' @references #' #' \insertRef{CRIB:04}{plm} #' #' \insertRef{DRIS:KRAA:98}{plm} #' #' \insertRef{MACK:WHIT:85}{plm} #' #' \insertRef{NEWE:WEST:87}{plm} #' #' \insertRef{ZEIL:04}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package="plm") #' zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") #' ## as function input to plm's summary method (with and without additional arguments): #' summary(zz, vcov = vcovNW) #' summary(zz, vcov = function(x) vcovNW(x, method="arellano", type="HC1")) #' ## standard coefficient significance test #' library(lmtest) #' coeftest(zz) #' ## NW robust significance test, default #' coeftest(zz, vcov.=vcovNW) #' ## idem with parameters, pass vcov as a function argument #' coeftest(zz, vcov.=function(x) vcovNW(x, type="HC1", maxlag=4)) #' ## joint restriction test #' waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovNW) #' \dontrun{ #' ## test of hyp.: 2*log(pc)=log(emp) #' library(car) #' linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovNW) #' } vcovNW <- function(x, ...){ UseMethod("vcovNW") } #' Double-Clustering Robust Covariance Matrix Estimator #' #' High-level convenience wrapper for double-clustering robust #' covariance matrix estimators *a la* #' \insertCite{THOM:11;textual}{plm} and #' \insertCite{CAME:GELB:MILL:11;textual}{plm} for panel models. #' #' `vcovDC` is a function for estimating a robust covariance matrix of #' parameters for a panel model with errors clustering along both dimensions. #' The function is a convenience wrapper simply summing a group- and a #' time-clustered covariance matrix and subtracting a diagonal one *a la* #' White. #' #' Weighting schemes specified by `type` are analogous to those in #' [sandwich::vcovHC()] in package \CRANpkg{sandwich} and are #' justified theoretically (although in the context of the standard #' linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and #' \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. #' #' The main use of `vcovDC` (and the other variance-covariance estimators #' provided in the package `vcovHC`, `vcovBK`, `vcovNW`, `vcovSCC`) is to pass #' it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or #' together with testing functions from the `lmtest` and `car` packages. All of #' these typically allow passing the `vcov` or `vcov.` parameter either as a #' matrix or as a function, e.g., for Wald--type testing: argument `vcov.` to #' `coeftest()`, argument `vcov` to `waldtest()` and other methods in the #' \CRANpkg{lmtest} package; and argument `vcov.` to #' `linearHypothesis()` in the \CRANpkg{car} package (see the #' examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. #' #' @aliases vcovDC #' @param x an object of class `"plm"` or `"pcce"` #' @param type the weighting scheme used, one of `"HC0"`, `"sss"`, #' `"HC1"`, `"HC2"`, `"HC3"`, `"HC4"`, see Details, #' @param \dots further arguments #' @return An object of class `"matrix"` containing the estimate of #' the covariance matrix of coefficients. #' @export #' @author Giovanni Millo #' @seealso [sandwich::vcovHC()] from the \CRANpkg{sandwich} #' package for weighting schemes (`type` argument). #' @references #' #' \insertRef{CAME:GELB:MILL:11}{plm} #' #' \insertRef{CRIB:04}{plm} #' #' \insertRef{MACK:WHIT:85}{plm} #' #' \insertRef{THOM:11}{plm} #' #' \insertRef{ZEIL:04}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package="plm") #' zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="pooling") #' ## as function input to plm's summary method (with and without additional arguments): #' summary(zz, vcov = vcovDC) #' summary(zz, vcov = function(x) vcovDC(x, type="HC1", maxlag=4)) #' ## standard coefficient significance test #' library(lmtest) #' coeftest(zz) #' ## DC robust significance test, default #' coeftest(zz, vcov.=vcovDC) #' ## idem with parameters, pass vcov as a function argument #' coeftest(zz, vcov.=function(x) vcovDC(x, type="HC1", maxlag=4)) #' ## joint restriction test #' waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovDC) #' \dontrun{ #' ## test of hyp.: 2*log(pc)=log(emp) #' library(car) #' linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovDC) #' } vcovDC <- function(x, ...){ UseMethod("vcovDC") } #' Generic Lego building block for Robust Covariance Matrix Estimators #' #' Generic Lego building block for robust covariance matrix estimators #' of the vcovXX kind for panel models. #' #' `vcovG` is the generic building block for use by higher--level #' wrappers [vcovHC()], [vcovSCC()], [vcovDC()], and [vcovNW()]. The #' main use of `vcovG` is to be used internally by the former, but it #' is made available in the user space for use in non--standard #' combinations. For more documentation, see see wrapper functions #' mentioned. #' #' @aliases vcovG #' @param x an object of class `"plm"` or `"pcce"` #' @param type the weighting scheme used, one of `"HC0"`, #' `"sss"`, `"HC1"`, `"HC2"`, `"HC3"`, #' `"HC4"`, #' @param cluster one of `"group"`, `"time"`, #' @param l lagging order, defaulting to zero #' @param inner the function to be applied to the residuals inside the #' sandwich: one of `"cluster"` or `"white"` or #' `"diagavg"`, #' @param \dots further arguments #' @return An object of class `"matrix"` containing the estimate #' of the covariance matrix of coefficients. #' @export #' @author Giovanni Millo #' @seealso [vcovHC()], [vcovSCC()], #' [vcovDC()], [vcovNW()], and #' [vcovBK()] albeit the latter does not make use of #' vcovG. #' @references #' #' \insertRef{mil17b}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package="plm") #' zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, #' model="pooling") #' ## reproduce Arellano's covariance matrix #' vcovG(zz, cluster="group", inner="cluster", l=0) #' ## define custom covariance function #' ## (in this example, same as vcovHC) #' myvcov <- function(x) vcovG(x, cluster="group", inner="cluster", l=0) #' summary(zz, vcov = myvcov) #' ## use in coefficient significance test #' library(lmtest) #' ## robust significance test #' coeftest(zz, vcov. = myvcov) #' vcovG <- function(x, ...) { UseMethod("vcovG") } #' @rdname vcovG #' @export vcovG.plm <- function(x, type = c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), l = 0, inner = c("cluster", "white", "diagavg"), ...) { ## general building block for vcov ## for panel models (pooling, random, within or fd type plm obj.) ## ## * (7/11/2016): compliant with IV models # stopping control for weighted regressions if (!is.null(x$weights)) stop("vcovXX functions not implemented for weighted panel regressions") type <- match.arg(type) model <- describe(x, "model") if (!model %in% c("random", "within", "pooling", "fd")) { stop("Model has to be either \"random\", \"within\", \"pooling\", or \"fd\" model") } ## extract demeaned data demy <- pmodel.response(x, model = model) demX <- model.matrix(x, model = model, rhs = 1, cstcovar.rm = "all") ## drop any linear dependent columns (corresponding to aliased coefficients) ## from model matrix X ## na.rm = TRUE because currently, RE tw unbalanced models set aliased simply to NA if (!is.null(x$aliased) && any(x$aliased, na.rm = TRUE)) demX <- demX[ , !x$aliased, drop = FALSE] ## control: IV or not (two- or one-part formula) if(length(formula(x))[2L] > 1L) { demZ <- model.matrix(x, model = model, rhs = 2, cstcovar.rm = "all") ## substitute (transformed) X with projection of X on Z ## any linear dependence in Z (demZ) is appropriately taken care of by lm.fit() nms <- colnames(demX) demX <- lm.fit(demZ, demX)$fitted.values # catches case with only one regressor -> need to convert numeric # returned from lm.fit()$fitted.values to matrix: if(!is.matrix(demX)) demX <- matrix(demX, dimnames = list(NULL, nms[1L])) } pdim <- pdim(x) nT <- pdim$nT$N Ti <- pdim$Tint$Ti k <- dim(demX)[[2L]] n0 <- pdim$nT$n t0 <- pdim$nT$T ## extract residuals uhat <- x$residuals ## define residuals weighting function omega(res) ## (code taken from meatHC and modified) ## (the weighting is defined "in sqrt" relative to the literature) ## ## (see the theoretical comments in pvcovHC) ## this is computationally heavy, do only if needed switch(match.arg(type), "HC0" = {diaghat <- NULL}, "sss" = {diaghat <- NULL}, "HC1" = {diaghat <- NULL}, "HC2" = {diaghat <- try(dhat(demX), silent = TRUE)}, "HC3" = {diaghat <- try(dhat(demX), silent = TRUE)}, "HC4" = {diaghat <- try(dhat(demX), silent = TRUE)}) df <- nT - k switch(match.arg(type), "HC0" = { omega <- function(residuals, diaghat, df, g) residuals }, "sss" = { omega <- function(residuals, diaghat, df, g) residuals * sqrt(g/(g-1)*((nT-1)/(nT-k))) }, "HC1" = { omega <- function(residuals, diaghat, df, g) residuals * sqrt(length(residuals)/df) }, "HC2" = { omega <- function(residuals, diaghat, df, g) residuals / sqrt(1 - diaghat) }, "HC3" = { omega <- function(residuals, diaghat, df, g) residuals / (1 - diaghat) }, "HC4" = { omega <- function(residuals, diaghat, df, g) { residuals/sqrt(1 - diaghat)^ pmin(4, length(residuals) * diaghat/as.integer(round(sum(diaghat), digits = 0))) } }) ## Definition module for E(u,v) if(is.function(inner)) { E <- inner } else { ## outer for clustering/arellano, diag(diag(inner)) for white switch(match.arg(inner), "cluster" = { E <- function(u, v) outer(u, v) }, "white" = { E <- function(u, v) { # was simply: diag(diag(outer(u,v))) # but unfortunately we have to manage unbalanced panels # in the case l!=0 (the residual vectors are different) # by producing a "pseudo-diagonal" with all those obs. # common to both vectors if(isTRUE(all.equal(names(u), names(v)))) { ## ..then keep it simple! (halves time on EmplUK ex.) n <- length(u) euv <- diag(u*v, n) } else { ## calculate outer product efull <- outer(u, v) ## make matrix of zeros with same dims and names eres <- array(0, dim = dim(efull)) dimnames(eres) <- dimnames(efull) ## populate "pseudo-diagonal" with values from efull for(i in 1:length(names(u))) { for(j in 1:length(names(v))) { if(names(u)[i] == names(v)[j]) { eres[i, j] <- efull[i, j] } } } euv <- eres } return(euv) } }, "diagavg" = { E <- function(u,v) { ## this is the averaged version for 'white2' if(isTRUE(all.equal(names(u), names(v)))) { ## ..then keep it simple n <- length(u) euv <- diag(x = sum(u*v)/n, n) } else { ## do just as for 'white' and then average nonzeros: ## calculate outer product efull <- outer(u,v) ## make matrix of zeros with same dims and names eres <- array(0, dim = dim(efull)) dimnames(eres) <- dimnames(efull) ## populate "pseudo-diagonal" with values from efull for(i in 1:length(names(u))) { for(j in 1:length(names(v))) { if(names(u)[i] == names(v)[j]) { eres[i, j] <- efull[i, j] } } } euv <- eres ## substitute nonzeros with average thereof euv[euv != 0] <- mean(euv[euv != 0]) } return(euv) } }) } ## END: Definition module for E(u,v) ## try passing: function (a or b) or matrix (unconditional) to vcovG ## robustifying against either serial or xs intragroup dependence: ## if 'group' then keep current indexing, if 'time' then swap i<->t ## so that residuals get 'clustered' by time period instead of by ## group (i.e., the vcov estimator is robust vs. xsectional dependence) ## extract indices xindex <- unclass(attr(x$model, "index")) # unclass for speed groupind <- as.numeric(xindex[[1L]]) timeind <- as.numeric(xindex[[2L]]) ## adjust for 'fd' model (losing first time period) if(model == "fd") { groupi <- as.numeric(groupind) ## make vector =1 on first obs in each group, 0 elsewhere selector <- groupi - c(0, groupi[-length(groupi)]) selector[1L] <- 1 # the first must always be 1 ## eliminate first obs in time for each group groupind <- groupind[!selector] timeind <- timeind[!selector] nT <- nT - n0 Ti <- Ti - 1 t0 <- t0 - 1 } ## set grouping indexes switch(match.arg(cluster), "group" = { n <- n0 t <- t0 relevant.ind <- groupind lab <- timeind}, "time" = { n <- t0 t <- n0 relevant.ind <- timeind lab <- groupind}) tind <- vector("list", n) tlab <- vector("list", n) for (i in 1:length(unique(relevant.ind))) { tind[[i]] <- which(relevant.ind == i) tlab[[i]] <- lab[which(relevant.ind == i)] } ## lab were the 'labels' (a numeric, actually) for the relevant index; ## in use again from the need to make pseudo-diagonals for ## calc. the lagged White terms on unbalanced panels ## transform residuals by weights (here because type='sss' needs to ## know who the grouping index 'g' is ## set number of clusters for Stata-like small sample correction ## (if clustering, i.e., inner="cluster", then G is the cardinality of ## the grouping index; if inner="white" it is simply the sample size) ## find some more elegant solution for this! ## (perhaps if white then sss -> HC1 but check...) G <- if(match.arg(inner) == "cluster") n else nT uhat <- omega(uhat, diaghat, df, G) ## compute basic block: X'_t u_t u'_(t-l) X_(t-l) foreach t, ## then calculate Sl_t and sum over t (here i in place of t) ## here the benchmark case is time-clustering, but beware ## that group-clustering is the default ## preallocate k x k x (T-l) array for 'pile' of kxk matrices ## holding the X' E(u,ul) X elements Sl <- array(dim = c(k, k, n-l)) ## (l=0 gives the special contemporaneous case where Xi=Xil, ui=uil ## for computing W, CX, CT) for(i in (1+l):n) { X <- demX[tind[[i]], , drop = FALSE] Xl <- demX[tind[[i-l]], , drop = FALSE] u <- uhat[tind[[i]]] ul <- uhat[tind[[(i-l)]]] names(u) <- tlab[[i]] names(ul) <- tlab[[(i-l)]] ## calculate V_yy Sl[ , , i-l] <- crossprod(X, E(u, ul)) %*% Xl } ## in order to sum on available observations two things can be done: ## a) apply sum(..., na.rm=TRUE) over the third dim ## b) apply mean(..., na.rm=TRUE) idem and multiply by n-l ## In case a) averaging is then done dividing each covariance point ## by (n-l), regardless of whether there are NAs in the "vertical" ## vector Sl[p,q, ] ## In case b) each mean is calculated correctly on the right number ## of observations, excluding missing data. 'salame' has to be ## multiplied by (n-l) ## But notice, here there should be none left! Each Sl_i is k x k. ## Hence use sum(). ## meat ## salame <- apply(Sl, 1:2, mean, na.rm=TRUE) * (n-l) salame <- rowSums(Sl, dims = 2L) # == apply(Sl, 1:2, sum) but faster ## bread by standard method pane <- solve(crossprod(demX)) ## sandwich mycov <- tcrossprod(crossprod(t(pane), salame), t(pane)) # == pane %*% salame %*% pane # save information about cluster variable in matrix (needed for e.g., # robust F test) attr(mycov, which = "cluster") <- match.arg(cluster) return(mycov) } #' Robust Covariance Matrix Estimators #' #' Robust covariance matrix estimators *a la White* for panel #' models. #' #' `vcovHC` is a function for estimating a robust covariance matrix of #' parameters for a fixed effects or random effects panel model #' according to the White method #' \insertCite{WHIT:80,WHIT:84b,AREL:87}{plm}. Observations may be #' clustered by `"group"` (`"time"`) to account for serial #' (cross-sectional) correlation. #' #' All types assume no intragroup (serial) correlation between errors #' and allow for heteroskedasticity across groups (time periods). As #' for the error covariance matrix of every single group of #' observations, `"white1"` allows for general heteroskedasticity but #' no serial (cross--sectional) correlation; `"white2"` is `"white1"` #' restricted to a common variance inside every group (time period) #' \insertCite{@see @GREE:03, Sec. 13.7.1-2, @GREE:12, Sec. 11.6.1-2 #' and @WOOL:02, Sec. 10.7.2}{plm}; `"arellano"` \insertCite{@see #' ibid. and the original ref. @AREL:87}{plm} allows a fully general #' structure w.r.t. heteroskedasticity and serial (cross--sectional) #' correlation. #' #' Weighting schemes specified by `type` are analogous to those in #' [sandwich::vcovHC()] in package \CRANpkg{sandwich} and are #' justified theoretically (although in the context of the standard #' linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and #' \insertCite{CRIB:04;textual}{plm} #' \insertCite{ZEIL:04}{plm}. `type = "sss"` employs the small sample #' correction as used by Stata. #' # % TODO: give formula for "sss"; # elaborate why different result for FE models (intercept) #' #' The main use of `vcovHC` (and the other variance-covariance estimators #' provided in the package `vcovBK`, `vcovNW`, `vcovDC`, `vcovSCC`) is to pass #' it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or #' together with testing functions from the `lmtest` and `car` packages. All of #' these typically allow passing the `vcov` or `vcov.` parameter either as a #' matrix or as a function, e.g., for Wald--type testing: argument `vcov.` to #' `coeftest()`, argument `vcov` to `waldtest()` and other methods in the #' \CRANpkg{lmtest} package; and argument `vcov.` to #' `linearHypothesis()` in the \CRANpkg{car} package (see the #' examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. #' #' A special procedure for `pgmm` objects, proposed by #' \insertCite{WIND:05;textual}{plm}, is also provided. #' #' @name vcovHC.plm #' @aliases vcovHC #' @importFrom sandwich vcovHC #' @export vcovHC #' @param x an object of class `"plm"` which should be the result of a #' random effects or a within model or a model of class `"pgmm"` #' or an object of class `"pcce"`, #' @param method one of `"arellano"`, `"white1"`, `"white2"`, #' @param type the weighting scheme used, one of `"HC0"`, `"sss"`, #' `"HC1"`, `"HC2"`, `"HC3"`, `"HC4"`, see Details, #' @param cluster one of `"group"`, `"time"`, #' @param \dots further arguments. #' @return An object of class `"matrix"` containing the estimate of #' the asymptotic covariance matrix of coefficients. #' @note The function `pvcovHC` is deprecated. Use `vcovHC` for the #' same functionality. #' @author Giovanni Millo & Yves Croissant #' @seealso [sandwich::vcovHC()] from the \CRANpkg{sandwich} #' package for weighting schemes (`type` argument). #' @references #' #' \insertRef{AREL:87}{plm} #' #' \insertRef{CRIB:04}{plm} #' #' \insertRef{GREE:03}{plm} #' #' \insertRef{GREE:12}{plm} #' #' \insertRef{MACK:WHIT:85}{plm} #' #' \insertRef{WIND:05}{plm} #' #' \insertRef{WHIT:84b}{plm} #' chap. 6 #' #' \insertRef{WHIT:80}{plm} #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{ZEIL:04}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "random") #' ## as function input to plm's summary method (with and without additional arguments): #' summary(zz, vcov = vcovHC) #' summary(zz, vcov = function(x) vcovHC(x, method="arellano", type="HC1")) #' #' ## standard coefficient significance test #' library(lmtest) #' coeftest(zz) #' ## robust significance test, cluster by group #' ## (robust vs. serial correlation) #' coeftest(zz, vcov.=vcovHC) #' ## idem with parameters, pass vcov as a function argument #' coeftest(zz, vcov.=function(x) vcovHC(x, method="arellano", type="HC1")) #' ## idem, cluster by time period #' ## (robust vs. cross-sectional correlation) #' coeftest(zz, vcov.=function(x) vcovHC(x, method="arellano", #' type="HC1", cluster="group")) #' ## idem with parameters, pass vcov as a matrix argument #' coeftest(zz, vcov.=vcovHC(zz, method="arellano", type="HC1")) #' ## joint restriction test #' waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovHC) #' \dontrun{ #' ## test of hyp.: 2*log(pc)=log(emp) #' library(car) #' linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovHC) #' } #' ## Robust inference for CCE models #' data("Produc", package = "plm") #' ccepmod <- pcce(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model="p") #' summary(ccepmod, vcov = vcovHC) #' #' ## Robust inference for GMM models #' data("EmplUK", package="plm") #' ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) #' + log(capital) + lag(log(capital), 2) + log(output) #' + lag(log(output),2) | lag(log(emp), 2:99), #' data = EmplUK, effect = "twoways", model = "twosteps") #' rv <- vcovHC(ar) #' mtest(ar, order = 2, vcov = rv) NULL #' @rdname vcovHC.plm #' @export vcovHC.plm <- function(x, method=c("arellano", "white1", "white2"), type=c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster=c("group", "time"), ...) { ## user-level wrapper for White-Arellano covariances ## translate arguments inner <- switch(match.arg(method), "arellano" = "cluster", "white1" = "white", "white2" = "diagavg") return(vcovG(x, type=type, cluster=cluster, l=0, inner=inner, ...)) } #' @rdname vcovNW #' @export vcovNW.plm <- function(x, type=c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), maxlag=NULL, wj=function(j, maxlag) 1-j/(maxlag+1), ...) { ## user-level wrapper for panel Newey-West estimator ## set default lag order if(is.null(maxlag)) maxlag <- floor((max(pdim(x)$Tint$Ti))^(1/4)) return(vcovSCC(x, type=type, maxlag=maxlag, inner="white", wj=wj, ...)) } #' @rdname vcovDC #' @export vcovDC.plm <- function(x, type=c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), ...) { ## user-level wrapper for double-clustering (no persistence) Vcx <- vcovG(x, type=type, cluster="group", l=0, inner="cluster", ...) Vct <- vcovG(x, type=type, cluster="time", l=0, inner="cluster", ...) Vw <- vcovG(x, type=type, l=0, inner="white", ...) res <- Vcx + Vct - Vw # save information about cluster variable in matrix (needed for e.g., # robust F test) attr(res, which = "cluster") <- "group-time" return(res) } #' @rdname vcovSCC #' @export vcovSCC.plm <- function(x, type=c("HC0", "sss", "HC1", "HC2", "HC3", "HC4"), cluster="time", maxlag=NULL, inner=c("cluster", "white", "diagavg"), wj=function(j, maxlag) 1-j/(maxlag+1), ...) { ## replicates vcovSCC ## set default lag order if(is.null(maxlag)) maxlag <- floor((max(pdim(x)$Tint$Ti))^(1/4)) ## def. Bartlett kernel ## wj <- function(j, maxlag) 1-j/(maxlag+1) ## has been passed as argument S0 <- vcovG(x, type=type, cluster=cluster, l=0, inner=inner) if(maxlag > 0) { for(i in 1:maxlag) { Vctl <- vcovG(x, type=type, cluster=cluster, l=i, inner=inner) S0 <- S0 + wj(i, maxlag) * (Vctl + t(Vctl)) } } return(S0) } ############################################################## ## separate function for BK (PCSE) covariance #' Beck and Katz Robust Covariance Matrix Estimators #' #' Unconditional Robust covariance matrix estimators *a la Beck #' and Katz* for panel models (a.k.a. Panel Corrected Standard Errors #' (PCSE)). #' #' `vcovBK` is a function for estimating a robust covariance matrix of #' parameters for a panel model according to the #' \insertCite{BECK:KATZ:95;textual}{plm} method, a.k.a. Panel #' Corrected Standard Errors (PCSE), which uses an unconditional #' estimate of the error covariance across time periods (groups) #' inside the standard formula for coefficient #' covariance. Observations may be clustered either by `"group"` to #' account for timewise heteroskedasticity and serial correlation or #' by `"time"` to account for cross-sectional heteroskedasticity and #' correlation. It must be borne in mind that the Beck and Katz #' formula is based on N- (T-) asymptotics and will not be appropriate #' elsewhere. #' #' The `diagonal` logical argument can be used, if set to #' `TRUE`, to force to zero all nondiagonal elements in the #' estimated error covariances; this is appropriate if both serial and #' cross--sectional correlation are assumed out, and yields a #' timewise- (groupwise-) heteroskedasticity--consistent estimator. #' #' Weighting schemes specified by `type` are analogous to those in #' [sandwich::vcovHC()] in package \CRANpkg{sandwich} and are #' justified theoretically (although in the context of the standard #' linear model) by \insertCite{MACK:WHIT:85;textual}{plm} and #' \insertCite{CRIB:04;textual}{plm} \insertCite{@see @ZEIL:04}{plm}. #' # % TODO: once "sss" has been added: `type = "sss"` employs the small # % sample correction as used by Stata. give formula for "sss"; # % elaborate why different result for FE models (intercept) #' #' The main use of `vcovBK` (and the other variance-covariance estimators #' provided in the package `vcovHC`, `vcovNW`, `vcovDC`, `vcovSCC`) is to pass #' it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or #' together with testing functions from the `lmtest` and `car` packages. All of #' these typically allow passing the `vcov` or `vcov.` parameter either as a #' matrix or as a function, e.g., for Wald--type testing: argument `vcov.` to #' `coeftest()`, argument `vcov` to `waldtest()` and other methods in the #' \CRANpkg{lmtest} package; and argument `vcov.` to #' `linearHypothesis()` in the \CRANpkg{car} package (see the #' examples), see \insertCite{@ZEIL:04, 4.1-2 and examples below}{plm}. #' #' @param x an object of class `"plm"`, #' @param type the weighting scheme used, one of `"HC0"`, `"HC1"`, #' `"HC2"`, `"HC3"`, `"HC4"`, see Details, #' @param cluster one of `"group"`, `"time"`, #' @param diagonal a logical value specifying whether to force #' nondiagonal elements to zero, #' @param \dots further arguments. #' @export #' @return An object of class `"matrix"` containing the estimate of #' the covariance matrix of coefficients. #' @author Giovanni Millo #' @seealso [sandwich::vcovHC()] from the \CRANpkg{sandwich} #' package for weighting schemes (`type` argument). #' @references #' #' #' \insertRef{BECK:KATZ:95}{plm} #' #' \insertRef{CRIB:04}{plm} #' #' \insertRef{GREE:03}{plm} #' #' \insertRef{MACK:WHIT:85}{plm} #' #' \insertRef{ZEIL:04}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package="plm") #' zz <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, model="random") #' summary(zz, vcov = vcovBK) #' summary(zz, vcov = function(x) vcovBK(x, type="HC1")) #' #' ## standard coefficient significance test #' library(lmtest) #' coeftest(zz) #' ## robust significance test, cluster by group #' ## (robust vs. serial correlation), default arguments #' coeftest(zz, vcov.=vcovBK) #' ## idem with parameters, pass vcov as a function argument #' coeftest(zz, vcov.=function(x) vcovBK(x, type="HC1")) #' ## idem, cluster by time period #' ## (robust vs. cross-sectional correlation) #' coeftest(zz, vcov.=function(x) vcovBK(x, type="HC1", cluster="time")) #' ## idem with parameters, pass vcov as a matrix argument #' coeftest(zz, vcov.=vcovBK(zz, type="HC1")) #' ## joint restriction test #' waldtest(zz, update(zz, .~.-log(emp)-unemp), vcov=vcovBK) #' \dontrun{ #' ## test of hyp.: 2*log(pc)=log(emp) #' library(car) #' linearHypothesis(zz, "2*log(pc)=log(emp)", vcov.=vcovBK) #' } vcovBK <- function(x, ...) { UseMethod("vcovBK") } # TODO: add type "sss" for vcovBK #' @rdname vcovBK #' @export vcovBK.plm <- function(x, type = c("HC0", "HC1", "HC2", "HC3", "HC4"), cluster = c("group", "time"), diagonal = FALSE, ...) { ## Robust vcov a la Beck and Katz (1995; AKA 'pcse') ## for panel models (pooling, random, within or fd type plm obj.) ## ## This version: October 20th, 2009; allows choosing the clustering dimension ## so as to have serial- or x-sectional-correlation robustness; ## ## This function takes the demeaned data from the ## plm object, then estimates an *unconditional* error covariance by ## averaging the empirical covariance blocks by group (time period); ## this average block (say, OmegaM in EViews notation) is then put into ## White's formula instead of each Omega_i. ## ## The clustering defaults to "group" for consistency with pvcovHC; ## nevertheless the most likely usage is cluster="time" for robustness vs. ## cross-sectional dependence, as in the original Beck and Katz paper (where ## it is applied to "pooling" models). ## ## This version: compliant with plm 1.2-0; lmtest. ## Code is identical to pvcovHC until mark. ## ## Usage: ## myplm <- plm(,, ...) ## # default (cluster by group = robust vs. serial correlation): ## coeftest(myplm, vcov=vcovBK) ## # cluster by time period (robust vs. XS correlation): ## coeftest(myplm, vcov=function(x) vcovBK(x, cluster="time")) ## # idem, HC3 weighting: ## coeftest(myplm, vcov=function(x) vcovBK(x,cluster="time",type="HC3")) ## waldtest(myplm,update(myplm,),vcov=vcovBK) ## ## This weighted version implements a system of weights as ## in vcovHC/meatHC. Sure this makes sense for white1, but it ## is open to question for white2 and arellano. We'll see. ## ## Results OK vs. EViews, vcov=PCSE. Unbal. case not exactly the ## same (but then, who knows what EViews does!) # stopping control for weighted regressions if (!is.null(x$weights)) stop("vcovXX functions not implemented for weighted panel regressions") type <- match.arg(type) model <- describe(x, "model") if (!model %in% c("random", "within", "pooling", "fd")) { stop("Model has to be either \"random\", \"within\", \"pooling\", or \"fd\" model") } ## extract demeaned data demy <- pmodel.response(x, model = model) demX <- model.matrix(x, model = model, rhs = 1, cstcovar.rm = "all") ## drop any linear dependent columns (corresponding to aliased coefficients) ## from model matrix X ## na.rm = TRUE because currently, RE tw unbalanced models set aliased simply to NA if (!is.null(x$aliased) && any(x$aliased, na.rm = TRUE)) demX <- demX[ , !x$aliased, drop = FALSE] ## control: IV or not (two- or one-part formula) if(length(formula(x))[2L] > 1L) { demZ <- model.matrix(x, model = model, rhs = 2, cstcovar.rm = "all") ## substitute (transformed) X with projection of X on Z ## any linear dependence in Z (demZ) is appropriately taken care of by lm.fit() nms <- colnames(demX) demX <- lm.fit(demZ, demX)$fitted.values # catches case with only one regressor -> need to convert numeric # returned from lm.fit()fitted.values to matrix: if(!is.matrix(demX)) demX <- matrix(demX, dimnames = list(NULL, nms[1L])) } pdim <- pdim(x) nT <- pdim$nT$N Ti <- pdim$Tint$Ti k <- dim(demX)[[2L]] n0 <- pdim$nT$n t0 <- pdim$nT$T ## extract residuals uhat <- x$residuals ## robustifying against either serial or xs intragroup dependence: ## if 'group' then keep current indexing, if 'time' then swap i<->t ## so that residuals get 'clustered' by time period instead of by ## group (i.e., the vcov estimator is robust vs. xsectional dependence) ## extract indices xindex <- unclass(attr(x$model, "index")) # unclass for speed groupind <- as.numeric(xindex[[1L]]) timeind <- as.numeric(xindex[[2L]]) ## Achim's fix for 'fd' model (losing first time period) if(model == "fd") { groupind <- groupind[timeind > 1] timeind <- timeind[timeind > 1] nT <- nT - n0 Ti <- Ti - 1 t0 <- t0 - 1 } ## set grouping indexes switch(match.arg(cluster), "group" = { n <- n0 # this is needed only for 'pcse' t <- t0 # this is needed only for 'pcse' relevant.ind <- groupind lab <- timeind }, "time" = { n <- t0 # this is needed only for 'pcse' t <- n0 # this is needed only for 'pcse' relevant.ind <- timeind lab <- groupind }) tind <- vector("list", n) tlab <- vector("list", n) for (i in 1:length(unique(relevant.ind))) { tind[[i]] <- which(relevant.ind == i) tlab[[i]] <- lab[which(relevant.ind == i)] } ## define residuals weighting function omega(res) ## (code taken from meatHC and modified) ## (the weighting is defined "in sqrt" relative to the literature) ## ## (see the theoretical comments in pvcovHC) ## this is computationally heavy, do only if needed switch(match.arg(type), "HC0" = {diaghat <- NULL}, "HC1" = {diaghat <- NULL}, "HC2" = {diaghat <- try(dhat(demX), silent = TRUE)}, "HC3" = {diaghat <- try(dhat(demX), silent = TRUE)}, "HC4" = {diaghat <- try(dhat(demX), silent = TRUE)}) df <- nT - k switch(match.arg(type), "HC0" = { omega <- function(residuals, diaghat, df) residuals }, "HC1" = { omega <- function(residuals, diaghat, df) residuals * sqrt(length(residuals)/df) }, "HC2" = { omega <- function(residuals, diaghat, df) residuals / sqrt(1 - diaghat) }, "HC3" = { omega <- function(residuals, diaghat, df) residuals / (1 - diaghat) }, "HC4" = { omega <- function(residuals, diaghat, df) residuals/sqrt(1 - diaghat)^pmin(4, length(residuals) * diaghat/as.integer(round(sum(diaghat), digits = 0))) }) ## transform residuals by weights uhat <- omega(uhat, diaghat, df) ## CODE TAKEN FROM pvcovHC() UNTIL HERE except for ind/time labeling ## ## the PCSE covariance estimator is based on the unconditional estimate ## of the intragroup (intraperiod) covariance of errors, OmegaT or OmegaM ## in the EViews help. ## we calculate this based on code from pggls(). ## the Omegai function is then: ## - constant if the panel is balanced ## - depending only on the intragroup (intraperiod) position index ## if the panel is unbalanced. ## (code for estimating OmegaM/OmegaT partly taken from pggls) ## est. omega submatrix ## "pre-allocate" an empty array tres <- array(dim = c(t, t, n)) ## array of n "empirical omega-blocks" ## with outer product of t(i) residuals ## for each group 1..n ## (use subscripting from condition 'label in labels' set', ## the rest stays NA if any) for(i in 1:n) { ut <- uhat[tind[[i]]] tpos <- (1:t)[unique(lab) %in% tlab[[i]]] ## put nondiag elements to 0 if diagonal=TRUE tres[tpos, tpos, i] <- if(diagonal) diag(diag(ut %o% ut)) else ut %o% ut } ## average over all omega blocks, removing NAs (apply preserving ## *two* dimensions, i.e., over the third) to get the unconditional ## covariance matrix of errors for a group (viz. time period): OmegaT <- rowMeans(tres, dims = 2L, na.rm = TRUE) # == apply(tres, 1:2, mean, na.rm = TRUE) but faster ## end of PCSE covariance calculation. ## fetch (all, unique) values of the relevant labels unlabs <- unique(lab) salame <- array(dim = c(k, k, n)) for(i in 1:n) { groupinds <- tind[[i]] grouplabs <- tlab[[i]] xi <- demX[groupinds, , drop = FALSE] ## for every group, take relevant positions tpos <- unlabs %in% grouplabs OmegaTi <- OmegaT[tpos, tpos, drop = FALSE] salame[ , , i] <- crossprod(xi, OmegaTi) %*% xi } ## meat salame <- rowSums(salame, dims = 2L) # == apply(salame, 1:2, sum) but faster ## bread pane <- solve(crossprod(demX)) ## sandwich mycov <- tcrossprod(crossprod(t(pane), salame), t(pane)) # == pane %*% salame %*% pane # save information about cluster variable in matrix (needed for e.g., # robust F test) attr(mycov, which = "cluster") <- match.arg(cluster) return(mycov) } ####################################################### ##################################### ## vcovXX methods for pcce objects ## ##################################### ## pcce is compliant with plm so vcovXX.pcce <- vcovXX.plm ## for any vcov that makes sense computed on the transformed ## data from model.matrix.pcce and pmodel.response.pcce ## TODO: vcovBK.pcce missing? Or not valid? #' @rdname vcovG #' @export vcovG.pcce <- vcovG.plm #' @rdname vcovHC.plm #' @export vcovHC.pcce <- vcovHC.plm #' @rdname vcovNW #' @export vcovNW.pcce <- vcovNW.plm #' @rdname vcovSCC #' @export vcovSCC.pcce <- vcovSCC.plm #################################### ## vcovHC method for pgmm objects ## #################################### #' @rdname vcovHC.plm #' @importFrom MASS ginv #' @export vcovHC.pgmm <- function(x, ...) { model <- describe(x, "model") transformation <- describe(x, "transformation") A1 <- x$A1 A2 <- x$A2 if(transformation == "ld") { ## yX <- lapply(x$model,function(x) rbind(diff(x),x)) ## residuals <-lapply(x$residuals,function(x) c(diff(x),x)) yX <- x$model residuals <- x$residuals } else { yX <- x$model residuals <- x$residuals } minevA2 <- min(abs(Re(eigen(A2)$values))) eps <- 1E-9 SA2 <- if(minevA2 < eps){ warning("a general inverse is used") ginv(A2) } else solve(A2) if(model == "twosteps") { coef1s <- x$coefficients[[1L]] res1s <- lapply(yX, function(x) x[ , 1L] - crossprod(t(x[ , -1L, drop = FALSE]), coef1s)) K <- ncol(yX[[1L]]) D <- c() WX <- Reduce("+", mapply(function(x, y) crossprod(x, y[ , -1L, drop = FALSE]), x$W, yX, SIMPLIFY = FALSE)) We <- Reduce("+", mapply(function(x, y) crossprod(x, y), x$W, residuals, SIMPLIFY = FALSE)) B1 <- solve(t(WX) %*% A1 %*% WX) B2 <- vcov(x) vcov1s <- B1 %*% (t(WX) %*% A1 %*% SA2 %*% A1 %*% WX) %*% B1 for (k in 2:K) { exk <- mapply( function(x, y){ z <- crossprod(t(x[ , k, drop = FALSE]), t(y)) - z - t(z) }, yX, res1s, SIMPLIFY = FALSE) wexkw <- Reduce("+", mapply( function(x, y) crossprod(x, crossprod(y, x)), x$W, exk, SIMPLIFY = FALSE)) Dk <- -B2 %*% t(WX) %*% A2 %*% wexkw %*% A2 %*% We D <- cbind(D, Dk) } vcovr <- B2 + crossprod(t(D), B2) + t(crossprod(t(D), B2)) + D %*% vcov1s %*% t(D) } else { # model = "onestep" res1s <- lapply(yX, function(z) z[ , 1L] - crossprod(t(z[ , -1L, drop = FALSE]), x$coefficients)) K <- ncol(yX[[1L]]) WX <- Reduce("+", mapply(function(z, y) crossprod(z[ , -1L, drop = FALSE], y), yX, x$W, SIMPLIFY = FALSE)) B1 <- vcov(x) vcovr <- B1 %*% (WX %*% A1 %*% SA2 %*% A1 %*% t(WX)) %*% B1 } vcovr } ## dhat: diaghat function for matrices # old: dhat <- function(x) {tx <- t(x); diag(crossprod(tx, solve(crossprod(x), tx)))} dhat <- function(x) { rowSums(crossprod(t(x), solve(crossprod(x))) * x) # == diag(crossprod(tx, solve(crossprod(x), tx))) }plm/R/tool_methods.R0000644000176200001440000005001114154734502014070 0ustar liggesusers# panelmodel and plm methods : ## panelmodel methods : # - terms # - vcov # - fitted # - residuals # - df.residual # - coef # - print # - update # - deviance # - nobs ## plm methods : # - summary # - print.summary # - predict # - formula # - plot # - residuals # - fitted #' @rdname plm #' @export terms.panelmodel <- function(x, ...){ terms(formula(x)) } #' @rdname plm #' @export vcov.panelmodel <- function(object, ...){ object$vcov } #' @rdname plm #' @export fitted.panelmodel <- function(object, ...){ object$fitted.values } #' @rdname plm #' @export residuals.panelmodel <- function(object, ...){ object$residuals } #' @rdname plm #' @export df.residual.panelmodel <- function(object, ...){ object$df.residual } #' @rdname plm #' @export coef.panelmodel <- function(object, ...){ object$coefficients } #' @rdname plm #' @export print.panelmodel <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ cat("\nModel Formula: ") print(formula(x)) cat("\nCoefficients:\n") print(coef(x), digits = digits) cat("\n") invisible(x) } #' Extract Total Number of Observations Used in Estimated Panelmodel #' #' This function extracts the total number of 'observations' from a #' fitted panel model. #' #' The number of observations is usually the length of the residuals #' vector. Thus, `nobs` gives the number of observations actually #' used by the estimation procedure. It is not necessarily the number #' of observations of the model frame (number of rows in the model #' frame), because sometimes the model frame is further reduced by the #' estimation procedure. This is, e.g., the case for first--difference #' models estimated by `plm(..., model = "fd")` where the model #' frame does not yet contain the differences (see also #' **Examples**). #' #' @name nobs.plm #' @aliases nobs #' @importFrom stats nobs #' @export nobs #' @param object a `panelmodel` object for which the number of #' total observations is to be extracted, #' @param \dots further arguments. #' @return A single number, normally an integer. #' @seealso [pdim()] #' @keywords attribute #' @examples #' #' # estimate a panelmodel #' data("Produc", package = "plm") #' z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, #' model="random", subset = gsp > 5000) #' #' nobs(z) # total observations used in estimation #' pdim(z)$nT$N # same information #' pdim(z) # more information about the dimensions (no. of individuals and time periods) #' #' # illustrate difference between nobs and pdim for first-difference model #' data("Grunfeld", package = "plm") #' fdmod <- plm(inv ~ value + capital, data = Grunfeld, model = "fd") #' nobs(fdmod) # 190 #' pdim(fdmod)$nT$N # 200 #' NULL # nobs() function to extract total number of observations used for estimating the panelmodel # like stats::nobs for lm objects # NB: here, use object$residuals rather than residuals(object) # [b/c the latter could do NA padding once NA padding works for plm objects. # NA padded residuals would yield wrong result for nobs!] #' @rdname nobs.plm #' @export nobs.panelmodel <- function(object, ...) { if (inherits(object, "plm") || inherits(object, "panelmodel")) return(length(object$residuals)) else stop("Input 'object' needs to be of class 'plm' or 'panelmodel'") } # No of obs calculated as in print.summary.pgmm [code copied from there] #' @rdname nobs.plm #' @export nobs.pgmm <- function(object, ...) { if (inherits(object, "pgmm")) return(sum(unlist(object$residuals, use.names = FALSE) != 0)) else stop("Input 'object' needs to be of class 'pgmm', i. e., a GMM estimation with panel data estimated by pgmm()") } # Almost the same as the default method except that update.formula is # replaced by update, so that the Formula method is used to update the # formula #' @rdname plm #' @export update.panelmodel <- function (object, formula., ..., evaluate = TRUE){ if (is.null(call <- object$call)) # was: getCall(object))) stop("need an object with call component") extras <- match.call(expand.dots = FALSE)$... # update.Formula fails if latter rhs are . ; simplify the formula # by removing the latter parts if (! missing(formula.)){ newform <- Formula(formula.) if (length(newform)[2L] == 2L && attr(newform, "rhs")[2L] == as.name(".")) newform <- formula(newform, rhs = 1) call$formula <- update(formula(object), newform) } if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call } #' @rdname plm #' @export deviance.panelmodel <- function(object, model = NULL, ...){ if (is.null(model)) as.numeric(crossprod(resid(object))) else as.numeric(crossprod(residuals(object, model = model))) } # summary.plm creates a specific summary.plm object that is derived # from the associated plm object #' Summary for plm objects #' #' The summary method for plm objects generates some more information about #' estimated plm models. #' #' The `summary` method for plm objects (`summary.plm`) creates an #' object of class `c("summary.plm", "plm", "panelmodel")` that #' extends the plm object it is run on with various information about #' the estimated model like (inferential) statistics, see #' **Value**. It has an associated print method #' (`print.summary.plm`). #' #' @aliases summary.plm #' @param object an object of class `"plm"`, #' @param x an object of class `"summary.plm"`, #' @param subset a character or numeric vector indicating a subset of #' the table of coefficients to be printed for #' `"print.summary.plm"`, #' @param vcov a variance--covariance matrix furnished by the user or #' a function to calculate one (see **Examples**), #' @param digits number of digits for printed output, #' @param width the maximum length of the lines in the printed output, #' @param eq the selected equation for list objects #' @param \dots further arguments. #' @return An object of class `c("summary.plm", "plm", #' "panelmodel")`. Some of its elements are carried over from the #' associated plm object and described there #' ([plm()]). The following elements are new or changed #' relative to the elements of a plm object: #' #' \item{fstatistic}{'htest' object: joint test of significance of #' coefficients (F or Chi-square test) (robust statistic in case of #' supplied argument `vcov`, see [pwaldtest()] for details),} #' #' \item{coefficients}{a matrix with the estimated coefficients, #' standard errors, t--values, and p--values, if argument `vcov` was #' set to non-`NULL` the standard errors (and t-- and p--values) in #' their respective robust variant,} #' #' \item{vcov}{the "regular" variance--covariance matrix of the coefficients (class "matrix"),} #' #' \item{rvcov}{only present if argument `vcov` was set to non-`NULL`: #' the furnished variance--covariance matrix of the coefficients #' (class "matrix"),} #' #' \item{r.squared}{a named numeric containing the R-squared ("rsq") #' and the adjusted R-squared ("adjrsq") of the model,} #' #' \item{df}{an integer vector with 3 components, (p, n-p, p*), where #' p is the number of estimated (non-aliased) coefficients of the #' model, n-p are the residual degrees of freedom (n being number of #' observations), and p* is the total number of coefficients #' (incl. any aliased ones).} #' #' @export #' @author Yves Croissant #' @seealso [plm()] for estimation of various models; [vcovHC()] for #' an example of a robust estimation of variance--covariance #' matrix; [r.squared()] for the function to calculate R-squared; #' [stats::print.power.htest()] for some information about class #' "htest"; [fixef()] to compute the fixed effects for "within" #' (=fixed effects) models and [within_intercept()] for an #' "overall intercept" for such models; [pwaldtest()] #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, index = c("state","year")) #' summary(zz) #' #' # summary with a furnished vcov, passed as matrix, as function, and #' # as function with additional argument #' data("Grunfeld", package = "plm") #' wi <- plm(inv ~ value + capital, #' data = Grunfeld, model="within", effect = "individual") #' summary(wi, vcov = vcovHC(wi)) #' summary(wi, vcov = vcovHC) #' summary(wi, vcov = function(x) vcovHC(x, method = "white2")) #' #' # extract F statistic #' wi_summary <- summary(wi) #' Fstat <- wi_summary[["fstatistic"]] #' #' # extract estimates and p-values #' est <- wi_summary[["coefficients"]][ , "Estimate"] #' pval <- wi_summary[["coefficients"]][ , "Pr(>|t|)"] #' #' # print summary only for coefficent "value" #' print(wi_summary, subset = "value") #' summary.plm <- function(object, vcov = NULL, ...){ vcov_arg <- vcov model <- describe(object, "model") effect <- describe(object, "effect") random.method <- describe(object, "random.method") # determine if intercept-only model (no other regressors) coef_wo_int <- object$coefficients[!(names(coef(object)) %in% "(Intercept)")] int.only <- !length(coef_wo_int) # as cor() is not defined for intercept-only models, use different approach # for R-squared ("rss" and "ess" are defined) object$r.squared <- if(!int.only) { c(rsq = r.squared(object), adjrsq = r.squared(object, dfcor = TRUE)) } else { c(rsq = r.squared(object, type = "rss"), adjrsq = r.squared(object, type = "rss", dfcor = TRUE)) } ## determine if standard normal and Chisq test or t distribution and F test to be used ## (normal/chisq for all random models, all IV models, and HT via plm(., model="ht")) use.norm.chisq <- if(model == "random" || length(formula(object))[2L] >= 2L || model == "ht") TRUE else FALSE # perform Wald test of joint sign. of regressors only if there are # other regressors besides the intercept if(!int.only) { object$fstatistic <- pwaldtest(object, test = if(use.norm.chisq) "Chisq" else "F", vcov = vcov_arg) } # construct the table of coefficients if (!is.null(vcov_arg)) { if (is.matrix(vcov_arg)) rvcov <- vcov_arg if (is.function(vcov_arg)) rvcov <- vcov_arg(object) std.err <- sqrt(diag(rvcov)) } else { std.err <- sqrt(diag(stats::vcov(object))) } b <- coefficients(object) z <- b / std.err p <- if(use.norm.chisq) { 2 * pnorm(abs(z), lower.tail = FALSE) } else { 2 * pt(abs(z), df = object$df.residual, lower.tail = FALSE) } # construct the object of class summary.plm object$coefficients <- cbind(b, std.err, z, p) colnames(object$coefficients) <- if(use.norm.chisq) { c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") } else { c("Estimate", "Std. Error", "t-value", "Pr(>|t|)") } ## add some info to summary.plm object # robust vcov (next to "normal" vcov) if (!is.null(vcov_arg)) { object$rvcov <- rvcov rvcov.name <- paste0(deparse(substitute(vcov))) attr(object$rvcov, which = "rvcov.name") <- rvcov.name } # mimics summary.lm's 'df' component # 1st entry: no. coefs (w/o aliased coefs); 2nd: residual df; 3rd no. coefs /w aliased coefs # NB: do not use length(object$coefficients) for 3rd entry! object$df <- c(length(b), object$df.residual, length(object$aliased)) class(object) <- c("summary.plm", "plm", "panelmodel") object } #' @rdname summary.plm #' @export print.summary.plm <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), subset = NULL, ...){ formula <- formula(x) has.instruments <- (length(formula)[2L] >= 2L) effect <- describe(x, "effect") model <- describe(x, "model") if (model != "pooling") { cat(paste(effect.plm.list[effect], " ", sep = "")) } cat(paste(model.plm.list[model], " Model", sep = "")) if (model == "random"){ ercomp <- describe(x, "random.method") cat(paste(" \n (", random.method.list[ercomp], "'s transformation)\n", sep = "")) } else{ cat("\n") } if (has.instruments){ cat("Instrumental variable estimation\n") if(model != "within") { # don't print transformation method for FE models as there is only one # such method for FE models but plenty for other model types ivar <- describe(x, "inst.method") cat(paste0(" (", inst.method.list[ivar], "'s transformation)\n")) } } if (!is.null(x$rvcov)) { cat("\nNote: Coefficient variance-covariance matrix supplied: ", attr(x$rvcov, which = "rvcov.name"), "\n", sep = "") } cat("\nCall:\n") print(x$call) cat("\n") pdim <- pdim(x) print(pdim) if (model %in% c("fd", "between")) { # print this extra info, b/c model.frames of FD and between models # have original (undifferenced/"un-between-ed") obs/rows of the data cat(paste0("Observations used in estimation: ", nobs(x), "\n"))} if (model == "random"){ cat("\nEffects:\n") print(x$ercomp) } cat("\nResiduals:\n") df <- x$df rdf <- df[2L] if (rdf > 5L) { save.digits <- unlist(options(digits = digits)) on.exit(options(digits = save.digits)) print(sumres(x)) } else if (rdf > 0L) print(residuals(x), digits = digits) if (rdf == 0L) { # estimation is a perfect fit cat("ALL", x$df[1L], "residuals are 0: no residual degrees of freedom!") cat("\n") } if (any(x$aliased, na.rm = TRUE)) { # na.rm = TRUE because currently, RE tw unbalanced models might have NAs? naliased <- sum(x$aliased, na.rm = TRUE) cat("\nCoefficients: (", naliased, " dropped because of singularities)\n", sep = "") } else cat("\nCoefficients:\n") if (is.null(subset)) printCoefmat(coef(x), digits = digits) else printCoefmat(coef(x)[subset, , drop = FALSE], digits = digits) cat("\n") cat(paste("Total Sum of Squares: ", signif(tss(x), digits), "\n", sep = "")) cat(paste("Residual Sum of Squares: ", signif(deviance(x), digits), "\n", sep = "")) cat(paste("R-Squared: ", signif(x$r.squared[1L], digits), "\n", sep = "")) cat(paste("Adj. R-Squared: ", signif(x$r.squared[2L], digits), "\n", sep = "")) # print Wald test of joint sign. of regressors only if there is a statistic # in summary.plm object (not computed by summary.plm if there are no other # regressors than the intercept if(!is.null(fstat <- x$fstatistic)) { if (names(fstat$statistic) == "F"){ cat(paste("F-statistic: ", signif(fstat$statistic), " on ", fstat$parameter["df1"]," and ", fstat$parameter["df2"], " DF, p-value: ", format.pval(fstat$p.value,digits=digits), "\n", sep="")) } else{ cat(paste("Chisq: ", signif(fstat$statistic), " on ", fstat$parameter, " DF, p-value: ", format.pval(fstat$p.value, digits = digits), "\n", sep="")) } } invisible(x) } #' @rdname plm #' @export predict.plm <- function(object, newdata = NULL, ...){ tt <- terms(object) if (is.null(newdata)){ result <- fitted(object, ...) } else{ Terms <- delete.response(tt) m <- model.frame(Terms, newdata) X <- model.matrix(Terms, m) beta <- coef(object) result <- as.numeric(crossprod(beta, t(X))) } result } #' @rdname plm #' @export formula.plm <- function(x, ...){ x$formula } #' @rdname plm #' @export plot.plm <- function(x, dx = 0.2, N = NULL, seed = 1, within = TRUE, pooling = TRUE, between = FALSE, random = FALSE, ...){ set.seed(seed)# 8 est bien pour beertax subs <- ! is.null(N) x <- update(x, model = "within") mco <- update(x, model = "pooling") if (random) re <- update(x, model = "random") if (between) be <- update(x, model = "between") pdim <- pdim(x) n <- pdim$nT$n if (! subs) N <- n ids <- unique(index(x, "id")) if (subs) ids <- ids[sample(1:length(ids), N, replace = FALSE)] sel <- index(x, "id") %in% ids T. <- pdim$nT$T cols <- rainbow(N) pts <- sample(1:25, N, replace = TRUE) thex <- as.numeric(model.matrix(x, model = "pooling")[sel, 2L]) they <- as.numeric(pmodel.response(x, model = "pooling")[sel]) plot(thex, they, col = rep(cols, each = T.), pch = rep(pts, each = T.), ann = FALSE, las = 1) idsel <- as.numeric(index(x, "id")[sel]) meanx <- tapply(thex, idsel, mean) meany <- tapply(they, idsel, mean) points(meanx, meany, pch = 19, col = cols, cex = 1.5) if (within){ beta <- coef(x) alphas <- meany - meanx * beta dx <- dx * (max(thex) - min(thex)) for (i in 1:N){ xmin <- meanx[i] - dx xmax <- meanx[i] + dx ymin <- alphas[i] + beta * xmin ymax <- alphas[i] + beta * xmax lines(c(xmin, xmax), c(ymin, ymax), col = cols[i]) } } if(random) abline(coef(re)[1L], coef(re)[2L], lty = "dotted") if(pooling) abline(coef(mco), lty = "dashed") if(between) abline(coef(be), lty = "dotdash") # where to put the legends, depends on the sign of the OLS slope modploted <- c(random, pooling, between, within) if (sum(modploted)){ poslegend <- ifelse(beta > 0, "topleft", "topright") ltylegend <- c("dotted", "dashed", "dotdash", "solid")[modploted] leglegend <- c("random", "pooling", "between", "within")[modploted] legend(poslegend, lty = ltylegend, legend = leglegend) } } #' @rdname plm #' @export residuals.plm <- function(object, model = NULL, effect = NULL, ...){ if (is.null(model) && is.null(effect)){ model <- describe(object, "model") res <- object$residuals } else{ cl <- match.call(expand.dots = FALSE) # fitted -> call to the plm method, used to be fitted.plm # which is not exported # cl[[1L]] <- as.name("fitted.plm") cl[[1L]] <- as.name("fitted") bX <- eval(cl, parent.frame()) if (is.null(model)) model <- describe(object, "model") if (is.null(effect)) effect <- describe(object, "effect") y <- pmodel.response(object, model = model, effect = effect) res <- y - bX } res <- if (model %in% c("between", "fd")) { # these models "compress" the data, thus an index does not make sense here # -> do not return pseries but plain numeric res } else { structure(res, index = index(object), class = unique(c("pseries", class(res)))) } return(res) } #' @rdname plm #' @export fitted.plm <- function(object, model = NULL, effect = NULL, ...){ fittedmodel <- describe(object, "model") if (is.null(model)) model <- fittedmodel if (is.null(effect)) effect <- describe(object, "effect") if (fittedmodel == "random") theta <- ercomp(object)$theta else theta <- NULL X <- model.matrix(object, model = "pooling") y <- pmodel.response(object, model = "pooling", effect = effect) beta <- coef(object) comonpars <- intersect(names(beta), colnames(X)) bX <- as.numeric(crossprod(t(X[, comonpars, drop = FALSE]), beta[comonpars])) bX <- structure(bX, index = index(object), class = unique(c("pseries", class(bX)))) if (fittedmodel == "within"){ intercept <- mean(y - bX) bX <- bX + intercept } ptransform(bX, model = model, effect = effect, theta = theta) } plm/R/make.pconsecutive_pbalanced.R0000644000176200001440000007771314154734502017026 0ustar liggesusers### This file: ### make.pconsecutive.* ### make.pbalanced.* ### ### is.pconsecutive.* is in separate file is.pconsecutive.R # consecutive: "consecutive in the numbers": t, t+1, t+2, ... where t is an integer, # i.e., the time index var is interpreted as a numerical # ## in the future, maybe make.pconsective could gain an additional argument 'fill' for the filled value (currently NA) ## if so, check other packages (data.table, dplyr, tidyr, ...) what the argument is called there ## arg would need to be a (named) list (for (p)data.frame methods) because columns of ## (p)data.frames are of arbitraty classes #' Make data consecutive (and, optionally, also balanced) #' #' This function makes the data consecutive for each individual (no "gaps" in #' time dimension per individual) and, optionally, also balanced #' #' (p)data.frame and pseries objects are made consecutive, meaning their time #' periods are made consecutive per individual. For consecutiveness, the time #' dimension is interpreted to be numeric, and the data are extended to a #' regularly spaced sequence with distance 1 between the time periods for each #' individual (for each individual the time dimension become a sequence t, t+1, #' t+2, \ldots{} where t is an integer). Non--index variables are filled with #' `NA` for the inserted elements (rows for (p)data.frames, vector #' elements for pseries). #' #' With argument `balanced = TRUE`, additionally to be made consecutive, #' the data also can be made a balanced panel/pseries. Note: This means #' consecutive AND balanced; balancedness does not imply consecutiveness. In #' the result, each individual will have the same time periods in their time #' dimension by taking the min and max of the time index variable over all #' individuals (w/o `NA` values) and inserting the missing time periods. #' Looking at the number of rows of the resulting (pdata.frame) (elements for #' pseries), this results in nrow(make.pconsecutive, balanced = FALSE) <= #' nrow(make.pconsecutive, balanced = TRUE). For making the data only #' balanced, i.e., not demanding consecutiveness at the same time, use #' [make.pbalanced()] (see **Examples** for a comparison)). #' #' Note: rows of (p)data.frames (elements for pseries) with `NA` values in #' individual or time index are not examined but silently dropped before the #' data are made consecutive. In this case, it is not clear which individual or #' time period is meant by the missing value(s). Especially, this means: If #' there are `NA` values in the first/last position of the original time #' periods for an individual, which usually depicts the beginning and ending of #' the time series for that individual, the beginning/end of the resulting time #' series is taken to be the min and max (w/o `NA` values) of the original #' time series for that individual, see also **Examples**. Thus, one might #' want to check if there are any `NA` values in the index variables #' before applying make.pconsecutive, and especially check for `NA` values #' in the first and last position for each individual in original data and, if #' so, maybe set those to some meaningful begin/end value for the time series. #' #' @aliases make.pconsecutive #' @param x an object of class `pdata.frame`, `data.frame`, #' or `pseries`, #' @param balanced logical, indicating whether the data should #' _additionally_ be made balanced (default: FALSE), #' @param index only relevant for `data.frame` interface; if #' `NULL`, the first two columns of the data.frame are #' assumed to be the index variables; if not `NULL`, both #' dimensions ('individual', 'time') need to be specified by #' `index` as character of length 2 for data frames, for #' further details see [pdata.frame()], #' @param \dots further arguments. #' @return An object of the same class as the input `x`, i.e., a #' pdata.frame, data.frame or a pseries which is made #' time--consecutive based on the index variables. The returned #' data are sorted as a stacked time series. #' @export #' @author Kevin Tappe #' @seealso [is.pconsecutive()] to check if data are #' consecutive; [make.pbalanced()] to make data only #' balanced (not consecutive).\cr [punbalancedness()] #' for two measures of unbalancedness, [pdim()] to check #' the dimensions of a 'pdata.frame' (and other objects), #' [pvar()] to check for individual and time variation #' of a 'pdata.frame' (and other objects), [lag()] for #' lagged (and leading) values of a 'pseries' object.\cr #' [pseries()], [data.frame()], #' [pdata.frame()]. #' @keywords attribute #' @examples #' #' # take data and make it non-consecutive #' # by deletion of 2nd row (2nd time period for first individual) #' data("Grunfeld", package = "plm") #' nrow(Grunfeld) # 200 rows #' Grunfeld_missing_period <- Grunfeld[-2, ] #' is.pconsecutive(Grunfeld_missing_period) # check for consecutiveness #' make.pconsecutive(Grunfeld_missing_period) # make it consecutiveness #' #' #' # argument balanced: #' # First, make data non-consecutive and unbalanced #' # by deletion of 2nd time period (year 1936) for all individuals #' # and more time periods for first individual only #' Grunfeld_unbalanced <- Grunfeld[Grunfeld$year != 1936, ] #' Grunfeld_unbalanced <- Grunfeld_unbalanced[-c(1,4), ] #' all(is.pconsecutive(Grunfeld_unbalanced)) # FALSE #' pdim(Grunfeld_unbalanced)$balanced # FALSE #' #' g_consec_bal <- make.pconsecutive(Grunfeld_unbalanced, balanced = TRUE) #' all(is.pconsecutive(g_consec_bal)) # TRUE #' pdim(g_consec_bal)$balanced # TRUE #' nrow(g_consec_bal) # 200 rows #' head(g_consec_bal) # 1st individual: years 1935, 1936, 1939 are NA #' #' g_consec <- make.pconsecutive(Grunfeld_unbalanced) # default: balanced = FALSE #' all(is.pconsecutive(g_consec)) # TRUE #' pdim(g_consec)$balanced # FALSE #' nrow(g_consec) # 198 rows #' head(g_consec) # 1st individual: years 1935, 1936 dropped, 1939 is NA #' #' #' # NA in 1st, 3rd time period (years 1935, 1937) for first individual #' Grunfeld_NA <- Grunfeld #' Grunfeld_NA[c(1, 3), "year"] <- NA #' g_NA <- make.pconsecutive(Grunfeld_NA) #' head(g_NA) # 1936 is begin for 1st individual, 1937: NA for non-index vars #' nrow(g_NA) # 199, year 1935 from original data is dropped #' #' #' # pdata.frame interface #' pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) #' make.pconsecutive(Grunfeld_missing_period) #' #' #' # pseries interface #' make.pconsecutive(pGrunfeld_missing_period$inv) #' #' #' # comparison to make.pbalanced (makes the data only balanced, not consecutive) #' g_bal <- make.pbalanced(Grunfeld_unbalanced) #' all(is.pconsecutive(g_bal)) # FALSE #' pdim(g_bal)$balanced # TRUE #' nrow(g_bal) # 190 rows #' make.pconsecutive <- function(x, ...){ UseMethod("make.pconsecutive") } # no export needed make.pconsecutive.indexes <- function(x, index, balanced = FALSE, ...) { # make.pconsecutive.indexes: helper function, not exported # returns list with 3 elements: # 1 "consec_index": consecutive data.frame to serve as the new index data.frame in other functions, # 2 "NArows_former_index": information about dropped lines (logical vector with length of original data) # 3 "has_fancy_rownames": logical whether fancy row.names were used in original data (can only be TRUE for pdata.frame or pseries) if (inherits(x, "pdata.frame") || inherits(x, "pseries")) { pdataframe_or_pseries <- TRUE index_orig <- attr(x, which = "index") id_orig <- index_orig[[1L]] # can leave as factor if it is a factor times_orig <- index_orig[[2L]] if (!is.numeric(times_orig) && is.factor(times_orig)) times_orig <- as.numeric(levels(times_orig))[as.integer(times_orig)] # time var needs to be numeric [as.character needed here!] # [R FAQ 7.10 for coercing factors to numeric # as.numeric(levels(factor_var))[as.integer(factor_var)] is more efficient than as.numeric(as.character(factor_var)) # check if fancy rownames are used (to restore them later) if (inherits(x, "pseries")) { has_fancy_rownames <- isTRUE(all.equal(names(x), fancy.row.names(index_orig))) rownames_mode <- mode(attr(x, "names")) rownames_typeof <- typeof(attr(x, "names")) } else { # pdata.frame has_fancy_rownames <- isTRUE(all.equal(row.names(x), fancy.row.names(index_orig))) rownames_mode <- mode(attr(x, "row.names")) rownames_typeof <- typeof(attr(attr(x, "index"), "row.names")) # here we want the typeof of the index } } if (inherits(x, "data.frame") && !inherits(x, "pdata.frame")) { # x is a data.frame, but no pdata.frame pdataframe_or_pseries <- FALSE has_fancy_rownames <- FALSE index_orig <- x[ , index] id_orig <- index_orig[[1L]] times_orig <- index_orig[[2L]] id_orig_typeof <- typeof(id_orig) times_orig_typeof <- typeof(times_orig) rownames_mode <- mode(attr(x, "row.names")) rownames_typeof <- typeof(attr(x, "row.names")) } df_index <- data.frame(id = id_orig, times = times_orig) # remove any rows with NA in id or time variable as it is impossible to # infer their values, thus: drop them is_NA <- is.na(id_orig) | is.na(times_orig) df_index <- df_index[!is_NA, ] n_id_orig <- length(unique(id_orig)) if (!balanced) { min_values <- by(df_index[ , "times"], df_index[ , "id"], min) max_values <- by(df_index[ , "times"], df_index[ , "id"], max) times_filled_list <- sapply(seq_len(n_id_orig), function(i) { seq(from = min_values[i], to = max_values[i], by = 1) }, simplify = FALSE, USE.NAMES = FALSE) } else { min_value <- min(df_index[, "times"]) max_value <- max(df_index[, "times"]) times_filled_list <- sapply(seq_len(n_id_orig), function(i) { seq(from = min_value, to = max_value, by = 1) }, simplify = FALSE, USE.NAMES = FALSE) } times_filled_vector <- unlist(times_filled_list, use.names = FALSE) id_times <- vapply(times_filled_list, length, FUN.VALUE = 0.0) # lengths (with an "s") would be more efficient, but requires R >= 3.2 id_filled_vector <- unlist(mapply(rep, unique(id_orig), id_times, SIMPLIFY = FALSE), use.names = FALSE) # SIMPLIFY = FALSE => always return list df_index_filled <- data.frame(id = id_filled_vector, times = times_filled_vector) names(df_index_filled)[1:2] <- names(index_orig)[1:2] # set original index names if (pdataframe_or_pseries) { df_index_filled[ , 1L] <- as.factor(df_index_filled[ , 1L]) df_index_filled[ , 2L] <- as.factor(df_index_filled[ , 2L]) class(df_index_filled) <- c("pindex", class(df_index_filled)) } else { if (typeof(df_index_filled[ , 1L]) != id_orig_typeof) { mode(df_index_filled[ , 1L]) <- id_orig_typeof } if (typeof(df_index_filled[ , 2L]) != times_orig_typeof) { mode(df_index_filled[ , 2L]) <- times_orig_typeof } } # restore mode of row.names attribute # [was changed by above code due to some simplification by R's standard behaviour] mode(attr(df_index_filled, "row.names")) <- rownames_typeof res <- list(consec_index = df_index_filled, NArows_former_index = is_NA, has_fancy_rownames = has_fancy_rownames) return(res) } ### END: make.pconsecutive.indexes #' @rdname make.pconsecutive #' @export make.pconsecutive.data.frame <- function(x, balanced = FALSE, index = NULL, ...){ # if not NULL, index is must be character of length 2 if (!is.null(index) && length(index) != 2L) stop("if argument 'index' is not NULL, 'index' needs to specify 'individual' and 'time' dimension for make.pconsecutive to work on a data.frame") # assume first two columns to be the index vars index_orig_names <- if(is.null(index)) names(x)[1:2] else index list_ret_make_index <- make.pconsecutive.indexes(x, index_orig_names, balanced = balanced, ...) index_df_filled <- list_ret_make_index[["consec_index"]] NArows_old_index <- list_ret_make_index[["NArows_former_index"]] has_fancy_rownames <- list_ret_make_index[["has_fancy_rownames"]] # silently drop rows with NA in either individual or time variable of original index x <- x[!NArows_old_index, ] index_df_filled_plus_x <- merge(index_df_filled, x, by.x = names(index_df_filled)[1:2], by.y = index_orig_names, all.x = TRUE) # restore mode of row.names attribute [was changed by above code due to some simplification as R's standard behaviour] mode(attr(index_df_filled_plus_x, "row.names")) <- typeof(attr(index_df_filled, "row.names")) # restore original order of columns, esp. place index vars at original position index_df_filled_plus_x <- index_df_filled_plus_x[ , names(x)] return(index_df_filled_plus_x) } ### END: make.pconsecutive.data.frame #' @rdname make.pconsecutive #' @export make.pconsecutive.pdata.frame <- function(x, balanced = FALSE, ...){ orig_column_names <- names(x) list_ret_make_index <- make.pconsecutive.indexes(x, balanced = balanced, ...) index_df_filled <- list_ret_make_index[["consec_index"]] NArows_old_index <- list_ret_make_index[["NArows_former_index"]] has_fancy_rownames <- list_ret_make_index[["has_fancy_rownames"]] # silently drop rows with NA in either individual or time variable of original index # do dropping only if there is any NA row, because calling the subsetting slightly changes the pdata.frame if (any(NArows_old_index)) x <- x[!NArows_old_index, ] # if index not as vars in pdata.frame: pad index vars in columns 1,2 to enable merging # determine position of index vars is c(NA, NA) if index vars are not columns in x pos_indexvars <- pos.index(x) index_orig_names <- names(pos_indexvars) if (anyNA(pos_indexvars)) { index_orig <- attr(x, "index") x <- cbind(index_orig, x) } x_df_filled <- merge(index_df_filled, x, by = index_orig_names, all.x = TRUE) # merge produces a pdata.frame with 'pseries' in columns (if [.pseries is active]) # -> remove pseries features from columns x_df_filled <- lapply(x_df_filled, remove_pseries_features) # make pdata.frame (index vars are already in columns 1,2) x_pdf_filled <- pdata.frame(x_df_filled, row.names = has_fancy_rownames) # save order of attributes to restore order later # attrib_names_before <- names(attributes(x_pdf_filled)) # restore original order of columns: # this also places index vars at original position or drops them if they were not in original pdata.frame # (do only if order of columns differs or index is not in pdata.frame to avoid adding extra attributes by subsetting) if (!isTRUE(all.equal(orig_column_names, names(x_pdf_filled)))) x_pdf_filled <- x_pdf_filled[ , orig_column_names] # restore mode of row.names attribute [was changed by above code due to some simplification as R's standard behaviour] mode(attr(attr(x_pdf_filled, "index"), "row.names")) <- typeof(attr(index_df_filled, "row.names")) # reorder attributes: subsetting with R's [.data.frame changes order # order of attribute shall be assumed to be a set rather than having an order, see do not reorder (see ?attributes) ## attributes(x_pdf_filled) <- attributes(x_pdf_filled)[attrib_names_before] return(x_pdf_filled) } ### END: make.pconsecutive.pdata.frame #' @rdname make.pconsecutive #' @export make.pconsecutive.pseries <- function(x, balanced = FALSE, ...) { is_p <- is.pconsecutive(x) is_bal <- is.pbalanced(x) make_balanced <- balanced == TRUE && !is_bal # consecutive AND balancedness requested but data not balanced # -> independent of the consecutiveness, we need to treat the balancedness if (anyNA(is_p) || !all(is_p) || make_balanced) { list_ret_make_index <- make.pconsecutive.indexes(x, balanced = balanced, ...) df_index_filled <- list_ret_make_index[["consec_index"]] NArows_old_index <- list_ret_make_index[["NArows_former_index"]] has_fancy_rownames <- list_ret_make_index[["has_fancy_rownames"]] df_old_index <- attr(x, "index") class(df_old_index) <- "data.frame" # strip x to its pure form (no index, no class pseries) df_old_index$x <- remove_pseries_features(x) # silently drop entries with NA in either individual or time variable of original index df_old_index <- df_old_index[!NArows_old_index, ] df_index_filled_plus_x <- merge(df_index_filled, df_old_index, by.x = names(df_index_filled)[1:2], by.y = names(df_old_index)[1:2], all.x = TRUE) pdf_index_filled_plus_x <- pdata.frame(df_index_filled_plus_x, drop.index = FALSE, row.names = has_fancy_rownames) x <- pdf_index_filled_plus_x$x } return(x) } ############# make.pbalanced ############# ## make.pbalanced.* methods make the input balanced (but not consecutive). ## It does so by either ## balance.type = "fill": filling in only those missing time periods are ## introduced that are present for at least one individual ## (union of time periods) ## ## balance.type = "shared.times": remove all observations with time periods ## not shared among all individuals ## (keep intersect of time periods) ## ## "shared.individuals": drop individuals which don't have all time periods ## (symmetric to "shared.times") #' Make data balanced #' #' This function makes the data balanced, i.e., each individual has the same #' time periods, by filling in or dropping observations #' #' (p)data.frame and pseries objects are made balanced, meaning each #' individual has the same time periods. Depending on the value of #' `balance.type`, the balancing is done in different ways: #' \itemize{ \item `balance.type = "fill"` (default): The union #' of available time periods over all individuals is taken (w/o #' `NA` values). Missing time periods for an individual are #' identified and corresponding rows (elements for pseries) are #' inserted and filled with `NA` for the non--index variables #' (elements for a pseries). This means, only time periods present #' for at least one individual are inserted, if missing. #' #' \item `balance.type = "shared.times"`: The intersect of available time #' periods over all individuals is taken (w/o `NA` values). Thus, time #' periods not available for all individuals are discarded, i. e., only time #' periods shared by all individuals are left in the result). #' #' \item `balance.type = "shared.individuals"`: All available time periods #' are kept and those individuals are dropped for which not all time periods #' are available, i. e., only individuals shared by all time periods are left #' in the result (symmetric to `"shared.times"`). } #' #' The data are not necessarily made consecutive (regular time series #' with distance 1), because balancedness does not imply #' consecutiveness. For making the data consecutive, use #' [make.pconsecutive()] (and, optionally, set argument #' `balanced = TRUE` to make consecutive and balanced, see also #' **Examples** for a comparison of the two functions. #' #' Note: Rows of (p)data.frames (elements for pseries) with `NA` #' values in individual or time index are not examined but silently #' dropped before the data are made balanced. In this case, it cannot #' be inferred which individual or time period is meant by the missing #' value(s) (see also **Examples**). Especially, this means: #' `NA` values in the first/last position of the original time #' periods for an individual are dropped, which are usually meant to #' depict the beginning and ending of the time series for that #' individual. Thus, one might want to check if there are any #' `NA` values in the index variables before applying #' make.pbalanced, and especially check for `NA` values in the #' first and last position for each individual in original data and, #' if so, maybe set those to some meaningful begin/end value for the #' time series. #' #' @aliases make.pbalanced #' @param x an object of class `pdata.frame`, `data.frame`, #' or `pseries`; #' @param balance.type character, one of `"fill"`, #' `"shared.times"`, or `"shared.individuals"`, see #' **Details**, #' @param index only relevant for `data.frame` interface; if #' `NULL`, the first two columns of the data.frame are #' assumed to be the index variables; if not `NULL`, both #' dimensions ('individual', 'time') need to be specified by #' `index` as character of length 2 for data frames, for #' further details see [pdata.frame()], #' @param \dots further arguments. #' @return An object of the same class as the input `x`, i.e., a #' pdata.frame, data.frame or a pseries which is made balanced #' based on the index variables. The returned data are sorted as a #' stacked time series. #' @export #' @author Kevin Tappe #' @seealso [is.pbalanced()] to check if data are balanced; #' [is.pconsecutive()] to check if data are consecutive; #' [make.pconsecutive()] to make data consecutive (and, #' optionally, also balanced).\cr [punbalancedness()] #' for two measures of unbalancedness, [pdim()] to check #' the dimensions of a 'pdata.frame' (and other objects), #' [pvar()] to check for individual and time variation #' of a 'pdata.frame' (and other objects), [lag()] for #' lagging (and leading) values of a 'pseries' object.\cr #' [pseries()], [data.frame()], #' [pdata.frame()]. #' @keywords attribute #' @examples #' #' # take data and make it unbalanced #' # by deletion of 2nd row (2nd time period for first individual) #' data("Grunfeld", package = "plm") #' nrow(Grunfeld) # 200 rows #' Grunfeld_missing_period <- Grunfeld[-2, ] #' pdim(Grunfeld_missing_period)$balanced # check if balanced: FALSE #' make.pbalanced(Grunfeld_missing_period) # make it balanced (by filling) #' make.pbalanced(Grunfeld_missing_period, balance.type = "shared.times") # (shared periods) #' nrow(make.pbalanced(Grunfeld_missing_period)) #' nrow(make.pbalanced(Grunfeld_missing_period, balance.type = "shared.times")) #' #' # more complex data: #' # First, make data unbalanced (and non-consecutive) #' # by deletion of 2nd time period (year 1936) for all individuals #' # and more time periods for first individual only #' Grunfeld_unbalanced <- Grunfeld[Grunfeld$year != 1936, ] #' Grunfeld_unbalanced <- Grunfeld_unbalanced[-c(1,4), ] #' pdim(Grunfeld_unbalanced)$balanced # FALSE #' all(is.pconsecutive(Grunfeld_unbalanced)) # FALSE #' #' g_bal <- make.pbalanced(Grunfeld_unbalanced) #' pdim(g_bal)$balanced # TRUE #' unique(g_bal$year) # all years but 1936 #' nrow(g_bal) # 190 rows #' head(g_bal) # 1st individual: years 1935, 1939 are NA #' #' # NA in 1st, 3rd time period (years 1935, 1937) for first individual #' Grunfeld_NA <- Grunfeld #' Grunfeld_NA[c(1, 3), "year"] <- NA #' g_bal_NA <- make.pbalanced(Grunfeld_NA) #' head(g_bal_NA) # years 1935, 1937: NA for non-index vars #' nrow(g_bal_NA) # 200 #' #' # pdata.frame interface #' pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) #' make.pbalanced(Grunfeld_missing_period) #' #' # pseries interface #' make.pbalanced(pGrunfeld_missing_period$inv) #' #' # comparison to make.pconsecutive #' g_consec <- make.pconsecutive(Grunfeld_unbalanced) #' all(is.pconsecutive(g_consec)) # TRUE #' pdim(g_consec)$balanced # FALSE #' head(g_consec, 22) # 1st individual: no years 1935/6; 1939 is NA; #' # other indviduals: years 1935-1954, 1936 is NA #' nrow(g_consec) # 198 rows #' #' g_consec_bal <- make.pconsecutive(Grunfeld_unbalanced, balanced = TRUE) #' all(is.pconsecutive(g_consec_bal)) # TRUE #' pdim(g_consec_bal)$balanced # TRUE #' head(g_consec_bal) # year 1936 is NA for all individuals #' nrow(g_consec_bal) # 200 rows #' #' head(g_bal) # no year 1936 at all #' nrow(g_bal) # 190 rows #' make.pbalanced <- function(x, balance.type = c("fill", "shared.times", "shared.individuals"), ...) { UseMethod("make.pbalanced") } #' @rdname make.pbalanced #' @export make.pbalanced.pdata.frame <- function(x, balance.type = c("fill", "shared.times", "shared.individuals"), ...) { if (length(balance.type) == 1 && balance.type == "shared") { # accept "shared" for backward compatibility balance.type <- "shared.times" warning("Use of balanced.type = 'shared' discouraged, set to 'shared.times'") } balance.type <- match.arg(balance.type) index <- attr(x, "index") switch(balance.type, "fill" = { x_consec_bal <- make.pconsecutive(x, balanced = TRUE) # delete time periods that were not present for any individual, but introduced by # making data consecutive # result: no time periods are added that are not present for at least one individual times_present_orig <- attr(x_consec_bal, "index")[[2L]] %in% unique(index[[2L]]) result <- x_consec_bal[times_present_orig, ] # drop not present factor levels (some new levels were introduced by making data consecutive first): # drop from index index_result <- attr(result, "index") index_result[[2L]] <- droplevels(index_result[[2L]]) attr(result, "index") <- index_result # drop from time column (if time index column present in pdata.frame) pos_indexvars <- pos.index(result) # position of index vars is c(NA, NA) if index vars are not present as columns index_orig_names <- names(pos_indexvars) if (!anyNA(pos_indexvars)) { result[ , pos_indexvars[2L]] <- droplevels(result[ , pos_indexvars[2L]]) } }, "shared.times" = { keep <- intersect_index(index, "time") result <- x[keep, ] }, "shared.individuals" = { keep <- intersect_index(index, "individual") result <- x[keep, ] }) return(result) } ## END make.pbalanced.pdata.frame #' @rdname make.pbalanced #' @export make.pbalanced.pseries <- function(x, balance.type = c("fill", "shared.times", "shared.individuals"), ...) { if (length(balance.type) == 1 && balance.type == "shared") { # accept "shared" for backward compatibility balance.type <- "shared.times" warning("Use of balanced.type = 'shared' discouraged, set to 'shared.times'") } balance.type <- match.arg(balance.type) index <- attr(x, "index") switch(balance.type, "fill" = { x_consec_bal <- make.pconsecutive(x, balanced = TRUE) # delete time periods that were not present for any individual, but introduced by # making data consecutive # result: no time periods are added that are not present for at least one individual x_consec_bal_index <- attr(x_consec_bal, "index") times_present_orig <- x_consec_bal_index[[2L]] %in% unique(index[[2L]]) result <- x_consec_bal[times_present_orig] # this drops the pseries features (index, class "pseries") # because there is no function "[.pseries]" (as of 2016-05-14) # drop introduced extra periods also from index x_consec_bal_index <- x_consec_bal_index[times_present_orig, ] # re-attach index and restore original class(es) attr(result, "index") <- x_consec_bal_index attr(result, "class") <- attr(x, "class") }, "shared.times" = { keep <- intersect_index(index, "time") result <- x[keep] # restore 'pseries' features # (no subsetting method for pseries in the package (yet), # usual vector subsetting removes the pseries features) attr(result, "index") <- index[keep, ] class(result) <- unique(c("pseries", class(result))) }, "shared.individuals" = { keep <- intersect_index(index, "individual") result <- x[keep] # restore 'pseries' features # (no subsetting method for pseries in the package (yet), # usual vector subsetting removes the pseries features) attr(result, "index") <- index[keep, ] class(result) <- unique(c("pseries", class(result))) }) return(result) } ## END make.pbalanced.pseries #' @rdname make.pbalanced #' @export make.pbalanced.data.frame <- function(x, balance.type = c("fill", "shared.times", "shared.individuals"), index = NULL, ...) { # NB: for data.frame interface: the data is also sorted as stack time series if (length(balance.type) == 1L && balance.type == "shared") { # accept "shared" for backward compatibility balance.type <- "shared.times" warning("Use of balanced.type = 'shared' discouraged, set to 'shared.times'") } balance.type <- match.arg(balance.type) ## identify index of data.frame # if not NULL, index is must be character of length 2 if (!is.null(index) && length(index) != 2L) stop("if argument 'index' is not NULL, 'index' needs to specify 'individual' and 'time' dimension for make.pconsecutive to work on a data.frame") # assume first two columns to be the index vars if (is.null(index)) index_orig_names <- names(x)[1:2] else index_orig_names <- index index_df <- x[ , index_orig_names] switch(balance.type, "fill" = { x_consec_bal <- make.pconsecutive(x, index = index_orig_names, balanced = TRUE) # delete time periods that were not present for any individual, but introduced by # making data consecutive # result: no time periods are added that are not present for at least one individual times_present_orig <- x_consec_bal[ , index_orig_names[2L]] %in% unique(index_df[[2L]]) result <- x_consec_bal[times_present_orig , ]}, "shared.times" = { keep <- intersect_index(index_df, "time") result <- x[keep, ]}, "shared.individuals" = { keep <- intersect_index(index_df, "individual") result <- x[keep, ] }) return(result) } ## END make.pbalanced.data.frame # helper function: returns logical vector which rows/entries to keep # when balance.type = "shared.times" or "shared.individuals" # (intersect of all time periods or individuals) intersect_index <- function(index, by) { # intersect() is defined on vectors (not factors) # -> convert respective index to character before unclass(index) # unclass for speed switch(by, "time" = { id <- index[[1L]] time <- as.character(index[[2L]]) }, "individual" = { id <- index[[2L]] time <- as.character(index[[1L]]) }) times_by_ids <- split(time, id) common_times <- Reduce(intersect, times_by_ids) keep_entries <- time %in% common_times return(keep_entries) } plm/R/groupGenerics_pseries.R0000644000176200001440000001013514154734502015741 0ustar liggesusers## groupGenerics for operations on pseries ## see ?groupGeneric ## see tests/test_groupGenerics_pseries.R for examples ## ## implemented wrappers for groups Ops, Math, Complex ## ## group generic for Summary (all, any, sum, prod, min, max, range) not needed ## as functions in this group do not change the data type ## ## groupGenerics need to be registered in NAMESPACE ## ## groupGenerics are used to allow automatic propagation to higher/lower data type ## when operations are performed on pseries, ## e.g., class c("pseries", "integer") -> c("pseries", "numeric") when a function ## takes an integer as input and outputs a numeric. Without the group generics, ## the class of the results would stay as c("pseries", "integer") while the values ## themselves are numerics. The associated test file demonstrates the behaviour, ## see tests/test_groupGenerics_pseries.R ## helper functions: remove_pseries_features and add_pseries_features remove_pseries_features <- function(x) { # debug: # if (!is.pseries(x)) warning("removing pseries features now but object was not a proper pseries before") attr(x, "index") <- NULL # unclass is simpler and faster than previously (up to and incl. rev. 1307) used # combination of check_propagation_correct_class() and class() <- setdiff(class(<.>), "pseries") # unclass handles propagation and keeps names but coerces factor to integer x <- if(!is.factor(x)) unclass(x) else { class(x) <- setdiff(class(x), "pseries"); x } x } add_pseries_features <- function(x, index) { # debug: # if (is.null(index)) warning("'index' is null") attr(x, "index") <- index class(x) <- unique(c("pseries", class(x))) return(x) } #' @export Ops.pseries <- function(e1, e2) { # print("Ops.pseries executed!") # debug output miss_e2 <- missing(e2) e1_pseries <- e2_pseries <- FALSE # either one or both could be pseries if(inherits(e1, "pseries")) { e1_pseries <- TRUE index_e1 <- attr(e1, "index") e1 <- remove_pseries_features(e1) } if(!miss_e2 && inherits(e2, "pseries")) { e2_pseries <- TRUE index_e2 <- attr(e2, "index") e2 <- remove_pseries_features(e2) } res <- if(!miss_e2) get(.Generic)(e1, e2) else get(.Generic)(e1) # result could be, e.g., matrix. So check if adding back pseries features # makes sense (e.g., do not create something of class c("pseries", "matrix")). # Need is.atomic because is.vector is too strict, however need to sort out # some other data types add_back_pseries <- if(is.atomic(res) && !is.matrix(res) && !is.pairlist(res)) TRUE else FALSE if(add_back_pseries) { if(miss_e2 && e1_pseries) relevant_index <- index_e1 if( e1_pseries && !e2_pseries) relevant_index <- index_e1 if(!e1_pseries && e2_pseries) relevant_index <- index_e2 if( e1_pseries && e2_pseries) { # decide on index for result: # if objects vary in length: shorter object is recycled by R # -> must take index of non-recycled object (= longer pseries) # # Also, base R uses the names of the first operand -> additional justification # to assign index_e1 in case of same number of rows relevant_index <- if(nrow(index_e1) >= nrow(index_e2)) index_e1 else index_e2 # do not warn anymore (since rev. 1181) # if ((nrow(index_e1) == nrow(index_e2)) && !isTRUE(all.equal(index_e1, index_e2))) # warning("indexes of pseries have same length but not same content: result was assigned first operand's index") } res <- add_pseries_features(res, relevant_index) } return(res) } #' @export Math.pseries <- function(x, ...) { # print("Math.pseries executed!") # debug output index <- attr(x, "index") x <- remove_pseries_features(x) x <- get(.Generic)(x, ...) x <- add_pseries_features(x, index) return(x) } #' @export Complex.pseries <- function(z) { # print("Complex.pseries executed!") # debug output index <- attr(z, "index") z <- remove_pseries_features(z) z <- get(.Generic)(z) z <- add_pseries_features(z, index) return(z) } plm/R/tool_pdata.frame.R0000644000176200001440000014447614155752643014641 0ustar liggesusers## pdata.frame and pseries are adaptations of respectively data.frame ## and vector for panel data. An index attribute is added to both, ## which is a data.frame containing the indexes. There is no pseries ## function, it is the class of series extracted from a ## pdata.frame. index and pdim functions are used to extract ## respectively the data.frame containing the index and the dimensions ## of the panel ## pdata.frame: ## - $<- ## - [ ## - $ ## - [[ ## - print ## - as.list ## - as.data.frame ## - pseriesfy ## pseries: ## - [ ## - print ## - as.matrix ## - plot ## - summary ## - plot.summary ## - print.summary ## - is.pseries ## pdim: ## - pdim.default ## - pdim.data.frame ## - pdim.pdata.frame ## - pdim.pseries ## - pdim.panelmodel ## - pdim.pgmm ## - print.pdim ## index: ## - index.pindex ## - index.pdata.frame ## - index.pseries ## - index.panelmodel ## - is.index (non-exported) ## - has.index (non-exported) ## - checkNA.index (non-exported) ## - pos.index (non-exported) fancy.row.names <- function(index, sep = "-") { ## non-exported # assumes index is a list of 2 or 3 factors [not class pindex] if (length(index) == 2L) {result <- paste(index[[1L]], index[[2L]], sep = sep)} # this in the order also used for sorting (group, id, time): if (length(index) == 3L) {result <- paste(index[[3L]], index[[1L]], index[[2L]], sep = sep)} return(result) } #' data.frame for panel data #' #' An object of class 'pdata.frame' is a data.frame with an index #' attribute that describes its individual and time dimensions. #' #' The `index` argument indicates the dimensions of the panel. It can #' be: \itemize{ #' \item a vector of two character strings which #' contains the names of the individual and of the time indexes, #' \item #' a character string which is the name of the individual index #' variable. In this case, the time index is created automatically and #' a new variable called "time" is added, assuming consecutive and #' ascending time periods in the order of the original data, #' \item an integer, the number of individuals. In this case, the data #' need to be a balanced panel and be organized as a stacked time series #' (successive blocks of individuals, each block being a time series #' for the respective individual) assuming consecutive and ascending #' time periods in the order of the original data. Two new variables #' are added: "id" and "time" which contain the individual and the #' time indexes. #' } #' #' The `"[["` and `"$"` extract a series from the `pdata.frame`. The #' `"index"` attribute is then added to the series and a class #' attribute `"pseries"` is added. The `"["` method behaves as for #' `data.frame`, except that the extraction is also applied to the #' `index` attribute. A safe way to extract the index attribute is to #' use the function [index()] for 'pdata.frames' (and other objects). #' #' `as.data.frame` removes the index attribute from the `pdata.frame` #' and adds it to each column. For its argument `row.names` set to #' `FALSE` row names are an integer series, `TRUE` gives "fancy" row #' names; if a character (with length of the resulting data frame), #' the row names will be the character's elements. #' #' `as.list` behaves by default identical to #' [base::as.list.data.frame()] which means it drops the #' attributes specific to a pdata.frame; if a list of pseries is #' wanted, the attribute `keep.attributes` can to be set to #' `TRUE`. This also makes `lapply` work as expected on a pdata.frame #' (see also **Examples**). #' #' @param x a `data.frame` for the `pdata.frame` function and a #' `pdata.frame` for the methods, #' @param i see [Extract()], #' @param j see [Extract()], #' @param y one of the columns of the `data.frame`, #' @param index this argument indicates the individual and time #' indexes. See **Details**, #' @param drop see [Extract()], #' @param drop.index logical, indicates whether the indexes are to be #' excluded from the resulting pdata.frame, #' @param optional see [as.data.frame()], #' @param row.names `NULL` or logical, indicates whether "fancy" row #' names (combination of individual index and time index) are to #' be added to the returned (p)data.frame (`NULL` and `FALSE` have #' the same meaning for `pdata.frame`; for #' `as.data.frame.pdata.frame` see Details), #' @param stringsAsFactors logical, indicating whether character #' vectors are to be converted to factors, #' @param replace.non.finite logical, indicating whether values for #' which `is.finite()` yields `TRUE` are to be replaced by `NA` #' values, except for character variables (defaults to `FALSE`), #' @param drop.NA.series logical, indicating whether all-`NA` columns #' are to be removed from the pdata.frame (defaults to `FALSE`), #' @param drop.const.series logical, indicating whether constant #' columns are to be removed from the pdata.frame (defaults to #' `FALSE`), #' @param drop.unused.levels logical, indicating whether unused levels #' of factors are to be dropped (defaults to `FALSE`) (unused #' levels are always dropped from variables serving to construct #' the index variables), #' @param keep.attributes logical, only for as.list and as.data.frame #' methods, indicating whether the elements of the returned #' list/columns of the data.frame should have the pdata.frame's #' attributes added (default: FALSE for as.list, TRUE for #' as.data.frame), #' @param name the name of the `data.frame`, #' @param value the name of the variable to include, #' @param \dots further arguments. #' @return a `pdata.frame` object: this is a `data.frame` with an #' `index` attribute which is a `data.frame` with two variables, #' the individual and the time indexes, both being factors. The #' resulting pdata.frame is sorted by the individual index, then #' by the time index. #' @export #' @author Yves Croissant #' @seealso [index()] to extract the index variables from a #' 'pdata.frame' (and other objects), [pdim()] to check the #' dimensions of a 'pdata.frame' (and other objects), [pvar()] to #' check for each variable if it varies cross-sectionally and over #' time. To check if the time periods are consecutive per #' individual, see [is.pconsecutive()]. #' @keywords classes #' @examples #' #' # Gasoline contains two variables which are individual and time #' # indexes #' data("Gasoline", package = "plm") #' Gas <- pdata.frame(Gasoline, index = c("country", "year"), drop.index = TRUE) #' #' # Hedonic is an unbalanced panel, townid is the individual index #' data("Hedonic", package = "plm") #' Hed <- pdata.frame(Hedonic, index = "townid", row.names = FALSE) #' #' # In case of balanced panel, it is sufficient to give number of #' # individuals data set 'Wages' is organized as a stacked time #' # series #' data("Wages", package = "plm") #' Wag <- pdata.frame(Wages, 595) #' #' # lapply on a pdata.frame by making it a list of pseries first #' lapply(as.list(Wag[ , c("ed", "lwage")], keep.attributes = TRUE), lag) #' #' pdata.frame <- function(x, index = NULL, drop.index = FALSE, row.names = TRUE, stringsAsFactors = default.stringsAsFactors(), replace.non.finite = FALSE, drop.NA.series = FALSE, drop.const.series = FALSE, drop.unused.levels = FALSE) { if (inherits(x, "pdata.frame")) stop("already a pdata.frame") if (length(index) > 3L){ stop("'index' can be of length 3 at the most (one index variable for individual, time, group)") } # prune input: x is supposed to be a plain data.frame. Other classes building # on top of R's data frame can inject attributes etc. that confuse functions # in pkg plm. x <- data.frame(x) # if requested: coerce character vectors to factors if (stringsAsFactors) { x.char <- names(x)[vapply(x, is.character, FUN.VALUE = TRUE, USE.NAMES = FALSE)] for (i in x.char){ x[[i]] <- factor(x[[i]]) } } # if requested: replace Inf, -Inf, NaN (everything for which is.finite is FALSE) by NA # (for all but any character columns [relevant if stringAsFactors == FALSE]) if (replace.non.finite) { for (i in names(x)) { if (!inherits(x[[i]], "character")) { x[[i]][!is.finite(x[[i]])] <- NA } } } # if requested: check and remove complete NA series if (drop.NA.series) { na.check <- vapply(x, function(x) sum(!is.na(x)) == 0L, FUN.VALUE = TRUE, USE.NAMES = FALSE) na.serie <- names(x)[na.check] if (length(na.serie) > 0L){ if (length(na.serie) == 1L) cat(paste0("This series is NA and has been removed: ", na.serie, "\n")) else cat(paste0("These series are NA and have been removed: ", paste(na.serie, collapse = ", "), "\n")) } x <- x[ , !na.check] } # if requested: check for constant series and remove if (drop.const.series) { # -> var() and sd() on factors is deprecated as of R 3.2.3 -> use duplicated() cst.check <- vapply(x, function(x) { if (is.factor(x) || is.character(x)) { all(duplicated(x[!is.na(x)])[-1L]) } else { x[! is.finite(x)] <- NA # infinite elements set to NA only for this check var(as.numeric(x), na.rm = TRUE) == 0 } }, FUN.VALUE = TRUE, USE.NAMES = FALSE) # following line: bug fixed thanks to Marciej Szelfer cst.check <- cst.check | is.na(cst.check) cst.serie <- names(x)[cst.check] if (length(cst.serie) > 0L){ if (length(cst.serie) == 1L){ cat(paste0("This series is constant and has been removed: ", cst.serie, "\n")) } else{ cat(paste0("These series are constants and have been removed: ", paste(cst.serie, collapse = ", "), "\n")) } } x <- x[ , !cst.check] } # sanity check for 'index' argument. First, check the presence of a # grouping variable, this should be the third element of the index # vector or any "group" named element of this vector group.name <- NULL if (! is.null(names(index)) || length(index == 3L)){ if (! is.null(names(index))){ grouppos <- match("group", names(index)) if (! is.na(grouppos)){ group.name <- index[grouppos] index <- index[- grouppos] } } if (length(index) == 3L){ group.name <- index[3L] index <- index[-3L] } } if (length(index) == 0L) index <- NULL # if index is NULL, both id and time are NULL if (is.null(index)){ id <- NULL time <- NULL } # if the length of index is 1, id = index and time is NULL if (length(index) == 1L){ id <- index time <- NULL } # if the length of index is 2, the first element is id, the second # is time if (length(index) == 2L){ id <- index[1L] time <- index[2L] } # if both id and time are NULL, the names of the index are the first # two names of x if (is.null(id) && is.null(time)){ id.name <- names(x)[1L] time.name <- names(x)[2L] } else{ id.name <- id time.name <- time } # if index is numeric, this indicats a balanced panel with no. of # individuals equal to id.name if(is.numeric(id.name)){ if(!is.null(time.name)) warning("The time index (second element of 'index' argument) will be ignored\n") N <- nrow(x) if( (N %% id.name) != 0){ stop(paste0("unbalanced panel, in this case the individual index may not be indicated by an integer\n", "but by specifying a column of the data.frame in the first element of the 'index' argument\n")) } else{ T <- N %/% id.name n <- N %/% T time <- rep((1:T), n) id <- rep((1:n), rep(T, n)) id.name <- "id" time.name <- "time" if (id.name %in% names(x)) warning(paste0("column '", id.name, "' overwritten by id index")) if (time.name %in% names(x)) warning(paste0("column '", time.name, "' overwritten by time index")) x[[id.name]] <- id <- as.factor(id) x[[time.name]] <- time <- as.factor(time) } } else{ # id.name is not numeric, i.e., individual index is supplied if (!id.name %in% names(x)) stop(paste("variable ", id.name, " does not exist (individual index)", sep="")) if (is.factor(x[[id.name]])){ id <- x[[id.name]] <- x[[id.name]][drop = TRUE] # drops unused levels of factor } else{ id <- x[[id.name]] <- as.factor(x[[id.name]]) } if (is.null(time.name)){ # if no time index is supplied, add time variable # automatically order data by individual index, necessary # for the automatic addition of time index to be # successful if no time index was supplied x <- x[order(x[[id.name]]), ] Ti <- table(x[[id.name]]) # was: Ti <- table(id) n <- length(Ti) time <- c() for (i in 1:n){ time <- c(time, 1:Ti[i]) } time.name <- "time" if (time.name %in% names(x)) warning(paste0("column '", time.name, "' overwritten by time index")) time <- x[[time.name]] <- as.factor(time) } else{ # use supplied time index if (!time.name %in% names(x)) stop(paste0("variable ", time.name, " does not exist (time index)")) if (is.factor(x[[time.name]])){ time <- x[[time.name]] <- x[[time.name]][drop = TRUE] } else{ time <- x[[time.name]] <- as.factor(x[[time.name]]) } } } # if present, make group variable a factor (just like for id and # time variables) if (!is.null(group.name)) { if (is.factor(x[[group.name]])){ group <- x[[group.name]] <- x[[group.name]][drop = TRUE] } else{ group <- x[[group.name]] <- as.factor(x[[group.name]]) } } # sort by group (if given), then by id, then by time if (! is.null(group.name)) x <- x[order(x[[group.name]], x[[id.name]], x[[time.name]]), ] else x <- x[order(x[[id.name]], x[[time.name]]), ] # if requested: drop unused levels from factor variables (spare # those serving for the index as their unused levels are dropped # already (at least in the attribute "index" they need to be # dropped b/c much code relies on it)) if (drop.unused.levels) { var.names <- setdiff(names(x), c(id.name, time.name, group.name)) for (i in var.names){ if (is.factor(x[[i]])){ x[[i]] <- droplevels(x[[i]]) } } } posindex <- match(c(id.name, time.name, group.name), names(x)) index <- unclass(x[ , posindex]) # unclass to list for speed in subsetting, make it data.frame again later if (drop.index) { x <- x[ , -posindex, drop = FALSE] if (ncol(x) == 0L) warning("after dropping of index variables, the pdata.frame contains 0 columns") } ### warn if duplicate couples test_doub <- table(index[[1L]], index[[2L]], useNA = "ifany") if (any(as.vector(test_doub[!is.na(rownames(test_doub)), !is.na(colnames(test_doub))]) > 1L)) warning(paste("duplicate couples (id-time) in resulting pdata.frame\n to find out which,", "use, e.g., table(index(your_pdataframe), useNA = \"ifany\")")) ### warn if NAs in index as likely not sane [not using check.NA because that outputs a line for each dimension -> not needed here] if (anyNA(index[[1L]]) || anyNA(index[[2L]]) || (if(length(index) == 3L) anyNA(index[[3L]]) else FALSE)) warning(paste0("at least one NA in at least one index dimension ", "in resulting pdata.frame\n to find out which, use, e.g., ", "table(index(your_pdataframe), useNA = \"ifany\")\n")) ### Could also remove rows with NA in any index' dimension # drop.rows <- is.na(index[[1L]]) | is.na(index[[2L]]) # if(ncol(index) == 3L) drop.rows <- drop.rows | is.na(index[[3L]]) # if((no.drop.rows <- sum(drop.rows)) > 0L) { # x <- x[!drop.rows, ] # index <- index[!drop.rows, ] # txt.drop.rows <- paste0(no.drop.rows, " row(s) dropped in resulting pdata.frame due to NA(s) in at least one index dimension") # warning(txt.drop.rows) # } if (row.names) { attr(x, "row.names") <- fancy.row.names(index) # NB: attr(x, "row.names") allows for duplicate rownames (as # opposed to row.names(x) <- something) # NB: no fancy row.names for index attribute (!?): # maybe because so it is possible to restore original row.names? } class(index) <- c("pindex", "data.frame") attr(x, "index") <- index class(x) <- c("pdata.frame", "data.frame") return(x) } #' @rdname pdata.frame #' @export "$<-.pdata.frame" <- function(x, name, value) { if (inherits(value, "pseries")){ # remove pseries features before adding value as a column to pdata.frame if (length(class(value)) == 1L) value <- unclass(value) else attr(value, "class") <- setdiff(class(value), "pseries") attr(value, "index") <- NULL } "$<-.data.frame"(x, name, value) } # NB: We don't have methods for [<-.pdata.frame and [[<-.pdata.frame, so these functions # dispatch to the respective data.frame methods which assign whatever is # handed over to the methods. Especially, if a pseries is handed over, this # results in really assigning a pseries to the pdata.frame in case of usage of # [<- and [[<-. This is inconsistent because the columns of a pdata.frame do not # have the 'pseries' features. # This can be seen by lapply(some_pdata.frame, class) after # assigning with the respective .data.frame methods # Extracting/subsetting method for class pseries, [.pseries, retaining the # pseries features. est cases are in tests/test_pdata.frame_subsetting.R. # # We do not provide a [[.pseries method in addition (note the double "["). Thus, # the base R method is used and behaviour for pseries is what one would expect # and is in line with base R, see ?Extract for [[ with atomic vectors: # "The usual form of indexing is [. [[ can be used to select a single element # dropping names, whereas [ keeps them, e.g., in c(abc = 123)[1]." # In addition, it also drops other attributes in base R, so applying [[ from # base R results in dropping names and index which is in line with what one # would expect for pseries. Example for base R behaviour: # a <- 1:10 # names(a) <- letters[1:10] # attr(a, "index") <- "some_index_attribute" # a[[3]] # drops names and attribute (a[3] keeps names and drops other attributes) ##### [.pseries is commented because it leads to headache when dplyr is loaded ### boiled down to pkg vctrs https://github.com/r-lib/vctrs/issues/1446 ### R.utils::detachPackage("dplyr") ### test_pure <- pcdtest(diff(log(price)) ~ diff(lag(log(price))) + diff(lag(log(price), 2)), data = php) ### ### library(dplyr) # first one will error with [.pseries, for plm 2.4-1 it gives a wrong result (lag is hijacked -> known case) ### test_dplyr <- pcdtest(diff(price) ~ diff(lag(price)), data = php) ### test_dplyr_plmlag <- pcdtest(diff(log(price)) ~ diff(plm::lag(log(price))) + diff(plm::lag(log(price), 2)), data = php) # save way ## ## ## @rdname pdata.frame ## @export # "[.pseries" <- function(x, ...) { # # ## use '...' instead of only one specific argument, because subsetting for # ## factors can have argument 'drop', e.g., x[i, drop=TRUE] see ?Extract.factor # index <- attr(x, "index") # # ## two sanity checks as [.pseries-subsetting was introduced in Q3/2021 and some packages # ## produced illegal pseries (these pkg errors were fixed by new CRAN releases but maybe # ## other code outhere produces illegal pseries, so leave these sanity checks in here for # ## a while, then remove (for speed) # if(is.null(index)) warning("pseries object with is.null(index(pseries)) == TRUE encountered") # if(!is.null(index) && !is.index(index)) warning(paste0("pseries object has illegal index with class(index) == ", paste0(class(index), collapse = ", "))) # # names_orig <- names(x) # keep_rownr <- seq_along(x) # full length row numbers original pseries # names(keep_rownr) <- names_orig # # if(is.null(names_orig)) { # names(x) <- keep_rownr # if no names are present, set names as integer sequence to identify rows to keep later # names(keep_rownr) <- keep_rownr # } # x <- remove_pseries_features(x) # result <- x[...] # actual subsetting # # # identify rows to keep in the index: # keep_rownr <- keep_rownr[names(result)] # row numbers to keep after subsetting # names(result) <- if(!is.null(names_orig)) names_orig[keep_rownr] else NULL # restore and subset original names if any # # # Subset index accordingly: # # Check if index is null is a workaround for R's data frame subsetting not # # stripping class pseries but its attributes for factor (for other data types, pseries class is dropped) # # see https://bugs.r-project.org/bugzilla/show_bug.cgi?id=18140 # if (!is.null(index)) { # index <- index[keep_rownr, ] # index <- droplevels(index) # drop unused levels (like in subsetting of pdata.frames) # } # # result <- add_pseries_features(result, index) # return(result) # } ## Non-exported internal function for subsetting of pseries. Can be used ## internally. ## While there is now a "proper" subsetting function for pseries, leave this ## subset_pseries for a while just to be safe (currently used in pcdtest()) subset_pseries <- function(x, ...) { ## use '...' instead of only one specific argument, because subsetting for ## factors can have argument 'drop', e.g., x[i, drop=TRUE] see ?Extract.factor index <- attr(x, "index") if(is.null(index)) warning("pseries object with is.null(index(pseries)) == TRUE encountered") if(!is.null(index) && !is.index(index)) warning(paste0("pseries object has illegal index with class(index) == ", paste0(class(index), collapse = ", "))) names_orig <- names(x) keep_rownr <- seq_along(x) # full length row numbers original pseries names(keep_rownr) <- names_orig if(is.null(names_orig)) { names(x) <- keep_rownr # if no names are present, set names as integer sequence to identify rows to keep later names(keep_rownr) <- keep_rownr } x <- remove_pseries_features(x) result <- x[...] # actual subsetting # identify rows to keep in the index: keep_rownr <- keep_rownr[names(result)] # row numbers to keep after subsetting names(result) <- if(!is.null(names_orig)) names_orig[keep_rownr] else NULL # restore and subset original names if any # Subset index accordingly: # Check if index is null is a workaround for R's data frame subsetting not # stripping class pseries but its attributes for factor (for other data types, pseries class is dropped) # see https://bugs.r-project.org/bugzilla/show_bug.cgi?id=18140 if(!is.null(index)) { index <- index[keep_rownr, ] index <- droplevels(index) # drop unused levels (like in subsetting of pdata.frames) } result <- add_pseries_features(result, index) return(result) } #' @rdname pdata.frame #' @export "[.pdata.frame" <- function(x, i, j, drop) { # signature of [.data.frame here missing.i <- missing(i) # missing is only guaranteed to yield correct results, missing.j <- missing(j) # if its argument was not modified before accessing it missing.drop <- missing(drop) # -> save information about missingness sc <- sys.call() # Nargs_mod to distinguish if called by [] (Nargs_mod == 2L); [,] (Nargs_mod == 3L); [,,] (Nargs_mod == 4L) Nargs_mod <- nargs() - (!missing.drop) ### subset index (and row names) appropriately: # subsetting data.frame by only j (x[ , j]) or missing j (x[i]) yields full-row # column(s) of data.frame, thus do not subset the index because it needs full rows (original index) # # subset index if: # * [i,j] (supplied i AND supplied j) (in this case: Nargs_mod == 3L (or 4L depending on present/missing drop)) # * [i, ] (supplied i AND missing j) (in this case: Nargs_mod == 3L (or 4L depending on present/missing drop)) # # do not subset index in all other cases (here are the values of Nargs_mod) # * [ ,j] (missing i AND j supplied) (Nargs_mod == 3L (or 4L depending on present/missing drop)) # * [i] (supplied i AND missing j) (Nargs_mod == 2L) [Nargs_mod distinguishes this case from the one where subsetting is needed!] # * [i, drop = TRUE/FALSE] (supplied i AND missing j) (Nargs_mod == 2L) # # => subset index (and row names) if: supplied i && Nargs_mod >= 3L index <- attr(x, "index") x.rownames <- row.names(x) if (!missing.i && Nargs_mod >= 3L) { iindex <- i if (is.character(iindex)) { # Kevin Tappe 2016-01-04 : in case of indexing (subsetting) a # pdata.frame by a character, the subsetting vector should be # converted to numeric by matching to the row names so that the # index can be correctly subsetted (by this numeric value). # Motivation: # Row names of the pdata.frame and row names of the pdata.frame's # index are not guaranteed to be the same! iindex <- match(iindex, rownames(x)) } # subset index and row names index <- "[.data.frame"(index, iindex, ) x.rownames <- x.rownames[iindex] # remove empty levels in index (if any) # NB: really do dropping of unused levels? Standard R behaviour is to leave the levels and not drop unused levels # Maybe the dropping is needed for functions like lag.pseries/lagt.pseries to work correctly? index <- droplevels(index) # NB: use droplevels() rather than x[drop = TRUE] as x[drop = TRUE] can also coerce mode! # old (up to rev. 251): index <- data.frame(lapply(index, function(x) x[drop = TRUE])) } ### end of subsetting index # delete attribute with old index first: # this preserves the order of the attributes because # order of non-standard attributes is scrambled by R's data.frame subsetting with `[.` # (need to add new index later anyway) attr(x, "index") <- NULL # Set class to "data.frame" first to avoid coercing which enlarges the (p)data.frame # (probably by as.data.frame.pdata.frame). # Coercing is the built-in behaviour for extraction from data.frames by "[." (see ?`[.data.frame`) # and it seems this cannot be avoided; thus we need to make sure, not to have any coercing going on # which adds extra data (such as as.matrix.pseries, as.data.frame.pdata.frame) by setting the class # to "data.frame" first class(x) <- "data.frame" # call [.data.frame exactly as [.pdata.frame was called but arg is now 'x' # this is necessary because there could be several missing arguments # use sys.call (and not match.call) because arguments other than drop may not be named # need to evaluate i, j, drop, if supplied, before passing on (do not pass on as the sys.call caught originally) sc_mod <- sc sc_mod[[1L]] <- quote(`[.data.frame`) sc_mod[[2L]] <- quote(x) if (!missing.i) sc_mod[[3L]] <- i # if present, i is always in pos 3 if (!missing.j) sc_mod[[4L]] <- j # if present, j is always in pos 4 if (!missing.drop) sc_mod[[length(sc)]] <- drop # if present, drop is always in last position (4 or 5, # depending on the call structure and whether missing j or not) mydata <- eval(sc_mod) if (is.null(dim(mydata))) { # if dim is NULL, subsetting did not return a data frame but a vector or a # factor or NULL (nothing more is left) if (is.null(mydata)) { # since R 3.4.0 NULL cannot have attributes, so special case it res <- NULL } else { # vector or factor -> make it a pseries res <- structure(mydata, names = x.rownames, index = index, class = unique(c("pseries", class(mydata)))) } } else { # subsetting returned a data.frame -> add attributes to make it a pdata.frame again res <- structure(mydata, index = index, class = c("pdata.frame", "data.frame")) } return(res) } #' @rdname pdata.frame #' @export "[[.pdata.frame" <- function(x, y) { index <- attr(x, "index") attr(x, "index") <- NULL class(x) <- "data.frame" result <- "[[.data.frame"(x, y) if (!is.null(result)){ # make extracted column a pseries # use this order for attributes to preserve original order of attributes for a pseries result <- structure(result, names = row.names(x), class = unique(c("pseries", class(result))), index = index ) } result } #' @rdname pdata.frame #' @export "$.pdata.frame" <- function(x, y) { "[[.pdata.frame"(x, paste(as.name(y))) } #' @rdname pdata.frame #' @export print.pdata.frame <- function(x, ...) { attr(x, "index") <- NULL class(x) <- "data.frame" # This is a workaround: print.data.frame cannot handle # duplicated row names which are currently possible for pdata frames if (anyDuplicated(rownames(x))) { print("Note: pdata.frame contains duplicated row names, thus original row names are not printed") rownames(x) <- NULL } print(x, ...) } # pseriesfy() takes a pdata.frame and makes each column a pseries # names of the pdata.frame are not added to the columns as base R's data.frames # do not allow for names in columns (but, e.g., a tibble does so since 3.0.0, # see https://github.com/tidyverse/tibble/issues/837) #' Turn all columns of a pdata.frame into class pseries. #' #' This function takes a pdata.frame and turns all of its columns into #' objects of class pseries. #' #' Background: Initially created pdata.frames have as columns the pure/basic #' class (e.g., numeric, factor, character). When extracting a column from such #' a pdata.frame, the extracted column is turned into a pseries. #' #' At times, it can be convenient to apply data transformation operations on #' such a `pseriesfy`-ed pdata.frame, see Examples. #' #' @name pseriesfy #' @param x an object of class `"pdata.frame"`, #' @param \dots further arguments (currently not used). #' @return A pdata.frame like the input pdata.frame but with all columns #' turned into pseries. #' @seealso [pdata.frame()], [plm::as.list()] #' @keywords attribute #' @export #' @examples #' library("plm") #' data("Grunfeld", package = "plm") #' pGrun <- pdata.frame(Grunfeld[ , 1:4], drop.index = TRUE) #' pGrun2 <- pseriesfy(pGrun) # pseriesfy-ed pdata.frame #' #' # compare classes of columns #' lapply(pGrun, class) #' lapply(pGrun2, class) #' #' # When using with() #' with(pGrun, lag(value)) # dispatches to base R's lag() #' with(pGrun2, lag(value)) # dispatches to plm's lag() respect. panel structure #' #' # When lapply()-ing #' lapply(pGrun, lag) # dispatches to base R's lag() #' lapply(pGrun2, lag) # dispatches to plm's lag() respect. panel structure #' #' # as.list(., keep.attributes = TRUE) on a non-pseriesfy-ed #' # pdata.frame is similar and dispatches to plm's lag #' lapply(as.list(pGrun, keep.attributes = TRUE), lag) #' pseriesfy <- function(x, ...) { if(!inherits(x, "pdata.frame")) stop("input 'x' needs to be a pdata.frame") ix <- attr(x, "index") nam <- attr(x, "row.names") pdf <- as.data.frame(lapply(x, function(col) add_pseries_features(col, ix))) class(pdf) <- c("pdata.frame", class(pdf)) attr(pdf, "index") <- ix rownames(pdf) <- nam return(pdf) } pseriesfy.collapse <- function(x, ...) { if(!inherits(x, "pdata.frame")) stop("input 'x' needs to be a pdata.frame") ix <- attr(x, "index") return(collapse::dapply(x, function(col) add_pseries_features(col, ix))) } # as.list.pdata.frame: # The default is to behave identical to as.list.data.frame. # This default is necessary, because some code relies on this # behaviour! Do not change this! # # as.list.data.frame does: # * unclass # * strips all classes but "list" # * strips row.names # # By setting argument keep.attributes = TRUE, the attributes of the pdata.frame # are preserved by as.list.pdata.frame: a list of pseries is returned # and lapply can be used as usual, now working on a list of pseries, e.g., # lapply(as.list(pdata.frame[ , your_cols], keep.attributes = TRUE), lag) # works as expected. #' @rdname pdata.frame #' @export as.list.pdata.frame <- function(x, keep.attributes = FALSE, ...) { if (!keep.attributes) { x <- as.list.data.frame(x) } else { # make list of pseries objects x_names <- names(x) x <- lapply(x_names, FUN = function(element, pdataframe){ "[[.pdata.frame"(x = pdataframe, y = element) }, pdataframe = x) names(x) <- x_names # note: this function is slower than the corresponding # as.list.data.frame function, # because we cannot simply use unclass() on the pdata.frame: # need to add index etc to all columns to get proper pseries # back => thus the extraction function "[[.pdata.frame" is used } return(x) } #' @rdname pdata.frame #' @export as.data.frame.pdata.frame <- function(x, row.names = NULL, optional = FALSE, keep.attributes = TRUE, ...) { index <- attr(x, "index") if(!keep.attributes) { attr(x, "index") <- NULL class(x) <- "data.frame" rownames(x) <- NULL } else { # make each column a pseries (w/o names) x <- lapply(x, function(z){ # names(z) <- row.names(x) # it is not possible to keep the names in the 'pseries'/ # in columns because the call to data.frame later deletes # the names attribute of columns (definition of data frame) attr(z, "index") <- index class(z) <- unique(c("pseries", class(z))) return(z) }) } if(is.null(row.names)) { # do as base::as.data.frame does for NULL x <- as.data.frame(x, row.names = NULL) } else { if(is.logical(row.names) && row.names == FALSE) { # set row names to integer sequence 1, 2, 3, ... x <- as.data.frame(x) row.names(x) <- NULL } if(is.logical(row.names) && row.names == TRUE) { # set fancy row names x <- as.data.frame(x) row.names(x) <- fancy.row.names(index) } if(is.character(row.names)) { x <- as.data.frame(x) row.names(x) <- row.names } if(!(isTRUE(row.names) || isFALSE(row.names) || is.character(row.names))) stop("argument 'row.names' is none of NULL, FALSE, TRUE, and not a character") # using row.names(x) <- "something" is safer (does not allow # duplicate row.names) than # attr(x,"row.names") <- "something" } return(x) } #' Check if an object is a pseries #' #' This function checks if an object qualifies as a pseries #' #' A `"pseries"` is a wrapper around a "basic class" (numeric, factor, #' logical, character, or complex). #' #' To qualify as a pseries, an object needs to have the following #' features: #' #' - class contains `"pseries"` and there are at least two classes #' (`"pseries"` and the basic class), #' #' - have an appropriate index attribute (defines the panel #' structure), #' #' - any of `is.numeric`, `is.factor`, `is.logical`, `is.character`, #' `is.complex` is `TRUE`. #' #' @param object object to be checked for pseries features #' #' @export #' @return A logical indicating whether the object is a pseries (`TRUE`) #' or not (`FALSE`). #' @seealso [pseries()] for some computations on pseries and some #' further links. #' @keywords attribute #' @examples #' #' # Create a pdata.frame and extract a series, which becomes a pseries #' data("EmplUK", package = "plm") #' Em <- pdata.frame(EmplUK) #' z <- Em$output #' #' class(z) # pseries as indicated by class #' is.pseries(z) # and confirmed by check #' #' # destroy index of pseries and re-check #' attr(z, "index") <- NA #' is.pseries(z) # now FALSE #' is.pseries <- function(object) { # checks if an object has the necessary features to qualify as a 'pseries' res <- TRUE if (!inherits(object, "pseries")) res <- FALSE # class 'pseries' is always on top of basic class: min 2 classes needed, if 2 classes "pseries" needs to be first entry if (!length(class(object)) >= 2L) res <- FALSE if (length(class(object)) == 2L && class(object)[1L] != "pseries") res <- FALSE if (!has.index(object)) res <- FALSE if (!any(c(is.numeric(object), is.factor(object), is.logical(object), is.character(object), is.complex(object)))) { res <- FALSE } return(res) } #' Check for the Dimensions of the Panel #' #' This function checks the number of individuals and time observations in the #' panel and whether it is balanced or not. #' #' `pdim` is called by the estimation functions and can be also used #' stand-alone. #' #' @name pdim #' @aliases pdim #' @param x a `data.frame`, a `pdata.frame`, a `pseries`, a #' `panelmodel`, or a `pgmm` object, #' @param y a vector, #' @param index see [pdata.frame()], #' @param \dots further arguments. #' @return An object of class `pdim` containing the following #' elements: #' #' \item{nT}{a list containing `n`, the number of individuals, `T`, #' the number of time observations, `N` the total number of #' observations,} #' #' \item{Tint}{a list containing two vectors (of type integer): `Ti` #' gives the number of observations for each individual and `nt` gives #' the number of individuals observed for each period,} #' #' \item{balanced}{a logical value: `TRUE` for a balanced panel, #' `FALSE` for an unbalanced panel,} #' #' \item{panel.names}{a list of character vectors: `id.names` contains #' the names of each individual and `time.names` contains the names of #' each period.} #' #' @note Calling `pdim` on an estimated `panelmodel` object #' and on the corresponding `(p)data.frame` used for this #' estimation does not necessarily yield the same result. When #' called on an estimated `panelmodel`, the number of #' observations (individual, time) actually used for model #' estimation are taken into account. When called on a #' `(p)data.frame`, the rows in the `(p)data.frame` are #' considered, disregarding any `NA`values in the dependent or #' independent variable(s) which would be dropped during model #' estimation. #' @export #' @author Yves Croissant #' @seealso [is.pbalanced()] to just determine balancedness #' of data (slightly faster than `pdim`),\cr #' [punbalancedness()] for measures of #' unbalancedness,\cr [nobs()], #' [pdata.frame()],\cr [pvar()] to check for #' each variable if it varies cross-sectionally and over time. #' @keywords attribute #' @examples #' #' # There are 595 individuals #' data("Wages", package = "plm") #' pdim(Wages, 595) #' #' # Gasoline contains two variables which are individual and time #' # indexes and are the first two variables #' data("Gasoline", package="plm") #' pdim(Gasoline) #' #' # Hedonic is an unbalanced panel, townid is the individual index #' data("Hedonic", package = "plm") #' pdim(Hedonic, "townid") #' #' # An example of the panelmodel method #' data("Produc", package = "plm") #' z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, #' model="random", subset = gsp > 5000) #' pdim(z) #' pdim <- function(x, ...) { UseMethod("pdim") } #' @rdname pdim #' @export pdim.default <- function(x, y, ...) { if (length(x) != length(y)) stop("The length of the two inputs differs\n") x <- x[drop = TRUE] # drop unused factor levels so that table() y <- y[drop = TRUE] # gives only needed combinations z <- table(x,y) Ti <- rowSums(z) # faster than: apply(z, 1, sum) nt <- colSums(z) # apply(z, 2, sum) n <- nrow(z) T <- ncol(z) N <- length(x) nT <- list(n = n, T = T, N = N) id.names <- rownames(z) time.names <- colnames(z) panel.names <- list(id.names = id.names, time.names = time.names) balanced <- if(any(as.vector(z) == 0)) FALSE else TRUE if(any(as.vector(z) > 1)) stop("duplicate couples (id-time)\n") Tint <- list(Ti = Ti, nt = nt) z <- list(nT = nT, Tint = Tint, balanced = balanced, panel.names = panel.names) class(z) <- "pdim" z } #' @rdname pdim #' @export pdim.data.frame <- function(x, index = NULL, ...) { x <- pdata.frame(x, index) index <- unclass(attr(x, "index")) pdim(index[[1L]], index[[2L]]) } #' @rdname pdim #' @export pdim.pdata.frame <- function(x,...) { index <- unclass(attr(x, "index")) pdim(index[[1L]], index[[2L]]) } #' @rdname pdim #' @export pdim.pseries <- function(x,...) { index <- unclass(attr(x, "index")) pdim(index[[1L]], index[[2L]]) } #' @rdname pdim #' @export pdim.pggls <- function(x, ...) { ## pggls is also class panelmodel, but take advantage of the pdim attribute in it attr(x, "pdim") } #' @rdname pdim #' @export pdim.pcce <- function(x, ...) { ## pcce is also class panelmodel, but take advantage of the pdim attribute in it attr(x, "pdim") } #' @rdname pdim #' @export pdim.pmg <- function(x, ...) { ## pmg is also class panelmodel, but take advantage of the pdim attribute in it attr(x, "pdim") } #' @rdname pdim #' @export pdim.pgmm <- function(x, ...) { ## pgmm is also class panelmodel, but take advantage of the pdim attribute in it attr(x, "pdim") } #' @rdname pdim #' @export pdim.panelmodel <- function(x, ...) { x <- model.frame(x) pdim(x) } #' @rdname pdim #' @export print.pdim <- function(x, ...) { if (x$balanced){ cat("Balanced Panel: ") cat(paste("n = ", x$nT$n, ", ", sep="")) cat(paste("T = ", x$nT$T, ", ", sep="")) cat(paste("N = ", x$nT$N, "\n", sep="")) } else{ cat("Unbalanced Panel: ") cat(paste("n = ", x$nT$n,", ", sep="")) cat(paste("T = ", min(x$Tint$Ti), "-", max(x$Tint$Ti), ", ", sep="")) cat(paste("N = ", x$nT$N, "\n", sep="")) } invisible(pdim) } #' Extract the indexes of panel data #' #' This function extracts the information about the structure of the #' individual and time dimensions of panel data. Grouping information #' can also be extracted if the panel data were created with a #' grouping variable. #' #' Panel data are stored in a `"pdata.frame"` which has an `"index"` #' attribute. Fitted models in `"plm"` have a `"model"` element which #' is also a `"pdata.frame"` and therefore also has an `"index"` #' attribute. Finally, each series, once extracted from a #' `"pdata.frame"`, becomes of class `"pseries"`, which also has this #' `"index"` attribute. `"index"` methods are available for all these #' objects. The argument `"which"` indicates which index should be #' extracted. If `which = NULL`, all indexes are extracted. `"which"` #' can also be a vector of length 1, 2, or 3 (3 only if the pdata #' frame was constructed with an additional group index) containing #' either characters (the names of the individual variable and/or of #' the time variable and/or the group variable or `"id"` and `"time"`) #' and `"group"` or integers (1 for the individual index, 2 for the #' time index, and 3 for the group index (the latter only if the pdata #' frame was constructed with such).) #' #' @name index.plm #' @aliases index #' @importFrom zoo index #' @export index #' @param x an object of class `"pindex"`, `"pdata.frame"`, #' `"pseries"` or `"panelmodel"`, #' @param which the index(es) to be extracted (see details), #' @param \dots further arguments. #' @return A vector or an object of class `c("pindex","data.frame")` #' containing either one index, individual and time index, or (any #' combination of) individual, time and group indexes. #' @author Yves Croissant #' @seealso [pdata.frame()], [plm()] #' @keywords attribute #' @examples #' #' data("Grunfeld", package = "plm") #' Gr <- pdata.frame(Grunfeld, index = c("firm", "year")) #' m <- plm(inv ~ value + capital, data = Gr) #' index(Gr, "firm") #' index(Gr, "time") #' index(Gr$inv, c(2, 1)) #' index(m, "id") #' #' # with additional group index #' data("Produc", package = "plm") #' pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) #' index(pProduc, 3) #' index(pProduc, "region") #' index(pProduc, "group") #' NULL #' @rdname index.plm #' @export index.pindex <- function(x, which = NULL, ...) { if (is.null(which)) { # if no specific index is requested, select all index variables which <- names(x) } else{ # catch case when someone enters "individual" albeit proper value is # "id" to extract individual index posindividual <- match("individual", which) if (! is.na(posindividual)) which[posindividual] <- "id" } if (length(which) > 3L) stop("the length of argument 'which' should be at most 3") if (is.numeric(which)){ if (! all(which %in% 1:3)) stop("if integer, argument 'which' should contain only 1, 2 and/or 3") if (ncol(x) == 2L && 3 %in% which) stop("no grouping variable, only 2 indexes") which <- names(x)[which] } nindex <- names(x) gindex <- c("id", "time") if (ncol(x) == 3L) gindex <- c(gindex, "group") if (any(! which %in% c(nindex, gindex))) stop("unknown variable") if ("id" %in% which) { which[which == "id"] <- names(x)[1L] if("id" %in% names(x)[-1L]) warning("an index variable not being the invidiual index is called 'id'. Likely, any results are distorted.") } if ("time" %in% which) { which[which == "time"] <- names(x)[2L] if("time" %in% names(x)[-2L]) warning("an index variable not being the time index is called 'time'. Likely, any results are distorted.") } if (ncol(x) == 3L) if ("group" %in% which) { which[which == "group"] <- names(x)[3L] if("group" %in% names(x)[-3L]) warning("an index variable not being the group index is called 'group'. Likely, any results are distorted.") } result <- x[ , which] result } #' @rdname index.plm #' @export index.pdata.frame <- function(x, which = NULL, ...) { anindex <- attr(x, "index") index(x = anindex, which = which) } #' @rdname index.plm #' @export index.pseries <- function(x, which = NULL, ...) { anindex <- attr(x, "index") index(x = anindex, which = which) } #' @rdname index.plm #' @export index.panelmodel <- function(x, which = NULL, ...) { anindex <- attr(x$model, "index") index(x = anindex, which = which) } is.index <- function(index) { # not exported, helper function # checks if the index is an index in the sense of package plm if(all(class(index) == c("pindex", "data.frame"))) TRUE else FALSE } has.index <- function(object) { # not exported, helper function # checks if an object has an index in sense of package plm # (esp. to distinguish from zoo::index() which always returns an index) index <- attr(object, "index") return(is.index(index)) } checkNA.index <- function(index, which = "all", error = TRUE) { # not exported, helper function # # check if any NA in indexes (all or specific dimension) # # index can be of class pindex (proper index attribute of pdata.frame/pseries # or a list of factors, thus can call checkNA.index(unclass(proper_index))) # which gives a speed up as the faster list-subetting is used (instead of the # relatively slower data.frame-subsetting) feedback <- if(error) stop else warning if(which == "all") { if(anyNA(index[[1L]])) feedback("NA in the individual index variable") if(anyNA(index[[2L]])) feedback("NA in the time index variable") n.index <- if(inherits(index, "pindex")) ncol(index) else length(index) # else-branche is list (for speed) if(n.index == 3L) { if(anyNA(index[[3L]])) feedback("NA in the group index variable") } } if(which == 1L) { if(anyNA(index[[1L]])) feedback("NA in the individual index variable") } if(which == 2L) { if(anyNA(index[[2L]])) feedback("NA in the time index variable") } if(which == 3L) { if(anyNA(index[[3L]])) feedback("NA in the group index variable") } } # pos.index: # not exported, helper function # # determines column numbers of the index variables in a pdata.frame # returns named numeric of length 2 or 3 with column numbers of the index variables # (1: individual index, 2: time index, if available 3: group index), # names are the names of the index variables # # returns c(NA, NA) / c(NA, NA, NA) if the index variables are not a column in the pdata.frame # (e.g., for pdata.frames created with drop.index = TRUE). # Cannot detect index variables if their columns names were changed after creation of the pdata.frame pos.index <- function(x, ...) { index <- attr(x, "index") index_names <- names(index) index_pos <- match(index_names, names(x)) names(index_pos) <- index_names return(index_pos) }plm/R/test_uroot.R0000644000176200001440000015752414161716755013630 0ustar liggesuserspadf <- function(x, exo = c("none", "intercept", "trend"), p.approx = NULL, ...){ # p-value approximation for tau distribution of (augmented) Dickey-Fuller test # as used in some panel unit root tests in purtest(). # # argument 'x' must be a numeric (can be length == 1 or >= 1) # # p-values approximation is performed by the method of MacKinnon (1994) or # MacKinnon (1996), the latter yielding better approximated p-values but # requires package 'urca'. # Default is NULL: check for availability of 'urca' and, if available, perform # MacKinnon (1996); fall back to MacKinnon (1994) if 'urca' is not available. # User can demand a specific method by setting the argument 'p.approx' to either # "MacKinnon1994" or "MacKinnon1996". exo <- match.arg(exo) # check if ellipsis (dots) has p.approx (could be passed from purtest()'s dots) # and if so, use p.approx from ellipsis dots <- list(...) if (!is.null(dots$p.approx)) p.approx <- dots$p.approx if (!is.null(p.approx) && !p.approx %in% c("MacKinnon1994", "MacKinnon1996")) stop(paste0("unknown argument value: p.approx = \"", p.approx, "\"")) # Check if package 'urca' is available on local machine. We placed 'urca' # in 'Suggests' rather than 'Imports' so that it is not an absolutely # required dependency.) ## Procedure for pkg check for pkg in 'Suggests' as recommended in ## Wickham, R packages (http://r-pkgs.had.co.nz/description.html). urca <- if(!requireNamespace("urca", quietly = TRUE)) FALSE else TRUE # default: if no p.approx specified by input (NULL), # use MacKinnon (1996) if 'urca' is available, else MacKinnon (1994) p.approx <- if(is.null(p.approx)) { if(urca) "MacKinnon1996" else "MacKinnon1994" } else p.approx if (!is.null(p.approx) && p.approx == "MacKinnon1996" && !urca) { # catch case when user demands MacKinnon (1996) per argument but 'urca' is unavailable warning("method MacKinnon (1996) requested via argument 'p.approx' but requires non-installed package 'urca'; falling back to MacKinnon (1994)") p.approx <- "MacKinnon1994" } if(p.approx == "MacKinnon1996") { # translate exo argument to what urca::punitroot expects punitroot.exo <- switch (exo, "none" = "nc", "intercept" = "c", "trend" = "ct") res <- urca::punitroot(x, N = Inf, trend = punitroot.exo) # return asymptotic value } if(p.approx == "MacKinnon1994") { # values from MacKinnon (1994), table 3, 4 small <- matrix(c(0.6344, 1.2378, 3.2496, 2.1659, 1.4412, 3.8269, 3.2512, 1.6047, 4.9588), nrow = 3, byrow = TRUE) small <- t(t(small) / c(1, 1, 100)) large <- matrix(c(0.4797, 9.3557, -0.6999, 3.3066, 1.7339, 9.3202, -1.2745, -1.0368, 2.5261, 6.1654, -3.7956, -6.0285), nrow = 3, byrow = TRUE) large <- t(t(large) / c(1, 10, 10, 100)) limit <- c(-1.04, -1.61, -2.89) rownames(small) <- rownames(large) <- names(limit) <- c("none", "intercept", "trend") c.x.x2 <- rbind(1, x, x ^ 2) psmall <- colSums(small[exo, ] * c.x.x2) plarge <- colSums(large[exo, ] * rbind(c.x.x2, x ^ 3)) res <- as.numeric(pnorm(psmall * (x <= limit[exo]) + plarge * (x > limit[exo]))) } attr(res, "p.approx") <- p.approx return(res) } ## END padf ## IPS (2003), table 3 for Wtbar statistic # x1: means without time trend from table 3 in IPS (2003) adj.ips.wtbar.x1 <- c( -1.504,-1.514,-1.522,-1.520,-1.526,-1.523,-1.527,-1.519,-1.524,-1.532, -1.488,-1.503,-1.516,-1.514,-1.519,-1.520,-1.524,-1.519,-1.522,-1.530, -1.319,-1.387,-1.428,-1.443,-1.460,-1.476,-1.493,-1.490,-1.498,-1.514, -1.306,-1.366,-1.413,-1.433,-1.453,-1.471,-1.489,-1.486,-1.495,-1.512, -1.171,-1.260,-1.329,-1.363,-1.394,-1.428,-1.454,-1.458,-1.470,-1.495, NA, NA,-1.313,-1.351,-1.384,-1.421,-1.451,-1.454,-1.467,-1.494, NA, NA, NA,-1.289,-1.331,-1.380,-1.418,-1.427,-1.444,-1.476, NA, NA, NA,-1.273,-1.319,-1.371,-1.411,-1.423,-1.441,-1.474, NA, NA, NA,-1.212,-1.266,-1.329,-1.377,-1.393,-1.415,-1.456 ) # x2: variances without time trend from table 3 in IPS (2003) adj.ips.wtbar.x2 <- c( 1.069,0.923,0.851,0.809,0.789,0.770,0.760,0.749,0.736,0.735, 1.255,1.011,0.915,0.861,0.831,0.803,0.781,0.770,0.753,0.745, 1.421,1.078,0.969,0.905,0.865,0.830,0.798,0.789,0.766,0.754, 1.759,1.181,1.037,0.952,0.907,0.858,0.819,0.802,0.782,0.761, 2.080,1.279,1.097,1.005,0.946,0.886,0.842,0.819,0.801,0.771, NA, NA,1.171,1.055,0.980,0.912,0.863,0.839,0.814,0.781, NA, NA, NA,1.114,1.023,0.942,0.886,0.858,0.834,0.795, NA, NA, NA,1.164,1.062,0.968,0.910,0.875,0.851,0.806, NA, NA, NA,1.217,1.105,0.996,0.929,0.896,0.871,0.818 ) # x3: means with time trend from table 3 in IPS (2003) adj.ips.wtbar.x3 <- c( -2.166,-2.167,-2.168,-2.167,-2.172,-2.173,-2.176,-2.174,-2.174,-2.177, -2.173,-2.169,-2.172,-2.172,-2.173,-2.177,-2.180,-2.178,-2.176,-2.179, -1.914,-1.999,-2.047,-2.074,-2.095,-2.120,-2.137,-2.143,-2.146,-2.158, -1.922,-1.977,-2.032,-2.065,-2.091,-2.117,-2.137,-2.142,-2.146,-2.158, -1.750,-1.823,-1.911,-1.968,-2.009,-2.057,-2.091,-2.103,-2.114,-2.135, NA, NA,-1.888,-1.955,-1.998,-2.051,-2.087,-2.101,-2.111,-2.135, NA, NA, NA,-1.868,-1.923,-1.995,-2.042,-2.065,-2.081,-2.113, NA, NA, NA,-1.851,-1.912,-1.986,-2.036,-2.063,-2.079,-2.112, NA, NA, NA,-1.761,-1.835,-1.925,-1.987,-2.024,-2.046,-2.088 ) # x4: variances with time trend from table 3 in IPS (2003) adj.ips.wtbar.x4 <- c( 1.132,0.869,0.763,0.713,0.690,0.655,0.633,0.621,0.610,0.597, 1.453,0.975,0.845,0.769,0.734,0.687,0.654,0.641,0.627,0.605, 1.627,1.036,0.882,0.796,0.756,0.702,0.661,0.653,0.634,0.613, 2.482,1.214,0.983,0.861,0.808,0.735,0.688,0.674,0.650,0.625, 3.947,1.332,1.052,0.913,0.845,0.759,0.705,0.685,0.662,0.629, NA, NA,1.165,0.991,0.899,0.792,0.730,0.705,0.673,0.638, NA, NA, NA,1.055,0.945,0.828,0.753,0.725,0.689,0.650, NA, NA, NA,1.145,1.009,0.872,0.786,0.747,0.713,0.661, NA, NA, NA,1.208,1.063,0.902,0.808,0.766,0.728,0.670 ) adj.ips.wtbar <- c(adj.ips.wtbar.x1, adj.ips.wtbar.x2, adj.ips.wtbar.x3, adj.ips.wtbar.x4) adj.ips.wtbar <- array(adj.ips.wtbar, dim = c(10, 9, 2, 2), dimnames = list( c(10, 15, 20, 25, 30, 40, 50, 60, 70, 100), 0:8, c("mean", "var"), c("intercept", "trend")) ) adj.ips.wtbar <- aperm(adj.ips.wtbar, c(2, 1, 3, 4)) ############### ## IPS (2003), table 2 (obvious typos (missing minus signs) corrected) # intercept 1% critical values critval.ips.tbar.int1 <- c( -3.79, -2.66, -2.54, -2.50, -2.46, -2.44, -2.43, -2.42, -2.42, -2.40, -2.40, -3.45, -2.47, -2.38, -2.33, -2.32, -2.31, -2.29, -2.28, -2.28, -2.28, -2.27, -3.06, -2.32, -2.24, -2.21, -2.19, -2.18, -2.16, -2.16, -2.16, -2.16, -2.15, -2.79, -2.14, -2.10, -2.08, -2.07, -2.05, -2.04, -2.05, -2.04, -2.04, -2.04, -2.61, -2.06, -2.02, -2.00, -1.99, -1.99, -1.98, -1.98, -1.98, -1.97, -1.97, -2.51, -2.01, -1.97, -1.95, -1.94, -1.94, -1.93, -1.93, -1.93, -1.93, -1.92, -2.20, -1.85, -1.83, -1.82, -1.82, -1.82, -1.81, -1.81, -1.81, -1.81, -1.81, -2.00, -1.75, -1.74, -1.73, -1.73, -1.73, -1.73, -1.73, -1.73, -1.73, -1.73) # intercept 5% critical values critval.ips.tbar.int5 <- c( -2.76, -2.28, -2.21, -2.19, -2.18, -2.16, -2.16, -2.15, -2.16, -2.15,-2.15, -2.57, -2.17, -2.11, -2.09, -2.08, -2.07, -2.07, -2.06, -2.06, -2.06,-2.05, -2.42, -2.06, -2.02, -1.99, -1.99, -1.99, -1.98, -1.98, -1.97, -1.98,-1.97, -2.28, -1.95, -1.92, -1.91, -1.90, -1.90, -1.90, -1.89, -1.89, -1.89,-1.89, -2.18, -1.89, -1.87, -1.86, -1.85, -1.85, -1.85, -1.85, -1.84, -1.84,-1.84, -2.11, -1.85, -1.83, -1.82, -1.82, -1.82, -1.81, -1.81, -1.81, -1.81,-1.81, -1.95, -1.75, -1.74, -1.73, -1.73, -1.73, -1.73, -1.73, -1.73, -1.73,-1.73, -1.84, -1.68, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67,-1.67) # intercept 10% critical values critval.ips.tbar.int10 <- c( -2.38, -2.10, -2.06, -2.04, -2.04, -2.02, -2.02, -2.02, -2.02, -2.02, -2.01, -2.27, -2.01, -1.98, -1.96, -1.95, -1.95, -1.95, -1.95, -1.94, -1.95, -1.94, -2.17, -1.93, -1.90, -1.89, -1.88, -1.88, -1.88, -1.88, -1.88, -1.88, -1.88, -2.06, -1.85, -1.83, -1.82, -1.82, -1.82, -1.81, -1.81, -1.81, -1.81, -1.81, -2.00, -1.80, -1.79, -1.78, -1.78, -1.78, -1.78, -1.78, -1.78, -1.77, -1.77, -1.96, -1.77, -1.76, -1.75, -1.75, -1.75, -1.75, -1.75, -1.75, -1.75, -1.75, -1.85, -1.70, -1.69, -1.69, -1.69, -1.69, -1.68, -1.68, -1.68, -1.68, -1.69, -1.77, -1.64, -1.64, -1.64, -1.64, -1.64, -1.64, -1.64, -1.64, -1.64, -1.64) # trend 1% critical values critval.ips.tbar.trend1 <- c( -8.12, -3.42, -3.21, -3.13, -3.09, -3.05, -3.03, -3.02, -3.00, -3.00, -2.99, -7.36, -3.20, -3.03, -2.97, -2.94, -2.93, -2.90, -2.88, -2.88, -2.87, -2.86, -6.44, -3.03, -2.88, -2.84, -2.82, -2.79, -2.78, -2.77, -2.76, -2.75, -2.75, -5.72, -2.86, -2.74, -2.71, -2.69, -2.68, -2.67, -2.65, -2.66, -2.65, -2.64, -5.54, -2.75, -2.67, -2.63, -2.62, -2.61, -2.59, -2.60, -2.59, -2.58, -2.58, -5.16, -2.69, -2.61, -2.58, -2.58, -2.56, -2.55, -2.55, -2.55, -2.54, -2.54, -4.50, -2.53, -2.48, -2.46, -2.45, -2.45, -2.44, -2.44, -2.44, -2.44, -2.43, -4.00, -2.42, -2.39, -2.38, -2.37, -2.37, -2.36, -2.36, -2.36, -2.36, -2.36) # trend 5% critical values critval.ips.tbar.trend5 <- c( -4.66, -2.98, -2.87, -2.82, -2.80, -2.79, -2.77, -2.76, -2.75, -2.75, -2.75, -4.38, -2.85, -2.76, -2.72, -2.70, -2.69, -2.68, -2.67, -2.67, -2.66, -2.66, -4.11, -2.74, -2.66, -2.63, -2.62, -2.60, -2.60, -2.59, -2.59, -2.58, -2.58, -3.88, -2.63, -2.57, -2.55, -2.53, -2.53, -2.52, -2.52, -2.52, -2.51, -2.51, -3.73, -2.56, -2.52, -2.49, -2.48, -2.48, -2.48, -2.47, -2.47, -2.46, -2.46, -3.62, -2.52, -2.48, -2.46, -2.45, -2.45, -2.44, -2.44, -2.44, -2.44, -2.43, -3.35, -2.42, -2.38, -2.38, -2.37, -2.37, -2.36, -2.36, -2.36, -2.36, -2.36, -3.13, -2.34, -2.32, -2.32, -2.31, -2.31, -2.31, -2.31, -2.31, -2.31, -2.31) # trend 10% critical values critval.ips.tbar.trend10 <- c( -3.73, -2.77, -2.70, -2.67, -2.65, -2.64, -2.63, -2.62, -2.63, -2.62, -2.62, -3.60, -2.68, -2.62, -2.59, -2.58, -2.57, -2.57, -2.56, -2.56, -2.55, -2.55, -3.45, -2.59, -2.54, -2.52, -2.51, -2.51, -2.50, -2.50, -2.50, -2.49, -2.49, -3.33, -2.52, -2.47, -2.46, -2.45, -2.45, -2.44, -2.44, -2.44, -2.44, -2.44, -3.26, -2.47, -2.44, -2.42, -2.41, -2.41, -2.41, -2.40, -2.40, -2.40, -2.40, -3.18, -2.44, -2.40, -2.39, -2.39, -2.38, -2.38, -2.38, -2.38, -2.38, -2.38, -3.02, -2.36, -2.33, -2.33, -2.33, -2.32, -2.32, -2.32, -2.32, -2.32, -2.32, -2.90, -2.30, -2.29, -2.28, -2.28, -2.28, -2.28, -2.28, -2.28, -2.28, -2.28) critval.ips.tbar <- c(critval.ips.tbar.int1, critval.ips.tbar.int5, critval.ips.tbar.int10, critval.ips.tbar.trend1, critval.ips.tbar.trend5, critval.ips.tbar.trend10) critval.ips.tbar <- array(critval.ips.tbar, dim = c(11, 8, 3, 2), dimnames = list( c(5, 10, 15, 20, 25, 30, 40, 50, 60, 70, 100), c(5, 7, 10, 15, 20, 25, 50, 100), c("1%", "5%", "10%"), c("intercept", "trend")) ) critval.ips.tbar <- aperm(critval.ips.tbar, c(2, 1, 3, 4)) ############### ## IPS (2003), table 1 # right hand pane of table 1 for Ztbar statistic adj.ips.zbar.time <- c(6, 7, 8, 9, 10, 15, 20, 25, 30, 40, 50, 100, 500, 1000, 2000) adj.ips.zbar.means <- c(-1.520, -1.514, -1.501, -1.501, -1.504, -1.514, -1.522, -1.520, -1.526, -1.523, -1.527, -1.532, -1.531, -1.529, -1.533) adj.ips.zbar.vars <- c(1.745, 1.414, 1.228, 1.132, 1.069, 0.923, 0.851, 0.809, 0.789, 0.770, 0.760, 0.735, 0.715, 0.707, 0.706) names(adj.ips.zbar.time) <- names(adj.ips.zbar.means) <- names(adj.ips.zbar.vars) <- adj.ips.zbar.time # left pane of table 1 [not used] adj.ips.zbarL.means <- c(-1.125, -1.178, -1.214, -1.244, -1.274, -1.349, -1.395, -1.423, -1.439, -1.463, -1.477, -1.504, -1.526, -1.526, -1.533) adj.ips.zbarL.vars <- c(0.497, 0.506, 0.506, 0.527, 0.521, 0.565, 0.592, 0.609, 0.623, 0.639, 0.656, 0.683, 0.704, 0.702, 0.706) ################ # table 2 in LLC (2002): mean and standard deviation adjustments Tn <- c( 25, 30, 35, 40, 45, 50, 60, 70, 80, 90, 100, 250, 500) v <- c(c( 0.004, 0.003, 0.002, 0.002, 0.001, 0.001, 0.001, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000), c( 1.049, 1.035, 1.027, 1.021, 1.017, 1.014, 1.011, 1.008, 1.007, 1.006, 1.005, 1.001, 1.000), c(-0.554, -0.546, -0.541, -0.537, -0.533, -0.531, -0.527, -0.524, -0.521, -0.520, -0.518, -0.509, -0.500), c( 0.919, 0.889, 0.867, 0.850, 0.837, 0.826, 0.810, 0.798, 0.789, 0.782, 0.776, 0.742, 0.707), c(-0.703, -0.674, -0.653, -0.637, -0.624, -0.614, -0.598, -0.587, -0.578, -0.571, -0.566, -0.533, -0.500), c( 1.003, 0.949, 0.906, 0.871, 0.842, 0.818, 0.780, 0.751, 0.728, 0.710, 0.695, 0.603, 0.500) ) adj.levinlin <- array(v, dim = c(13, 2, 3), dimnames = list(Tn, c("mu", "sigma"), c("none", "intercept", "trend"))) purtest.names.exo <- c(none = "None", intercept = "Individual Intercepts", trend = "Individual Intercepts and Trend") purtest.names.test <- c(levinlin = "Levin-Lin-Chu Unit-Root Test", ips = "Im-Pesaran-Shin Unit-Root Test", madwu = "Maddala-Wu Unit-Root Test", Pm = "Choi's modified P Unit-Root Test", invnormal = "Choi's Inverse Normal Unit-Root Test", logit = "Choi's Logit Unit-Root Test", hadri = "Hadri Test") ## General functions to transform series: YClags <- function(object, k = 3){ if (k > 0) sapply(1:k, function(x) c(rep(NA, x), object[1:(length(object)-x)])) else NULL } YCtrend <- function(object) 1:length(object) YCdiff <- function(object){ c(NA, object[2:length(object)] - object[1:(length(object)-1)]) } selectT <- function(x, Ts){ ## This function selects the length of the series as it is tabulated if (x %in% Ts) return(x) if (x < Ts[1L]){ warning("the time series is short") return(Ts[1L]) } if (x > Ts[length(Ts)]){ warning("the time series is long") return(Ts[length(Ts)]) } pos <- which((Ts - x) > 0)[1L] return(Ts[c(pos - 1, pos)]) } lagsel <- function(object, exo = c("intercept", "none", "trend"), method = c("Hall", "AIC", "SIC"), pmax = 10, dfcor = FALSE, fixedT = TRUE, ...){ # select the optimal number of lags using Hall method, AIC, or SIC method <- match.arg(method) y <- object Dy <- YCdiff(object) Ly <- c(NA, object[1:(length(object)-1)]) if (exo == "none") m <- NULL if (exo == "intercept") m <- rep(1, length(object)) if (exo == "trend") m <- cbind(1, YCtrend(object)) LDy <- YClags(Dy, pmax) decreasei <- TRUE i <- 0 narow <- 1:(pmax+1) if (method == "Hall"){ while(decreasei){ lags <- pmax - i if (!fixedT) narow <- 1:(lags+1) X <- cbind(Ly, LDy[ , 0:lags], m)[-narow, , drop = FALSE] y <- Dy[-narow] sres <- my.lm.fit(X, y, dfcor = dfcor) tml <- sres$coef[lags+1]/sres$se[lags+1] if (abs(tml) < 1.96 && lags > 0) i <- i + 1 else decreasei <- FALSE } } else{ l <- c() while(i <= pmax){ lags <- pmax - i if (!fixedT) narow <- 1:(lags+1) X <- cbind(Ly, LDy[ , 0:lags], m)[-narow, , drop = FALSE] y <- Dy[-narow] sres <- my.lm.fit(X, y, dfcor = dfcor) AIC <- if (method == "AIC") { log(sres$rss / sres$n) + 2 * sres$K / sres$n } else { log(sres$rss / sres$n) + sres$K * log(sres$n) / sres$n } l <- c(l, AIC) i <- i + 1 } lags <- pmax + 1 - which.min(l) } lags } ## END lagsel adj.levinlin.value <- function(l, exo = c("intercept", "none", "trend")){ ## extract the adjustment values for Levin-Lin-Chu test theTs <- as.numeric(dimnames(adj.levinlin)[[1L]]) Ts <- selectT(l, theTs) if (length(Ts) == 1L){ return(adj.levinlin[as.character(Ts), , exo]) } else{ low <- adj.levinlin[as.character(Ts[1L]), , exo] high <- adj.levinlin[as.character(Ts[2L]), , exo] return(low + (l - Ts[1L])/(Ts[2L] - Ts[1L]) * (high - low)) } } ## END adj.levinlin.value adj.ips.wtbar.value <- function(l = 30, lags = 2, exo = c("intercept", "trend")){ ## extract the adjustment values for Im-Pesaran-Shin test for Wtbar statistic (table 3 in IPS (2003)) if (!lags %in% 0:8) warning("lags should be an integer between 0 and 8") lags <- min(lags, 8) theTs <- as.numeric(dimnames(adj.ips.wtbar)[[2L]]) Ts <- selectT(l, theTs) if (length(Ts) == 1L){ # take value as in table return(adj.ips.wtbar[as.character(lags), as.character(Ts), , exo]) } else{ # interpolate value from table low <- adj.ips.wtbar[as.character(lags), as.character(Ts[1L]), , exo] high <- adj.ips.wtbar[as.character(lags), as.character(Ts[2L]), , exo] return(low + (l - Ts[1L])/(Ts[2L] - Ts[1L]) * (high - low)) } } ## END adj.ips.wtbar.value adj.ips.ztbar.value <- function(l = 30L, time, means, vars){ ## extract the adjustment values for Im-Pesaran-Shin test's Ztbar statistic ## from table 1, right hand pane in IPS (2003) fed by arguments means and vars Ts <- selectT(l, time) if (length(Ts) == 1L){ # take value as in table return(c("mean" = means[as.character(Ts)], "var" = vars[as.character(Ts)])) } else{ # interpolate value from table low <- c("mean" = means[as.character(Ts[1L])], "var" = vars[as.character(Ts[1L])]) high <- c("mean" = means[as.character(Ts[2L])], "var" = vars[as.character(Ts[2L])]) return(low + (l - Ts[1L])/(Ts[2L] - Ts[1L]) * (high - low)) } } ## END adj.ips.ztbar.value critval.ips.tbar.value <- function(ind = 10L, time = 19L, critvals, exo = c("intercept", "trend")){ ## extract and interpolate 1%, 5%, 10% critical values for Im-Pesaran-Shin test's ## tbar statistic (table 2 in IPS (2003)) ## ## Interpolation is based on inverse distance weighting (IDW) of ## L1 distance (1d case) and L2 distance (euclidean distance) (2d case) ## (optical inspections shows this method is a good approximation) theInds <- as.numeric(dimnames(critvals)[[1L]]) theTs <- as.numeric(dimnames(critvals)[[2L]]) Inds <- selectT(ind, theInds) Ts <- selectT(time, theTs) exo <- match.arg(exo) if(length(Inds) == 1L && length(Ts) == 1L) { # exact hit for individual AND time: take value as in table return(critvals[as.character(Inds), as.character(Ts), , exo]) } else{ if(length(Inds) == 1L || length(Ts) == 1L) { # exact hit for individual (X)OR time: interpolate other dimension if(length(Inds) == 1L) { low <- critvals[as.character(Inds), as.character(Ts[1L]), , exo] high <- critvals[as.character(Inds), as.character(Ts[2L]), , exo] # L1 distances and inverse weighting for time dimension dist1 <- abs(time - Ts[1L]) dist2 <- abs(time - Ts[2L]) weight1 <- 1/dist1 weight2 <- 1/dist2 return ((weight1 * low + weight2 * high ) / (weight1 + weight2)) } if(length(Ts) == 1L) { # L1 distances and inverse weighting for individual dimension low <- critvals[as.character(Inds[1L]), as.character(Ts), , exo] high <- critvals[as.character(Inds[2L]), as.character(Ts), , exo] dist1 <- abs(ind - Inds[1L]) dist2 <- abs(ind - Inds[2L]) weight1 <- 1/dist1 weight2 <- 1/dist2 return ((weight1 * low + weight2 * high ) / (weight1 + weight2)) } } else { # only get to this part when both dimensions are not an exact hit: # 2d interpolate # extract the 4 critical values as basis of interpolation interpolate ("corners of box") crit4 <- critvals[as.character(Inds), as.character(Ts), , exo] dot <- c(ind, time) # point of interest m <- as.matrix(expand.grid(Inds, Ts)) colnames(m) <- c("ind", "time") dist <- lapply(1:4, function(x) m[x, ] - dot) dist <- vapply(dist, function(x) sqrt(as.numeric(crossprod(x))), 0.0, USE.NAMES = FALSE) weight <- 1/dist res <- ( crit4[as.character(Inds[1L]), as.character(Ts[1L]), ] * weight[1L] + crit4[as.character(Inds[2L]), as.character(Ts[1L]), ] * weight[2L] + crit4[as.character(Inds[1L]), as.character(Ts[2L]), ] * weight[3L] + crit4[as.character(Inds[2L]), as.character(Ts[2L]), ] * weight[4L]) / sum(weight) return(res) } } } ## END critval.ips.tbar.value tsadf <- function(object, exo = c("intercept", "none", "trend"), lags = NULL, dfcor = FALSE, comp.aux.reg = FALSE, ...){ # compute some ADF regressions for each time series y <- object L <- length(y) Dy <- YCdiff(object) Ly <- c(NA, object[1:(length(object) - 1)]) if(exo == "none") m <- NULL if(exo == "intercept") m <- rep(1, length(object)) if(exo == "trend") m <- cbind(1, YCtrend(object)) narow <- 1:(lags+1) LDy <- YClags(Dy, lags) X <- cbind(Ly, LDy, m)[-narow, , drop = FALSE] y <- Dy[- narow] result <- my.lm.fit(X, y, dfcor = dfcor) sigma <- result$sigma rho <- result$coef[1L] sdrho <- result$se[1L] trho <- rho/sdrho p.trho <- padf(trho, exo = exo, ...) result <- list(rho = rho, sdrho = sdrho, trho = trho, sigma = sigma, T = L, lags = lags, p.trho = p.trho) if(comp.aux.reg){ # for Levin-Lin-Chu test only, compute the residuals of the auxiliary # regressions X <- cbind(LDy[ , 0:lags], m)[-narow, , drop = FALSE] if(lags == 0 && exo == "none"){ resid.diff <- Dy[-narow]/sigma resid.level <- Ly[-narow]/sigma } else{ y <- Dy[-narow] resid.diff <- lm.fit(X, y)$residuals/sigma y <- Ly[-narow] resid.level <- lm.fit(X, y)$residuals/sigma } result$resid <- data.frame(resid.diff = resid.diff, resid.level = resid.level) } result } longrunvar <- function(x, exo = c("intercept", "none", "trend"), q = NULL){ # compute the long run variance of the dependent variable # q: lag truncation parameter: default (q == NULL) as in LLC, p. 14 # it can be seen from LLC, table 2, that round() was used to get an # integer from that formula (not, e.g., trunc) T <- length(x) if (is.null(q)) q <- round(3.21 * T^(1/3)) dx <- x[2:T] - x[1:(T-1)] if(exo == "intercept") dx <- dx - mean(dx) if(exo == "trend") dx <- lm.fit(cbind(1, 1:length(dx)), dx)$residuals dx <- c(NA, dx) res <- 1/(T-1)*sum(dx[-1]^2)+ 2*sum( sapply(1:q, function(L){ sum(dx[2:(T-L)] * dx[(L+2):T]) / (T-1) * (1 - L / (q+1)) } ) ) return(res) } hadritest <- function(object, exo, Hcons, dfcor, method, cl, args, data.name, ...) { ## used by purtest(<.>, test = "hadri"); non-exported function ## Hadri's test is applicable to balanced data only ## input 'object' is a list with observations per individual if(!is.list(object)) stop("argument 'object' in hadritest is supposed to be a list") if(exo == "none") stop("exo = \"none\" is not a valid option for Hadri's test") # determine L (= time periods), unique for balanced panel and number of individuals (n) if(length(L <- unique(vapply(object, length, FUN.VALUE = 0.0, USE.NAMES = FALSE))) > 1L) stop("Hadri test is not applicable to unbalanced panels") n <- length(object) if(exo == "intercept"){ # can use lm.fit here as NAs are dropped in beginning of 'purtest' resid <- lapply(object, function(x) lm.fit(matrix(1, nrow = length(x)), x)$residuals) adj <- c(1/6, 1/45) # xi, zeta^2 in eq. (17) in Hadri (2000) } if (exo == "trend"){ resid <- lapply(object, function(x) { lx <- length(x) dmat <- matrix(c(rep(1, lx), 1:lx), nrow = lx) # can use lm.fit here as NAs are dropped in beginning of 'purtest' lm.fit(dmat, x)$residuals }) adj <- c(1/15, 11/6300) # xi, zeta^2 in eq. (25) in Hadri (2000) } cumres2 <- lapply(resid, function(x) cumsum(x)^2) if (!dfcor) { sigma2 <- mean(unlist(resid, use.names = FALSE)^2) sigma2i <- vapply(resid, function(x) mean(x^2), FUN.VALUE = 0.0, USE.NAMES = FALSE) } else { # df correction as suggested in Hadri (2000), p. 157 dfcorval <- switch(exo, "intercept" = (L-1), "trend" = (L-2)) # -> apply to full length residuals over all individuals -> n*(L-1) or n*(L-2) sigma2 <- as.numeric(crossprod(unlist(resid, use.names = FALSE))) / (n * dfcorval) # -> apply to individual residuals' length, so just L -> L-1 or L-2 sigma2i <- vapply(resid, function(x) crossprod(x)/dfcorval, FUN.VALUE = 0.0, USE.NAMES = FALSE) } Si2 <- vapply(cumres2, function(x) sum(x), FUN.VALUE = 0.0, USE.NAMES = FALSE) numerator <- 1/n * sum(1/(L^2) * Si2) LM <- numerator / sigma2 # non-het consist case (Hcons == FALSE) LMi <- 1/(L^2) * Si2 / sigma2i # individual LM statistics if (Hcons) { LM <- mean(LMi) method <- paste0(method, " (Heterosked. Consistent)") } stat <- c(z = sqrt(n) * (LM - adj[1L]) / sqrt(adj[2L])) # eq. (14), (22) in Hadri (2000) pvalue <- pnorm(stat, lower.tail = FALSE) # is one-sided! was until rev. 572: 2*(pnorm(abs(stat), lower.tail = FALSE)) htest <- structure(list(statistic = stat, parameter = NULL, alternative = "at least one series has a unit root", # correct alternative (at least one unit root) data.name = data.name, method = method, p.value = pvalue), class = "htest") idres <- mapply(list, LMi, sigma2i, SIMPLIFY = FALSE) idres <- lapply(idres, setNames, c("LM", "sigma2")) result <- list(statistic = htest, call = cl, args = args, idres = idres) class(result) <- "purtest" return(result) } # END hadritest #' Unit root tests for panel data #' #' `purtest` implements several testing procedures that have been proposed #' to test unit root hypotheses with panel data. #' #' #' All these tests except `"hadri"` are based on the estimation of #' augmented Dickey-Fuller (ADF) regressions for each time series. A #' statistic is then computed using the t-statistics associated with #' the lagged variable. The Hadri residual-based LM statistic is the #' cross-sectional average of the individual KPSS statistics #' \insertCite{KWIA:PHIL:SCHM:SHIN:92;textual}{plm}, standardized by their #' asymptotic mean and standard deviation. #' #' Several Fisher-type tests that combine p-values from tests based on #' ADF regressions per individual are available: #' #' - `"madwu"` is the inverse chi-squared test #' \insertCite{MADDA:WU:99;textual}{plm}, also called P test by #' \insertCite{CHOI:01;textual}{plm}. #' #' - `"Pm"` is the modified P test proposed by #' \insertCite{CHOI:01;textual}{plm} for large N, #' #' - `"invnormal"` is the inverse normal test by \insertCite{CHOI:01;textual}{plm}, and #' #' - `"logit"` is the logit test by \insertCite{CHOI:01;textual}{plm}. #' #' The individual p-values for the Fisher-type tests are approximated #' as described in \insertCite{MACK:96;textual}{plm} if the package \CRANpkg{urca} #' (\insertCite{PFAFF:08;textual}{plm}) is available, otherwise as described in #' \insertCite{MACK:94;textual}{plm}. #' #' For the test statistic tbar of the test of Im/Pesaran/Shin (2003) #' (`ips.stat = "tbar"`), no p-value is given but 1%, 5%, and 10% critical #' values are interpolated from paper's tabulated values via inverse distance #' weighting (printed and contained in the returned value's element #' `statistic$ips.tbar.crit`). #' #' Hadri's test, the test of Levin/Lin/Chu, and the tbar statistic of #' Im/Pesaran/Shin are not applicable to unbalanced panels; the tbar statistic #' is not applicable when `lags > 0` is given. #' #' The exogeneous instruments of the tests (where applicable) can be specified #' in several ways, depending on how the data is handed over to the function: #' #' - For the `formula`/`data` interface (if `data` is a `data.frame`, #' an additional `index` argument should be specified); the formula #' should be of the form: `y ~ 0`, `y ~ 1`, or `y ~ trend` for a test #' with no exogenous variables, with an intercept, or with individual #' intercepts and time trend, respectively. The `exo` argument is #' ignored in this case. #' #' - For the `data.frame`, `matrix`, and `pseries` interfaces: in #' these cases, the exogenous variables are specified using the `exo` #' argument. #' #' With the associated `summary` and `print` methods, additional #' information can be extracted/displayed (see also Value). #' #' @aliases purtest #' @param object,x Either a `"data.frame"` or a matrix containing the #' time series (individuals as columns), a `"pseries"` object, a formula; #' a `"purtest"` object for the print and summary methods, #' @param data a `"data.frame"` or a `"pdata.frame"` object (required for #' formula interface, see Details and Examples), #' @param index the indexes, #' @param test the test to be computed: one of `"levinlin"` for #' \insertCite{LEVIN:LIN:CHU:02;textual}{plm}, `"ips"` for #' \insertCite{IM:PESAR:SHIN:03;textual}{plm}, `"madwu"` for #' \insertCite{MADDA:WU:99;textual}{plm}, `"Pm"` , `"invnormal"`, #' or `"logit"` for various tests as in #' \insertCite{CHOI:01;textual}{plm}, or `"hadri"` for #' \insertCite{HADR:00;textual}{plm}, see Details, #' @param exo the exogenous variables to introduce in the augmented #' Dickey--Fuller (ADF) regressions, one of: no exogenous #' variables (`"none"`), individual intercepts (`"intercept"`), or #' individual intercepts and trends (`"trend"`), but see Details, #' @param lags the number of lags to be used for the augmented #' Dickey-Fuller regressions: either a single value integer (the number of #' lags for all time series), a vector of integers (one for each #' time series), or a character string for an automatic #' computation of the number of lags, based on the AIC #' (`"AIC"`), the SIC (`"SIC"`), or on the method by #' \insertCite{HALL:94;textual}{plm} (`"Hall"`); argument is irrelevant #' for `test = "hadri"`, #' @param pmax maximum number of lags (irrelevant for `test = "hadri"`), #' @param Hcons logical, only relevant for `test = "hadri"`, #' indicating whether the heteroskedasticity-consistent test of #' \insertCite{HADR:00;textual}{plm} should be computed, #' @param q the bandwidth for the estimation of the long-run variance #' (only relevant for `test = "levinlin"`, the default (`q = NULL`) #' gives the value as suggested by the authors as round(3.21 * T^(1/3))), #' @param dfcor logical, indicating whether the standard deviation of #' the regressions is to be computed using a degrees-of-freedom #' correction, #' @param fixedT logical, indicating whether the individual ADF #' regressions are to be computed using the same number of #' observations (irrelevant for `test = "hadri"`), #' @param ips.stat `NULL` or character of length 1 to request a specific #' IPS statistic, one of `"Wtbar"` (also default if `ips.stat = NULL`), #' `"Ztbar"`, `"tbar"`, #' @param \dots further arguments (can set argument `p.approx` to be passed on #' to non-exported function `padf` to either `"MacKinnon1994"` or `"MacKinnon1996"` #' to force a specific method for p-value approximation, the latter only being #' possible if package 'urca' is installed). #' @return For purtest: An object of class `"purtest"`: a list with the elements #' named: #' - `"statistic"` (a `"htest"` object), #' - `"call"`, #' - `"args"`, #' - `"idres"` (containing results from the individual regressions), #' - `"adjval"` (containing the simulated means and variances needed to compute #' the statistic, for `test = "levinlin"` and `"ips"`, otherwise `NULL`), #' - `"sigma2"` (short-run and long-run variance for `test = "levinlin"`, otherwise NULL). #' @export #' @importFrom stats setNames #' @author Yves Croissant and for "Pm", "invnormal", and "logit" Kevin Tappe #' @seealso [cipstest()], [phansitest()] #' @references #' \insertAllCited{} #' #' @keywords htest # # TODO: add more examples / interfaces #' @examples #' #' data("Grunfeld", package = "plm") #' y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) # individuals in columns #' #' purtest(y, pmax = 4, exo = "intercept", test = "madwu") #' #' ## same via pseries interface #' pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) #' purtest(pGrunfeld$inv, pmax = 4, exo = "intercept", test = "madwu") #' #' ## same via formula interface #' purtest(inv ~ 1, data = Grunfeld, index = c("firm", "year"), pmax = 4, test = "madwu") #' purtest <- function(object, data = NULL, index = NULL, test = c("levinlin", "ips", "madwu", "Pm" , "invnormal", "logit", "hadri"), exo = c("none", "intercept", "trend"), lags = c("SIC", "AIC", "Hall"), pmax = 10, Hcons = TRUE, q = NULL, dfcor = FALSE, fixedT = TRUE, ips.stat = NULL, ...) { data.name <- paste(deparse(substitute(object))) id <- NULL if (inherits(object, "formula")){ # exo is derived from specified formula: terms <- terms(object) lab <- labels(terms) if(length(lab) == 0L){ if(attr(terms, "intercept")) exo <- "intercept" else exo <- "none" } else{ if(length(lab) > 1L || lab != "trend") stop("incorrect formula") exo <- "trend" } object <- paste(deparse(object[[2L]])) if(exists(object) && is.vector(get(object))){ # is.vector because, eg, inv exists as a function object <- get(object) } else{ if(is.null(data)) stop("unknown response") else{ if(!inherits(data, "data.frame")) stop("'data' does not specify a data.frame/pdata.frame") if(object %in% names(data)){ object <- data[[object]] if(!inherits(data, "pdata.frame")){ if(is.null(index)) stop("the index attribute is required") else data <- pdata.frame(data, index) } id <- unclass(attr(data, "index"))[[1L]] } else{ stop(paste0("unknown response (\"", object, "\" not in data)")) } } } } # END object is a formula else{ exo <- match.arg(exo) if(is.null(dim(object))){ if(inherits(object, "pseries")){ id <- unclass(attr(object, "index"))[[1L]] } else stop("the individual dimension is undefined") # cannot derive individual dimension from a vector if not pseries } if(is.matrix(object) || is.data.frame(object)) { if(!is.null(data)) stop("object is data.frame or matrix but argument 'data' is not NULL") if(is.matrix(object)) object <- as.data.frame(object) } } # by now, object is either a pseries to be split or a data.frame, code continues with list object <- na.omit(object) if(!is.null(attr(object, "na.action"))) warning("NA value(s) encountered and dropped, results may not be reliable") if(!inherits(object, "data.frame")){ if(is.null(id)) stop("the individual dimension is undefined") # adjust 'id' to correspond data in 'object' after NA dropping: if(!is.null(attr(object, "na.action"))) id <- id[-attr(object, "na.action")] object <- split(object, id) } else { if(!ncol(object) > 1L) warning("data.frame or matrix specified in argument object does not contain more than one individual (individuals are supposed to be in columns)") object <- as.list(object) } cl <- match.call() test <- match.arg(test) ips.stat <- if (is.null(ips.stat)) "Wtbar" else ips.stat # set default for IPS test if (is.character(lags)) lags <- match.arg(lags) # if character, match from list of possible values args <- list(test = test, exo = exo, pmax = pmax, lags = lags, dfcor = dfcor, fixedT = fixedT, ips.stat = ips.stat) n <- length(object) # number of individuals, assumes object is a list sigma2 <- NULL pvalues.trho <- NULL ips.tbar.crit <- NULL alternative <- "stationarity" method <- paste0(purtest.names.test[test], " (ex. var.: ", purtest.names.exo[exo],")") # If Hadri test, call function and exit early if(test == "hadri") return(hadritest(object, exo, Hcons, dfcor, method, cl, args, data.name, ...)) # compute the lags for each time series if necessary if(is.numeric(lags)){ if(length(lags) == 1L) lags <- rep(lags, n) else{ if(length(lags) != n) stop("lags should be of length 1 or n") else lags <- as.list(lags) } } else{ # lag selection procedure SIC, AIC, or Hall lag.method <- match.arg(lags) lags <- sapply(object, function(x) lagsel(x, exo = exo, method = lag.method, pmax = pmax, dfcor = dfcor, fixedT = fixedT)) } # compute the augmented Dickey-Fuller regressions for each time series comp.aux.reg <- (test == "levinlin") idres <- mapply(function(x, y) tsadf(x, exo = exo, lags = y, dfcor = dfcor, comp.aux.reg = comp.aux.reg, ...), object, as.list(lags), SIMPLIFY = FALSE) if (test == "levinlin"){ if (length(T.levinlin <- unique(vapply(object, length, FUN.VALUE = 0.0))) > 1L) stop("test = \"levinlin\" is not applicable to unbalanced panels") # get the adjustment parameters for the mean and the variance adjval <- adj.levinlin.value(T.levinlin, exo = exo) mymu <- adjval[1L] mysig <- adjval[2L] # calculate the ratio of LT/ST variance sigmaST <- sapply(idres, function(x) x[["sigma"]]) sigmaLT <- sqrt(sapply(object, longrunvar, exo = exo, q = q)) si <- sigmaLT/sigmaST # LLC (2002), formula 6 sbar <- mean(si) # stack the residuals of each time series and perform the pooled # regression res.level <- unlist(lapply(idres, function(x) x$resid[["resid.level"]]), use.names = FALSE) res.diff <- unlist(lapply(idres, function(x) x$resid[["resid.diff"]]), use.names = FALSE) z <- my.lm.fit(as.matrix(res.level), res.diff, dfcor = dfcor) # compute the Levin-Lin-Chu statistic tildeT <- T.levinlin - mean(lags) - 1 sigmaeps2 <- z$rss / (n * tildeT) rho <- z$coef sdrho <- z$se trho <- rho/sdrho stat <- (trho - n * tildeT * sbar / sigmaeps2 * sdrho * mymu)/mysig # LLC (2002), formula 12 names(stat) <- "z" # avoids a concatenated name like z.x1 pvalue <- pnorm(stat, lower.tail = TRUE) # need lower.tail = TRUE (like ADF one-sided to the left) parameter <- NULL sigma2 <- cbind(sigmaST^2, sigmaLT^2) colnames(sigma2) <- c("sigma2ST", "sigma2LT") pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0) } if(test == "ips"){ if(exo == "none") stop("exo = \"none\" is not a valid option for the Im-Pesaran-Shin test") if(!is.null(ips.stat) && !any(ips.stat %in% c("Wtbar", "Ztbar", "tbar"))) stop("argument 'ips.stat' must be one of \"Wtbar\", \"Ztbar\", \"tbar\"") lags <- vapply(idres, function(x) x[["lags"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) L.ips <- vapply(idres, function(x) x[["T"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) - lags - 1 trho <- vapply(idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) tbar <- mean(trho) parameter <- NULL adjval <- NULL if(is.null(ips.stat) || ips.stat == "Wtbar") { # calc Wtbar - default adjval <- mapply(function(x, y) adj.ips.wtbar.value(x, y, exo = exo), as.list(L.ips), as.list(lags)) Etbar <- mean(adjval[1L, ]) Vtbar <- mean(adjval[2L, ]) stat <- c("Wtbar" = sqrt(n) * (tbar - Etbar) / sqrt(Vtbar)) # (3.13) = (4.10) in IPS (2003) [same generic formula for Ztbar and Wtbar] pvalue <- pnorm(stat, lower.tail = TRUE) # need lower.tail = TRUE (like ADF one-sided to the left), was until rev. 577: 2*pnorm(abs(stat), lower.tail = FALSE) } if(!is.null(ips.stat) && ips.stat == "Ztbar") { # calc Ztbar adjval <- adjval.ztbar <- sapply(L.ips, adj.ips.ztbar.value, adj.ips.zbar.time, adj.ips.zbar.means, adj.ips.zbar.vars) rownames(adjval) <- rownames(adjval.ztbar) <- c("mean", "var") Etbar.ztbar <- mean(adjval.ztbar[1L, ]) Vtbar.ztbar <- mean(adjval.ztbar[2L, ]) stat <- stat.ztbar <- c("Ztbar" = sqrt(n) * (tbar - Etbar.ztbar) / sqrt(Vtbar.ztbar)) # (3.13) = (4.10) in IPS (2003) [same generic formula for Ztbar and Wtbar] pvalue <- pvalue.ztbar <- pnorm(stat.ztbar, lower.tail = TRUE) } if(!is.null(ips.stat) && ips.stat == "tbar") { # give tbar T.tbar <- unique(vapply(object, length, FUN.VALUE = 0.0, USE.NAMES = FALSE)) if(length(T.tbar) > 1L) stop("tbar statistic is not applicable to unbalanced panels") if(any(lags > 0L)) stop("tbar statistic is not applicable when 'lags' > 0 is specified") L.tbar <- T.tbar - 1 stat <- tbar names(stat) <- "tbar" pvalue <- NA ips.tbar.crit <- critval.ips.tbar.value(ind = n, time = L.tbar, critval.ips.tbar, exo = exo) adjval <- NULL } } if(test == "madwu"){ # Maddala/Wu (1999), pp. 636-637; Choi (2001), p. 253; Baltagi (2013), pp. 283-285 ## does not require a balanced panel trho <- vapply(idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) stat <- c(chisq = - 2 * sum(log(pvalues.trho))) n.madwu <- length(trho) parameter <- c(df = 2 * n.madwu) pvalue <- pchisq(stat, df = parameter, lower.tail = FALSE) adjval <- NULL } if(test == "Pm"){ ## Choi Pm (modified P) [proposed for large N] trho <- vapply(idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) n.Pm <- length(trho) # formula (18) in Choi (2001), p. 255: stat <- c( "Pm" = 1/(2 * sqrt(n.Pm)) * sum(-2 * log(pvalues.trho) - 2) ) # == -1/sqrt(n.Pm) * sum(log(pvalues.trho) +1) pvalue <- pnorm(stat, lower.tail = FALSE) # one-sided parameter <- NULL adjval <- NULL } if(test == "invnormal"){ # inverse normal test as in Choi (2001) trho <- vapply(idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) n.invnormal <- length(trho) stat <- c("z" = sum(qnorm(pvalues.trho)) / sqrt(n.invnormal)) # formula (9), Choi (2001), p. 253 pvalue <- pnorm(stat, lower.tail = TRUE) # formula (12), Choi, p. 254 parameter <- NULL adjval <- NULL } if(test == "logit"){ # logit test as in Choi (2001) trho <- vapply(idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) pvalues.trho <- vapply(idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) n.logit <- length(trho) l_stat <- c("L*" = sum(log(pvalues.trho / (1 - pvalues.trho)))) # formula (10), Choi (2001), p. 253 k <- (3 * (5 * n.logit + 4)) / (pi^2 * n.logit * (5 * n.logit + 2)) stat <- sqrt(k) * l_stat # formula (13), Choi (2001), p. 254 parameter <- c("df" = 5 * n.logit + 4) pvalue <- pt(stat, df = parameter, lower.tail = TRUE) adjval <- NULL } htest <- structure(list(statistic = stat, parameter = parameter, alternative = alternative, data.name = data.name, method = method, p.value = pvalue, ips.tbar.crit = ips.tbar.crit), class = "htest") result <- list(statistic = htest, call = cl, args = args, idres = idres, adjval = adjval, sigma2 = sigma2) class(result) <- "purtest" result } #' @rdname purtest #' @export print.purtest <- function(x, ...){ print(x$statistic, ...) if (x$args$test == "ips" && x$args$ips.stat == "tbar"){ cat("tbar critival values:\n") print(x$statistic$ips.tbar.crit, ...) } invisible(x) } #' @rdname purtest #' @export summary.purtest <- function(object, ...){ if(!object$args$test == "hadri"){ lags <- vapply(object$idres, function(x) x[["lags"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) L <- vapply(object$idres, function(x) x[["T"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) rho <- vapply(object$idres, function(x) x[["rho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) trho <- vapply(object$idres, function(x) x[["trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) p.trho <- vapply(object$idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) sumidres <- cbind("lags" = lags, "obs" = L - lags - 1, "rho" = rho, "trho" = trho, "p.trho" = p.trho) if (object$args$test == "ips" && !object$args$ips.stat == "tbar") { sumidres <- cbind(sumidres, t(object$adjval)) } if (object$args$test == "levinlin") { sumidres <- cbind(sumidres, object$sigma2) } } else { # hadri case LM <- vapply(object$idres, function(x) x[["LM"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) sigma2 <- vapply(object$idres, function(x) x[["sigma2"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) sumidres <- cbind("LM" = LM, "sigma2" = sigma2) } nam <- names(object$idres) rownames(sumidres) <- nam object$sumidres <- sumidres class(object) <- c("summary.purtest", "purtest") object } #' @rdname purtest #' @export print.summary.purtest <- function(x, ...){ cat(paste(purtest.names.test[x$args$test], "\n")) cat(paste("Exogenous variables:", purtest.names.exo[x$args$exo], "\n")) if (x$args$test != "hadri") { thelags <- vapply(x$idres, function(x) x[["lags"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) if (is.character(x$args$lags)){ lagselectionmethod <- if (x$args$lags == "Hall") "Hall's method" else x$args$lags cat(paste0("Automatic selection of lags using ", lagselectionmethod, ": ", min(thelags), " - ", max(thelags), " lags (max: ", x$args$pmax, ")\n")) } else{ cat("User-provided lags\n") } } if (x$args$test == "ips") { cat(paste(paste0("statistic (", x$args$ips.stat,"):"), round(x$statistic$statistic, 3), "\n")) } else { cat(paste("statistic:", round(x$statistic$statistic, 3), "\n")) } cat(paste("p-value:", round(x$statistic$p.value, 3), "\n")) if (x$args$test == "ips" && x$args$ips.stat == "tbar"){ cat("tbar critival values:\n") print(x$statistic$ips.tbar.crit, ...) } cat("\n") print(x$sumidres, ...) invisible(x) } #' Simes Test for unit roots in panel data #' #' Simes' test of intersection of individual hypothesis tests #' (\insertCite{SIMES:86;textual}{plm}) applied to panel unit root tests as suggested by #' \insertCite{HANCK:13;textual}{plm}. #' #' Simes' approach to testing is combining p-values from single hypothesis tests #' with a global (intersected) hypothesis. \insertCite{HANCK:13;textual}{plm} #' mentions it can be applied to any panel unit root test which yield a p-value #' for each individual series. #' The test is robust versus general patterns of cross-sectional dependence. #' #' Further, this approach allows to discriminate between individuals for which #' the individual H0 (unit root present for individual series) is rejected/is #' not rejected by Hommel's procedure (\insertCite{HOMM:88;textual}{plm}) for #' family-wise error rate control (FWER) at pre-specified significance level #' alpha via argument `alpha` (defaulting to `0.05`), i.e., it controls for the #' multiplicity in testing. #' #' The function `phansitest` takes as main input `object` either a plain numeric #' containing p-values of individual tests or a `purtest` object which holds #' a suitable pre-computed panel unit root test (one that produces p-values per #' individual series). #' #' The function's return value (see section Value) is a list with detailed #' evaluation of the applied Simes test. #' #' The associated `print` method prints a verbal evaluation. #' #' @aliases phansitest #' @param object either a numeric containing p-values of individual unit root #' test results (does not need to be sorted) or a suitable `purtest` object #' (as produced by `purtest()` for a test which gives p-values of the individuals #' (Hadri's test in `purtest` is not suitable)), #' @param alpha numeric, the pre-specified significance level (defaults to `0.05`), #' @param x an object of class `c("phansitest", "list")` as produced by #' `phansitest` to be printed, #' @param cutoff integer, cutoff value for printing of enumeration of individuals with #' rejected individual H0, for print method only, #' @param \dots further arguments (currently not used). #' #' @return For `phansitest`, an object of class `c("phansitest", "list")` which i #' s a list with the elements: #' - `id`: integer, the identifier of the individual (integer sequence referring to #' position in input), #' - `name`: character, name of the input's individual (if it has a name, #' otherwise "1", "2", "3", ...), #' - `p`: numeric, p-values as input (either the numeric or extracted from #' the purtest object), #' - `p.hommel`: numeric, p-values after Hommel's transformation, #' - `rejected`: logical, indicating for which individual the individual null #' hypothesis is rejected (`TRUE`)/non-rejected (`FALSE`) (after controlling #' for multiplicity), #' - `rejected.no`: integer, giving the total number of rejected individual series, #' - `alpha`: numeric, the input `alpha`. #' #' @export #' @importFrom stats p.adjust #' #' @author Kevin Tappe #' @seealso [purtest()], [cipstest()] #' #' @references #' \insertAllCited{} #' #' @keywords htest # #' @examples #' #' ### input is numeric (p-values) #' #### example from Hanck (2013), Table 11 (left side) #' pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050, #' 0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475) #' #' countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France", #' "Germany","Belgium","U.K.","Brazil","Australia","Netherlands", #' "Portugal","Canada", "Spain","Denmark","Switzerland","Japan") #' names(pvals) <- countries #' #' h <- phansitest(pvals) #' print(h) # (explicitly) prints test's evaluation #' print(h, cutoff = 3L) # print only first 3 rejected ids #' h$rejected # logical indicating the individuals with rejected individual H0 #' #' #' ### input is a (suitable) purtest object #' data("Grunfeld", package = "plm") #' y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) #' obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu") #' #' phansitest(obj) #' phansitest <- function(object, alpha = 0.05) { is.purtest <- if(inherits(object, "purtest")) TRUE else FALSE if(!is.purtest) { if(is.numeric(object)) { if(anyNA(object)) stop("input p-values in 'object' contain at least one NA/NaN value") n <- length(object) p <- object } else { stop("argument 'object' needs to specify either a 'purtest' object or a numeric") } } else { # purtest object if(object$args$test == "hadri") stop("phansitest() [Hanck/Simes' test] not possible for purtest objects based on Hadri's test") p <- vapply(object$idres, function(x) x[["p.trho"]], FUN.VALUE = 0.0, USE.NAMES = FALSE) n <- length(p) } id <- seq_len(n) names(id) <- if(!is.null(names(p))) names(p) else id p.hommel <- p.adjust(p, method = "hommel") rejected.ind <- p.hommel <= alpha # is TRUE for individual-H0-rejected individuals rejected.ind.no <- sum(rejected.ind) # number of rejected individuals res <- structure(list(id = id, name = names(id), p = p, p.hommel = p.hommel, rejected = rejected.ind, rejected.no = rejected.ind.no, alpha = alpha), class = c("phansitest", "list")) return(res) } phansi <- function(object, alpha = 0.05) { .Deprecated(new = "phansitest", msg = "function 'phansi' renamed to 'phansitest'. Change your code to use 'phansitest'.", old = "phansi") phansitest(object, alpha = alpha) } #' @rdname phansitest #' @export print.phansitest <- function(x, cutoff = 10L, ...) { if(round(cutoff) != cutoff) stop("Argument 'cutoff' has to be an integer") id <- x$id alpha <- x$alpha rej.ind <- x$rejected rej.ind.no <- x$rejected.no n <- length(rej.ind) H0.txt <- "H0: All individual series have a unit root\n" HA.txt <- "HA: Stationarity for at least some individuals\n" H0.rej.txt <- "H0 rejected (globally)" H0.not.rej.txt <- "H0 not rejected (globally)" test.txt <- " Simes Test as Panel Unit Root Test (Hanck (2013))" cat("\n") cat(paste0(" ", test.txt, "\n")) cat("\n") cat(H0.txt) cat(HA.txt) cat("\n") cat(paste0("Alpha: ", alpha, "\n")) cat(paste0("Number of individuals: ", n, "\n")) cat("\n") cat("Evaluation:\n") if(rej.ind.no > 0L) { cat(paste0(" ", H0.rej.txt, "\n")) cat("\n") if(rej.ind.no <= cutoff && cutoff >= 0L) { ind.cutoff <- paste0(paste0(id[rej.ind], collapse = ", ")) ind.txt <- paste0("Individual H0 rejected for ", rej.ind.no, " individual(s) (integer id(s)):\n") cat(paste0(" ", ind.txt)) cat(paste0(" ", ind.cutoff, "\n")) } else { # cut off enumeration of individuals if more than specified in cutoff if(cutoff > 0L) { ind.cutoff <- paste0(paste0(id[rej.ind][seq_len(cutoff)], collapse = ", "), ", ...") ind.txt <- paste0("Individual H0 rejected for ", rej.ind.no ," individuals, only first ", cutoff, " printed (integer id(s)):\n") cat(paste0(" ", ind.txt)) cat(paste0(" ", ind.cutoff, "\n")) } else cat(paste0(" Individual H0 rejected for ", rej.ind.no ," individuals. None printed as 'cutoff' set to ", cutoff, ".\n")) } } else { cat(paste0(" ", H0.rej.txt, "\n")) } invisible(x) } plm/R/detect_lin_dep_alias.R0000644000176200001440000002777314154734502015526 0ustar liggesusers# functions to aid in detecting linear dependent columns in the (transformed) # model matrix or estimated plm models: # * detect.lindep # * alias (the latter is a wrapper around alias.lm) # # doc file provides an extensive example how linear dependence can arise after # the data transformation, e. g., for within transformation ### detect.lindep.matrix, .data.frame, .plm #' Functions to detect linear dependence #' #' Little helper functions to aid users to detect linear dependent columns in a #' two-dimensional data structure, especially in a (transformed) model matrix - #' typically useful in interactive mode during model building phase. #' #' #' Linear dependence of columns/variables is (usually) readily avoided when #' building one's model. However, linear dependence is sometimes not obvious #' and harder to detect for less experienced applied statisticians. The so #' called "dummy variable trap" is a common and probably the best--known #' fallacy of this kind (see e. g. Wooldridge (2016), sec. 7-2.). When building #' linear models with `lm` or `plm`'s `pooling` model, linear #' dependence in one's model is easily detected, at times post hoc. #' #' However, linear dependence might also occur after some transformations of #' the data, albeit it is not present in the untransformed data. The within #' transformation (also called fixed effect transformation) used in the #' `"within"` model can result in such linear dependence and this is #' harder to come to mind when building a model. See **Examples** for two #' examples of linear dependent columns after the within transformation: ex. 1) #' the transformed variables have the opposite sign of one another; ex. 2) the #' transformed variables are identical. #' #' During `plm`'s model estimation, linear dependent columns and their #' corresponding coefficients in the resulting object are silently dropped, #' while the corresponding model frame and model matrix still contain the #' affected columns. The plm object contains an element `aliased` which #' indicates any such aliased coefficients by a named logical. #' #' Both functions, `detect.lindep` and `alias`, help to #' detect linear dependence and accomplish almost the same: #' `detect.lindep` is a stand alone implementation while #' `alias` is a wrapper around #' [stats::alias.lm()], extending the `alias` #' generic to classes `"plm"` and `"pdata.frame"`. #' `alias` hinges on the availability of the package #' \CRANpkg{MASS} on the system. Not all arguments of `alias.lm` #' are supported. Output of `alias` is more informative as it #' gives the linear combination of dependent columns (after data #' transformations, i. e., after (quasi)-demeaning) while #' `detect.lindep` only gives columns involved in the linear #' dependence in a simple format (thus being more suited for automatic #' post--processing of the information). #' #' @aliases detect.lindep #' @param object for `detect.lindep`: an object which should be checked #' for linear dependence (of class `"matrix"`, `"data.frame"`, or #' `"plm"`); for `alias`: either an estimated model of class #' `"plm"` or a `"pdata.frame"`. Usually, one wants to input a model #' matrix here or check an already estimated plm model, #' @param suppressPrint for `detect.lindep` only: logical indicating #' whether a message shall be printed; defaults to printing the message, i. e., #' to `suppressPrint = FALSE`, #' @param model (see `plm`), #' @param effect (see `plm`), #' @param \dots further arguments. #' @return For `detect.lindep`: A named numeric vector containing column #' numbers of the linear dependent columns in the object after data #' transformation, if any are present. `NULL` if no linear dependent #' columns are detected. #' #' For `alias`: return value of [stats::alias.lm()] run on the #' (quasi-)demeaned model, i. e., the information outputted applies to #' the transformed model matrix, not the original data. #' @note function `detect.lindep` was called `detect_lin_dep` #' initially but renamed for naming consistency later. #' @export #' @author Kevin Tappe #' @seealso [stats::alias()], [stats::model.matrix()] and especially #' `plm`'s [model.matrix()] for (transformed) model matrices, #' plm's [model.frame()]. #' @references #' #' \insertRef{WOOL:13}{plm} #' #' @keywords manip array #' @examples #' #' ### Example 1 ### #' # prepare the data #' data("Cigar" , package = "plm") #' Cigar[ , "fact1"] <- c(0,1) #' Cigar[ , "fact2"] <- c(1,0) #' Cigar.p <- pdata.frame(Cigar) #' #' # setup a formula and a model frame #' 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) #' detect.lindep(model.matrix(mf, model = "pooling")) #' # linear dependence present in the FE transformed model matrix #' modmat_FE <- model.matrix(mf, model = "within") #' detect.lindep(modmat_FE) #' mod_FE <- plm(form, data = Cigar.p, model = "within") #' detect.lindep(mod_FE) #' alias(mod_FE) # => fact1 == -1*fact2 #' plm(form, data = mf, model = "within")$aliased # "fact2" indicated as aliased #' #' # look at the data: after FE transformation fact1 == -1*fact2 #' head(modmat_FE) #' all.equal(modmat_FE[ , "fact1"], -1*modmat_FE[ , "fact2"]) #' #' ### Example 2 ### #' # Setup the data: #' # Assume CEOs stay with the firms of the Grunfeld data #' # for the firm's entire lifetime and assume some fictional #' # data about CEO tenure and age in year 1935 (first observation #' # in the data set) to be at 1 to 10 years and 38 to 55 years, respectively. #' # => CEO tenure and CEO age increase by same value (+1 year per year). #' data("Grunfeld", package = "plm") #' set.seed(42) #' # add fictional data #' Grunfeld$CEOtenure <- c(replicate(10, seq(from=s<-sample(1:10, 1), to=s+19, by=1))) #' Grunfeld$CEOage <- c(replicate(10, seq(from=s<-sample(38:65, 1), to=s+19, by=1))) #' #' # look at the data #' head(Grunfeld, 50) #' #' form <- inv ~ value + capital + CEOtenure + CEOage #' mf <- model.frame(pdata.frame(Grunfeld), form) #' # no linear dependent columns in original data/pooling model #' modmat_pool <- model.matrix(mf, model="pooling") #' detect.lindep(modmat_pool) #' mod_pool <- plm(form, data = Grunfeld, model = "pooling") #' alias(mod_pool) #' #' # CEOtenure and CEOage are linear dependent after FE transformation #' # (demeaning per individual) #' modmat_FE <- model.matrix(mf, model="within") #' detect.lindep(modmat_FE) #' mod_FE <- plm(form, data = Grunfeld, model = "within") #' detect.lindep(mod_FE) #' alias(mod_FE) #' #' # look at the transformed data: after FE transformation CEOtenure == 1*CEOage #' head(modmat_FE, 50) #' all.equal(modmat_FE[ , "CEOtenure"], modmat_FE[ , "CEOage"]) #' detect.lindep <- function(object, ...) { UseMethod("detect.lindep") } #' @rdname detect.lindep #' @method detect.lindep matrix #' @export detect.lindep.matrix <- function(object, suppressPrint = FALSE, ...) { if (!inherits(object, "matrix")) { stop("Input 'object' must be a matrix. Presumably, one wants a model matrix generated by some 'model.matrix' function.")} # do rank reduction to detect lin. dep. columns rank_rec <- sapply(1:ncol(object), function(col) qr(object[ , -col])$rank) if (diff(range(rank_rec)) == 0) { num <- NULL # return NULL if there is no linear dep. } else { num <- which(rank_rec == max(rank_rec)) names(num) <- colnames(object)[num] } if(!suppressPrint) { if(is.null(num)) { print("No linear dependent column(s) detected.") } else { print(paste0("Suspicious column number(s): ", paste(num, collapse = ", "))) print(paste0("Suspicious column name(s): ", paste(names(num), collapse = ", "))) } return(invisible(num)) } return(num) } #' @rdname detect.lindep #' @method detect.lindep data.frame #' @export detect.lindep.data.frame <- function(object, suppressPrint = FALSE, ...) { if (!inherits(object, "data.frame")) { stop("Input 'object' must be a data.frame")} return(detect.lindep.matrix(as.matrix(object), suppressPrint = suppressPrint, ...)) } #' @rdname detect.lindep #' @method detect.lindep plm #' @export detect.lindep.plm <- function(object, suppressPrint = FALSE, ...) { if (!inherits(object, "plm")) { stop("Input 'object' must be of class \"plm\"")} return(detect.lindep.matrix(model.matrix(object), suppressPrint = suppressPrint, ...)) } ### alias.plm, alias.pFormula # This is just a wrapper function to allow to apply the generic stats::alias on # plm objects and pFormulas with the _transformed data_ (the transformed model.matrix). # NB: arguments 'model' and 'effect' are not treated here. #' @rdname detect.lindep #' @export alias.plm <- function(object, ...) { dots <- list(...) if (!is.null(dots$inst.method)) stop("alias.plm/alias.pFormula: IV not supported") if (length(formula(object))[2] == 2) stop("alias.plm/alias.pFormula: IV not supported") # catch unsupported alias.lm args and convert if (!is.null(dots[["partial"]])) { if (dots[["partial"]]) { dots[["partial"]] <- FALSE warning("alias.plm/alias.pFormula: arg partial = TRUE not supported, changed to FALSE") } } if (!is.null(dots[["partial.pattern"]])) { if (dots[["partial.pattern"]]) { dots[["partial.pattern"]] <- FALSE warning("alias.plm/alias.pFormula: arg partial.pattern = TRUE not supported, changed to FALSE") } } X <- model.matrix(object) y <- pmodel.response(object) lm.fit.obj <- lm.fit(X, y) class(lm.fit.obj) <- "lm" lm.fit.obj$terms <- deparse(object$formula) ## use lm.fit rather than lm(): ## could estimate lm model with lm(), but takes more resources and ## need to remove extra classes "formula" for lm to prevent warning # form <- object$formula # form <- setdiff(class(form), c("pFormula", "Formula")) # Xdf <- as.data.frame(X) # ydf <- as.data.frame(y) # names(ydf) <- names(object$model)[1] # data <- cbind(ydf, Xdf) # lmobj <- lm(form, data = data) # return(stats::alias(lmobj)) return(stats::alias(lm.fit.obj, ... = dots)) } ## alias.pFormula <- function(object, data, ## model = c("pooling", "within", "Between", "between", ## "mean", "random", "fd"), ## effect = c("individual", "time", "twoways"), ## ...) { ## dots <- list(...) ## if (!is.null(dots$inst.method)) stop("alias.plm/alias.pFormula: IV not supported") ## model <- match.arg(model) ## effect <- match.arg(effect) ## formula <- object ## # check if object is already pFormula, try to convert if not ## if (!inherits(formula, "pFormula")) formula <- pFormula(formula) ## # check if data is already a model frame, convert to if not ## if (is.null(attr(data, "terms"))) { ## data <- model.frame.pFormula(pFormula(formula), data) ## } ## plmobj <- plm(formula, data = data, model = model, effect = effect, ...) ## # print(summary(plmobj)) ## return(alias(plmobj, ...)) ## } #' @rdname detect.lindep #' @export alias.pdata.frame <- function(object, model = c("pooling", "within", "Between", "between", "mean", "random", "fd"), effect = c("individual", "time", "twoways"), ...) { dots <- list(...) if (!is.null(dots$inst.method)) stop("alias.plm/alias.pFormula: IV not supported") model <- match.arg(model) effect <- match.arg(effect) # check if data is already a model frame, if not exit if (is.null(attr(object, "terms"))) stop("the argument must be a model.frame") formula <- attr(object, "formula") plmobj <- plm(formula, data = object, model = model, effect = effect, ...) return(alias(plmobj, ...)) } plm/R/est_plm.R0000644000176200001440000007606614164705200013047 0ustar liggesusersstarX <- function(formula, data, model, rhs = 1, effect){ # non-exported, used for IV estimations "am" and "bms" # produces a column per time period with the (transformed) data # NB: function is not symmetric in individual and time effect apdim <- pdim(data) amatrix <- model.matrix(data, model, effect, rhs) T <- apdim$nT$T # was (same): length(unique(index(data, 2L))) N <- apdim$nT$n # was (same): length(unique(index(data, 1L))) if (apdim$balanced){ result <- Reduce("cbind", lapply(seq_len(ncol(amatrix)), function(x) matrix(amatrix[ , x], ncol = T, byrow = TRUE)[rep(1:N, each = T), ])) } else{ # unbalanced Ti <- apdim$Tint$Ti result <- lapply(seq_len(ncol(amatrix)), function(x) structure(amatrix[ , x], index = index(data), class = c("pseries", class(amatrix[ , x])))) result <- Reduce("cbind", lapply(result, as.matrix)) result <- result[rep(1:N, times = Ti), ] result[is.na(result)] <- 0 } result } # Regards plm man page: some elements not listed here...: "assign", "contrast", # etc... \item{na.action}{if relevant, information about handling of # NAs by the model.frame function,} # NB: na.action is currently not included as it is not supported #' Panel Data Estimators #' #' Linear models for panel data estimated using the `lm` function on #' transformed data. #' #' `plm` is a general function for the estimation of linear panel #' models. It supports the following estimation methods: pooled OLS #' (`model = "pooling"`), fixed effects (`"within"`), random effects #' (`"random"`), first--differences (`"fd"`), and between #' (`"between"`). It supports unbalanced panels and two--way effects #' (although not with all methods). #' #' For random effects models, four estimators of the transformation #' parameter are available by setting `random.method` to one of #' `"swar"` \insertCite{SWAM:AROR:72}{plm} (default), `"amemiya"` #' \insertCite{AMEM:71}{plm}, `"walhus"` #' \insertCite{WALL:HUSS:69}{plm}, or `"nerlove"` #' \insertCite{NERLO:71}{plm} (see below for Hausman-Taylor instrumental #' variable case). #' #' For first--difference models, the intercept is maintained (which #' from a specification viewpoint amounts to allowing for a trend in #' the levels model). The user can exclude it from the estimated #' specification the usual way by adding `"-1"` to the model formula. #' #' Instrumental variables estimation is obtained using two--part #' formulas, the second part indicating the instrumental variables #' used. This can be a complete list of instrumental variables or an #' update of the first part. If, for example, the model is `y ~ x1 + #' x2 + x3`, with `x1` and `x2` endogenous and `z1` and `z2` external #' instruments, the model can be estimated with: #' #' \itemize{ #' \item `formula = y~x1+x2+x3 | x3+z1+z2`, #' \item `formula = y~x1+x2+x3 | . -x1-x2+z1+z2`. #' } #' #' If an instrument variable estimation is requested, argument #' `inst.method` selects the instrument variable transformation #' method: #' #' - `"bvk"` (default) for \insertCite{BALE:VARA:87;textual}{plm}, #' - `"baltagi"` for \insertCite{BALT:81;textual}{plm}, #' - `"am"` for \insertCite{AMEM:MACU:86;textual}{plm}, #' - `"bms"` for \insertCite{BREU:MIZO:SCHM:89;textual}{plm}. #' #' The Hausman--Taylor estimator \insertCite{HAUS:TAYL:81}{plm} is #' computed with arguments `random.method = "ht"`, `model = "random"`, #' `inst.method = "baltagi"` (the other way with only `model = "ht"` #' is deprecated). #' #' See also the vignettes for introductions to model estimations (and more) with #' examples. #' #' @aliases plm #' @param formula a symbolic description for the model to be #' estimated, #' @param x,object an object of class `"plm"`, #' @param data a `data.frame`, #' @param subset see [stats::lm()], #' @param weights see [stats::lm()], #' @param na.action see [stats::lm()]; currently, not fully #' supported, #' @param effect the effects introduced in the model, one of #' `"individual"`, `"time"`, `"twoways"`, or #' `"nested"`, #' @param model one of `"pooling"`, `"within"`, #' `"between"`, `"random"` `"fd"`, or `"ht"`, #' @param random.method method of estimation for the variance #' components in the random effects model, one of `"swar"` #' (default), `"amemiya"`, `"walhus"`, `"nerlove"`; for #' Hausman-Taylor estimation set to `"ht"` (see Details and Examples), #' @param random.models an alternative to the previous argument, the #' models used to compute the variance components estimations are #' indicated, #' @param random.dfcor a numeric vector of length 2 indicating which #' degree of freedom should be used, #' @param inst.method the instrumental variable transformation: one of #' `"bvk"`, `"baltagi"`, `"am"`, or `"bms"` (see also Details), #' @param index the indexes, #' @param restrict.matrix a matrix which defines linear restrictions #' on the coefficients, #' @param restrict.rhs the right hand side vector of the linear #' restrictions on the coefficients, #' @param digits number of digits for printed output, #' @param width the maximum length of the lines in the printed output, #' @param dx the half--length of the individual lines for the plot #' method (relative to x range), #' @param N the number of individual to plot, #' @param seed the seed which will lead to individual selection, #' @param within if `TRUE`, the within model is plotted, #' @param pooling if `TRUE`, the pooling model is plotted, #' @param between if `TRUE`, the between model is plotted, #' @param random if `TRUE`, the random effect model is plotted, #' @param formula. a new formula for the update method, #' @param evaluate a boolean for the update method, if `TRUE` the #' updated model is returned, if `FALSE` the call is returned, #' @param newdata the new data set for the `predict` method, #' @param \dots further arguments. #' #' @return An object of class `"plm"`. #' #' #' A `"plm"` object has the following elements : #' #' \item{coefficients}{the vector of coefficients,} #' \item{vcov}{the variance--covariance matrix of the coefficients,} #' \item{residuals}{the vector of residuals (these are the residuals #' of the (quasi-)demeaned model),} #' \item{weights}{(only for weighted estimations) weights as #' specified,} #' \item{df.residual}{degrees of freedom of the residuals,} #' \item{formula}{an object of class `"Formula"` describing the model,} #' \item{model}{the model frame as a `"pdata.frame"` containing the #' variables used for estimation: the response is in first column followed by #' the other variables, the individual and time indexes are in the 'index' #' attribute of `model`,} #' \item{ercomp}{an object of class `"ercomp"` providing the #' estimation of the components of the errors (for random effects #' models only),} #' \item{aliased}{named logical vector indicating any aliased #' coefficients which are silently dropped by `plm` due to #' linearly dependent terms (see also [detect.lindep()]),} #' \item{call}{the call.} #' #' #' It has `print`, `summary` and `print.summary` methods. The #' `summary` method creates an object of class `"summary.plm"` that #' extends the object it is run on with information about (inter alia) F #' statistic and (adjusted) R-squared of model, standard errors, t--values, and #' p--values of coefficients, (if supplied) the furnished vcov, see #' [summary.plm()] for further details. #' @import Formula #' @importFrom stats alias approx as.formula coef coefficients cor delete.response #' @importFrom stats deviance df.residual dnorm fitted formula lm lm.fit model.frame #' @importFrom stats model.matrix model.response model.weights na.omit pchisq pf #' @importFrom stats pnorm printCoefmat pt qnorm reshape resid residuals sd terms #' @importFrom stats update var vcov #' @importFrom grDevices heat.colors rainbow #' @importFrom graphics abline axis barplot legend lines plot points #' @export #' @author Yves Croissant #' @seealso [summary.plm()] for further details about the associated #' summary method and the "summary.plm" object both of which provide some model #' tests and tests of coefficients. [fixef()] to compute the fixed #' effects for "within" models (=fixed effects models). #' @references #' #' \insertRef{AMEM:71}{plm} #' #' \insertRef{AMEM:MACU:86}{plm} #' #' \insertRef{BALE:VARA:87}{plm} #' #' \insertRef{BALT:81}{plm} #' #' \insertRef{BALT:SONG:JUNG:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BREU:MIZO:SCHM:89}{plm} #' #' \insertRef{HAUS:TAYL:81}{plm} #' #' \insertRef{NERLO:71}{plm} #' #' \insertRef{SWAM:AROR:72}{plm} #' #' \insertRef{WALL:HUSS:69}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, index = c("state","year")) #' summary(zz) #' #' # replicates some results from Baltagi (2013), table 3.1 #' data("Grunfeld", package = "plm") #' p <- plm(inv ~ value + capital, #' data = Grunfeld, model = "pooling") #' #' wi <- plm(inv ~ value + capital, #' data = Grunfeld, model = "within", effect = "twoways") #' #' swar <- plm(inv ~ value + capital, #' data = Grunfeld, model = "random", effect = "twoways") #' #' amemiya <- plm(inv ~ value + capital, #' data = Grunfeld, model = "random", random.method = "amemiya", #' effect = "twoways") #' #' walhus <- plm(inv ~ value + capital, #' data = Grunfeld, model = "random", random.method = "walhus", #' effect = "twoways") #' #' # summary and summary with a furnished vcov (passed as matrix, #' # as function, and as function with additional argument) #' summary(wi) #' summary(wi, vcov = vcovHC(wi)) #' summary(wi, vcov = vcovHC) #' summary(wi, vcov = function(x) vcovHC(x, method = "white2")) #' #' #' ## nested random effect model #' # replicate Baltagi/Song/Jung (2001), p. 378 (table 6), columns SA, WH #' # == Baltagi (2013), pp. 204-205 #' data("Produc", package = "plm") #' pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) #' form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp #' summary(plm(form, data = pProduc, model = "random", effect = "nested")) #' summary(plm(form, data = pProduc, model = "random", effect = "nested", #' random.method = "walhus")) #' #' ## Instrumental variable estimations #' # replicate Baltagi (2013/2021), p. 133/162, table 7.1 #' data("Crime", package = "plm") #' FE2SLS <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + #' ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + #' lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) #' | . - lprbarr - lpolpc + ltaxpc + lmix, #' data = Crime, model = "within") #' G2SLS <- update(FE2SLS, model = "random", inst.method = "bvk") #' EC2SLS <- update(G2SLS, model = "random", inst.method = "baltagi") #' #' ## Hausman-Taylor estimator and Amemiya-MaCurdy estimator #' # replicate Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 #' data("Wages", package = "plm") #' ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + #' bluecol + ind + union + sex + black + ed | #' bluecol + south + smsa + ind + sex + black | #' wks + married + union + exp + I(exp ^ 2), #' data = Wages, index = 595, #' random.method = "ht", model = "random", inst.method = "baltagi") #' summary(ht) #' #' am <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + #' bluecol + ind + union + sex + black + ed | #' bluecol + south + smsa + ind + sex + black | #' wks + married + union + exp + I(exp ^ 2), #' data = Wages, index = 595, #' random.method = "ht", model = "random", inst.method = "am") #' summary(am) #' plm <- function(formula, data, subset, weights, na.action, effect = c("individual", "time", "twoways", "nested"), model = c("within", "random", "ht", "between", "pooling", "fd"), random.method = NULL, random.models = NULL, random.dfcor = NULL, inst.method = c("bvk", "baltagi", "am", "bms"), restrict.matrix = NULL, restrict.rhs = NULL, index = NULL, ...){ if (is.list(formula)){ # if the first argument is a list (of formulas), then call plmlist and early exit plmlist <- match.call(expand.dots = FALSE) plmlist[[1L]] <- as.name("plm.list") # eval in nframe and not the usual parent.frame(), relevant? nframe <- length(sys.calls()) plmlist <- eval(plmlist, sys.frame(which = nframe)) return(plmlist) } if ((! is.null(restrict.matrix) || ! is.null(restrict.rhs)) && ! is.list(formula)) { stop(paste0("arguments 'restrict.matrix' and 'restrict.rhs' cannot yet be used ", "for single equations")) } dots <- list(...) # match and check the effect and model arguments effect <- match.arg(effect) inst.method <- match.arg(inst.method) # note that model can be NA, in this case the model.frame is returned if (! anyNA(model)) model <- match.arg(model) if (! anyNA(model) && effect == "nested" && model != "random") { # input check for nested RE model stop(paste0("effect = \"nested\" only valid for model = \"random\", but input is model = \"", model, "\".")) } if (! anyNA(model) && model == "fd") { # input checks for FD model: give informative error messages as # described in footnote in vignette if (effect == "time") stop(paste("effect = \"time\" for first-difference model", "meaningless because cross-sections do not", "generally have a natural ordering")) if (effect == "twoways") stop(paste("effect = \"twoways\" is not defined", "for first-difference models")) } # Deprecated section # model = "ht" in plm() and pht() are no longer maintained, but working # -> call pht() and early exit if (! anyNA(model) && model == "ht"){ ht <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "index"), names(ht), 0) ht <- ht[c(1L, m)] ht[[1L]] <- as.name("pht") ht <- eval(ht, parent.frame()) return(ht) } # check whether data and formula are pdata.frame and Formula and if not # coerce them orig_rownames <- row.names(data) if (! inherits(data, "pdata.frame")) data <- pdata.frame(data, index) if (! inherits(formula, "Formula")) formula <- as.Formula(formula) # in case of 2-part formula, check whether the second part should # be updated, e.g., y ~ x1 + x2 + x3 | . - x2 + z becomes # y ~ x1 + x2 + x3 | x1 + x3 + z # use length(formula)[2] because the length is now a vector of length 2 # if (length(formula)[2] == 2) formula <- expand.formula(formula) # eval the model.frame cl <- match.call() mf <- match.call(expand.dots = FALSE) m <- match(c("data", "formula", "subset", "weights", "na.action"), names(mf), 0) mf <- mf[c(1L, m)] names(mf)[2:3] <- c("formula", "data") mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") # use the Formula and pdata.frame which were created if necessary (and not # the original formula / data) mf$formula <- data mf$data <- formula data <- eval(mf, parent.frame()) # preserve original row.names for data [also fancy rownames]; so functions # like pmodel.response(), model.frame(), model.matrix(), residuals() return # the original row.names eval(mf, parent.frame()) returns row.names as # character vector containing the "row_number" with incomplete observations # dropped row.names(data) <- orig_rownames[as.numeric(row.names(data))] # return the model.frame (via early exit) if model = NA, else estimate model if (is.na(model)){ attr(data, "formula") <- formula return(data) } # note that the model.frame has as attributes the Formula and the index # data.frame args <- list(model = model, effect = effect, random.method = random.method, random.models = random.models, random.dfcor = random.dfcor, inst.method = inst.method) result <- plm.fit(data, model, effect, random.method, random.models, random.dfcor, inst.method) result$call <- cl result$args <- args result } plm.fit <- function(data, model, effect, random.method, random.models, random.dfcor, inst.method){ formula <- attr(data, "formula") # check for 0 cases like in stats::lm.fit (e.g., due to NA dropping) if (nrow(data) == 0L) stop("0 (non-NA) cases") # if a random effect model is estimated, compute the error components if (model == "random"){ is.balanced <- is.pbalanced(data) estec <- ercomp(data, effect, method = random.method, models = random.models, dfcor = random.dfcor) sigma2 <- estec$sigma2 theta <- estec$theta if (length(formula)[2L] > 1L && effect == "twoways") stop(paste("Instrumental variable random effect estimation", "not implemented for two-ways panels")) } else theta <- NULL # For all models except the unbalanced twoways random model, the # estimator is obtained as a linear regression on transformed data if (! (model == "random" && effect == "twoways" && ! is.balanced)){ # extract the model.matrix and the model.response actually, this can be # done by providing model.matrix and pmodel.response's methods # to pdata.frames X <- model.matrix(data, rhs = 1, model = model, effect = effect, theta = theta, cstcovar.rm = "all") y <- pmodel.response(data, model = model, effect = effect, theta = theta) if (ncol(X) == 0L) stop("empty model") w <- model.weights(data) if (! is.null(w)){ if (! is.numeric(w)) stop("'weights' must be a numeric vector") if (any(w < 0 | is.na(w))) stop("missing or negative weights not allowed") X <- X * sqrt(w) y <- y * sqrt(w) } else w <- 1 # IV case: extract the matrix of instruments if necessary # (means here that we have a multi-parts formula) if (length(formula)[2L] > 1L) { if(!is.null(model.weights(data)) || any(w != 1)) stop("argument 'weights' not yet implemented for instrumental variable models") if ( ! (model == "random" && inst.method != "bvk")) { # FD/FE/BE IV and RE "bvk" IV estimator if (length(formula)[2L] == 2L) { W <- model.matrix(data, rhs = 2, model = model, effect = effect, theta = theta, cstcovar.rm = "all") } else { W <- model.matrix(data, rhs = c(2, 3), model = model, effect = effect, theta = theta, cstcovar.rm = "all") } } if (model == "random" && inst.method != "bvk") { # IV estimators RE "baltagi", "am", and "bms" X <- X / sqrt(sigma2["idios"]) y <- y / sqrt(sigma2["idios"]) W1 <- model.matrix(data, rhs = 2, model = "within", effect = effect, theta = theta, cstcovar.rm = "all") B1 <- model.matrix(data, rhs = 2, model = "Between", effect = effect, theta = theta, cstcovar.rm = "all") if (inst.method %in% c("am", "bms")) StarW1 <- starX(formula, data, rhs = 2, model = "within", effect = effect) if (length(formula)[2L] == 3L) { # eval. 3rd part of formula, if present W2 <- model.matrix(data, rhs = 3, model = "within", effect = effect, theta = theta, cstcovar.rm = "all") if (inst.method == "bms") StarW2 <- starX(formula, data, rhs = 3, model = "within", effect = effect) } else W2 <- StarW2 <- NULL # TODO: here, some weighting is done but prevented earlier by stop()?! # also: RE bvk/BE/FE IV do not have weighting code. if (inst.method == "baltagi") W <- sqrt(w) * cbind(W1, W2, B1) if (inst.method == "am") W <- sqrt(w) * cbind(W1, W2, B1, StarW1) if (inst.method == "bms") W <- sqrt(w) * cbind(W1, W2, B1, StarW1, StarW2) } if (ncol(W) < ncol(X)) stop("insufficient number of instruments") } # END all IV cases else W <- NULL # no instruments (no IV case) result <- mylm(y, X, W) df <- df.residual(result) vcov <- result$vcov aliased <- result$aliased # in case of a within estimation, correct the degrees of freedom if (model == "within"){ pdim <- pdim(data) card.fixef <- switch(effect, "individual" = pdim$nT$n, "time" = pdim$nT$T, "twoways" = pdim$nT$n + pdim$nT$T - 1 ) df <- df.residual(result) - card.fixef vcov <- result$vcov * df.residual(result) / df } result <- list(coefficients = coef(result), vcov = vcov, residuals = resid(result), weights = w, df.residual = df, formula = formula, model = data) if (is.null(model.weights(data))) result$weights <- NULL if (model == "random") result$ercomp <- estec } else { # random twoways unbalanced: pdim <- pdim(data) TS <- pdim$nT$T theta <- estec$theta$id phi2mu <- estec$sigma2["time"] / estec$sigma2["idios"] Dmu <- model.matrix( ~ unclass(index(data))[[2L]] - 1) attr(Dmu, "index") <- index(data) Dmu <- Dmu - theta * Between(Dmu, "individual") X <- model.matrix(data, rhs = 1, model = "random", effect = "individual", theta = theta) y <- pmodel.response(data, model = "random", effect = "individual", theta = theta) P <- solve(diag(TS) + phi2mu * crossprod(Dmu)) phi2mu.CPXDmu.P <- phi2mu * crossprod(X, Dmu) %*% P XPX <- crossprod(X) - phi2mu.CPXDmu.P %*% crossprod(Dmu, X) XPy <- crossprod(X, y) - phi2mu.CPXDmu.P %*% crossprod(Dmu, y) gamma <- solve(XPX, XPy)[ , , drop = TRUE] # residuals 'e' are not the residuals of a quasi-demeaned # model but of the 'outer' model e <- pmodel.response(data, model = "pooling", effect = effect) - as.numeric(model.matrix(data, rhs = 1, model = "pooling") %*% gamma) result <- list(coefficients = gamma, vcov = solve(XPX), formula = formula, model = data, ercomp = estec, df.residual = nrow(X) - ncol(X), residuals = e) # derive 'aliased' information (this is based on the assumption that # estimation fails anyway if singularities are present). aliased <- is.na(gamma) } result$assign <- attr(X, "assign") result$contrasts <- attr(X, "contrasts") result$args <- list(model = model, effect = effect) result$aliased <- aliased class(result) <- c("plm", "panelmodel") result } tss <- function(x, ...){ UseMethod("tss") } tss.default <- function(x){ # always gives centered TSS (= demeaned TSS) var(x) * (length(x) - 1) } tss.plm <- function(x, model = NULL){ if(is.null(model)) model <- describe(x, "model") effect <- describe(x, "effect") if(model == "ht") model <- "pooling" theta <- if(model == "random") x$ercomp$theta else NULL tss(pmodel.response(x, model = model, effect = effect, theta = theta)) } #' R squared and adjusted R squared for panel models #' #' This function computes R squared or adjusted R squared for plm objects. It #' allows to define on which transformation of the data the (adjusted) R #' squared is to be computed and which method for calculation is used. #' #' #' @param object an object of class `"plm"`, #' @param model on which transformation of the data the R-squared is to be #' computed. If `NULL`, the transformation used to estimate the model is #' also used for the computation of R squared, #' @param type indicates method which is used to compute R squared. One of\cr #' `"rss"` (residual sum of squares),\cr `"ess"` (explained sum of #' squares), or\cr `"cor"` (coefficient of correlation between the fitted #' values and the response), #' @param dfcor if `TRUE`, the adjusted R squared is computed. #' @return A numerical value. The R squared or adjusted R squared of the model #' estimated on the transformed data, e. g., for the within model the so called #' "within R squared". #' @seealso [plm()] for estimation of various models; #' [summary.plm()] which makes use of `r.squared`. #' @keywords htest #' @export #' @examples #' #' data("Grunfeld", package = "plm") #' p <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") #' r.squared(p) #' r.squared(p, dfcor = TRUE) #' r.squared <- function(object, model = NULL, type = c("cor", "rss", "ess"), dfcor = FALSE){ ## TODO: does not handle non-intercept models correctly ## see below r.squared_no_intercept if (is.null(model)) model <- describe(object, "model") effect <- describe(object, "effect") type <- match.arg(type) if (type == "cor"){ y <- pmodel.response(object, model = model, effect = effect) haty <- fitted(object, model = model, effect = effect) R2 <- cor(y, haty)^2 } if (type == "rss"){ R2 <- 1 - deviance(object, model = model) / tss(object, model = model) } if (type == "ess"){ haty <- fitted(object, model = model) mhaty <- mean(haty) ess <- as.numeric(crossprod((haty - mhaty))) R2 <- ess / tss(object, model = model) } ### adj. R2 Still wrong for models without intercept, e.g., pooling models # (but could be correct for within models, see comment below in function r.squared_no_intercept) if (dfcor) R2 <- 1 - (1 - R2) * (length(resid(object)) - 1) / df.residual(object) R2 } ## first try at r.squared adapted to be suitable for non-intercept models r.squared_no_intercept <- function(object, model = NULL, type = c("rss", "ess", "cor"), dfcor = FALSE){ if(is.null(model)) model <- describe(object, "model") effect <- describe(object, "effect") type <- match.arg(type) ## TODO: check what is sane for IV and what for within # [1L] as has.intercept returns > 1 boolean for IV models # TODO: to check if this is sane has.int <- if(model != "within") has.intercept(object)[1L] else FALSE if (type == "rss"){ # approach: 1 - RSS / TSS R2 <- if(has.int) { 1 - deviance(object, model = model) / tss(object, model = model) } else { # use non-centered (= non-demeaned) TSS 1 - deviance(object, model = model) / as.numeric(crossprod(pmodel.response(object, model = model))) } } if(type == "ess"){ # approach: ESS / TSS haty <- fitted(object, model = model) R2 <- if(has.int) { mhaty <- mean(haty) ess <- as.numeric(crossprod(haty - mhaty)) tss <- tss(object, model = model) ess / tss } else { # use non-centered (=non-demeaned) ESS and non-centered TSS ess <- as.numeric(crossprod(haty)) tss <- as.numeric(crossprod(pmodel.response(object, model = model))) ess / tss } } if(type == "cor"){ # approach: squared-correlation(dependent variable, predicted value), only for models with intercept if(!has.int) warning("for models without intercept, type = \"cor\" may not be sane") # TODO: tbd if warning is good # TODO: Check should this be for "cor" the original variable? This makes a difference for (at least) RE models! # and on the fitted values which are not given by fitted() for RE models # y <- pmodel.response(object, model = model, effect = effect) # haty <- fitted(object, model = model, effect = effect) y <- pmodel.response(object, model = "pooling") haty <- fitted_exp.plm(object) R2 <- cor(y, haty)^2 } # this takes care of the intercept # Still unclear, how the adjustment for within models should look like, # i.e., subtract 1 for intercept or not if(dfcor) R2 <- 1 - (1 - R2) * (length(resid(object)) - has.int) / df.residual(object) return(R2) } # describe function: extract characteristics of plm model describe <- function(x, what = c("model", "effect", "random.method", "inst.method", "transformation", "ht.method")){ what <- match.arg(what) cl <- x$args switch(what, "model" = if(!is.null(cl$model)) cl$model else "within", "effect" = if(!is.null(cl$effect)) cl$effect else "individual", "random.method" = if(!is.null(cl$random.method)) cl$random.method else "swar", "inst.method" = if(!is.null(cl$inst.method)) cl$inst.method else "bvk", "transformation" = if(!is.null(cl$transformation)) cl$transformation else "d", "ht.method" = if(!is.null(cl$ht.method)) cl$ht.method else "ht" ) } plm/R/test_cips.R0000644000176200001440000006146614161714613013404 0ustar liggesusers## taken from pmg to estimate CIPS test statistic as "average of t's" ## since version 4: added type warning, and output single CADF ## regressions as well, use func gettvalue for speed. estimation loop ## for single TS models is now lm(formula, data) with 'data' properly ## subsetted; this allows for decent output of individual mods. ## needed for standalone operation: #plm <- plm:::plm #pdim <- plm:::pdim #model.matrix.plm <- plm:::model.matrix.plm #pmodel.response <- plm:::pmodel.response.plm ## Reference is ## Pesaran, M.H. (2007) A simple panel unit root test in the presence of ## cross-section dependence, Journal of Applied Econometrics, 22(2), pp. 265-312 #' Cross-sectionally Augmented IPS Test for Unit Roots in Panel Models #' #' Cross-sectionally augmented Im, Pesaran and Shin (IPS) test for #' unit roots in panel models. #' #' Pesaran's \insertCite{pes07}{plm} cross-sectionally augmented version of #' the IPS unit root test \insertCite{IM:PESAR:SHIN:03}{plm} (H0: `pseries` #' has a unit root) is a so-called second-generation panel unit root test: it #' is in fact robust against cross-sectional dependence, provided that the default #' `model="cmg"` is calculated. Else one can obtain the standard #' (`model="mg"`) or cross-sectionally demeaned (`model="dmg"`) #' versions of the IPS test. #' #' Argument `type` controls how the test is executed: #' - `"none"`: no intercept, no trend (Case I in \insertCite{pes07}{plm}), #' - `"drift"`: with intercept, no trend (Case II), #' - `"trend"` (default): with intercept, with trend (Case III). #' #' @param x an object of class `"pseries"`, #' @param lags integer, lag order for Dickey-Fuller augmentation, #' @param type one of `"trend"` (default), `"drift"`, `"none"`, #' @param model one of `"cmg"` (default), `"mg"`, `"dmg"`, #' @param truncated logical, specifying whether to calculate the #' truncated version of the test (default: `FALSE`), #' @param \dots further arguments passed to `critvals.cips` #' (non-exported function). #' @return An object of class `"htest"`. #' @author Giovanni Millo #' @export #' @seealso [purtest()], [phansitest()] #' @references #' #' \insertAllCited{} #' #' @aliases cipstest #' @keywords htest #' @examples #' #' data("Produc", package = "plm") #' Produc <- pdata.frame(Produc, index=c("state", "year")) #' ## check whether the gross state product (gsp) is trend-stationary #' cipstest(Produc$gsp, type = "trend") #' cipstest <- function (x, lags = 2, type = c("trend", "drift", "none"), model = c("cmg", "mg", "dmg"), truncated = FALSE, ...) { ## type = c("trend", "drift", "none") corresponds to Case III, II, I ## in Pesaran (2007), respectively. ## input checks if(!inherits(x, "pseries")) stop("Argument 'x' has to be a pseries") if(!is.numeric(lags)) stop("Argument 'lags' has to be an integer") # but accept numeric as well if(round(lags) != lags) stop("Argument 'lags' has to be an integer") # TODO: does 'lags' always need to be >= 1? if so, check for this, too dati <- pmerge(diff(x), lag(x)) dati <- pmerge(dati, diff(lag(x))) ## minimal column names indexnames <- c("ind", "tind") dimnames(dati)[[2L]][1:2] <- indexnames clnames <- c("de", "le", "d1e") dimnames(dati)[[2L]][3:5] <- clnames ## add lags if lags > 1 if(lags > 1L) { for(i in 2:lags) { dati <- pmerge(dati, diff(lag(x, i))) clnames <- c(clnames, paste("d", i, "e", sep = "")) } } dimnames(dati)[[2]][3:(lags+4)] <- clnames deterministic <- switch(match.arg(type), "trend" = {"+as.numeric(tind)"}, "drift" = {""}, "none" = {"-1"}) ## make formula adffm <- as.formula(paste("de~le+", paste(clnames[3:(lags+2)], collapse = "+"), deterministic, sep = "")) ## estimate preliminary pooling plm, to take care of all diffs ## and lags in a 'panel' way (would be lost in single TS regr.s) pmod <- plm(adffm, data = dati, model = "pooling") ## this as in pmg() index <- attr(model.frame(pmod), "index") ind <- index[[1L]] ## individual index tind <- index[[2L]] ## time index ## set dimension variables pdim <- pdim(pmod) balanced <- pdim$balanced nt <- pdim$Tint$nt Ti <- pdim$Tint$Ti T. <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N ## set index names time.names <- pdim$panel.names$time.names id.names <- pdim$panel.names$id.names coef.names <- names(coef(pmod)) ## number of coefficients k <- length(coef.names) ## CIPS test needs an ADF regression with k lags ## so fm <- has to be like diff(e) ~ lag(e)+diff(lag(e)) etc. ## model data, remove index and pseries attributes X <- model.matrix(pmod) attr(X, "index") <- NULL y <- as.numeric(model.response(model.frame(pmod))) ## det. *minimum* group numerosity t <- min(Ti) # == min(tapply(X[,1], ind, length)) ## check min. t numerosity ## NB it is also possible to allow estimation if there *is* one group ## with t large enough and average on coefficients removing NAs ## Here we choose the explicit way: let estimation fail if we lose df ## but a warning would do... if(t < (k+1)) stop("Insufficient number of time periods") ## one regression for each group i in 1..n ## and retrieve coefficients putting them into a matrix ## (might be unbalanced => t1!=t2 but we don't care as long ## as min(t)>k+1) ## "pre-allocate" models' list for the n models tmods <- vector("list", n) switch(match.arg(model), "mg" = { ## final data as dataframe, to be subset for single TS models ## (if 'trend' fix this variable's name) switch(match.arg(type), "trend" = { ## make datafr. removing intercept and add trend adfdati <- data.frame(cbind(y, X[ , -1L, drop = FALSE])) dimnames(adfdati)[[2L]] <- c(clnames, "trend") adffm <- update(adffm, . ~ . -as.numeric(tind) + trend)}, "drift" = { ## make df removing intercept adfdati <- data.frame(cbind(y, X[ , -1L, drop = FALSE])) dimnames(adfdati)[[2L]] <- clnames}, "none" = { ## just make df (intercept isn't there) adfdati <- data.frame(cbind(y, X)) dimnames(adfdati)[[2L]] <- clnames} ) ## for each x-sect. i=1..n unind <- unique(ind) for(i in 1:n) { tdati <- adfdati[ind == unind[i], ] tmods[[i]] <- lm(adffm, tdati, model = FALSE) # TODO: check if my.lm.fit can be used } # (with minor modifications to code down below for t-val extraction etc.) }, "dmg" = { ## demean (via means over group for each t) ## we do not care about demeaning the intercept or not as it is ## eliminated anyway demX <- Within(X, effect = tind, na.rm = TRUE) demy <- Within(y, effect = tind, na.rm = TRUE) ## final data as dataframe, to be subset for single TS models ## (if 'trend' fix this variable's name) switch(match.arg(type), "trend" = { ## make datafr. removing intercept and add trend adfdati <- data.frame(cbind(demy, demX[ , -1L, drop = FALSE])) dimnames(adfdati)[[2L]] <- c(clnames, "trend") adffm <- update(adffm, . ~ . -as.numeric(tind) + trend)}, "drift" = { ## make df removing intercept adfdati <- data.frame(cbind(demy, demX[ , -1L, drop = FALSE])) dimnames(adfdati)[[2L]] <- clnames}, "none" = { ## just make df (intercept isn't there) adfdati <- data.frame(cbind(demy, demX)) dimnames(adfdati)[[2L]] <- clnames}) ## for each x-sect. i=1..n estimate (over t) a demeaned model ## (y_it-my_t) = alpha_i + beta_i*(X_it-mX_t) + err_it unind <- unique(ind) for(i in 1:n) { tdati <- adfdati[ind == unind[i], ] tmods[[i]] <- lm(adffm, tdati, model = FALSE) # TODO: check if my.lm.fit can be used } }, "cmg" = { deterministic2 <- switch(match.arg(type), "trend" = {"+trend"}, "drift" = {""}, "none" = {"-1"}) ## adjust formula adffm <- as.formula(paste("de~le+", paste(clnames[3:(lags+2)], collapse = "+"), "+", paste(paste(clnames, "bar", sep = "."), collapse = "+"), deterministic2, sep = "")) ## between-periods transformation (take means over groups for each t) Xm <- Between(X, effect = tind, na.rm = TRUE) ym <- Between(y, effect = tind, na.rm = TRUE) ## final data as dataframe, to be subset for single TS models ## (purge intercepts etc., if 'trend' fix this variable's name) switch(match.arg(type), "trend" = { ## purge intercept, averaged intercept and averaged trend ## (the latter is always last col. of Xm) augX <- cbind(X[ , -1L, drop = FALSE], ym, Xm[ , -c(1L, dim(Xm)[[2L]]), drop = FALSE]) adfdati <- data.frame(cbind(y, augX)) dimnames(adfdati)[[2L]] <- c(clnames, "trend", paste(clnames, "bar", sep=".")) adffm <- update(adffm, . ~ . -as.numeric(tind) + trend)}, "drift" = { # remove intercepts augX <- cbind(X[ , -1L, drop = FALSE], ym, Xm[ , -1L, drop = FALSE]) adfdati <- data.frame(cbind(y, augX)) dimnames(adfdati)[[2L]] <- c(clnames, paste(clnames, "bar", sep="."))}, "none" = { ## no intercepts here, so none to be removed augX <- cbind(X, ym, Xm) adfdati <- data.frame(cbind(y, augX)) dimnames(adfdati)[[2L]] <- c(clnames, paste(clnames, "bar", sep=".")) }) ## for each x-sect. i=1..n estimate (over t) an augmented model ## y_it = alpha_i + beta_i*X_it + c1_i*my_t + c2_i*mX_t + err_it unind <- unique(ind) for(i in 1:n) { tdati <- adfdati[ind == unind[i], ] tmods[[i]] <- lm(adffm, tdati, model = FALSE) # TODO: check if my.lm.fit can be used } }) ## CIPS statistic as an average of the t-stats on the coefficient of 'le' tstats <- vapply(tmods, function(mod) gettvalue(mod, "le"), FUN.VALUE = 0.0, USE.NAMES = FALSE) if(truncated) { ## set bounds, Pesaran (2007), p. 277 ## NB: there is a typo in the paper (see p. 279/281 to confirm): ## Case I: "with an intercept or trend" -> "with_out_ an intercept or trend" ## "with_out_ an intercept or trend (Case I): K1 = 6.12, K2 = 4.16" ## "with an intercept and no trend (Case II): K1 = 6.19, K2 = 2.61" ## "with a linear trend (Case III): K1 = 6.42, K2 = 1.70" ## (use negative values for K1's to ease assignment if bound is reached) trbounds <- switch(match.arg(type), "none" = {c(-6.12, 4.16)}, "drift" = {c(-6.19, 2.61)}, "trend" = {c(-6.42, 1.70)}) ## formulae (34) in Pesaran (2007): ## truncate at lower bound tstats <- ifelse(tstats > trbounds[1L], tstats, trbounds[1L]) ## truncate at upper bound tstats <- ifelse(tstats < trbounds[2L], tstats, trbounds[2L]) } ## here allow for '...' to pass 'na.rm=TRUE' in case (but see what happens ## if unbalanced! cipstat <- mean(tstats, ...) #sum(tstats)/n pval <- critvals.cips(stat = cipstat, n= n, T. = T., type = type, truncated = truncated) ## if pval out of critical values' then set at boundary and issue ## a warning if(pval == "> 0.10") { pval <- 0.10 warning("p-value greater than printed p-value") } else if(pval == "< 0.01") { pval <- 0.01 warning("p-value smaller than printed p-value") } parameter <- lags names(parameter) <- "lag order" names(cipstat) <- "CIPS test" RVAL <- list(statistic = cipstat, parameter = parameter, data.name = paste(deparse(substitute(x))), tmods = tmods, method = "Pesaran's CIPS test for unit roots", alternative = "Stationarity", p.value = pval) class(RVAL) <- "htest" return(RVAL) } ## separate function computing critical values: critvals.cips <- function(stat, n, T., type = c("trend", "drift", "none"), truncated = FALSE) { ## auxiliary function for cipstest() ## extracts --or calculates by interpolation-- p-values for the ## (averaged) CIPS statistic depending on whether n and T, ## given the critical values of average of individual cross-sectionally ## augmented Dickey-Fuller distribution ## Non truncated version rnam <- c(10, 15, 20, 30, 50, 70, 100, 200) cnam <- rnam znam <- c(1, 5, 10) ## In all following tables N in rows, T in cols unlike Pesaran (2007) ## No intercept, no trend (Case I); Table II(a) Pesaran (2007), p. 279 ## 1% critical values nvals1 <- cbind( c(-2.16, -2.02, -1.93, -1.85, -1.78, -1.74, -1.71, -1.70), c(-2.03, -1.91, -1.84, -1.77, -1.71, -1.68, -1.66, -1.63), c(-2.00, -1.89, -1.83, -1.76, -1.70, -1.67, -1.65, -1.62), c(-1.98, -1.87, -1.80, -1.74, -1.69, -1.67, -1.64, -1.61), c(-1.97, -1.86, -1.80, -1.74, -1.69, -1.66, -1.63, -1.61), c(-1.95, -1.86, -1.80, -1.74, -1.68, -1.66, -1.63, -1.61), c(-1.94, -1.85, -1.79, -1.74, -1.68, -1.65, -1.63, -1.61), c(-1.95, -1.85, -1.79, -1.73, -1.68, -1.65, -1.63, -1.61) ) ## 5% critical values nvals5 <- cbind( c(-1.80, -1.71, -1.67, -1.61, -1.58, -1.56, -1.54, -1.53), c(-1.74, -1.67, -1.63, -1.58, -1.55, -1.53, -1.52, -1.51), c(-1.72, -1.65, -1.62, -1.58, -1.54, -1.53, -1.52, -1.50), c(-1.72, -1.65, -1.61, -1.57, -1.55, -1.54, -1.52, -1.50), c(-1.72, -1.64, -1.61, -1.57, -1.54, -1.53, -1.52, -1.51), c(-1.71, -1.65, -1.61, -1.57, -1.54, -1.53, -1.52, -1.51), c(-1.71, -1.64, -1.61, -1.57, -1.54, -1.53, -1.52, -1.51), c(-1.71, -1.65, -1.61, -1.57, -1.54, -1.53, -1.52, -1.51) ) ## 10% critical values nvals10 <- cbind( c(-1.61, -1.56, -1.52, -1.49, -1.46, -1.45, -1.44, -1.43), c(-1.58, -1.53, -1.50, -1.48, -1.45, -1.44, -1.44, -1.43), c(-1.58, -1.52, -1.50, -1.47, -1.45, -1.45, -1.44, -1.43), c(-1.57, -1.53, -1.50, -1.47, -1.46, -1.45, -1.44, -1.43), c(-1.58, -1.52, -1.50, -1.47, -1.45, -1.45, -1.44, -1.43), c(-1.57, -1.52, -1.50, -1.47, -1.46, -1.45, -1.44, -1.43), c(-1.56, -1.52, -1.50, -1.48, -1.46, -1.45, -1.44, -1.43), c(-1.57, -1.53, -1.50, -1.47, -1.45, -1.45, -1.44, -1.43) ) ## make critical values' cube nvals <- array(data = NA_real_, dim = c(8L, 8L, 3L)) nvals[ , , 1L] <- nvals1 nvals[ , , 2L] <- nvals5 nvals[ , , 3L] <- nvals10 dimnames(nvals) <- list(rnam, cnam, znam) ## Intercept only (Case II), Table II(b) in Pesaran (2007), p. 280 ## 1% critical values dvals1 <- cbind( c(-2.97, -2.76, -2.64, -2.51, -2.41, -2.37, -2.33, -2.28), c(-2.66, -2.52, -2.45, -2.34, -2.26, -2.23, -2.19, -2.16), c(-2.60, -2.47, -2.40, -2.32, -2.25, -2.20, -2.18, -2.14), c(-2.57, -2.45, -2.38, -2.30, -2.23, -2.19, -2.17, -2.14), c(-2.55, -2.44, -2.36, -2.30, -2.23, -2.20, -2.17, -2.14), c(-2.54, -2.43, -2.36, -2.30, -2.23, -2.20, -2.17, -2.14), c(-2.53, -2.42, -2.36, -2.30, -2.23, -2.20, -2.18, -2.15), c(-2.53, -2.43, -2.36, -2.30, -2.23, -2.21, -2.18, -2.15) ) ## 5% critical values dvals5 <- cbind( c(-2.52, -2.40, -2.33, -2.25, -2.19, -2.16, -2.14, -2.10), c(-2.37, -2.28, -2.22, -2.17, -2.11, -2.09, -2.07, -2.04), c(-2.34, -2.26, -2.21, -2.15, -2.11, -2.08, -2.07, -2.04), c(-2.33, -2.25, -2.20, -2.15, -2.11, -2.08, -2.07, -2.05), c(-2.33, -2.25, -2.20, -2.16, -2.11, -2.10, -2.08, -2.06), c(-2.33, -2.25, -2.20, -2.15, -2.12, -2.10, -2.08, -2.06), c(-2.32, -2.25, -2.20, -2.16, -2.12, -2.10, -2.08, -2.07), c(-2.32, -2.25, -2.20, -2.16, -2.12, -2.10, -2.08, -2.07) ) ## 10% critical values dvals10 <- cbind( c(-2.31, -2.22, -2.18, -2.12, -2.07, -2.05, -2.03, -2.01), c(-2.22, -2.16, -2.11, -2.07, -2.03, -2.01, -2.00, -1.98), c(-2.21, -2.14, -2.10, -2.07, -2.03, -2.01, -2.00, -1.99), c(-2.21, -2.14, -2.11, -2.07, -2.04, -2.02, -2.01, -2.00), c(-2.21, -2.14, -2.11, -2.08, -2.05, -2.03, -2.02, -2.01), c(-2.21, -2.15, -2.11, -2.08, -2.05, -2.03, -2.02, -2.01), c(-2.21, -2.15, -2.11, -2.08, -2.05, -2.03, -2.03, -2.02), c(-2.21, -2.15, -2.11, -2.08, -2.05, -2.04, -2.03, -2.02) ) ## make critical values' cube dvals <- array(data = NA_real_, dim = c(8L, 8L, 3L)) dvals[ , , 1L] <- dvals1 dvals[ , , 2L] <- dvals5 dvals[ , , 3L] <- dvals10 dimnames(dvals) <- list(rnam, cnam, znam) ## Intercept and trend (Case III), Table II(c) in Pesaran (2007), p. 281 ## 1% critical values tvals1 <- cbind( c(-3.88, -3.61, -3.46, -3.30, -3.15, -3.10, -3.05, -2.98), c(-3.24, -3.09, -3.00, -2.89, -2.81, -2.77, -2.74, -2.71), c(-3.15, -3.01, -2.92, -2.83, -2.76, -2.72, -2.70, -2.65), c(-3.10, -2.96, -2.88, -2.81, -2.73, -2.69, -2.66, -2.63), c(-3.06, -2.93, -2.85, -2.78, -2.72, -2.68, -2.65, -2.62), c(-3.04, -2.93, -2.85, -2.78, -2.71, -2.68, -2.65, -2.62), c(-3.03, -2.92, -2.85, -2.77, -2.71, -2.68, -2.65, -2.62), c(-3.03, -2.91, -2.85, -2.77, -2.71, -2.67, -2.65, -2.62) ) ## 5% critical values tvals5 <- cbind( c(-3.27, -3.11, -3.02, -2.94, -2.86, -2.82, -2.79, -2.75), c(-2.93, -2.83, -2.77, -2.70, -2.64, -2.62, -2.60, -2.57), c(-2.88, -2.78, -2.73, -2.67, -2.62, -2.59, -2.57, -2.55), c(-2.86, -2.76, -2.72, -2.66, -2.61, -2.58, -2.56, -2.54), c(-2.84, -2.76, -2.71, -2.65, -2.60, -2.58, -2.56, -2.54), c(-2.83, -2.76, -2.70, -2.65, -2.61, -2.58, -2.57, -2.54), c(-2.83, -2.75, -2.70, -2.65, -2.61, -2.59, -2.56, -2.55), c(-2.83, -2.75, -2.70, -2.65, -2.61, -2.59, -2.57, -2.55) ) ## 10% critical values tvals10 <- cbind( c(-2.98, -2.89, -2.82, -2.76, -2.71, -2.68, -2.66, -2.63), c(-2.76, -2.69, -2.65, -2.60, -2.56, -2.54, -2.52, -2.50), c(-2.74, -2.67, -2.63, -2.58, -2.54, -2.53, -2.51, -2.49), c(-2.73, -2.66, -2.63, -2.58, -2.54, -2.52, -2.51, -2.49), c(-2.73, -2.66, -2.63, -2.58, -2.55, -2.53, -2.51, -2.50), c(-2.72, -2.66, -2.62, -2.58, -2.55, -2.53, -2.52, -2.50), c(-2.72, -2.66, -2.63, -2.59, -2.55, -2.53, -2.52, -2.50), c(-2.73, -2.66, -2.63, -2.59, -2.55, -2.54, -2.52, -2.51) ) ## make critical values' cube tvals <- array(data = NA_real_, dim = c(8L, 8L, 3L)) tvals[ , , 1L] <- tvals1 tvals[ , , 2L] <- tvals5 tvals[ , , 3L] <- tvals10 dimnames(tvals) <- list(rnam, cnam, znam) ## if truncated substitute values according to Tables II(a), II(b), II(c) ## in Pesaran (2007) if(truncated) { # Case III (Intercept and trend) tvals[,1,1] <- -c(3.51, 3.31, 3.20, 3.10, 3.00, 2.96, 2.93, 2.88) # II(c), 1% tvals[,2,1] <- -c(3.21, 3.07, 2.98, 2.88, 2.80, 2.76, 2.74, 2.70) # II(c), 1% tvals[,1,2] <- -c(3.10, 2.97, 2.89, 2.82, 2.75, 2.73, 2.70, 2.67) # II(c), 5% tvals[,2,2] <- -c(2.92, 2.82, 2.76, 2.69, 2.64, 2.62, 2.59, 2.57) # II(c), 5% tvals[,1,3] <- -c(2.87, 2.78, 2.73, 2.67, 2.63, 2.60, 2.58, 2.56) # II(c), 10% tvals[,2,3] <- -c(2.76, 2.68, 2.64, 2.59, 2.55, 2.53, 2.51, 2.50) # II(c), 10% # Case II (Intercept only) dvals[,1,1] <- -c(2.85, 2.66, 2.56, 2.44, 2.36, 2.32, 2.29, 2.25) # II(b), 1% dvals[,1,2] <- -c(2.47, 2.35, 2.29, 2.22, 2.16, 2.13, 2.11, 2.08) # II(b), 5% dvals[,1,3] <- -c(2.28, 2.20, 2.15, 2.10, 2.05, 2.03, 2.01, 1.99) # II(b), 10% # Case I (No intercept, no trend) nvals[,1,1] <- -c(2.14, 2.00 ,1.91, 1.84, 1.77, 1.73, 1.71, 1.69) # II(a), 1% nvals[,1,2] <- -c(1.79, 1.71, 1.66, 1.61, 1.57, 1.55, 1.53, 1.52) # II(a), 5% nvals[,1,3][c(2,4,7)] <- -c(1.55, 1.48, 1.43) # II(a), 10% } ## set this according to model switch(match.arg(type), "trend" = {cvals <- tvals}, "drift" = {cvals <- dvals}, "none" = {cvals <- nvals}) ## find intervals for current n and T. nintl <- findInterval(n, rnam) ninth <- nintl + 1 nintv <- rnam[nintl:ninth] tintl <- findInterval(T., cnam) tinth <- tintl + 1 tintv <- cnam[tintl:tinth] ## for each critical value cv <- numeric(3) for(i in 1:3) { ## on N dim if(n %in% rnam) { ## if n is exactly one of the tabulated values: tl <- cvals[which(rnam == n), tintl, i] th <- cvals[which(rnam == n), tinth, i] } else { ## interpolate interval of interest to get cvals(n,T.) tl <- approx(nintv, cvals[nintl:ninth, tintl, i], n = max(nintv) - min(nintv))$y[n - min(nintv)] th <- approx(nintv, cvals[nintl:ninth, tinth, i], n = max(nintv) - min(nintv))$y[n - min(nintv)] } ## on T. dim if(T. %in% cnam) { ## if T. is exactly one of the tabulated values: if(n %in% rnam) { ## ... and n too: cv[i] <- cvals[which(rnam == n), which(cnam == T.), i] } else { ## or if n is not, interpolate n on T.'s exact row: cv[i] <- approx(nintv, cvals[nintl:ninth, which(cnam == T.), i], n = max(nintv) - min(nintv))$y[n - min(nintv)] } } else { ## idem: interpolate T.-interval to get critical value cv[i] <- approx(tintv, c(tl, th), n = max(tintv) - min(tintv))$y[T. - min(tintv)] } } ## approximate p-values' sequence cvprox <- approx(cv, c(0.01, 0.05, 0.1), n = 200) cvseq <- cvprox$x pvseq <- cvprox$y if(stat < min(cv)) { pval <- "< 0.01" } else { if(stat > max(cv)) { pval <- "> 0.10" } else { if(stat %in% cv) { ## if exactly one of the tabulated values pval <- c(0.01, 0.05, 0.10)[which(cv == stat)] } else { ## find interval where true p-value lies and ## set p-value as the mean of bounds kk <- findInterval(stat, cvseq) pval <- mean(pvseq[kk:(kk+1)]) } } } return(pval) } gettvalue <- function(x, coefname) { ## non-exported ## helper function to extract one or more t value(s) ## (coef/s.e.) for a coefficient from model object useful if one wants ## to avoid the computation of a whole lot of values with summary() # x: model object (usually class plm or lm) coefname: character # indicating name(s) of coefficient(s) for which the t value(s) is # (are) requested # return value: named numeric vector of length == length(coefname) # with requested t value(s) beta <- coef(x)[coefname] se <- sqrt(diag(vcov(x))[coefname]) tvalue <- beta / se return(tvalue) } pseries2pdataframe <- function(x, pdata.frame = TRUE, ...) { ## non-exported ## Transforms a pseries in a (p)data.frame with the indices as regular columns ## in positions 1, 2 and (if present) 3 (individual index, time index, group index). ## if pdataframe = TRUE -> return a pdata.frame, if FALSE -> return a data.frame ## ellipsis (dots) passed on to pdata.frame() if(!inherits(x, "pseries")) stop("input needs to be of class 'pseries'") indices <- attr(x, "index") class(indices) <- setdiff(class(indices), "pindex") vx <- remove_pseries_features(x) dfx <- cbind(indices, vx) dimnames(dfx)[[2L]] <- c(names(indices), deparse(substitute(x))) res <- if(pdata.frame == TRUE) { pdata.frame(dfx, index = names(indices), ...) } else { dfx } return(res) } pmerge <- function(x, y, ...) { ## non-exported ## Returns a data.frame, not a pdata.frame. ## pmerge is used to merge pseries or pdata.frames into a data.frame or ## to merge a pseries to a data.frame ## transf. if pseries or pdata.frame if(inherits(x, "pseries")) x <- pseries2pdataframe(x, pdata.frame = FALSE) if(inherits(y, "pseries")) y <- pseries2pdataframe(y, pdata.frame = FALSE) if(inherits(x, "pdata.frame")) x <- as.data.frame(x, keep.attributes = FALSE) if(inherits(y, "pdata.frame")) y <- as.data.frame(y, keep.attributes = FALSE) # input to merge() needs to be data.frames; not yet suitable for 3rd index (group variable) z <- merge(x, y, by.x = dimnames(x)[[2L]][1:2], by.y = dimnames(y)[[2L]][1:2], ...) return(z) } plm/R/plm-package.R0000644000176200001440000005454014124132276013561 0ustar liggesusers#' Functions exported from other packages #' #' These functions are imported from other packages and re-exported by #' \pkg{plm} to enable smooth use within \pkg{plm}. Please follow the #' links to view the function's original documentation. #' @name re-export_functions #' @keywords internal NULL #' @rdname re-export_functions #' @name maxLik #' @importFrom maxLik maxLik #' @export NULL #' plm package: linear models for panel data #' #' plm is a package for R which intends to make the estimation of linear panel #' models straightforward. plm provides functions to estimate a wide variety of #' models and to make (robust) inference. #' #' For a gentle and comprehensive introduction to the package, please see the #' package's vignette. #' #' The main functions to estimate models are: #' #' - `plm`: panel data estimators using `lm` on transformed data, #' - `pvcm`: variable coefficients models #' - `pgmm`: generalized method of moments (GMM) estimation for panel #' data, #' - `pggls`: estimation of general feasible generalized least squares models, #' - `pmg`: mean groups (MG), demeaned MG and common correlated effects #' (CCEMG) estimators, #' - `pcce`: estimators for common correlated effects mean groups (CCEMG) and #' pooled (CCEP) for panel data with common factors, #' - `pldv`: panel estimators for limited dependent variables. #' #' Next to the model estimation functions, the package offers several #' functions for statistical tests related to panel data/models. #' #' Multiple functions for (robust) variance--covariance matrices are #' at hand as well. #' #' The package also provides data sets to demonstrate functions and to #' replicate some text book/paper results. Use #' `data(package="plm")` to view a list of available data sets in #' the package. #' #' @name plm-package #' @docType package #' @keywords package #' @examples #' #' data("Produc", package = "plm") #' zz <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, index = c("state","year")) #' summary(zz) #' #' # replicates some results from Baltagi (2013), table 3.1 #' data("Grunfeld", package = "plm") #' p <- plm(inv ~ value + capital, #' data = Grunfeld, model="pooling") #' #' wi <- plm(inv ~ value + capital, #' data = Grunfeld, model="within", effect = "twoways") #' #' swar <- plm(inv ~ value + capital, #' data = Grunfeld, model="random", effect = "twoways") #' #' amemiya <- plm(inv ~ value + capital, #' data = Grunfeld, model = "random", random.method = "amemiya", #' effect = "twoways") #' #' walhus <- plm(inv ~ value + capital, #' data = Grunfeld, model = "random", random.method = "walhus", #' effect = "twoways") #' NULL #' Cigarette Consumption #' #' a panel of 46 observations from 1963 to 1992 #' #' *total number of observations* : 1380 #' #' *observation* : regional #' #' *country* : United States #' #' #' @name Cigar #' @docType data #' @format #' #' A data frame containing : #' \describe{ #' \item{state}{state abbreviation} #' \item{year}{the year} #' \item{price}{price per pack of cigarettes} #' \item{pop}{population} #' \item{pop16}{population above the age of 16} #' \item{cpi}{consumer price index (1983=100)} #' \item{ndi}{per capita disposable income} #' \item{sales}{cigarette sales in packs per capita} #' \item{pimin}{minimum price in adjoining states per pack of cigarettes} #' } #' #' @references #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:LEVI:92}{plm} #' #' \insertRef{BALT:GRIF:XION:00}{plm} #' #' @source #' #' Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @importFrom Rdpack reprompt #' @keywords datasets NULL #' Crime in North Carolina #' #' a panel of 90 observational units (counties) from 1981 to 1987 #' #' *total number of observations* : 630 #' #' *observation* : regional #' #' *country* : United States #' #' The variables l* (lcrmrte, lprbarr, ...) contain the pre-computed logarithms #' of the base variables as found in the original data set. Note that these #' values slightly differ from what R's log() function yields for the base #' variables. In order to reproduce examples from the literature, the #' pre-computed logs need to be used, otherwise the results differ slightly. #' #' @name Crime #' @docType data #' @format A data frame containing : #' \describe{ #' \item{county}{county identifier} #' \item{year}{year from 1981 to 1987} #' \item{crmrte}{crimes committed per person} #' \item{prbarr}{'probability' of arrest} #' \item{prbconv}{'probability' of conviction} #' \item{prbpris}{'probability' of prison sentence} #' \item{avgsen}{average sentence, days} #' \item{polpc}{police per capita} #' \item{density}{people per square mile} #' \item{taxpc}{tax revenue per capita} #' \item{region}{factor. One of 'other', 'west' or 'central'.} #' \item{smsa}{factor. (Also called "urban".) Does the individual reside in a SMSA (standard metropolitan statistical area)?} #' \item{pctmin}{percentage minority in 1980} #' \item{wcon}{weekly wage in construction} #' \item{wtuc}{weekly wage in transportation, utilities, communications} #' \item{wtrd}{weekly wage in wholesale and retail trade} #' \item{wfir}{weekly wage in finance, insurance and real estate} #' \item{wser}{weekly wage in service industry} #' \item{wmfg}{weekly wage in manufacturing} #' \item{wfed}{weekly wage in federal government} #' \item{wsta}{weekly wage in state government} #' \item{wloc}{weekly wage in local government} #' \item{mix}{offence mix: face-to-face/other} #' \item{pctymle}{percentage of young males (between ages 15 to 24)} #' \item{lcrmrte}{log of crimes committed per person} #' \item{lprbarr}{log of 'probability' of arrest} #' \item{lprbconv}{log of 'probability' of conviction} #' \item{lprbpris}{log of 'probability' of prison sentence} #' \item{lavgsen}{log of average sentence, days} #' \item{lpolpc}{log of police per capita} #' \item{ldensity}{log of people per square mile} #' \item{ltaxpc}{log of tax revenue per capita} #' \item{lpctmin}{log of percentage minority in 1980} #' \item{lwcon}{log of weekly wage in construction} #' \item{lwtuc}{log of weekly wage in transportation, utilities, communications} #' \item{lwtrd}{log of weekly wage in wholesale and retail trade} #' \item{lwfir}{log of weekly wage in finance, insurance and real estate} #' \item{lwser}{log of weekly wage in service industry} #' \item{lwmfg}{log of weekly wage in manufacturing} #' \item{lwfed}{log of weekly wage in federal government} #' \item{lwsta}{log of weekly wage in state government} #' \item{lwloc}{log of weekly wage in local government} #' \item{lmix}{log of offence mix: face-to-face/other} #' \item{lpctymle}{log of percentage of young males (between ages 15 to 24)}} #' #' @references #' #' \insertRef{CORN:TRUM:94}{plm} #' #' \insertRef{BALT:06}{plm} #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' @source #' #' Journal of Applied Econometrics Data Archive (complements Baltagi #' (2006)): #' #' \url{http://qed.econ.queensu.ca/jae/2006-v21.4/baltagi/} #' #' Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' #' See also Journal of Applied Econometrics data archive entry for #' Baltagi (2006) at #' \url{http://qed.econ.queensu.ca/jae/2006-v21.4/baltagi/}. #' #' @keywords datasets NULL #' Employment and Wages in the United Kingdom #' #' An unbalanced panel of 140 observations from 1976 to 1984 #' #' *total number of observations* : 1031 #' #' *observation* : firms #' #' *country* : United Kingdom #' #' #' @name EmplUK #' @docType data #' @format A data frame containing : #' \describe{ #' \item{firm}{firm index} #' \item{year}{year} #' \item{sector}{the sector of activity} #' \item{emp}{employment} #' \item{wage}{wages} #' \item{capital}{capital} #' \item{output}{output} #' } #' @source #' \insertRef{AREL:BOND:91}{plm} #' @keywords datasets NULL #' Gasoline Consumption #' #' A panel of 18 observations from 1960 to 1978 #' #' *total number of observations* : 342 #' #' *observation* : country #' #' *country* : OECD #' #' #' @name Gasoline #' @docType data #' @format A data frame containing : #' \describe{ #' \item{country}{a factor with 18 levels} #' \item{year}{the year} #' \item{lgaspcar}{logarithm of motor gasoline consumption per car} #' \item{lincomep}{logarithm of real per-capita income} #' \item{lrpmg}{logarithm of real motor gasoline price} #' \item{lcarpcap}{logarithm of the stock of cars per capita} #' } #' @references #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:GRIF:83}{plm} #' #' @source #' #' Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @keywords datasets NULL #' Grunfeld's Investment Data #' #' A balanced panel of 10 observational units (firms) from 1935 to 1954 #' #' *total number of observations* : 200 #' #' *observation* : production units #' #' *country* : United States #' #' #' @name Grunfeld #' @docType data #' @format A data frame containing : #' \describe{ #' \item{firm}{observation} #' \item{year}{date} #' \item{inv}{gross Investment} #' \item{value}{value of the firm} #' \item{capital}{stock of plant and equipment} } #' #' @note The Grunfeld data as provided in package `plm` is the #' same data as used in Baltagi (2001), see **Examples** below. #' #' NB:\cr Various versions of the Grunfeld data circulate #' online. Also, various text books (and also varying among editions) #' and papers use different subsets of the original Grunfeld data, #' some of which contain errors in a few data points compared to the #' original data used by Grunfeld (1958) in his PhD thesis. See #' Kleiber/Zeileis (2010) and its accompanying website for a #' comparison of various Grunfeld data sets in use. #' #' @seealso For the complete Grunfeld data (11 firms), see #' [AER::Grunfeld], in the `AER` package. #' #' @references #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{GRUN:58}{plm} #' #' \insertRef{KLEI:ZEIL:10}{plm} #' #' website accompanying the paper with various variants of the #' Grunfeld data: #' \url{https://www.zeileis.org/grunfeld/}. ## \url{https://eeecon.uibk.ac.at/~zeileis/grunfeld/}. ## \url{http://statmath.wu-wien.ac.at/~zeileis/grunfeld/}. #' #' @source Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/supp/Grunfeld.fil} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @keywords datasets #' @examples #' #' \dontrun{ #' # Compare plm's Grunfeld data to Baltagi's (2001) Grunfeld data: #' data("Grunfeld", package="plm") #' Grunfeld_baltagi2001 <- read.csv("http://www.wiley.com/legacy/wileychi/ #' baltagi/supp/Grunfeld.fil", sep="", header = FALSE) #' library(compare) #' compare::compare(Grunfeld, Grunfeld_baltagi2001, allowAll = T) # same data set #' } #' NULL #' Hedonic Prices of Census Tracts in the Boston Area #' #' A cross-section #' #' *number of observations* : 506 #' #' *observation* : regional #' #' *country* : United States #' #' #' @name Hedonic #' @docType data #' @format A dataframe containing: #' \describe{ #' \item{mv}{median value of owner--occupied homes} #' \item{crim}{crime rate} #' \item{zn}{proportion of 25,000 square feet residential lots} #' \item{indus}{proportion of no--retail business acres} #' \item{chas}{is the tract bounds the Charles River?} #' \item{nox}{annual average nitrogen oxide concentration in parts per hundred million} #' \item{rm}{average number of rooms} #' \item{age}{proportion of owner units built prior to 1940} #' \item{dis}{weighted distances to five employment centers in the Boston area} #' \item{rad}{index of accessibility to radial highways} #' \item{tax}{full value property tax rate ($/$10,000)} #' \item{ptratio}{pupil/teacher ratio} #' \item{blacks}{proportion of blacks in the population} #' \item{lstat}{proportion of population that is lower status} #' \item{townid}{town identifier} } #' #' @references #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BESL:KUH:WELS:80}{plm} #' #' \insertRef{HARR:RUBI:78}{plm} #' @source Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @keywords datasets NULL #' Wages and Hours Worked #' #' A panel of 532 observations from 1979 to 1988 #' #' *number of observations* : 5320 #' #' #' @name LaborSupply #' @docType data #' @format A data frame containing : #' \describe{ #' \item{lnhr}{log of annual hours worked} #' \item{lnwg}{log of hourly wage} #' \item{kids}{number of children} #' \item{age}{age} #' \item{disab}{bad health} #' \item{id}{id} #' \item{year}{year} #' } #' #' @references #' #' \insertRef{CAME:TRIV:05}{plm} #' #' \insertRef{ZILI:97}{plm} #' #' @source Online complements to Ziliak (1997). #' #' Journal of Business Economics and Statistics web site: #' \url{https://amstat.tandfonline.com/loi/ubes20/}. #' #' @keywords datasets NULL #' Wages and Education of Young Males #' #' A panel of 545 observations from 1980 to 1987 #' #' *total number of observations* : 4360 #' #' *observation* : individuals #' #' *country* : United States #' #' #' @name Males #' @docType data #' @format A data frame containing : #' \describe{ #' \item{nr}{identifier} #' \item{year}{year} #' \item{school}{years of schooling} #' \item{exper}{years of experience (computed as `age-6-school`)} #' \item{union}{wage set by collective bargaining?} #' \item{ethn}{a factor with levels `black, hisp, other`} #' \item{married}{married?} #' \item{health}{health problem?} #' \item{wage}{log of hourly wage} #' \item{industry}{a factor with 12 levels} #' \item{occupation}{a factor with 9 levels} #' \item{residence}{a factor with levels `rural_area, north_east, northern_central, south`} #' } #' #' @references #' #' \insertRef{VELL:VERB:98}{plm} #' #' \insertRef{VERB:04}{plm} #' #' @source Journal of Applied Econometrics data archive #' \url{http://qed.econ.queensu.ca/jae/1998-v13.2/vella-verbeek/}. #' #' @keywords datasets NULL #' Purchasing Power Parity and other parity relationships #' #' A panel of 104 quarterly observations from 1973Q1 to 1998Q4 #' #' *total number of observations* : 1768 #' #' *observation* : country #' #' *country* : OECD #' #' #' @name Parity #' @docType data #' @format A data frame containing : #' \describe{ #' \item{country}{country codes: a factor with 17 levels} #' \item{time}{the quarter index, 1973Q1-1998Q4} #' \item{ls}{log spot exchange rate vs. USD} #' \item{lp}{log price level} #' \item{is}{short term interest rate} #' \item{il}{long term interest rate} #' \item{ld}{log price differential vs. USA} #' \item{uis}{U.S. short term interest rate} #' \item{uil}{U.S. long term interest rate} } #' #' @references #' #' \insertRef{COAK:FUER:SMIT:06}{plm} #' #' \insertRef{DRIS:KRAA:98}{plm} #' #' @source #' #' \insertRef{COAK:FUER:SMIT:06}{plm} #' @keywords datasets NULL #' US States Production #' #' A panel of 48 observations from 1970 to 1986 #' #' *total number of observations* : 816 #' #' *observation* : regional #' #' *country* : United States #' #' #' @name Produc #' @docType data #' @format A data frame containing : #' \describe{ #' \item{state}{the state} #' \item{year}{the year} #' \item{region}{the region} #' \item{pcap}{public capital stock} #' \item{hwy}{highway and streets} #' \item{water}{water and sewer facilities} #' \item{util}{other public buildings and structures} #' \item{pc}{private capital stock} #' \item{gsp}{gross state product} #' \item{emp}{labor input measured by the employment in non--agricultural payrolls} #' \item{unemp}{state unemployment rate} } #' #' @references #' #' \insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:PINN:95}{plm} #' #' \insertRef{MUNN:90}{plm} #' #' @source Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @keywords datasets NULL #' Production of Rice in Indonesia #' #' a panel of 171 observations #' #' *number of observations* : 1026 #' #' *observation* : farms #' #' *country* : Indonesia #' #' #' @name RiceFarms #' @docType data #' @format A dataframe containing : #' \describe{ #' \item{id}{the farm identifier} #' #' \item{size}{the total area cultivated with rice, measured in hectares} #' #' \item{status}{land status, on of `'owner'` (non sharecroppers, #' owner operators or leaseholders or both), `'share'` #' (sharecroppers), `'mixed'` (mixed of the two previous status)} #' #' \item{varieties}{one of `'trad'` (traditional varieties), #' `'high'` (high yielding varieties) and `'mixed'` (mixed #' varieties)} #' #' \item{bimas}{bIMAS is an intensification program; one of #' `'no'` (non-bimas farmer), `'yes'` (bimas farmer) or #' `'mixed'` (part but not all of farmer's land was registered to #' be in the bimas program)} #' #' \item{seed}{seed in kilogram} #' #' \item{urea}{urea in kilogram} #' #' \item{phosphate}{phosphate in kilogram} #' #' \item{pesticide}{pesticide cost in Rupiah} #' #' \item{pseed}{price of seed in Rupiah per kg} #' #' \item{purea}{price of urea in Rupiah per kg} #' #' \item{pphosph}{price of phosphate in Rupiah per kg} #' #' \item{hiredlabor}{hired labor in hours} #' #' \item{famlabor}{family labor in hours} #' #' \item{totlabor}{total labor (excluding harvest labor)} #' #' \item{wage}{labor wage in Rupiah per hour} #' #' \item{goutput}{gross output of rice in kg} #' #' \item{noutput}{net output, gross output minus harvesting cost (paid #' in terms of rice)} #' #' \item{price}{price of rough rice in Rupiah per kg} #' #' \item{region}{one of `'wargabinangun'`, `'langan'`, #' `'gunungwangi'`, `'malausma'`, `'sukaambit'`, #' `'ciwangi'`} #' #' } #' #' @source #' #' \insertRef{FENG:HORR:12}{plm} #' @keywords datasets NULL #' Employment and Wages in Spain #' #' A panel of 738 observations from 1983 to 1990 #' #' *total number of observations*: 5904 #' #' *observation*: firms #' #' *country*: Spain #' #' #' @name Snmesp #' @docType data #' @format A data frame containing: #' #' \describe{ #' \item{firm}{firm index} #' \item{year}{year} #' \item{n}{log of employment} #' \item{w}{log of wages} #' \item{y}{log of real output} #' \item{i}{log of intermediate inputs} #' \item{k}{log of real capital stock} #' \item{f}{real cash flow} } #' #' @references #' #' \insertRef{ALON:AREL:99}{plm} #' @source Journal of Business Economics and Statistics data archive: #' #' \url{https://amstat.tandfonline.com/loi/ubes20/}. #' #' @keywords datasets NULL #' The Penn World Table, v. 5 #' #' A panel of 125 observations from 1960 to 1985 #' #' *total number of observations* : 3250 #' #' *observation* : country #' #' *country* : World #' #' #' @name SumHes #' @docType data #' @format A data frame containing : #' \describe{ #' \item{year}{the year} #' \item{country}{the country name (factor)} #' \item{opec}{OPEC member?} #' \item{com}{communist regime? } #' \item{pop}{country's population (in thousands)} #' \item{gdp}{real GDP per capita (in 1985 US dollars)} #' \item{sr}{saving rate (in percent)}} #' #' @references #' #' \insertRef{HAYA:00}{plm} #' #' \insertRef{SUMM:HEST:91}{plm} #' #' @source Online supplements to Hayashi (2000). #' #' \url{http://fhayashi.fc2web.com/datasets.htm} #' #' @keywords datasets NULL #' Panel Data of Individual Wages #' #' A panel of 595 individuals from 1976 to 1982, taken from the Panel Study of #' Income Dynamics (PSID).\cr\cr The data are organized as a stacked time #' series/balanced panel, see **Examples** on how to convert to a #' `pdata.frame`. #' #' *total number of observations* : 4165 #' #' *observation* : individuals #' #' *country* : United States #' #' #' @name Wages #' @docType data #' @format A data frame containing: #' \describe{ #' \item{exp}{years of full-time work experience.} #' \item{wks}{weeks worked.} #' \item{bluecol}{blue collar?} #' \item{ind}{works in a manufacturing industry?} #' \item{south}{resides in the south?} #' \item{smsa}{resides in a standard metropolitan statistical area?} #' \item{married}{married?} #' \item{sex}{a factor with levels `"male"` and `"female"`} #' \item{union}{individual's wage set by a union contract?} #' \item{ed}{years of education.} #' \item{black}{is the individual black?} #' \item{lwage}{logarithm of wage.} } #' #' @references #' #'\insertRef{BALT:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{CORN:RUPE:88}{plm} #' #' @source Online complements to Baltagi (2001): #' #' \url{https://www.wiley.com/legacy/wileychi/baltagi/} #' #' Online complements to Baltagi (2013): #' #' \url{https://bcs.wiley.com/he-bcs/Books?action=resource&bcsId=4338&itemId=1118672321&resourceId=13452} #' @keywords datasets #' @examples #' #' # data set 'Wages' is organized as a stacked time series/balanced panel #' data("Wages", package = "plm") #' Wag <- pdata.frame(Wages, index=595) #' NULL plm/R/test_granger.R0000644000176200001440000002500614160656620014063 0ustar liggesusers### Panel Granger (Non-)Causality Test ## ## Reference: ## * Dumitrescu, Elena-Ivona/Hurlin, Christophe (2012), Testing for Granger non-causality in heterogeneous panels, ## Economic Modelling, 29(4), pp. 1450-460. ## * supplements (test data, MATLAB code): http://www.runmycode.org/companion/view/42 ## ## * Lopez, Luciano/Weber, Sylvain (2017), Testing for Granger causality in panel data, ## The Stata Journal, Vol 17, Issue 4, pp. 972-984. ## * Working paper: Testing for Granger causality in panel data, ## IRENE Working paper 17-03, September 11, 2017 ## * supplements (xtgcause for Stata) https://ideas.repec.org/c/boc/bocode/s458308.html ## ## * EViews blog with introduction to the test and a Monte Carlo study: ## http://blog.eviews.com/2017/08/dumitrescu-hurlin-panel-granger.html ## ## TODO (if someone is willing...) ## * Lopez/Weber (2017) also demonstrate lag selection procedure by AIC, BIC, ... ## #' Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012)) #' #' Test for Granger (non-)causality in panel data. #' #' # % TODO: write about assumptions of panel Granger test: % * cross-sectional # independence % * convergence #' #' The panel Granger (non-)causality test is a combination of Granger #' tests \insertCite{GRAN:69}{plm} performed per individual. The test #' is developed by \insertCite{DUMI:HURL:12;textual}{plm}, a shorter #' exposition is given in \insertCite{LOPE:WEBE:17;textual}{plm}. #' #' The formula `formula` describes the direction of the (panel) Granger #' causation where `y ~ x` means "x (panel) Granger causes y". #' #' By setting argument `test` to either `"Ztilde"` (default) or #' `"Zbar"`, two different statistics can be requested. `"Ztilde"` #' gives the standardised statistic recommended by Dumitrescu/Hurlin (2012) for #' fixed T samples. If set to `"Wbar"`, the intermediate Wbar statistic #' (average of individual Granger chi-square statistics) is given which is used #' to derive the other two. #' #' The Zbar statistic is not suitable for unbalanced panels. For the Wbar #' statistic, no p-value is available. #' #' The implementation uses [lmtest::grangertest()] from #' package \CRANpkg{lmtest} to perform the individual Granger tests. #' #' @param formula a `formula` object to describe the direction of the #' hypothesized Granger causation, #' @param data a `pdata.frame` or a `data.frame`, #' @param test a character to request the statistic to be returned, #' either `"Ztilde"` (default),or `"Zbar"`, alternatively, set to #' `"Wbar"` for an intermediate statistic (see Details), #' @param order integer(s) giving the number of lags to include in the #' test's auxiliary regressions, the length of order must be #' either 1 (same lag order for all individuals) or equal to the #' number of individuals (to specify a lag order per individual), #' @param index only relevant if `data` is `data.frame` and not a #' `pdata.frame`; if `NULL`, the first two columns of the #' data.frame are assumed to be the index variables, for further #' details see [pdata.frame()]. #' @return An object of class `c("pgrangertest", "htest")`. Besides #' the usual elements of a `htest` object, it contains the data #' frame `indgranger` which carries the Granger test statistics #' per individual along the associated p-values, degrees of #' freedom, and the specified lag order. #' @export #' @author Kevin Tappe #' @seealso [lmtest::grangertest()] for the original (non-panel) #' Granger causality test in \CRANpkg{lmtest}. #' @references #' #' \insertRef{DUMI:HURL:12}{plm} #' #' \insertRef{GRAN:69}{plm} #' #' \insertRef{LOPE:WEBE:17}{plm} #' #' @keywords htest #' @examples #' #' ## not meaningful, just to demonstrate usage #' ## H0: 'value' does not Granger cause 'inv' for all invididuals #' #' data("Grunfeld", package = "plm") #' pgrangertest(inv ~ value, data = Grunfeld) #' pgrangertest(inv ~ value, data = Grunfeld, order = 2L) #' pgrangertest(inv ~ value, data = Grunfeld, order = 2L, test = "Zbar") #' #' # varying lag order (last individual lag order 3, others lag order 2) #' (pgrt <- pgrangertest(inv ~ value, data = Grunfeld, order = c(rep(2L, 9), 3L))) #' # chisq statistics per individual #' pgrt$indgranger #' pgrangertest <- function(formula, data, test = c("Ztilde", "Zbar", "Wbar"), order = 1L, index = NULL) { # Implementation of formulae follows Lopez/Weber (2017), the formulas are slightly different # compared to Dumistrescu/Hurlin (2012), because "Note however that T in DH's formulae # must be understood as the number of observations remaining in the estimations, that # is the number of periods minus the number of lags included. In order to be consistent # with our notation, we therefore replaced DH's T by T - K in the following formulas of # the present paper." # y ~ x: to test whether x (panel-)Granger causes y test <- match.arg(test) if (!inherits(data, "pdata.frame")) data <- pdata.frame(data, index = index) pdim <- pdim(data) balanced <- pdim$balanced N <- pdim$nT$n T. <- pdim$nT$T Ti <- pdim$Tint$Ti indi <- unclass(index(data))[[1L]] indi_con <- is.pconsecutive(data) # some input checks if (!inherits(formula, "formula") || length(all.vars(formula)) > 2L) { stop(paste0("Argument 'formula' must be of class \"formula\" and may not contain ", "more than 2 variables, one LHS and one RHS variable, e.g., 'y ~ x'")) } if (!(is.numeric(order) && all(round(order) == order) && all(order > 0L))) stop("Lag order 'order' must contain positive integer(s)") if (length(order) > 1L && length(order) != N) stop("'order' must have length 1 or the number of individuals") if (test == "Zbar" && !balanced) stop("'test = \"Zbar\"' is not suited for unbalanced panels") if (test == "Zbar" && length(unique(order)) != 1L) stop("'test = \"Zbar\"' is not suited for varying lag order") # For statistic Ztilde, the second order moments of the individual statistics must exist # (formula (10) in Dumitrescu/Hurlin (2012) where T = T - K) req.obs <- 5L + 3L*order if (length(order) == 1L) { if (test == "Ztilde" && !all((Ti > (req.obs)))) { stop(paste0("Condition for test = \"Ztilde\" not met for all individuals: length of time series ", "must be larger than 5+3*order (>5+3*", order, "=", req.obs, ")")) } } else { if (test == "Ztilde" && !all((Ti > (req.obs)))) { stop(paste0("Condition for test = \"Ztilde\" not met for all individuals: length of time series ", "must be larger than 5+3*order [where order is the order specified for the individuals]")) } } # give warning if data is not consecutive per individual if (!all(indi_con)) { indnames <- pdim[["panel.names"]][["id.names"]] wrn1 <- "pgrangertest: result may be unreliable due to individuals with non-consecutive time periods: " wrn2 <- if (sum(!indi_con) <= 5L) { paste0(indnames[!indi_con], collapse = ", ") } else { # cut off enumeration of individuals in warning message if more than 5 breakpoint <- which(cumsum(!indi_con) == 5L)[1L] paste0(paste0(indnames[1L:breakpoint][!indi_con[1L:breakpoint]], collapse = ", "), ", ...") } wrn <- paste0(wrn1, wrn2) warning(wrn) } listdata <- split(data, indi) # split data per individual ## use lmtest::grangertest for the individual Granger tests # for this, if necessary, expand order argument for lmtest::grangertest to full length (N) # [but leave variable 'order' in its current length for later decision making] order_grangertest <- if(length(order) == 1L) rep(order, N) else order # Dumitrescu/Hurlin (2012), p. 1453 use the Chisq definition of the Granger test grangertests_i <- mapply(function(data, order) lmtest::grangertest(formula, data = data, order = order, test = "Chisq"), listdata, order_grangertest, SIMPLIFY = FALSE) # extract Wald/Chisq-statistics and p-values of individual Granger tests Wi <- vapply(grangertests_i, function(g) g[["Chisq"]][2L], FUN.VALUE = 0.0, USE.NAMES = FALSE) pWi <- vapply(grangertests_i, function(g) g[["Pr(>Chisq)"]][[2L]], FUN.VALUE = 0.0, USE.NAMES = FALSE) dfWi <- vapply(grangertests_i, function(g) abs(g[["Df"]][2L]), FUN.VALUE = 0.0, USE.NAMES = FALSE) Wbar <- c("Wbar" = mean(Wi)) if(test == "Zbar") { stat <- c(sqrt(N/(2*order)) * (Wbar - order)) names(stat) <- "Zbar" pval <- 2*pnorm(abs(stat), lower.tail = FALSE) } if(test == "Ztilde") { # Ztilde recommended for fixed T if (balanced && length(order) == 1L) { stat <- c( sqrt( N/(2*order) * (T. - 3*order - 5) / (T. - 2*order - 3) ) * ( (T. - 3*order - 3) / (T. - 3*order - 1) * Wbar - order)) } else { # unbalanced and/or varying lag order # unbal stat reduces to the balanced case for balanced data but rather treat it separately here # formula (33) in Dumitrescu/Hurlin (2012), p. 1459 if (length(order) == 1L) order <- rep(order, N) # replicate lag order for all individuals stat <- c( sqrt(N) * ( Wbar - 1/N * sum( order * (Ti - 3*order - 1) / (Ti - 3*order - 3) )) * 1/sqrt( 1/N * sum( 2* order * ((Ti - 3*order - 1)^2 * (Ti - 2*order - 3)) / ((Ti - 3*order - 3)^2 * (Ti - 3*order - 5)) ) ) ) } names(stat) <- "Ztilde" pval <- 2*pnorm(abs(stat), lower.tail = FALSE) } if(test == "Wbar") { stat <- Wbar names(stat) <- "Wbar" pval <- NULL } # make data frame with individual Granger test results and lag order indgranger <- data.frame(indi[!duplicated(indi)], Wi, pWi, dfWi, (if(length(order) == 1L) rep(order, N) else order)) colnames(indgranger) <- c(names(index(data))[1L], "Chisq", "p-value", "df", "lag") RVAL <- list(statistic = stat, parameter = NULL, p.value = pval, method = "Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012))", alternative = "Granger causality for at least one individual", data.name = deparse(formula), indgranger = indgranger) class(RVAL) <- c("pgrangertest", "htest") return(RVAL) } plm/R/est_ggls.R0000644000176200001440000002572514175272067013223 0ustar liggesusers#' General FGLS Estimators #' #' General FGLS estimators for panel data (balanced or unbalanced) #' #' #' `pggls` is a function for the estimation of linear panel models by #' general feasible generalized least squares, either with or without #' fixed effects. General FGLS is based on a two-step estimation #' process: first a model is estimated by OLS (`model = "pooling"`), #' fixed effects (`model = "within"`) or first differences #' (`model = "fd"`), then its residuals are used to estimate an error #' covariance matrix for use in a feasible-GLS analysis. This framework allows #' the error covariance structure inside every group #' (if `effect = "individual"`, else symmetric) of observations to be fully #' unrestricted and is therefore robust against any type of intragroup #' heteroskedasticity and serial correlation. Conversely, this #' structure is assumed identical across groups and thus general FGLS #' estimation is inefficient under groupwise heteroskedasticity. Note #' also that this method requires estimation of \eqn{T(T+1)/2} #' variance parameters, thus efficiency requires N >> T #' (if `effect = "individual"`, else the opposite). #' #' If `model = "within"` (the default) then a FEGLS (fixed effects GLS, see #' Wooldridge, Ch. 10.5) is estimated; if `model = "fd"` a FDGLS #' (first-difference GLS). Setting `model = "pooling"` produces an unrestricted #' FGLS model (see ibid.) (`model = "random"` does the same, but using this value #' is deprecated and included only for retro--compatibility reasons). #' #' @aliases pggls #' @param formula a symbolic description of the model to be estimated, #' @param object,x an object of class `pggls`, #' @param data a `data.frame`, #' @param subset see [lm()], #' @param na.action see [lm()], #' @param effect the effects introduced in the model, one of #' `"individual"` or `"time"`, #' @param model one of `"within"`, `"pooling"`, `"fd"`, #' @param index the indexes, see [pdata.frame()], #' @param digits digits, #' @param width the maximum length of the lines in the print output, #' @param \dots further arguments. #' @return An object of class `c("pggls","panelmodel")` containing: #' \item{coefficients}{the vector of coefficients,} #' \item{residuals}{the vector of residuals,} #' \item{fitted.values}{the vector of fitted values,} #' \item{vcov}{the covariance matrix of the coefficients,} #' \item{df.residual}{degrees of freedom of the residuals,} #' \item{model}{a data.frame containing the variables used for the #' estimation,} #' \item{call}{the call,} #' \item{sigma}{the estimated intragroup (or cross-sectional, if #' `effect = "time"`) covariance of errors,} #' @export #' @importFrom bdsmatrix bdsmatrix #' @author Giovanni Millo #' @references #' #' \insertRef{IM:SEUN:SCHM:WOOL:99}{plm} #' #' \insertRef{KIEF:80}{plm} #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' zz_wi <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "within") #' summary(zz_wi) #' #' zz_pool <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "pooling") #' summary(zz_pool) #' #' zz_fd <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, model = "fd") #' summary(zz_fd) #' #' pggls <- function(formula, data, subset, na.action, effect = c("individual", "time"), model = c("within", "pooling", "fd"), index = NULL, ...) { # check and match the arguments effect <- match.arg(effect) if(length(model) == 1L && model == "random") { msg.random <- paste0("pggls(): argument 'model = \"random\"' is deprecated, ", " changed to 'model = \"pooling\"' for estimation ", " of unrestricted FGLS model") warning(msg.random, call. = FALSE) model <- "pooling" } model.name <- match.arg(model) data.name <- paste(deparse(substitute(data))) cl <- match.call() plm.model <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "na.action", "effect", "model", "index"), names(plm.model), 0) plm.model <- plm.model[c(1L, m)] plm.model[[1L]] <- as.name("plm") plm.model$model <- model.name plm.model <- eval(plm.model, parent.frame()) mf <- model.frame(plm.model) index <- attr(mf, "index") pdim <- pdim(plm.model) balanced <- pdim$balanced time.names <- pdim$panel.names$time.names id.names <- pdim$panel.names$id.names coef.names <- names(coef(plm.model)) K <- length(coef.names) if (model.name == "fd") { ## eliminate first year in indices nt <- pdim$Tint$nt[-1L] Ti <- pdim$Tint$Ti - 1 T <- pdim$nT$T - 1 n <- pdim$nT$n N <- pdim$nT$N - pdim$Tint$nt[1L] time.names <- pdim$panel.names$time.names[-1L] tind <- as.numeric(index[ , 2L]) sel <- (tind - c(-1, tind[-length(tind)])) == 1 index <- index[sel, ] id <- index[[1L]] time <- factor(index[[2L]], levels = attr(index[ , 2L], "levels")[-1L]) } else { nt <- pdim$Tint$nt Ti <- pdim$Tint$Ti T <- pdim$nT$T n <- pdim$nT$n N <- pdim$nT$N id <- index[[1L]] time <- index[[2L]] } if (effect == "time") { cond <- time other <- id ncond <- T nother <- n cond.names <- time.names other.names <- id.names groupsdim <- nt } else { cond <- id other <- time ncond <- n nother <- T cond.names <- id.names other.names <- time.names groupsdim <- Ti } myord <- order(cond, other) X <- model.matrix(plm.model)[myord, , drop = FALSE] commonpars <- intersect(coef.names, colnames(X)) X <- X[ , commonpars, drop = FALSE] y <- pmodel.response(plm.model)[myord] resid <- lm.fit(X, y)$residuals cond <- cond[myord] other <- other[myord] drop1 <- FALSE if (drop1 && model.name %in% c("within", "fd")) { ## drop one time period (e.g., first as we do here) ## (see Wooldridge (2002) 10.5, eq. 10.61)/Wooldridge (2010),10.5.5, eq.10.61) ## this is needed according to Wooldridge (2002), p.277 / Wooldridge (2010), p. 312 ## but is not totally robust to unbalancedness, dummies etc. ## ## The function turns out to work irrespective of dropping ## one time period or not! Absolutely the same results! ## This is thx to solve.bdsmatrix() using a generalized ## inverse, which in this case where rank=T-1 is equivalent ## to discarding one year (N columns) ## -> as noted by Wooldridge ## ## The 'if' parameterization is just for debugging. numeric.t <- as.numeric(other) t1 <- which(numeric.t != min(numeric.t)) X0 <- X y0 <- y X <- X[t1, ] y <- y[t1] resid <- lm.fit(X, y)$residuals #resid[t1] cond <- cond[t1] other <- other[t1] nother <- nother - 1 other.names <- other.names[-1L] } tres <- array(NA_real_, dim = c(nother, nother, ncond), dimnames = list(other.names, other.names, cond.names)) lcnd <- levels(cond) if (balanced) { for (i in 1:ncond) { ut <- resid[cond == lcnd[i]] tres[ , , i] <- ut %o% ut } subOmega <- rowMeans(tres, dims = 2L) # == apply(tres, 1:2, mean) but faster omega <- bdsmatrix::bdsmatrix(rep(nother, ncond), rep(subOmega, ncond)) } else { lti <- list() for (i in 1:ncond) { cond.i <- cond == lcnd[i] ut <- resid[cond.i] names(ut) <- lti[[i]] <- other[cond.i] out <- ut %o% ut tres[names(ut), names(ut), i] <- out } subOmega <- rowMeans(tres, dims = 2L, na.rm = TRUE) # == apply(tres, 1:2, mean, na.rm = TRUE) but faster list.cov.blocks <- list() for (i in 1:ncond) { list.cov.blocks[[i]] <- subOmega[lti[[i]], lti[[i]]] } omega <- bdsmatrix::bdsmatrix(groupsdim, unlist(list.cov.blocks, use.names = FALSE)) } A <- crossprod(X, solve(omega, X)) B <- crossprod(X, solve(omega, y)) vcov <- solve(A) coef <- as.numeric(solve(A, B)) if (drop1 && model == "within") { X <- X0 y <- y0 } residuals <- y - as.numeric(tcrossprod(coef, X)) df.residual <- nrow(X) - ncol(X) fitted.values <- y - residuals names(coef) <- rownames(vcov) <- colnames(vcov) <- coef.names pmodel <- list(model.name = model.name, effect.name = effect) fullGLS <- list(coefficients = coef, residuals = residuals, fitted.values = fitted.values, vcov = vcov, df.residual = df.residual, model = mf, sigma = subOmega, call = cl, formula = plm.model$formula) fullGLS <- structure(fullGLS, pdim = pdim, pmodel = pmodel) class(fullGLS) <- c("pggls", "panelmodel") fullGLS } #' @rdname pggls #' @export summary.pggls <- function(object,...){ std.err <- sqrt(diag(object$vcov)) b <- object$coefficients z <- b/std.err p <- 2*pnorm(abs(z), lower.tail = FALSE) CoefTable <- cbind(b, std.err, z, p) colnames(CoefTable) <- c("Estimate", "Std. Error", "z-value", "Pr(>|z|)") object$CoefTable <- CoefTable y <- object$model[[1L]] object$tss <- tss(y) object$ssr <- as.numeric(crossprod(residuals(object))) object$rsqr <- 1-object$ssr/object$tss class(object) <- c("summary.pggls") return(object) } #' @rdname pggls #' @export print.summary.pggls <- function(x, digits = max(3, getOption("digits") - 2), width = getOption("width"), ...){ pmodel <- attr(x, "pmodel") pdim <- attr(x, "pdim") cat(paste(effect.pggls.list[pmodel$effect.name], " ", sep = "")) cat(paste(model.pggls.list[ pmodel$model.name], "\n", sep = "")) cat("\nCall:\n") print(x$call) cat("\n") print(pdim) cat("\nResiduals:\n") print(sumres(x)) # was until rev. 1176: print(summary(unlist(residuals(x)))) cat("\nCoefficients:\n") printCoefmat(x$CoefTable, digits = digits) cat(paste("Total Sum of Squares: ", signif(x$tss, digits), "\n", sep="")) cat(paste("Residual Sum of Squares: ", signif(x$ssr, digits), "\n", sep="")) cat(paste("Multiple R-squared: ", signif(x$rsqr, digits), "\n", sep="")) invisible(x) } #' @rdname pggls #' @export residuals.pggls <- function(object, ...) { return(pres(object)) } plm/R/test_serial.R0000644000176200001440000015601514161204706013715 0ustar liggesusers #' Breusch--Godfrey Test for Panel Models #' #' Test of serial correlation for (the idiosyncratic component of) the #' errors in panel models. #' #' This Lagrange multiplier test uses the auxiliary model on #' (quasi-)demeaned data taken from a model of class `plm` which may #' be a `pooling` (default for formula interface), `random` or #' `within` model. It performs a Breusch--Godfrey test (using `bgtest` #' from package \CRANpkg{lmtest} on the residuals of the #' (quasi-)demeaned model, which should be serially uncorrelated under #' the null of no serial correlation in idiosyncratic errors, as #' illustrated in \insertCite{WOOL:10;textual}{plm}. The function #' takes the demeaned data, estimates the model and calls `bgtest`. #' #' Unlike most other tests for serial correlation in panels, this one #' allows to choose the order of correlation to test for. #' #' @aliases pbgtest #' @importFrom lmtest bgtest #' @param x an object of class `"panelmodel"` or of class `"formula"`, #' @param order an integer indicating the order of serial correlation #' to be tested for. `NULL` (default) uses the minimum number of #' observations over the time dimension (see also section #' **Details** below), #' @param type type of test statistic to be calculated; either #' `"Chisq"` (default) for the Chi-squared test statistic or `"F"` #' for the F test statistic, #' @param data only relevant for formula interface: data set for which #' the respective panel model (see `model`) is to be evaluated, #' @param model only relevant for formula interface: compute test #' statistic for model `pooling` (default), `random`, or `within`. #' When `model` is used, the `data` argument needs to be passed as #' well, #' @param \dots further arguments (see [lmtest::bgtest()]). #' @return An object of class `"htest"`. #' @note The argument `order` defaults to the minimum number of #' observations over the time dimension, while for #' `lmtest::bgtest` it defaults to `1`. #' @export #' @author Giovanni Millo #' @seealso For the original test in package \CRANpkg{lmtest} see #' [lmtest::bgtest()]. See [pdwtest()] for the analogous #' panel Durbin--Watson test. See [pbltest()], [pbsytest()], #' [pwartest()] and [pwfdtest()] for other serial correlation #' tests for panel models. #' @references #' #' \insertRef{BREU:78}{plm} #' #' \insertRef{GODF:78}{plm} #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' \insertRef{WOOL:13}{plm} #' Sec. 12.2, pp. 421--422. #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' g <- plm(inv ~ value + capital, data = Grunfeld, model = "random") #' #' # panelmodel interface #' pbgtest(g) #' pbgtest(g, order = 4) #' #' # formula interface #' pbgtest(inv ~ value + capital, data = Grunfeld, model = "random") #' #' # F test statistic (instead of default type="Chisq") #' pbgtest(g, type="F") #' pbgtest(inv ~ value + capital, data = Grunfeld, model = "random", type = "F") #' pbgtest <- function (x, ...) { UseMethod("pbgtest") } #' @rdname pbgtest #' @export pbgtest.panelmodel <- function(x, order = NULL, type = c("Chisq", "F"), ...) { ## residual serial correlation test based on the residuals of the demeaned ## model (see Wooldridge (2002), p. 288) and the regular lmtest::bgtest() ## structure: ## 1: take demeaned data from 'plm' object ## 2: est. auxiliary model by OLS on demeaned data ## 3: apply lmtest::bgtest() to auxiliary model and return the result model <- describe(x, "model") effect <- describe(x, "effect") theta <- x$ercomp$theta ## retrieve demeaned data demX <- model.matrix(x, model = model, effect = effect, theta = theta, cstcovar.rm = "all") demy <- pmodel.response(model.frame(x), model = model, effect = effect, theta = theta) ## ...and group numerosities Ti <- pdim(x)$Tint$Ti ## set lag order to minimum group numerosity if not specified by user ## (check whether this is sensible) if(is.null(order)) order <- min(Ti) ## lmtest::bgtest on the demeaned model: ## pbgtest is the return value of lmtest::bgtest, exception made for the method attribute auxformula <- demy ~ demX - 1 lm.mod <- lm(auxformula) bgtest <- bgtest(lm.mod, order = order, type = type, ...) bgtest$method <- "Breusch-Godfrey/Wooldridge test for serial correlation in panel models" bgtest$alternative <- "serial correlation in idiosyncratic errors" bgtest$data.name <- data.name(x) names(bgtest$statistic) <- if(length(bgtest$parameter) == 1) "chisq" else "F" return(bgtest) } #' @rdname pbgtest #' @export pbgtest.formula <- function(x, order = NULL, type = c("Chisq", "F"), data, model=c("pooling", "random", "within"), ...) { ## formula method for pbgtest; ## defaults to a pooling model cl <- match.call(expand.dots = TRUE) if (names(cl)[3L] == "") names(cl)[3L] <- "data" if (is.null(cl$model)) cl$model <- "pooling" names(cl)[2L] <- "formula" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl,parent.frame()) pbgtest(plm.model, order = order, type = type, data = data, ...) } #' Wooldridge's Test for Unobserved Effects in Panel Models #' #' Semi-parametric test for the presence of (individual or time) unobserved #' effects in panel models. #' #' This semi-parametric test checks the null hypothesis of zero #' correlation between errors of the same group. Therefore, it has #' power both against individual effects and, more generally, any kind #' of serial correlation. #' #' The test relies on large-N asymptotics. It is valid under error #' heteroskedasticity and departures from normality. #' #' The above is valid if `effect="individual"`, which is the most #' likely usage. If `effect="time"`, symmetrically, the test relies on #' large-T asymptotics and has power against time effects and, more #' generally, against cross-sectional correlation. #' #' If the panelmodel interface is used, the inputted model must be a pooling #' model. #' #' @aliases pwtest #' @param x an object of class `"formula"`, or an estimated model of class #' `panelmodel`, #' @param effect the effect to be tested for, one of `"individual"` #' (default) or `"time"`, #' @param data a `data.frame`, #' @param \dots further arguments passed to `plm`. #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo #' @seealso [pbltest()], [pbgtest()], #' [pdwtest()], [pbsytest()], [pwartest()], #' [pwfdtest()] for tests for serial correlation in panel models. #' [plmtest()] for tests for random effects. #' @references #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' @keywords htest #' @examples #' #' data("Produc", package = "plm") #' ## formula interface #' pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) #' pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time") #' #' ## panelmodel interface #' # first, estimate a pooling model, than compute test statistics #' form <- formula(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp) #' pool_prodc <- plm(form, data = Produc, model = "pooling") #' pwtest(pool_prodc) # == effect="individual" #' pwtest(pool_prodc, effect="time") #' pwtest <- function(x, ...){ UseMethod("pwtest") } #' @rdname pwtest #' @export pwtest.formula <- function(x, data, effect = c("individual", "time"), ...) { effect <- match.arg(effect, choices = c("individual", "time")) # match effect to pass it on to pwtest.panelmodel cl <- match.call(expand.dots = TRUE) if (names(cl)[3] == "") names(cl)[3] <- "data" if (is.null(cl$model)) cl$model <- "pooling" if (cl$model != "pooling") stop("pwtest only relevant for pooling models") names(cl)[2] <- "formula" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl,parent.frame()) pwtest.panelmodel(plm.model, effect = effect, ...) # pass on desired 'effect' argument to pwtest.panelmodel ## "RE" test a la Wooldridge (2002/2010), see 10.4.4 ## (basically the scaled and standardized estimator for sigma from REmod) ## does not rely on normality or homoskedasticity; ## H0: composite errors uncorrelated ## ref. Wooldridge (2002), pp. 264-265; Wooldridge (2010), pp. 299-300 ######### from here generic testing interface from ######### plm to my code } #' @rdname pwtest #' @export pwtest.panelmodel <- function(x, effect = c("individual", "time"), ...) { if (describe(x, "model") != "pooling") stop("pwtest only relevant for pooling models") effect <- match.arg(effect, choices = c("individual", "time")) data <- model.frame(x) ## extract indices ## if effect="individual" std., else swap xindex <- unclass(attr(data, "index")) # unclass for speed if (effect == "individual"){ index <- xindex[[1L]] tindex <- xindex[[2L]] } else{ index <- xindex[[2L]] tindex <- xindex[[1L]] } ## det. number of groups and df n <- length(unique(index)) X <- model.matrix(x) k <- ncol(X) ## det. total number of obs. (robust vs. unbalanced panels) nT <- nrow(X) ## det. max. group numerosity t <- max(tapply(X[ , 1L], index, length)) ## ref. Wooldridge (2002), p.264 / Wooldridge (2010), p.299 ## extract resids u <- x$residuals ## est. random effect variance ## "pre-allocate" an empty list of length n tres <- vector("list", n) ## list of n "empirical omega-blocks" ## with averages of xproducts of t(i) residuals ## for each group 1..n ## (possibly different sizes if unbal., thus a list ## and thus, unlike Wooldridge (eq.10.37), we divide ## every block by *its* t(t-1)/2) unind <- unique(index) # ???? for(i in 1:n) { ut <- u[index == unind[i]] tres[[i]] <- ut %o% ut } ## det. # of upper triangle members (n*t(t-1)/2 if balanced) ## no needed, only for illustration # ti <- vapply(tres, function(x) dim(x)[[1L]], FUN.VALUE = 0.0, USE.NAMES = FALSE) # uptrinum <- sum(ti*(ti-1)/2) ## sum over all upper triangles of emp. omega blocks: ## and sum over resulting vector (df corrected) sum.uptri <- vapply(tres, function(x) sum(x[upper.tri(x, diag = FALSE)]), FUN.VALUE = 0.0, USE.NAMES = FALSE) W <- sum(sum.uptri) # /sqrt(n) simplifies out ## calculate se(Wstat) as in 10.40 seW <- sqrt(as.numeric(crossprod(sum.uptri))) ## NB should we apply a df correction here, maybe that of the standard ## RE estimator? (see page 261) Wstat <- W/seW names(Wstat) <- "z" pW <- 2*pnorm(abs(Wstat), lower.tail = FALSE) # unlike LM, test is two-tailed! ## insert usual htest features RVAL <- list(statistic = Wstat, parameter = NULL, method = paste("Wooldridge's test for unobserved", effect, "effects"), alternative = "unobserved effect", p.value = pW, data.name = paste(deparse(substitute(formula)))) class(RVAL) <- "htest" return(RVAL) } #' Wooldridge Test for AR(1) Errors in FE Panel Models #' #' Test of serial correlation for (the idiosyncratic component of) the errors #' in fixed--effects panel models. #' #' As \insertCite{WOOL:10;textual}{plm}, Sec. 10.5.4 observes, under #' the null of no serial correlation in the errors, the residuals of a #' FE model must be negatively serially correlated, with #' \eqn{cor(\hat{u}_{it}, \hat{u}_{is})=-1/(T-1)} for each #' \eqn{t,s}. He suggests basing a test for this null hypothesis on a #' pooled regression of FE residuals on their first lag: #' \eqn{\hat{u}_{i,t} = \alpha + \delta \hat{u}_{i,t-1} + #' \eta_{i,t}}. Rejecting the restriction \eqn{\delta = -1/(T-1)} #' makes us conclude against the original null of no serial #' correlation. #' #' `pwartest` estimates the `within` model and retrieves residuals, #' then estimates an AR(1) `pooling` model on them. The test statistic #' is obtained by applying a F test to the latter model to test the #' above restriction on \eqn{\delta}, setting the covariance matrix to #' `vcovHC` with the option `method="arellano"` to control for serial #' correlation. #' #' Unlike the [pbgtest()] and [pdwtest()], this test does #' not rely on large--T asymptotics and has therefore good properties in #' ``short'' panels. Furthermore, it is robust to general heteroskedasticity. #' #' @aliases pwartest #' @param x an object of class `formula` or of class `panelmodel`, #' @param data a `data.frame`, #' @param \dots further arguments to be passed on to `vcovHC` (see #' Details and Examples). #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo #' @seealso [pwfdtest()], [pdwtest()], [pbgtest()], [pbltest()], #' [pbsytest()]. #' @references #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' @keywords htest #' @examples #' #' data("EmplUK", package = "plm") #' pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK) #' #' # pass argument 'type' to vcovHC used in test #' pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3") #' #' pwartest <- function(x, ...) { UseMethod("pwartest") } #' @rdname pwartest #' @export pwartest.formula <- function(x, data, ...) { ## small-sample serial correlation test for FE models ## ref.: Wooldridge (2002/2010) 10.5.4 cl <- match.call(expand.dots = TRUE) if (is.null(cl$model)) cl$model <- "within" if (cl$model != "within") stop("pwartest only relevant for within models") if (names(cl)[3L] == "") names(cl)[3L] <- "data" names(cl)[2L] <- "formula" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl, parent.frame()) pwartest(plm.model, ...) } #' @rdname pwartest #' @export pwartest.panelmodel <- function(x, ...) { if (describe(x, "model") != "within") stop("pwartest only relevant for within models") FEres <- x$residuals data <- model.frame(x) ## this is a bug fix for incorrect naming of the "data" attr. ## for the pseries in pdata.frame() attr(FEres, "data") <- NULL N <- length(FEres) FEres.1 <- c(NA, FEres[1:(N-1)]) xindex <- unclass(attr(data, "index")) # unclass for speed id <- xindex[[1L]] time <- xindex[[2L]] lagid <- as.numeric(id) - c(NA, as.numeric(id)[1:(N-1)]) FEres.1[lagid != 0] <- NA data <- data.frame(id, time, FEres = unclass(FEres), FEres.1 = unclass(FEres.1)) names(data)[c(1L, 2L)] <- c("id", "time") data <- na.omit(data) # calc. auxiliary model auxmod <- plm(FEres ~ FEres.1, data = data, model = "pooling", index = c("id", "time")) ## calc. theoretical rho under H0: no serial corr. in errors t. <- pdim(x)$nT$T rho.H0 <- -1/(t.-1) myH0 <- paste("FEres.1 = ", as.character(rho.H0), sep="") ## test H0: rho=rho.H0 with HAC myvcov <- function(x) vcovHC(x, method = "arellano", ...) # more params may be passed via ellipsis # calc F stat with restriction rho.H0 and robust vcov FEARstat <- ((coef(auxmod)["FEres.1"] - rho.H0)/sqrt(myvcov(auxmod)["FEres.1", "FEres.1"]))^2 names(FEARstat) <- "F" df1 <- c("df1" = 1) df2 <- c("df2" = df.residual(auxmod)) pFEARstat <- pf(FEARstat, df1 = df1, df2 = df2, lower.tail = FALSE) ## insert usual htest features RVAL <- list(statistic = FEARstat, parameter = c(df1, df2), p.value = pFEARstat, method = "Wooldridge's test for serial correlation in FE panels", alternative = "serial correlation", data.name = paste(deparse(substitute(x)))) class(RVAL) <- "htest" return(RVAL) } ## Bera, Sosa-Escudero and Yoon type LM test for random effects ## under serial correlation (H0: no random effects) or the inverse; ## test="ar": serial corr. test robust vs. RE ## test="re": RE test robust vs. serial corr. ## test="j": joint test for serial corr. and random effects # Reference for the _balanced_ tests="ar"|"re": # Bera/Sosa-Escudero/Yoon (2001), Tests for the error component model in the presence of local misspecifcation, # Journal of Econometrics 101 (2001), pp. 1-23. # # for original (balanced) test="j": Baltagi/Li (1991), A joint test for serial correlation and random individual effects, # Statistics & Probability Letters 11 (1991), pp. 277-280. # # Reference for _un_balanced versions of all three tests (boil down to the balanced versions for balanced panels): # Sosa-Escudero/Bera (2008), Tests for unbalanced error-components models under local misspecification, # The Stata Journal (2008), Vol. 8, Number 1, pp. 68-78. # # Concise treatment of only _balanced_ tests in # Baltagi (2005), Econometric Analysis of Panel Data, 3rd edition, pp. 96-97 # or Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, pp. 108. # # ## Implementation follows the formulae for unbalanced panels, which reduce for balanced data to the formulae for balanced panels. ## ## Notation in code largely follows Sosa-Escudero/Bera (2008) (m in Sosa-Escudero/Bera (2008) is total number of observations -> N_obs) ## NB: Baltagi's book matrix A is slightly different defined: A in Baltagi is -A in Sosa-Escudera/Bera (2008) #' Bera, Sosa-Escudero and Yoon Locally--Robust Lagrange Multiplier #' Tests for Panel Models and Joint Test by Baltagi and Li #' #' Test for residual serial correlation (or individual random effects) #' locally robust vs. individual random effects (serial correlation) #' for panel models and joint test of serial correlation and the #' random effect specification by Baltagi and Li. #' #' These Lagrange multiplier tests are robust vs. local #' misspecification of the alternative hypothesis, i.e., they test the #' null of serially uncorrelated residuals against AR(1) residuals in #' a pooling model, allowing for local departures from the assumption #' of no random effects; or they test the null of no random effects #' allowing for local departures from the assumption of no serial #' correlation in residuals. They use only the residuals of the #' pooled OLS model and correct for local misspecification as outlined #' in \insertCite{BERA:SOSA:YOON:01;textual}{plm}. #' #' For `test = "re"`, the default (`re.normal = TRUE`) is to compute #' a one-sided test which is expected to lead to a more powerful test #' (asymptotically N(0,1) distributed). Setting `re.normal = FALSE` gives #' the two-sided test (asymptotically chi-squared(2) distributed). Argument #' `re.normal` is irrelevant for all other values of `test`. #' #' The joint test of serial correlation and the random effect #' specification (`test = "j"`) is due to #' \insertCite{BALT:LI:91;textual}{plm} (also mentioned in #' \insertCite{BALT:LI:95;textual}{plm}, pp. 135--136) and is added #' for convenience under this same function. #' #' The unbalanced version of all tests are derived in #' \insertCite{SOSA:BERA:08;textual}{plm}. The functions implemented #' are suitable for balanced as well as unbalanced panel data sets. #' #' A concise treatment of the statistics for only balanced panels is #' given in \insertCite{BALT:13;textual}{plm}, p. 108. #' #' Here is an overview of how the various values of the `test` #' argument relate to the literature: #' #' \itemize{ \item `test = "ar"`: \itemize{ \item \eqn{RS*_{\rho}} in Bera #' et al. (2001), p. 9 (balanced) \item \eqn{LM*_{\rho}} in Baltagi (2013), p. #' 108 (balanced) \item \eqn{RS*_{\lambda}} in Sosa-Escudero/Bera (2008), p. 73 #' (unbalanced) } #' #' \item `test = "re", re.normal = TRUE` (default) (one-sided test, #' asymptotically N(0,1) distributed): \itemize{ \item \eqn{RSO*_{\mu}} in Bera #' et al. (2001), p. 11 (balanced) \item \eqn{RSO*_{\mu}} in Sosa-Escudero/Bera #' (2008), p. 75 (unbalanced) } #' #' \item `test = "re", re.normal = FALSE` (two-sided test, asymptotically #' chi-squared(2) distributed): \itemize{ \item \eqn{RS*_{\mu}} in Bera et al. #' (2001), p. 7 (balanced) \item \eqn{LM*_{\mu}} in Baltagi (2013), p. 108 #' (balanced) \item \eqn{RS*_{\mu}} in Sosa-Escudero/Bera (2008), p. 73 #' (unbalanced) } #' #' \item `test = "j"`: \itemize{ \item \eqn{RS_{\mu\rho}} in Bera et al. #' (2001), p. 10 (balanced) \item \eqn{LM} in Baltagi/Li (2001), p. 279 #' (balanced) \item \eqn{LM_{1}} in Baltagi and Li (1995), pp. 135--136 #' (balanced) \item \eqn{LM1} in Baltagi (2013), p. 108 (balanced) \item #' \eqn{RS_{\lambda\rho}} in Sosa-Escudero/Bera (2008), p. 74 (unbalanced) } } #' #' @aliases pbsytest #' @param x an object of class `formula` or of class `panelmodel`, #' @param data a `data.frame`, #' @param test a character string indicating which test to perform: #' first--order serial correlation (`"ar"`), random effects (`"re"`) #' or joint test for either of them (`"j"`), #' @param re.normal logical, only relevant for `test = "re"`: `TRUE` #' (default) computes the one-sided `"re"` test, `FALSE` the #' two-sided test (see also Details); not relevant for other values of #' `test` and, thus, should be `NULL`, #' @param \dots further arguments. #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo (initial implementation) & Kevin Tappe (extension to #' unbalanced panels) #' @seealso [plmtest()] for individual and/or time random effects #' tests based on a correctly specified model; [pbltest()], #' [pbgtest()] and [pdwtest()] for serial correlation tests #' in random effects models. #' @references #' #' \insertRef{BERA:SOSA:YOON:01}{plm} #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:LI:91}{plm} #' #' \insertRef{BALT:LI:95}{plm} #' #' \insertRef{SOSA:BERA:08}{plm} #' #' @keywords htest #' #' @examples #' #' ## Bera et. al (2001), p. 13, table 1 use #' ## a subset of the original Grunfeld #' ## data which contains three errors -> construct this subset: #' data("Grunfeld", package = "plm") #' Grunsubset <- rbind(Grunfeld[1:80, ], Grunfeld[141:160, ]) #' Grunsubset[Grunsubset$firm == 2 & Grunsubset$year %in% c(1940, 1952), ][["inv"]] <- c(261.6, 645.2) #' Grunsubset[Grunsubset$firm == 2 & Grunsubset$year == 1946, ][["capital"]] <- 232.6 #' #' ## default is AR testing (formula interface) #' pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year")) #' pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), test = "re") #' pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), #' test = "re", re.normal = FALSE) #' pbsytest(inv ~ value + capital, data = Grunsubset, index = c("firm", "year"), test = "j") #' #' ## plm interface #' mod <- plm(inv ~ value + capital, data = Grunsubset, model = "pooling") #' pbsytest(mod) #' pbsytest <- function (x, ...) { UseMethod("pbsytest") } #' @rdname pbsytest #' @export pbsytest.formula <- function(x, data, ..., test = c("ar", "re", "j"), re.normal = if (test == "re") TRUE else NULL) { ######### from here generic testing interface from ######### plm to my code if (length(test) == 1L) test <- tolower(test) # for backward compatibility: allow upper case test <- match.arg(test) cl <- match.call(expand.dots = TRUE) if (is.null(cl$model)) cl$model <- "pooling" if (cl$model != "pooling") stop("pbsytest only relevant for pooling models") names(cl)[2L] <- "formula" if (names(cl)[3L] == "") names(cl)[3L] <- "data" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1, m)] cl[[1L]] <- as.name("plm") plm.model <- eval(cl, parent.frame()) pbsytest(plm.model, test = test, re.normal = re.normal, ...) } #' @rdname pbsytest #' @export pbsytest.panelmodel <- function(x, test = c("ar", "re", "j"), re.normal = if (test == "re") TRUE else NULL, ...) { test <- match.arg(test) if (describe(x, "model") != "pooling") stop("pbsytest only relevant for pooling models") # interface check for argument re.normal if (test != "re" && !is.null(re.normal)) { stop("argument 're.normal' only relevant for test = \"re\", set re.normal = NULL for other tests")} poolres <- x$residuals data <- model.frame(x) ## extract indices index <- attr(data, "index") iindex <- index[[1L]] tindex <- index[[2L]] ## till here. ## ordering here if needed. ## this needs ordering of obs. on time, regardless ## whether before that on groups or after ## and numerosity check ## order by group, then time oo <- order(iindex,tindex) ind <- iindex[oo] tind <- tindex[oo] poolres <- poolres[oo] pdim <- pdim(x) n <- max(pdim$Tint$n) ## det. number of groups T_i <- pdim$Tint$Ti N_t <- pdim$Tint$nt t <- max(T_i) ## det. max. group numerosity N_obs <- pdim$nT$N ## det. total number of obs. (m in Sosa-Escudera/Bera (2008), p. 69) ## calc. matrices A and B: # Sosa-Escudera/Bera (2008), p. 74 # Baltagi (2013), p. 108 defines A=(S1/S2)-1 and, thus, has slightly different formulae [opposite sign in Baltagi] S1 <- as.numeric(crossprod(tapply(poolres,ind,sum))) # == sum(tapply(poolres,ind,sum)^2) S2 <- as.numeric(crossprod(poolres)) # == sum(poolres^2) A <- 1 - S1/S2 unind <- unique(ind) uu <- uu1 <- rep(NA, length(unind)) for(i in 1:length(unind)) { u.t <- poolres[ind == unind[i]] u.t.1 <- u.t[-length(u.t)] u.t <- u.t[-1L] uu[i] <- crossprod(u.t) uu1[i] <- crossprod(u.t, u.t.1) } B <- sum(uu1)/sum(uu) a <- as.numeric(crossprod(T_i)) # Sosa-Escudera/Bera (2008), p. 69 switch(test, "ar" = { # RS*_lambda from Sosa-Escudero/Bera (2008), p. 73 (unbalanced formula) stat <- (B + (((N_obs - n)/(a - N_obs)) * A))^2 * (((a - N_obs)*N_obs^2) / ((N_obs - n)*(a - 3*N_obs + 2*n))) df <- c(df = 1) names(stat) <- "chisq" pstat <- pchisq(stat, df = df, lower.tail = FALSE) tname <- "Bera, Sosa-Escudero and Yoon locally robust test" myH0_alt <- "AR(1) errors sub random effects" }, "re" = { if(re.normal) { # RSO*_mu from Sosa-Escudero/Bera (2008), p. 75 (unbalanced formula), normally distributed stat <- -sqrt( (N_obs^2) / (2*(a - 3*N_obs + 2*n))) * (A + 2*B) names(stat) <- "z" df <- NULL pstat <- pnorm(stat, lower.tail = FALSE) tname <- "Bera, Sosa-Escudero and Yoon locally robust test (one-sided)" myH0_alt <- "random effects sub AR(1) errors" } else { # RS*_mu from Sosa-Escudero/Bera (2008), p. 73 (unbalanced formula), chisq(1) stat <- ((N_obs^2) * (A + 2*B)^2) / (2*(a - 3*N_obs + 2*n)) names(stat) <- "chisq" df <- c(df = 1) pstat <- pchisq(stat, df = df, lower.tail = FALSE) tname <- "Bera, Sosa-Escudero and Yoon locally robust test (two-sided)" myH0_alt <- "random effects sub AR(1) errors" } }, "j" = { # RS_lambda_mu in Sosa-Escudero/Bera (2008), p. 74 (unbalanced formula) stat <- N_obs^2 * ( ((A^2 + 4*A*B + 4*B^2) / (2*(a - 3*N_obs + 2*n))) + (B^2/(N_obs - n))) # Degrees of freedom in the joint test (test="j") of Baltagi/Li (1991) are 2 (chisquare(2) distributed), # see Baltagi/Li (1991), p. 279 and again in Baltagi/Li (1995), p. 136 df <- c(df = 2) names(stat) <- "chisq" pstat <- pchisq(stat, df = df, lower.tail = FALSE) tname <- "Baltagi and Li AR-RE joint test" myH0_alt <- "AR(1) errors or random effects" } ) # END switch dname <- paste(deparse(substitute(formula))) balanced.type <- if(pdim$balanced) "balanced" else "unbalanced" tname <- paste(tname, "-", balanced.type, "panel", collapse = " ") RVAL <- list(statistic = stat, parameter = df, method = tname, alternative = myH0_alt, p.value = pstat, data.name = dname) class(RVAL) <- "htest" return(RVAL) } #' Durbin--Watson Test for Panel Models #' #' Test of serial correlation for (the idiosyncratic component of) the errors #' in panel models. #' #' This Durbin--Watson test uses the auxiliary model on #' (quasi-)demeaned data taken from a model of class `plm` which may #' be a `pooling` (the default), `random` or `within` model. It #' performs a Durbin--Watson test (using `dwtest` from package #' \CRANpkg{lmtest} on the residuals of the (quasi-)demeaned model, #' which should be serially uncorrelated under the null of no serial #' correlation in idiosyncratic errors. The function takes the #' demeaned data, estimates the model and calls `dwtest`. Thus, this #' test does not take the panel structure of the residuals into #' consideration; it shall not be confused with the generalized #' Durbin-Watson test for panels in `pbnftest`. #' #' @aliases pdwtest #' @importFrom lmtest dwtest #' @param x an object of class `"panelmodel"` or of class #' `"formula"`, #' @param data a `data.frame`, #' @param \dots further arguments to be passed on to `dwtest`, #' e.g., `alternative`, see [lmtest::dwtest()] for #' further details. #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo #' @seealso [lmtest::dwtest()] for the Durbin--Watson test #' in \CRANpkg{lmtest}, [pbgtest()] for the analogous #' Breusch--Godfrey test for panel models, #' [lmtest::bgtest()] for the Breusch--Godfrey test for #' serial correlation in the linear model. [pbltest()], #' [pbsytest()], [pwartest()] and #' [pwfdtest()] for other serial correlation tests for #' panel models. #' #' For the Durbin-Watson test generalized to panel data models see #' [pbnftest()]. #' @references #' #' \insertRef{DURB:WATS:50}{plm} #' #' \insertRef{DURB:WATS:51}{plm} #' #' \insertRef{DURB:WATS:71}{plm} #' #' \insertRef{WOOL:02}{plm} #' #' \insertRef{WOOL:10}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' g <- plm(inv ~ value + capital, data = Grunfeld, model="random") #' pdwtest(g) #' pdwtest(g, alternative="two.sided") #' ## formula interface #' pdwtest(inv ~ value + capital, data=Grunfeld, model="random") #' pdwtest <- function (x, ...) { UseMethod("pdwtest") } #' @rdname pdwtest #' @export pdwtest.panelmodel <- function(x, ...) { ## does not respect panel structure: ## residual serial correlation test based on the residuals of the demeaned ## model and passed on to lmtest::dwtest() for the original DW test ## approach justified in Wooldridge (2002/2010), Econometric Analysis of Cross Section and Panel Data, p. 288/328. ## ## For the Bhargava et al. (1982) generalized DW test see pbnftest() ## structure: ## 1: take demeaned data from 'plm' object ## 2: est. auxiliary model by OLS on demeaned data ## 3: apply lmtest::dwtest() to auxiliary model and return the result model <- describe(x, "model") effect <- describe(x, "effect") theta <- x$ercomp$theta ## retrieve demeaned data demX <- model.matrix(x, model = model, effect = effect, theta = theta, cstcovar.rm = "all") demy <- pmodel.response(model.frame(x), model = model, effect = effect, theta = theta) ## lmtest::dwtest on the demeaned model: ## ARtest is the return value of lmtest::dwtest, exception made for the method attribute dots <- list(...) order.by <- if(is.null(dots$order.by)) NULL else dots$order.by alternative <- if(is.null(dots$alternative)) "greater" else dots$alternative iterations <- if(is.null(dots$iterations)) 15 else dots$iterations exact <- if(is.null(dots$exact)) NULL else dots$exact tol <- if(is.null(dots$tol)) 1e-10 else dots$tol demy <- remove_pseries_features(demy) # needed as lmtest::dwtest cannot cope with pseries auxformula <- demy ~ demX - 1 lm.mod <- lm(auxformula) ARtest <- dwtest(lm.mod, order.by = order.by, alternative = alternative, iterations = iterations, exact = exact, tol = tol) # overwrite elements of the values produced by lmtest::dwtest ARtest$method <- "Durbin-Watson test for serial correlation in panel models" ARtest$alternative <- "serial correlation in idiosyncratic errors" ARtest$data.name <- data.name(x) return(ARtest) } #' @rdname pdwtest #' @export pdwtest.formula <- function(x, data, ...) { ## formula method for pdwtest; ## defaults to pooling model cl <- match.call(expand.dots = TRUE) if (is.null(cl$model)) cl$model <- "pooling" names(cl)[2L] <- "formula" if (names(cl)[3L] == "") names(cl)[3L] <- "data" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl, parent.frame()) pdwtest(plm.model, ...) } ## references: ## * balanced and consecutive: ## Bhargava/Franzini/Narendranathan (1982), Serial Correlation and the Fixed Effects Model, Review of Economic Studies (1982), XLIX(4), pp. 533-549. ## (also in Baltagi (2005/2013), p. 98-99/109-110 for FE application) ## * unbalanced and/or non-consecutive: modified BNF statistic and LBI statistic ## Baltagi/Wu (1999), Unequally spaced panel data regressions with AR(1) disturbances. Econometric Theory, 15(6), pp. 814-823. ## (an example is also in Baltagi (2005/2013), p. 90/101) #' Modified BNF--Durbin--Watson Test and Baltagi--Wu's LBI Test for Panel #' Models #' #' Tests for AR(1) disturbances in panel models. #' #' The default, `test = "bnf"`, gives the (modified) BNF statistic, #' the generalised Durbin-Watson statistic for panels. For balanced #' and consecutive panels, the reference is #' Bhargava/Franzini/Narendranathan (1982). The modified BNF is given #' for unbalanced and/or non-consecutive panels (d1 in formula 16 of #' \insertCite{BALT:WU:99;textual}{plm}). #' #' `test = "lbi"` yields Baltagi--Wu's LBI statistic #' \insertCite{BALT:WU:99}{plm}, the locally best invariant test which #' is based on the modified BNF statistic. #' #' No specific variants of these tests are available for random effect models. #' As the within estimator is consistent also under the random effects #' assumptions, the test for random effect models is performed by taking the #' within residuals. #' #' No p-values are given for the statistics as their distribution is #' quite difficult. \insertCite{BHAR:FRAN:NARE:82;textual}{plm} supply #' tabulated bounds for p = 0.05 for the balanced case and consecutive #' case. #' #' For large N, \insertCite{BHAR:FRAN:NARE:82}{plm} suggest it is #' sufficient to check whether the BNF statistic is < 2 to test #' against positive serial correlation. #' #' @aliases pbnftest #' @param x an object of class `"panelmodel"` or of class `"formula"`, #' @param test a character indicating the test to be performed, either #' `"bnf"` or `"lbi"` for the (modified) BNF statistic or #' Baltagi--Wu's LBI statistic, respectively, #' @param data a `data.frame` (only relevant for formula interface), #' @param model a character indicating on which type of model the test #' shall be performed (`"pooling"`, `"within"`, `"random"`, only #' relevant for formula interface), #' @param \dots only relevant for formula interface: further arguments #' to specify the model to test (arguments passed on to plm()), #' e.g., `effect`. #' @return An object of class `"htest"`. #' @export #' @author Kevin Tappe #' @seealso [pdwtest()] for the original Durbin--Watson test using #' (quasi-)demeaned residuals of the panel model without taking #' the panel structure into account. [pbltest()], [pbsytest()], #' [pwartest()] and [pwfdtest()] for other serial correlation #' tests for panel models. #' @references #' #' \insertRef{BALT:13}{plm} #' #' \insertRef{BALT:WU:99}{plm} #' #' \insertRef{BHAR:FRAN:NARE:82}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' #' # formula interface, replicate Baltagi/Wu (1999), table 1, test case A: #' data_A <- Grunfeld[!Grunfeld[["year"]] %in% c("1943", "1944"), ] #' pbnftest(inv ~ value + capital, data = data_A, model = "within") #' pbnftest(inv ~ value + capital, data = data_A, test = "lbi", model = "within") #' #' # replicate Baltagi (2013), p. 101, table 5.1: #' re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") #' pbnftest(re) #' pbnftest(re, test = "lbi") #' pbnftest <- function (x, ...) { UseMethod("pbnftest") } #' @rdname pbnftest #' @export pbnftest.panelmodel <- function(x, test = c("bnf", "lbi"), ...) { test <- match.arg(test) # no test for random effects available: take FE as also consistent (Verbeek (2004, 2nd edition), p. 358) model <- describe(x, "model") if (model == "random") x <- update(x, model = "within") consec <- all(is.pconsecutive(x)) balanced <- is.pbalanced(x) # residuals are now class pseries, so diff.pseries is used and the # differences are computed within observational units (not across as # it would be the case if base::diff() is used and as it is done for # lm-objects) NAs are introduced by the differencing as one # observation is lost per observational unit if (!inherits(residuals(x), "pseries")) stop("pdwtest internal error: residuals are not of class \"pseries\"") # check to be safe: need pseries ind <- unclass(index(x))[[1L]] # unclass for speed obs1 <- !duplicated(ind) # first ob of each individual obsn <- !duplicated(ind, fromLast = TRUE) # last ob of each individual #### d1, d2, d3, d4 as in Baltagi/Wu (1999), p. 819 formula (16) res_crossprod <- as.numeric(crossprod(residuals(x))) # denominator ## d1 consists of two parts: ## d1.1: BNF statistic (sum of squared differenced residuals of consecutive time periods per individual) ## d1.2: sum of squared "later" residuals (not differenced) surrounded by gaps in time periods ## typo in Baltagi/Wu (1999) for d1: index j starts at j = 2, not j = 1 res_diff <- diff(residuals(x), shift = "time") d1.1 <- sum(res_diff^2, na.rm = T) / res_crossprod # == BNF (1982), formula (4) d1.2_contrib <- as.logical(is.na(res_diff) - obs1) d1.2 <- as.numeric(crossprod(residuals(x)[d1.2_contrib])) / res_crossprod d1 <- d1.1 + d1.2 # == modified BNF statistic = d1 in Baltagi/Wu (1999) formula (16) # [reduces to original BNF in case of balanced and consecutive data (d1.2 is zero)] if (test == "bnf") { stat <- d1 names(stat) <- "DW" method <- "Bhargava/Franzini/Narendranathan Panel Durbin-Watson Test" if (!consec || !balanced) method <- paste0("modified ", method) } if (test == "lbi") { ## d2 contains the "earlier" obs surrounded by gaps in time periods d2_contrib <- as.logical(is.na(lead(residuals(x), shift = "time")) - obsn) d2 <- as.numeric(crossprod(residuals(x)[d2_contrib])) / res_crossprod ## d3, d4: sum squared residual of first/last time period for all individuals / crossprod(residuals) d3 <- as.numeric(crossprod(residuals(x)[obs1])) / res_crossprod d4 <- as.numeric(crossprod(residuals(x)[obsn])) / res_crossprod stat <- d1 + d2 + d3 + d4 names(stat) <- "LBI" method <- "Baltagi/Wu LBI Test for Serial Correlation in Panel Models" } result <- list(statistic = stat, # p.value = NA, # none method = method, alternative = "serial correlation in idiosyncratic errors", data.name = data.name(x)) class(result) <- "htest" return(result) } #' @rdname pbnftest #' @export pbnftest.formula <- function(x, data, test = c("bnf", "lbi"), model = c("pooling", "within", "random"), ...) { ## formula method for pdwtest; ## defaults to pooling model test <- match.arg(test) model <- match.arg(model) cl <- match.call(expand.dots = TRUE) if (is.null(model)) model <- "pooling" names(cl)[2L] <- "formula" if (names(cl)[3L] == "") names(cl)[3L] <- "data" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl, parent.frame()) pbnftest(plm.model, test = test) } ######### Baltagi and Li's LM_rho|mu ######## ## ex Baltagi and Li (1995) Testing AR(1) against MA(1)..., ## JE 68, 133-151, test statistic (one-sided) is LM_4; ## see also idem (1997), Monte Carlo results..., ## Annales d'Econometrie et Statistique 48, formula (8) ## from version 2: disposes of Kronecker products, ## thus much faster and feasible on large NT (original ## is already infeasible for NT>3000, this takes 10'' ## on N=3000, T=10 and even 20000x10 (55'') is no problem; ## lme() hits the memory limit at ca. 20000x20) #' Baltagi and Li Serial Dependence Test For Random Effects Models #' #' \insertCite{BALT:LI:95;textual}{plm}'s Lagrange multiplier test for #' AR(1) or MA(1) idiosyncratic errors in panel models with random #' effects. #' #' This is a Lagrange multiplier test for the null of no serial #' correlation, against the alternative of either an AR(1) or a MA(1) #' process, in the idiosyncratic component of the error term in a #' random effects panel model (as the analytical expression of the #' test turns out to be the same under both alternatives, #' \insertCite{@see @BALT:LI:95 and @BALT:LI:97}{plm}. The #' `alternative` argument, defaulting to `twosided`, allows testing #' for positive serial correlation only, if set to `onesided`. #' #' @aliases pbltest #' @importFrom nlme lme #' @param x a model formula or an estimated random--effects model of #' class `plm` , #' @param data for the formula interface only: a `data.frame`, #' @param alternative one of `"twosided"`, #' `"onesided"`. Selects either \eqn{H_A: \rho \neq 0} or #' \eqn{H_A: \rho = 0} (i.e., the Normal or the Chi-squared #' version of the test), #' @param index the index of the `data.frame`, #' @param \dots further arguments. #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo #' @seealso [pdwtest()], [pbnftest()], [pbgtest()], #' [pbsytest()], [pwartest()] and #' [pwfdtest()] for other serial correlation tests for #' panel models. #' @references #' #' \insertRef{BALT:LI:95}{plm} #' #' \insertRef{BALT:LI:97}{plm} #' #' @keywords htest #' @examples #' #' data("Grunfeld", package = "plm") #' #' # formula interface #' pbltest(inv ~ value + capital, data = Grunfeld) #' #' # plm interface #' re_mod <- plm(inv ~ value + capital, data = Grunfeld, model = "random") #' pbltest(re_mod) #' pbltest(re_mod, alternative = "onesided") #' pbltest <- function (x, ...) { UseMethod("pbltest") } #' @rdname pbltest #' @export pbltest.formula <- function(x, data, alternative = c("twosided", "onesided"), index = NULL, ...) { ## this version (pbltest0) based on a "formula, pdataframe" interface ## reduce X to model matrix value (no NAs) X <- model.matrix(x, data = data) ## reduce data accordingly data <- data[which(row.names(data) %in% row.names(X)), ] if (! inherits(data, "pdata.frame")) data <- pdata.frame(data, index = index) ## need name of individual index gindex <- dimnames(attr(data, "index"))[[2L]][1L] ## make random effects formula rformula <- NULL eval(parse(text = paste("rformula <- ~1|", gindex, sep = ""))) ## est. MLE model mymod <- lme(x, data = data, random = rformula, method = "ML") nt. <- mymod$dims$N n. <- as.numeric(mymod$dims$ngrps[1L]) t. <- nt./n. Jt <- matrix(1, ncol = t., nrow = t.)/t. Et <- diag(1, t.) - Jt ## make 'bidiagonal' matrix (see BL, p.136) G <- matrix(0, ncol = t., nrow = t.) for(i in 2:t.) { G[i-1, i] <- 1 G[i, i-1] <- 1 } ## retrieve composite (=lowest level) residuals uhat <- residuals(mymod, level = 0) ## sigma2.e and sigma2.1 as in BL ## break up residuals by group to get rid of Kronecker prod. ## data have to be balanced and sorted by group/time, so this works uhat.i <- vector("list", n.) for(i in 1:n.) { uhat.i[[i]] <- uhat[t.*(i-1)+1:t.] } s2e <- rep(NA, n.) s21 <- rep(NA, n.) for(i in 1:n.) { u.i <- uhat.i[[i]] s2e[i] <- as.numeric(crossprod(u.i, Et) %*% u.i) s21[i] <- as.numeric(crossprod(u.i, Jt) %*% u.i) } sigma2.e <- sum(s2e) / (n.*(t.-1)) sigma2.1 <- sum(s21) / n. ## calc. score under the null: star1 <- (Jt/sigma2.1 + Et/sigma2.e) %*% G %*% (Jt/sigma2.1 + Et/sigma2.e) star2 <- rep(NA, n.) ## again, do this group by group to avoid Kronecker prod. for(i in 1:n.) { star2[i] <- as.numeric(crossprod(uhat.i[[i]], star1) %*% uhat.i[[i]]) } star2 <- sum(star2) Drho <- (n.*(t.-1)/t.) * (sigma2.1-sigma2.e)/sigma2.1 + sigma2.e/2 * star2 ## star2 is (crossprod(uhat, kronecker(In, star1)) %*% uhat) ## components for the information matrix a <- (sigma2.e - sigma2.1)/(t.*sigma2.1) j.rr <- n. * (2 * a^2 * (t.-1)^2 + 2*a*(2*t.-3) + (t.-1)) j.12 <- n.*(t.-1)*sigma2.e / sigma2.1^2 j.13 <- n.*(t.-1)/t. * sigma2.e * (1/sigma2.1^2 - 1/sigma2.e^2) j.22 <- (n. * t.^2) / (2 * sigma2.1^2) j.23 <- (n. * t.) / (2 * sigma2.1^2) j.33 <- (n./2) * (1/sigma2.1^2 + (t.-1)/sigma2.e^2) ## build up information matrix Jmat <- matrix(nrow = 3L, ncol = 3L) Jmat[1L, ] <- c(j.rr, j.12, j.13) Jmat[2L, ] <- c(j.12, j.22, j.23) Jmat[3L, ] <- c(j.13, j.23, j.33) J11 <- n.^2 * t.^2 * (t.-1) / (det(Jmat) * 4*sigma2.1^2 * sigma2.e^2) ## this is the same as J11 <- solve(Jmat)[1,1], see BL page 73 switch(match.arg(alternative), "onesided" = { LMr.m <- Drho * sqrt(J11) pval <- pnorm(LMr.m, lower.tail = FALSE) names(LMr.m) <- "z" method1 <- "one-sided" method2 <- "H0: rho = 0, HA: rho > 0" parameter <- NULL }, "twosided" = { LMr.m <- Drho^2 * J11 pval <- pchisq(LMr.m, df = 1, lower.tail = FALSE) names(LMr.m) <- "chisq" parameter <- c(df = 1) method1 <- "two-sided" method2 <- "H0: rho = 0, HA: rho != 0" } ) dname <- paste(deparse(substitute(x))) method <- paste("Baltagi and Li", method1, "LM test") alternative <- "AR(1)/MA(1) errors in RE panel model" res <- list(statistic = LMr.m, p.value = pval, method = method, alternative = alternative, parameter = parameter, data.name = dname) class(res) <- "htest" res } #' @rdname pbltest #' @export pbltest.plm <- function(x, alternative = c("twosided", "onesided"), ...) { # only continue if random effects model if (describe(x, "model") != "random") stop("Test is only for random effects models.") # call pbltest.formula the right way pbltest.formula(formula(x$formula), data = cbind(index(x), x$model), index = names(index(x)), alternative = alternative, ...) } #' Wooldridge first--difference--based test for AR(1) errors in levels #' or first--differenced panel models #' #' First--differencing--based test of serial correlation for (the idiosyncratic #' component of) the errors in either levels or first--differenced panel #' models. #' #' As \insertCite{WOOL:10;textual}{plm}, Sec. 10.6.3 observes, if the #' idiosyncratic errors in the model in levels are uncorrelated (which #' we label hypothesis `"fe"`), then the errors of the model in first #' differences (FD) must be serially correlated with #' \eqn{cor(\hat{e}_{it}, \hat{e}_{is}) = -0.5} for each \eqn{t,s}. If #' on the contrary the levels model's errors are a random walk, then #' there must be no serial correlation in the FD errors (hypothesis #' `"fd"`). Both the fixed effects (FE) and the first--differenced #' (FD) estimators remain consistent under either assumption, but the #' relative efficiency changes: FE is more efficient under `"fe"`, FD #' under `"fd"`. #' #' Wooldridge (ibid.) suggests basing a test for either hypothesis on #' a pooled regression of FD residuals on their first lag: #' \eqn{\hat{e}_{i,t}=\alpha + \rho \hat{e}_{i,t-1} + #' \eta_{i,t}}. Rejecting the restriction \eqn{\rho = -0.5} makes us #' conclude against the null of no serial correlation in errors of the #' levels equation (`"fe"`). The null hypothesis of no serial #' correlation in differenced errors (`"fd"`) is tested in a similar #' way, but based on the zero restriction on \eqn{\rho} (\eqn{\rho = #' 0}). Rejecting `"fe"` favours the use of the first--differences #' estimator and the contrary, although it is possible that both be #' rejected. #' #' `pwfdtest` estimates the `fd` model (or takes an `fd` model as #' input for the panelmodel interface) and retrieves its residuals, #' then estimates an AR(1) `pooling` model on them. The test statistic #' is obtained by applying a F test to the latter model to test the #' relevant restriction on \eqn{\rho}, setting the covariance matrix #' to `vcovHC` with the option `method="arellano"` to control for #' serial correlation. #' #' Unlike the `pbgtest` and `pdwtest`, this test does not rely on #' large--T asymptotics and has therefore good properties in ''short'' #' panels. Furthermore, it is robust to general #' heteroskedasticity. The `"fe"` version can be used to test for #' error autocorrelation regardless of whether the maintained #' specification has fixed or random effects #' \insertCite{@see @DRUK:03}{plm}. #' #' @aliases pwfdtest #' @param x an object of class `formula` or a `"fd"`-model (plm #' object), #' @param data a `data.frame`, #' @param h0 the null hypothesis: one of `"fd"`, `"fe"`, #' @param \dots further arguments to be passed on to `vcovHC` (see Details #' and Examples). #' @return An object of class `"htest"`. #' @export #' @author Giovanni Millo #' @seealso `pdwtest`, `pbgtest`, `pwartest`, #' @references #' #' \insertRef{DRUK:03}{plm} #' #' \insertRef{WOOL:02}{plm} #' Sec. 10.6.3, pp. 282--283. #' #' \insertRef{WOOL:10}{plm} #' Sec. 10.6.3, pp. 319--320 #' #' @keywords htest #' @examples #' #' data("EmplUK" , package = "plm") #' pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK) #' pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, h0 = "fe") #' #' # pass argument 'type' to vcovHC used in test #' pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3", h0 = "fe") #' #' #' # same with panelmodel interface #' mod <- plm(log(emp) ~ log(wage) + log(capital), data = EmplUK, model = "fd") #' pwfdtest(mod) #' pwfdtest(mod, h0 = "fe") #' pwfdtest(mod, type = "HC3", h0 = "fe") #' #' pwfdtest <- function(x, ...) { UseMethod("pwfdtest") } #' @rdname pwfdtest #' @export pwfdtest.formula <- function(x, data, ..., h0 = c("fd", "fe")) { cl <- match.call(expand.dots = TRUE) if (is.null(cl$model)) cl$model <- "fd" names(cl)[2L] <- "formula" if (names(cl)[3L] == "") names(cl)[3L] <- "data" m <- match(plm.arg, names(cl), 0) cl <- cl[c(1L, m)] cl[[1L]] <- quote(plm) plm.model <- eval(cl, parent.frame()) pwfdtest(plm.model, ..., h0 = h0) } #' @rdname pwfdtest #' @export pwfdtest.panelmodel <- function(x, ..., h0 = c("fd", "fe")) { ## first-difference-based serial correlation test for panel models ## ref.: Wooldridge (2002/2010), par. 10.6.3 # interface check model <- describe(x, "model") if (model != "fd") stop(paste0("input 'x' needs to be a \"fd\" model (first-differenced model), but is \"", model, "\"")) ## fetch fd residuals FDres <- x$residuals ## indices (full length! must reduce by 1st time period) ## this is an ad-hoc solution for the fact that the 'fd' model ## carries on the full indices while losing the first time period xindex <- unclass(attr(model.frame(x), "index")) # unclass for speed time <- as.numeric(xindex[[2L]]) id <- as.numeric(xindex[[1L]]) ## fetch dimensions and adapt to those of indices pdim <- pdim(x) n <- pdim$nT$n Ti_minus_one <- pdim$Tint$Ti-1 ## generate new individual index: drop one observation per individual ## NB: This is based on the assumption that the estimated FD model performs ## its diff-ing row-wise (it currently does so). If the diff-ing for FD ## is changed to diff-ing based on time dimension, this part about index ## creation needs to be re-worked because more than 1 observation per ## individual can be dropped red_id <- integer() for(i in 1:n) { red_id <- c(red_id, rep(i, Ti_minus_one[i])) } # additional check # (but should error earlier already as the FD model should be nonestimable) if(length(red_id) == 0L) stop("only individuals with one observation in original data: test not feasible") # make pdata.frame for auxiliary regression: time dimension is not relevant # as the first observation of each individual was dropped -> let time dimension # be created (is not related to the original times anymore) auxdata <- pdata.frame(as.data.frame(cbind(red_id, FDres)), index = "red_id") # lag residuals by row (as the FD model diffs by row) # NB: need to consider change to shift = "time" if behaviour of FD model is changed auxdata[["FDres.1"]] <- lag(auxdata[["FDres"]], shift = "row") ## pooling model FDres vs. lag(FDres), with intercept (might as well do it w.o.) auxmod <- plm(FDres ~ FDres.1, data = auxdata, model = "pooling") switch(match.arg(h0), "fd" = {h0des <- "differenced" ## theoretical rho under H0: no serial ## corr. in differenced errors is 0 rho.H0 <- 0}, "fe" = {h0des <- "original" ## theoretical rho under H0: no serial ## corr. in original errors is -0.5 rho.H0 <- -0.5}) myH0 <- paste("FDres.1 = ", as.character(rho.H0), sep="") ## test H0: rho=rho.H0 with HAC, more params may be passed via ellipsis myvcov <- function(x) vcovHC(x, method = "arellano", ...) # calc F stat with restriction rho.H0 and robust vcov FDARstat <- ((coef(auxmod)["FDres.1"] - rho.H0)/sqrt(myvcov(auxmod)["FDres.1", "FDres.1"]))^2 names(FDARstat) <- "F" df1 <- c(df1 = 1) df2 <- c(df2 = df.residual(auxmod)) pFDARstat <- pf(FDARstat, df1 = df1, df2 = df2, lower.tail = FALSE) ## insert usual htest features RVAL <- list(statistic = FDARstat, parameter = c(df1, df2), p.value = pFDARstat, method = "Wooldridge's first-difference test for serial correlation in panels", alternative = paste("serial correlation in", h0des, "errors"), data.name = paste(deparse(substitute(x)))) class(RVAL) <- "htest" return(RVAL) } plm/R/tool_ercomp.R0000644000176200001440000010744414161615042013722 0ustar liggesusers #' Estimation of the error components #' #' This function enables the estimation of the variance components of a panel #' model. #' #' #' @aliases ercomp #' @param object a `formula` or a `plm` object, #' @param data a `data.frame`, #' @param effect the effects introduced in the model, see [plm()] for #' details, #' @param method method of estimation for the variance components, see #' [plm()] for details, #' @param models the models used to estimate the variance components #' (an alternative to the previous argument), #' @param dfcor a numeric vector of length 2 indicating which degree #' of freedom should be used, #' @param index the indexes, #' @param x an `ercomp` object, #' @param digits digits, #' @param \dots further arguments. #' @return An object of class `"ercomp"`: a list containing \itemize{ #' \item `sigma2` a named numeric with estimates of the variance #' components, \item `theta` contains the parameter(s) used for #' the transformation of the variables: For a one-way model, a #' numeric corresponding to the selected effect (individual or #' time); for a two-ways model a list of length 3 with the #' parameters. In case of a balanced model, the numeric has length #' 1 while for an unbalanced model, the numerics' length equal the #' number of observations. } #' @export #' @author Yves Croissant #' @seealso [plm()] where the estimates of the variance components are #' used if a random effects model is estimated #' @references #' #' \insertRef{AMEM:71}{plm} #' #' \insertRef{NERLO:71}{plm} #' #' \insertRef{SWAM:AROR:72}{plm} #' #' \insertRef{WALL:HUSS:69}{plm} #' #' @keywords regression #' @examples #' #' data("Produc", package = "plm") #' # an example of the formula method #' ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, #' method = "walhus", effect = "time") #' # same with the plm method #' z <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, #' data = Produc, random.method = "walhus", #' effect = "time", model = "random") #' ercomp(z) #' # a two-ways model #' ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, #' method = "amemiya", effect = "twoways") #' ercomp <- function(object, ...){ UseMethod("ercomp") } #' @rdname ercomp #' @export ercomp.plm <- function(object, ...){ model <- describe(object, "model") if (model != "random") stop("ercomp only relevant for random models") object$ercomp } #' @rdname ercomp #' @export ercomp.pdata.frame <- function(object, effect = c("individual", "time", "twoways", "nested"), method = NULL, models = NULL, dfcor = NULL, index = NULL, ...){ data <- object object <- attr(data, "formula") ercomp(object, data, effect = effect, method = method, models = models, dfcor = dfcor, index = index, ...) } #' @rdname ercomp #' @export ercomp.formula <- function(object, data, effect = c("individual", "time", "twoways", "nested"), method = NULL, models = NULL, dfcor = NULL, index = NULL, ...){ effect <- match.arg(effect) if (! inherits(object, "Formula")) object <- as.Formula(object) # if the data argument is not a pdata.frame, create it using plm if (! inherits(data, "pdata.frame")) data <- plm(object, data, model = NA, index = index) if(is.null(attr(data, "terms"))) data <- model.frame(data, object) # check whether the panel is balanced balanced <- is.pbalanced(data) # method and models arguments can't be both set if (! is.null(method) && ! is.null(models)) stop("you can't use both, the 'method' and the 'models' arguments") # method and models arguments aren't set, use swar if (is.null(method) && is.null(models)) method <- "swar" # dfcor is set, coerce it to a length 2 vector if necessary if (! is.null(dfcor)){ if (length(dfcor) > 2L) stop("dfcor length should be at most 2") if (length(dfcor) == 1L) dfcor <- rep(dfcor, 2L) if (! balanced && any(dfcor != 3)) stop("dfcor should equal 3 for unbalanced panels") } # we use later a general expression for the three kinds of effects, # select the relevant lines therows <- switch(effect, "individual" = 1:2, "time" = c(1, 3), "twoways" = 1:3) if(! is.null(method) && method == "nerlove") { ## special case Nerlove estimator with early exit if (effect == "nested") stop("nested random effect model not implemented for Nerlove's estimator") est <- plm.fit(data, model = "within", effect = effect) pdim <- pdim(data) N <- pdim$nT$n TS <- pdim$nT$T O <- pdim$nT$N NTS <- N * (effect != "time") + TS * (effect != "individual") - 1 * (effect == "twoways") s2nu <- deviance(est) / O # NB: Nerlove takes within residual sums of squares divided by #obs without df correction (Baltagi (2013), p. 23/45) s2eta <- s2mu <- NULL if(balanced) { if (effect != "time") s2eta <- as.numeric(crossprod(fixef(est, type = "dmean", effect = "individual"))) / (N - 1) if (effect != "individual") s2mu <- as.numeric(crossprod(fixef(est, type = "dmean", effect = "time"))) / (TS - 1) sigma2 <- c(idios = s2nu, id = s2eta, time = s2mu) theta <- list() if (effect != "time") theta$id <- (1 - (1 + TS * sigma2["id"] / sigma2["idios"]) ^ (-0.5)) if (effect != "individual") theta$time <- (1 - (1 + N * sigma2["time"] / sigma2["idios"]) ^ (-0.5)) if (effect == "twoways") { theta$total <- theta$id + theta$time - 1 + (1 + N * sigma2["time"] / sigma2["idios"] + TS * sigma2["id"] / sigma2["idios"]) ^ (-0.5) names(theta$total) <- "total" # tweak for numerical precision: # if either theta$id or theta$time is 0 => theta$total must be zero # but in calculation above some precision is lost if( isTRUE(all.equal(sigma2[["time"]], 0, check.attributes = FALSE)) || isTRUE(all.equal(sigma2[["id"]], 0, check.attributes = FALSE))) theta$total <- 0 } } else { # Nerlove unbalanced as in Cottrell (2017), gretl working paper #4 # -> use weighting # (albeit the formula for unbalanced panels reduces to original # Nerlove formula for balanced data, we keep it separated) if (effect != "time") s2eta <- sum( (fixef(est, type = "dmean", effect = "individual"))^2 * pdim$Tint$Ti / pdim$nT$N) * (pdim$nT$n/(pdim$nT$n-1)) if (effect != "individual") s2mu <- sum( (fixef(est, type = "dmean", effect = "time"))^2 * pdim$Tint$nt / pdim$nT$N) * (pdim$nT$T/(pdim$nT$T-1)) sigma2 <- c(idios = s2nu, id = s2eta, time = s2mu) theta <- list() # Tns, Nts: full length xindex <- unclass(index(data)) # unclass for speed ids <- xindex[[1L]] tss <- xindex[[2L]] Tns <- pdim$Tint$Ti[as.character(ids)] Nts <- pdim$Tint$nt[as.character(tss)] if (effect != "time") theta$id <- (1 - (1 + Tns * sigma2["id"] / sigma2["idios"]) ^ (-0.5)) if (effect != "individual") theta$time <- (1 - (1 + Nts * sigma2["time"] / sigma2["idios"]) ^ (-0.5)) if (effect == "twoways") { theta$total <- theta$id + theta$time - 1 + (1 + Nts * sigma2["time"] / sigma2["idios"] + Tns * sigma2["id"] / sigma2["idios"]) ^ (-0.5) names(theta$total) <- paste0(names(theta$id), "-", names(theta$time)) # tweak for numerical precision: # if either theta$id or theta$time is 0 => theta$total must be zero # but in calculation above some precision is lost if( isTRUE(all.equal(sigma2[["time"]], 0, check.attributes = FALSE)) || isTRUE(all.equal(sigma2[["id"]], 0, check.attributes = FALSE))) theta$total <- 0 } } if (effect != "twoways") theta <- theta[[1L]] result <- list(sigma2 = sigma2, theta = theta) result <- structure(result, class = "ercomp", balanced = balanced, effect = effect) return(result) } ## end Nerlove case if (! is.null(method) && method == "ht"){ ## special case HT with early exit pdim <- pdim(data) N <- pdim$nT$n TS <- pdim$nT$T O <- pdim$nT$N wm <- plm.fit(data, effect = "individual", model = "within") X <- model.matrix(data, rhs = 1) ixid <- unclass(index(data))[[1L]] # unclass for speed charixid <- as.character(ixid) constants <- apply(X, 2, function(x) all(tapply(x, ixid, is.constant))) FES <- fixef(wm, type = "dmean")[charixid] XCST <- X[ , constants, drop = FALSE] ra <- if(length(object)[2L] > 1L){ # with instruments W1 <- model.matrix(data, rhs = 2) twosls(FES, XCST, W1, lm.type = "lm.fit") } else{ # without instruments lm.fit(XCST, FES) } s2nu <- deviance(wm) / (O - N) s21 <- as.numeric(crossprod(ra$residuals)) / N # == deviance(ra) / N s2eta <- (s21 - s2nu) / TS sigma2 <- c(idios = s2nu, id = s2eta) theta <- (1 - (1 + TS * sigma2["id"] / sigma2["idios"]) ^ (-0.5)) result <- list(sigma2 = sigma2, theta = theta) result <- structure(result, class = "ercomp", balanced = balanced, effect = effect) return(result) } ## end HT # method argument is used, check its validity and set the relevant # models and dfcor if (! is.null(method)){ if (! method %in% c("swar", "walhus", "amemiya")) stop(paste(method, "is not a relevant method")) if (method == "swar") models <- c("within", "Between") if (method == "walhus") models <- c("pooling", "pooling") if (method == "amemiya") models <- c("within", "within") if (is.null(dfcor)){ if (balanced){ dfcor <- switch(method, "swar" = c(2L, 2L), "walhus" = c(1L, 1L), "amemiya" = c(1L, 1L)) } else dfcor <- c(3L, 3L) } } else{ # the between estimator is only relevant for the second # quadratic form if (models[1L] %in% c("Between", "between")) stop("the between estimator is only relevant for the between quadratic form") # if the argument is of length 2, duplicate the second value if (length(models) == 2L) models <- c(models[1L], rep(models[2L], 2L)) # if the argument is of length 1, triple its value if (length(models) == 1L) models <- c(rep(models, 3L)) # set one of the last two values to NA in the case of one way # model if (effect == "individual") models[3L] <- NA if (effect == "time") models[2L] <- NA # default value of dfcor 3,3 if (is.null(dfcor)) dfcor <- c(3L, 3L) } # The nested error component model if (effect == "nested"){ xindex <- unclass(attr(data, "index")) # unclass for speed ids <- xindex[[1L]] tss <- xindex[[2L]] gps <- xindex[[3L]] G <- length(unique(gps)) Z <- model.matrix(data, model = "pooling") X <- model.matrix(data, model = "pooling", cstcovar.rm = "intercept") y <- pmodel.response(data, model = "pooling", effect = "individual") O <- nrow(Z) K <- ncol(Z) - (ncol(Z) - ncol(X)) pdim <- pdim(data) N <- pdim$nT$n TS <- pdim$nT$T TG <- unique(data.frame(tss, gps)) TG <- table(TG$gps) NG <- unique(data.frame(ids, gps)) NG <- table(NG$gps) Tn <- pdim$Tint$Ti Nt <- pdim$Tint$nt quad <- vector(length = 3L, mode = "numeric") M <- matrix(NA_real_, nrow = 3L, ncol = 3L, dimnames = list(c("w", "id", "gp"), c("nu", "eta", "lambda"))) if (method == "walhus"){ estm <- plm.fit(data, model = "pooling", effect = "individual") hateps <- resid(estm, model = "pooling") Between.hateps.group <- Between(hateps, effect = "group") quad <- c(crossprod(Within(hateps, effect = "individual")), crossprod(Between(hateps, effect = "individual") - Between.hateps.group), crossprod(Between.hateps.group)) ZSeta <- model.matrix(estm, model = "Sum", effect = "individual") ZSlambda <- Sum(Z, effect = "group") CPZM <- solve(crossprod(Z)) CPZSeta <- crossprod(ZSeta, Z) CPZSlambda <- crossprod(ZSlambda, Z) Between.Z.ind <- Between(Z, "individual") Between.Z.group <- Between(Z, "group") Between.Z.ind_minus_Between.Z.group <- Between.Z.ind - Between.Z.group CPZW <- crossprod(Z - Between.Z.ind) CPZBlambda <- crossprod(Between.Z.group) CPZM.CPZW <- crossprod(CPZM, CPZW) CPZM.CPZBlamda <- crossprod(CPZM, CPZBlambda) CPZM.CPZSeta <- crossprod(CPZM, CPZSeta) CPZM.CPZSlambda <- crossprod(CPZM, CPZSlambda) CPZM.CPZW.CPZM.CPZSeta <- crossprod(t(CPZM.CPZW), CPZM.CPZSeta) CPZM.CPZW.CPZM.CPZSlambda <- crossprod(t(CPZM.CPZW), CPZM.CPZSlambda) CPZBetaBlambda <- crossprod(Between.Z.ind_minus_Between.Z.group) CPZBetaBlambdaSeta <- crossprod(Between.Z.ind_minus_Between.Z.group, ZSeta) CPZBlambdaSeta <- crossprod(Between.Z.group, ZSeta) CPZM.CPZBetaBlambda <- crossprod(CPZM, CPZBetaBlambda) CPZM.CPZBlambda <- crossprod(CPZM, CPZBlambda) M["w", "nu"] <- O - N - trace(CPZM.CPZW) M["w", "eta"] <- trace(CPZM.CPZW.CPZM.CPZSeta) M["w", "lambda"] <- trace(CPZM.CPZW.CPZM.CPZSlambda) M["id", "nu"] <- N - G - trace(CPZM.CPZBetaBlambda) M["id", "eta"] <- O - sum(TG) - 2 * trace(crossprod(CPZM, CPZBetaBlambdaSeta)) + trace(crossprod(t(CPZM.CPZBetaBlambda), CPZM.CPZSeta)) M["id", "lambda"] <- trace(crossprod(t(CPZM.CPZBetaBlambda), CPZM.CPZSlambda)) M["gp", "nu"] <- G - trace(CPZM.CPZBlambda) M["gp", "eta"] <- sum(TG) - 2 * trace(crossprod(CPZM, CPZBlambdaSeta)) + trace(crossprod(t(CPZM.CPZBlambda), CPZM.CPZSeta)) M["gp", "lambda"] <- O - 2 * trace(CPZM.CPZSlambda) + trace(crossprod(t(CPZM.CPZBlambda), CPZM.CPZSlambda)) } if (method == "amemiya"){ estm <- plm.fit(data, effect = "individual", model = "within") hateps <- resid(estm, model = "pooling") Betweeen.hateps.group <- Between(hateps, effect = "group") XBlambda <- Between(X, "group") quad <- c(crossprod(Within(hateps, effect = "individual")), crossprod(Between(hateps, effect = "individual") - Betweeen.hateps.group), crossprod(Betweeen.hateps.group)) WX <- model.matrix(estm, model = "within", effect = "individual", cstcovar.rm = "all") XBetaBlambda <- Between(X, "individual") - XBlambda XBlambda <- t(t(XBlambda) - colMeans(XBlambda)) CPXBlambda <- crossprod(XBlambda) CPXM <- solve(crossprod(WX)) CPXBetaBlambda <- crossprod(XBetaBlambda) K <- ncol(WX) MK <- length(setdiff("(Intercept)", attr(WX, "constant"))) # Pas sur, a verifier KW <- ncol(WX) M["w", "nu"] <- O - N - K + MK M["w", "eta"] <- 0 M["w", "lambda"] <- 0 M["id", "nu"] <- N - G + trace(crossprod(CPXM, CPXBetaBlambda)) M["id", "eta"] <- O - sum(TG) M["id", "lambda"] <- 0 M["gp", "nu"] <- G - 1 + trace(crossprod(CPXM, CPXBlambda)) M["gp", "eta"] <- sum(TG) - sum(NG * TG ^ 2) / O M["gp", "lambda"] <- O - sum(NG ^ 2 * TG ^ 2) / O } if (method == "swar"){ yBetaBlambda <- pmodel.response(data, model = "Between", effect = "individual") - pmodel.response(data, model = "Between", effect = "group") ZBlambda <- Between(Z, "group") CPZBlambda.solve <- solve(crossprod(ZBlambda)) ZBetaBlambda <- Between(Z, "individual") - ZBlambda XBetaBlambda <- Between(X, "individual") - Between(X, "group") yBlambda <- pmodel.response(data, model = "Between", effect = "group") ZSeta <- Sum(Z, effect = "individual") ZSlambda <- Sum(Z, effect = "group") XSeta <- Sum(X, effect = "individual") estm1 <- plm.fit(data, effect = "individual", model = "within") estm2 <- lm.fit(ZBetaBlambda, yBetaBlambda) estm3 <- lm.fit(ZBlambda, yBlambda) quad <- c(crossprod(estm1$residuals), crossprod(estm2$residuals), crossprod(estm3$residuals)) M["w", "nu"] <- O - N - K M["w", "eta"] <- 0 M["w", "lambda"] <- 0 M["id", "nu"] <- N - G - K M["id", "eta"] <- O - sum(TG) - trace(crossprod(t(solve(crossprod(XBetaBlambda))), crossprod(XSeta, XBetaBlambda))) M["id", "lambda"] <- 0 M["gp", "nu"] <- G - K - 1 M["gp", "eta"] <- sum(TG) - trace(crossprod(t(CPZBlambda.solve), crossprod(ZBlambda, ZSeta))) M["gp", "lambda"] <- O - trace(crossprod(t(CPZBlambda.solve), crossprod(ZSlambda, Z))) } Gs <- as.numeric(table(gps)[as.character(gps)]) Tn <- as.numeric(table(ids)[as.character(ids)]) sigma2 <- as.numeric(solve(M, quad)) names(sigma2) <- c("idios", "id", "gp") theta <- list(id = 1 - sqrt(sigma2["idios"] / (Tn * sigma2["id"] + sigma2["idios"])), gp = sqrt(sigma2["idios"] / (Tn * sigma2["id"] + sigma2["idios"])) - sqrt(sigma2["idios"] / (Gs * sigma2["gp"] + Tn * sigma2["id"] + sigma2["idios"])) ) result <- list(sigma2 = sigma2, theta = theta) return(structure(result, class = "ercomp", balanced = balanced, effect = effect)) } ### END nested models # the "classic" error component model Z <- model.matrix(data) O <- nrow(Z) K <- ncol(Z) - 1 # INTERCEPT pdim <- pdim(data) N <- pdim$nT$n TS <- pdim$nT$T NTS <- N * (effect != "time") + TS * (effect != "individual") - 1 * (effect == "twoways") Tn <- pdim$Tint$Ti Nt <- pdim$Tint$nt # Estimate the relevant models estm <- vector(length = 3L, mode = "list") estm[[1L]] <- plm.fit(data, model = models[1L], effect = effect) # Check what is the second model secmod <- na.omit(models[2:3])[1L] if (secmod %in% c("within", "pooling")){ amodel <- plm.fit(data, model = secmod, effect = effect) if (effect != "time") estm[[2L]] <- amodel if (effect != "individual") estm[[3L]] <- amodel } if (secmod %in% c("between", "Between")){ if (effect != "time") estm[[2L]] <- plm.fit(data, model = secmod, effect = "individual") if (effect != "individual") estm[[3L]] <- plm.fit(data, model = secmod, effect = "time") # check if Between model was estimated correctly swar_Between_check(estm[[2L]], method) swar_Between_check(estm[[3L]], method) } KS <- vapply(estm, function(x) { length(x$coefficients) - "(Intercept)" %in% names(x$coefficients) }, FUN.VALUE = 0.0, USE.NAMES = FALSE) quad <- vector(length = 3L, mode = "numeric") # first quadratic form, within transformation hateps_w <- resid(estm[[1L]], model = "pooling") quad[1L] <- crossprod(Within(hateps_w, effect = effect)) # second quadratic form, between transformation if (effect != "time"){ hateps_id <- resid(estm[[2L]], model = "pooling") quad[2L] <- as.numeric(crossprod(Between(hateps_id, effect = "individual"))) } if (effect != "individual"){ hateps_ts <- resid(estm[[3L]], model = "pooling") quad[3L] <- as.numeric(crossprod(Between(hateps_ts, effect = "time"))) } M <- matrix(NA_real_, nrow = 3L, ncol = 3L, dimnames = list(c("w", "id", "ts"), c("nu", "eta", "mu"))) # Compute the M matrix : ## ( q_w) ( w_nu w_eta w_mu ) ( s^2_nu ) ## | | = | | | | ## ( q_bid) ( bid_nu bid_eta bid_mu ) ( s^2_eta) ## | | = | | | | ## (q_btime) ( btime_nu btime_eta btime_mu) ( s^2_mu ) # In case of balanced panels, simple denominators are # available if dfcor < 3 if (dfcor[1L] != 3L){ # The number of time series in the balanced panel is replaced # by the harmonic mean of the number of time series in case of # unbalanced panels barT <- if(balanced) TS else { length(Tn) / sum(Tn ^ (- 1)) } M["w", "nu"] <- O if (dfcor[1L] == 1L) M["w", "nu"] <- M["w", "nu"] - NTS if (dfcor[1L] == 2L) M["w", "nu"] <- M["w", "nu"] - NTS - KS[1L] if (effect != "time"){ M["w", "eta"] <- 0 M["id", "nu"] <- if(dfcor[2L] == 2L) { N - KS[2L] - 1 } else N M["id", "eta"] <- barT * M["id", "nu"] } if (effect != "individual"){ M["w", "mu"] <- 0 M["ts", "nu"] <- if(dfcor[2L] == 2L) { TS - KS[3L] - 1 } else TS M["ts", "mu"] <- N * M["ts", "nu"] } if (effect == "twoways") { M["ts", "eta"] <- M["id", "mu"] <- 0 } } else{ # General case, compute the unbiased version of the estimators if ("pooling" %in% models){ mp <- match("pooling", models) Z <- model.matrix(estm[[mp]], model = "pooling") CPZM <- solve(crossprod(Z)) if (effect != "time"){ ZSeta <- model.matrix(estm[[mp]], model = "Sum", effect = "individual") CPZSeta <- crossprod(ZSeta, Z) } if (effect != "individual"){ ZSmu <- model.matrix(estm[[mp]], model = "Sum", effect = "time") CPZSmu <- crossprod(ZSmu, Z) } } if (models[1L] == "pooling"){ ZW <- model.matrix(estm[[1L]], model = "within", effect = effect, cstcovar.rm = "none") CPZW <- crossprod(ZW) CPZM.CPZW <- crossprod(CPZM, CPZW) M["w", "nu"] <- O - NTS - trace(CPZM.CPZW) if (effect != "time"){ CPZM.CPZSeta <- crossprod(CPZM, CPZSeta) M["w", "eta"] <- trace(crossprod(t(CPZM.CPZW), CPZM.CPZSeta)) } if (effect != "individual"){ CPZM.CPZSmu <- crossprod(CPZM, CPZSmu) M["w", "mu"] <- trace(crossprod(t(CPZM.CPZW), CPZM.CPZSmu)) } } if (secmod == "pooling"){ if (effect != "time"){ ZBeta <- model.matrix(estm[[2L]], model = "Between", effect = "individual") CPZBeta <- crossprod(ZBeta) CPZM.CPZBeta <- crossprod(CPZM, CPZBeta) CPZM.CPZSeta <- crossprod(CPZM, CPZSeta) CPZM.CPZBeta.CPZM.CPZSeta <- crossprod(t(CPZM.CPZBeta), CPZM.CPZSeta) # == CPZM %*% CPZBeta %*% CPZM %*% CPZSeta M["id", "nu"] <- N - trace(CPZM.CPZBeta) M["id", "eta"] <- O - 2 * trace(CPZM.CPZSeta) + trace(CPZM.CPZBeta.CPZM.CPZSeta) } if (effect != "individual"){ ZBmu <- model.matrix(estm[[3L]], model = "Between", effect = "time") CPZBmu <- crossprod(ZBmu) CPZM.CPZBmu <- crossprod(CPZM, CPZBmu) CPZM.CPZSmu <- crossprod(CPZM, CPZSmu) CPZM.CPZBmu.CPZM.CPZSmu <- crossprod(t(CPZM.CPZBmu), CPZM.CPZSmu) M["ts", "nu"] <- TS - trace(CPZM.CPZBmu) M["ts", "mu"] <- O - 2 * trace(CPZM.CPZSmu) + trace(CPZM.CPZBmu.CPZM.CPZSmu) } if (effect == "twoways"){ CPZBmuSeta <- crossprod(ZBmu, ZSeta) CPZBetaSmu <- crossprod(ZBeta, ZSmu) CPZM.CPZBetaSmu <- crossprod(CPZM, CPZBetaSmu) CPZM.CPZBmuSeta <- crossprod(CPZM, CPZBmuSeta) ## These are already calc. by effect != "individual" and effect != "time" # CPZM.CPZSmu <- crossprod(CPZM, CPZSmu) # CPZM.CPZBmu <- crossprod(CPZM, CPZBmu) # CPZM.CPZBeta <- crossprod(CPZM, CPZBeta) # CPZM.CPZSeta <- crossprod(CPZM, CPZSeta) CPZM.CPZBeta.CPZM.CPZSmu <- crossprod(t(CPZM.CPZBeta), CPZM.CPZSmu) # == CPZM %*% CPZBeta %*% CPZM %*% CPZSmu CPZM.CPZBmu.CPZM.CPZSeta <- crossprod(t(CPZM.CPZBmu), CPZM.CPZSeta) # == CPZM %*% CPZBmu %*% CPZM %*% CPZSeta M["id", "mu"] <- N - 2 * trace(CPZM.CPZBetaSmu) + trace(CPZM.CPZBeta.CPZM.CPZSmu) M["ts", "eta"] <- TS - 2 * trace(CPZM.CPZBmuSeta) + trace(CPZM.CPZBmu.CPZM.CPZSeta) } } if ("within" %in% models){ WX <- model.matrix(estm[[match("within", models)]], model = "within", effect = effect, cstcovar.rm = "all") # K <- ncol(WX) # MK <- length(attr(WX, "constant")) - 1 KW <- ncol(WX) if (models[1L] == "within"){ M["w", "nu"] <- O - NTS - KW # + MK # INTERCEPT if (effect != "time") M["w", "eta"] <- 0 if (effect != "individual") M["w", "mu"] <- 0 } if (secmod == "within"){ CPXM <- solve(crossprod(WX)) if (effect != "time"){ XBeta <- model.matrix(estm[[2L]], model = "Between", effect = "individual")[ , -1L, drop = FALSE] # INTERCEPT XBeta <- t(t(XBeta) - colMeans(XBeta)) CPXBeta <- crossprod(XBeta) amemiya_check(CPXM, CPXBeta, method) # catch non-estimable 'amemiya' M["id", "nu"] <- N - 1 + trace( crossprod(CPXM, CPXBeta) ) M["id", "eta"] <- O - sum(Tn ^ 2) / O } if (effect != "individual"){ XBmu <- model.matrix(estm[[3L]], model = "Between", effect = "time")[ , -1L, drop = FALSE] # INTERCEPT XBmu <- t(t(XBmu) - colMeans(XBmu)) CPXBmu <- crossprod(XBmu) amemiya_check(CPXM, CPXBmu, method) # catch non-estimable 'amemiya' M["ts", "nu"] <- TS - 1 + trace( crossprod(CPXM, CPXBmu) ) M["ts", "mu"] <- O - sum(Nt ^ 2) / O } if (effect == "twoways"){ M["id", "mu"] <- N - sum(Nt ^ 2) / O M["ts", "eta"] <- TS - sum(Tn ^ 2) / O } } } # END if ("within" %in% models) if (length(intersect(c("between", "Between"), models))){ if (effect != "time"){ Zeta <- model.matrix(estm[[2L]], model = "pooling", effect = "individual") ZBeta <- model.matrix(estm[[2L]], model = "Between", effect = "individual") ZSeta <- model.matrix(estm[[2L]], model = "Sum", effect = "individual") CPZSeta <- crossprod(ZSeta, Z) CPZMeta <- solve(crossprod(ZBeta)) M["id", "nu"] <- N - K - 1 M["id", "eta"] <- O - trace( crossprod(CPZMeta, CPZSeta) ) } if (effect != "individual"){ Zmu <- model.matrix(estm[[3L]], model = "pooling", effect = "time") ZBmu <- model.matrix(estm[[3L]], model = "Between", effect = "time") ZSmu <- model.matrix(estm[[3L]], model = "Sum", effect = "time") CPZSmu <- crossprod(ZSmu, Z) CPZMmu <- solve(crossprod(ZBmu)) M["ts", "nu"] <- TS - K - 1 M["ts", "mu"] <- O - trace( crossprod(CPZMmu, CPZSmu) ) } if (effect == "twoways"){ if (! balanced){ ZSmuBeta <- Sum(ZBeta, effect = "time") ZBetaSmuBeta <- crossprod(ZBeta, ZSmuBeta) ZSetaBmu <- Sum(ZBmu, effect = "individual") ZBmuSetaBmu <- crossprod(ZBmu, ZSetaBmu) M["id", "mu"] <- N - trace(crossprod(CPZMeta, ZBetaSmuBeta)) M["ts", "eta"] <- TS - trace(crossprod(CPZMmu, ZBmuSetaBmu)) } else M["id", "mu"] <- M["ts", "eta"] <- 0 } } } ## END of General case, compute the unbiased version of the estimators sigma2 <- as.numeric(solve(M[therows, therows], quad[therows])) names(sigma2) <- c("idios", "id", "time")[therows] sigma2[sigma2 < 0] <- 0 theta <- list() if (! balanced){ xindex <- unclass(index(data)) # unclass for speed ids <- xindex[[1L]] tss <- xindex[[2L]] Tns <- Tn[as.character(ids)] Nts <- Nt[as.character(tss)] } else{ Tns <- TS Nts <- N } if (effect != "time") theta$id <- (1 - (1 + Tns * sigma2["id"] / sigma2["idios"]) ^ (-0.5)) if (effect != "individual") theta$time <- (1 - (1 + Nts * sigma2["time"] / sigma2["idios"]) ^ (-0.5)) if (effect == "twoways") { theta$total <- theta$id + theta$time - 1 + (1 + Nts * sigma2["time"] / sigma2["idios"] + Tns * sigma2["id"] / sigma2["idios"]) ^ (-0.5) names(theta$total) <- if(balanced) "total" else paste0(names(theta$id), "-", names(theta$time)) # tweak for numerical precision: # if either theta$id or theta$time is 0 => theta$total must be zero # but in calculation above some precision is lost if( isTRUE(all.equal(sigma2[["time"]], 0, check.attributes = FALSE)) || isTRUE(all.equal(sigma2[["id"]], 0, check.attributes = FALSE))) theta$total <- 0 } if (effect != "twoways") theta <- theta[[1L]] result <- list(sigma2 = sigma2, theta = theta) structure(result, class = "ercomp", balanced = balanced, effect = effect) } #' @rdname ercomp #' @export print.ercomp <- function(x, digits = max(3, getOption("digits") - 3), ...){ effect <- attr(x, "effect") balanced <- attr(x, "balanced") sigma2 <- x$sigma2 theta <- x$theta if (effect == "twoways"){ sigma2 <- unlist(sigma2) sigma2Table <- cbind(var = sigma2, std.dev = sqrt(sigma2), share = sigma2 / sum(sigma2)) rownames(sigma2Table) <- c("idiosyncratic", "individual", "time") } if (effect == "individual"){ sigma2 <- unlist(sigma2[c("idios", "id")]) sigma2Table <- cbind(var = sigma2, std.dev = sqrt(sigma2), share = sigma2 / sum(sigma2)) rownames(sigma2Table) <- c("idiosyncratic", effect) } if (effect == "time"){ sigma2 <- unlist(sigma2[c("idios", "time")]) sigma2Table <- cbind(var = sigma2, std.dev = sqrt(sigma2), share = sigma2 / sum(sigma2)) rownames(sigma2Table) <- c("idiosyncratic", effect) } if (effect == "nested"){ sigma2 <- unlist(sigma2) sigma2Table <- cbind(var = sigma2, std.dev = sqrt(sigma2), share = sigma2 / sum(sigma2)) rownames(sigma2Table) <- c("idiosyncratic", "individual", "group") } printCoefmat(sigma2Table, digits) if (! is.null(x$theta)){ if (effect %in% c("individual", "time")){ if (balanced){ cat(paste("theta: ", signif(x$theta,digits), "\n", sep = "")) } else{ cat("theta:\n") print(summary(x$theta)) } } if (effect == "twoways"){ if(balanced){ cat(paste("theta: ", signif(x$theta$id,digits), " (id) ", signif(x$theta$time,digits), " (time) ", signif(x$theta$total,digits), " (total)\n", sep = "")) } else { cat("theta:\n") print(rbind(id = summary(x$theta$id), time = summary(x$theta$time), total = summary(x$theta$total))) } } if (effect == "nested"){ cat("theta:\n") print(rbind(id = summary(x$theta$id), group = summary(x$theta$gp))) } } invisible(x) } amemiya_check <- function(matA, matB, method) { ## non-exported, used in ercomp() ## little helper function to check matrix multiplication compatibility ## in ercomp() for the amemiya estimator: if model contains variables without ## within variation (individual or time), the model is not estimable if (NROW(matA) < NCOL(matB) && method == "amemiya" ) { offending_vars <- setdiff(colnames(matB), rownames(matA)) offending_vars <- if (length(offending_vars) > 3L) { paste0(paste(offending_vars[1:3], collapse = ", "), ", ...") } else { paste(offending_vars, collapse = ", ") } stop(paste0("'amemiya' model not estimable due to variable(s) lacking within variation: ", offending_vars)) } else NULL } swar_Between_check <- function(x, method) { ## non-exported, used in ercomp() ## little helper function to check feasibility of Between model in Swamy-Arora estimation ## in ercomp(): if model contains too few groups (individual, time) the Between ## model is not estimable (but does not error) if (describe(x, "model") %in% c("between", "Between")) { pdim <- pdim(x) grp <- switch(describe(x, "effect"), "individual" = pdim$nT$n, "time" = pdim$nT$T) # cannot use df.residual(x) here because that gives the number for the "uncompressed" Between model if (length(x$aliased) >= grp) stop(paste0("model not estimable: ", length(x$aliased), " coefficient(s) (incl. intercept) to be estimated", " but only ", grp, " ", describe(x, "effect"), "(s)", " in data for the between model necessary for", " Swamy-Arora random-effect model estimation")) } else NULL } plm/NEWS.md0000644000176200001440000020274614176016326012161 0ustar liggesusers--- title: NEWS/Changelog for package plm subtitle: plm - Linear Models for Panel Data - A set of estimators and tests for panel data econometrics - --- *** # plm 2.6-0 ### Speed-up: * Fast mode is now the default for the package: when the package is attached, `options("plm.fast" = TRUE)` is set (by R's .onAttach mechanism), requiring package `collapse` as a hard dependency. * *Recommendation*: Install suggest-dependency package `fixest` or `lfe` as a further significant speed up for the two-ways within transformation (as in two-ways fixed effects models) is gained. * See `?plm.fast` for more information and a benchmark. ### Features: * make.dummies: new simple function to conveniently create contrast-coded dummies from a factor. ### Clean-ups: * phansi: function renamed to phansitest for name consistency, with a *temporary* back-compatible solution. * phtest: for formula method, argument 'effect' is now explicit as 4th argument (previously, it was extracted from ellipsis (...)). * detect_lin_dep/detect.lindep: alias detect_lin_dep removed, thus this functionality is now only accessible via detect.lindep (function was renamed from detect_lin_dep to detect.lindep in CRAN version 1.7-0 (2019-01-04), detect_lin_dep was originally introduced in CRAN version 1.6-4 (2016-11-30)). * has.intercept.plm: removed temporary back-compatible solution for ill-introduced argument 'part', use argument 'rhs' instead (see also NEWS for 2.4-2). * Within (only matrix method): removed matrix-specific argument 'rm.null' (has been defunct since August 2018 anyways). * plm: * error informatively if argument effect = "nested" and model != "random" (previously, this was a warning incl. argument adjustment, see also NEWS for 2.4-2). * (as well as pht) for argument 'inst.method', standard R argument matching and error message are used (so no more dedicated message if misspelled value "bmc" instead of "bms" is used, "bmc" was a long-standing typo, then accepted with a warning and later errored with an informative error message, see also NEWS for 2.4-0, 1.6-6). * pggls: * argument model: removed "random" from the list of official argument's values as its use is depreciated (model = "pooling" does the same; however, value "random" is still accepted and adapted to "pooling" for back-compatibility with a warning). * print.summary.pggls: fix printed model name in case default model was selected (print only one model name, previously all three model names possible for the function were printed). ### Documentation: * DESCRIPTION file: more comprehensive description of the package, so displayed on CRAN. * First vignette gained an example for the auxiliary-regression-based Hausman test (`phtest(. , method = "aux")`). ### Dependencies: * Shifted package `collapse` from 'Suggests' to 'Imports'. * Removed from 'Suggests' as not needed: `bookdown`, `clusterSEs`, `Ecdat`, `foreign`, `pcse`, `pglm`, `spdep`, `splm`, and `stargazer`. This safeguards package `plm` shall the previously suggested packages be removed from CRAN. *** # plm 2.4-3 * Release to pacify CRAN additional checks with various BLAS implementations/platforms: Checks moaned about neglectable small numerical differences vs. (at times) platform-specific reference output (`.Rout.save` files). Moved almost all test files to directory `inst/tests` so they are not run on CRAN. Tests can be run manually and by `R CMD check --test-dir=inst/tests plm_VERSION.tar.gz`. ### Admin: * Source code repository for development is now on GitHub , not on R-Forge anymore. * Added a REAMDE file to the package giving basic information about package, displayed on CRAN (as on GitHub repository). * Update one author's e-mail address. *** # plm 2.4-2 ### Speed-up: * "Fast mode" is not yet the default. To enable, set `options("plm.fast" = TRUE)` manually or in your `.Rprofile` file (see `?plm.fast`, also for benchmarks), option introduced in plm version 2.4-0. It is planned to default to "fast mode" for the next CRAN release of plm (then making package `collapse` a hard dependency). * Further speed-up if `options("plm.fast" = TRUE)` is set: In case package `fixest` or `lfe` is available locally *in addition* to package `collapse`, the two-ways fixed effect transformation is significantly faster compared to the case if only `collapse` is available due to specialised algorithms in these two packages, all being fully integrated into the usual plm functions/user interfaces (`fixest` is preferred over `lfe`, in this case, plm uses internally `collapse::fhdwithin` which in turn uses `fixest::demean`). Thanks to Sebastian Krantz for guidance on this. * various efficiency gains throughout the package by using more vapply(), crossprod(), lm.fit(), better branching, rowSums(., dims = 2L) (instead of apply(., 1:2, sum)), etc., e.g., in plm for non-default random IV cases (cases with `inst.method = "baltagi"` / `"am"` / `"bms"`), pmg, pcce, purtest. ### Features: * phansi: new function for Simes (1986) test applied to panels for panel unit root testing, as suggested in Hanck (2013) [later renamed to phansitest in plm 2.6]. * pseriesfy: new function to make each column of a pdata.frame a pseries, see `?pseriesfy` for background and useful examples. (Faster version is executed if `options("plm.fast" = TRUE)` is set, see `?plm.fast` (then internally using `collapse::dapply`)). Thanks to Sebastian Krantz for inspiration. ### Bug Fixes: * between (and hence fixef, ranef): order of output is order of *factor levels* again (this reverts a change introduced in 2.4-0, there called a fix introducing the order of the appearance in the data which is actually not desirable). Change is relevant in specific unbalanced data constellations. * fixef: for two-ways FE models, fixef does not error anymore if factor is in model and not anymore in IV case ([#10](https://github.com/ycroissant/plm/issues/10)). * vcovG (hence vcovHC, vcovDC, vcovNW, vcovSCC) and vcovBK: fix bug in case of IV estimation with only one regressor (errored previously) ([#4](https://github.com/ycroissant/plm/issues/4)). * within_intercept: * fix bug which caused an error for FE models with only one regressor ([#4](https://github.com/ycroissant/plm/issues/4)). * error informatively for IV models as not suitable. * between.matrix: do not coerce result to numeric vector for n x 1 matrix input (by using drop = FALSE in extraction) (prior to this fix, estimation of the between model with only an intercept errored). * pvcm: intercept-only models are now estimable. * detect.lindep: argument 'suppressPrint' now correctly passed on/respected (methods for data frame and matrix) ([#11](https://github.com/ycroissant/plm/issues/11)). * has.intercept.plm: argument 'part' renamed to 'rhs', argument values (integer or NULL) aligned with and correctly passed on to has.intercept.Formula (with a *temporary* back-compatible solution). * pcdtest: for formula method, the formula is evaluated in the parent environment. * groupGenerics: no more warning in arithmetic operations on pseries when index of both operands have same length but different content (e.g., something like this does not warn anymore: `your_pseries[1:(length(your_pseries)-1)] + your_pseries[2:length(your_pseries)]`). ### Others: * plm: for the nested random effect model (`effect = "nested"`), check if argument `model = "random"` is set, if not, plm now warns and adjusts accordingly (will become an error in the future). * pgmm: printing of summary gives more information about the model estimated (print.summary.pgmm). * purtest: now checks for NA-values, drops any, and warns about dropping. * piest: better printing (handling of 'digits' and 'subset' argument) (print.piest, print.summary.piest). * pwaldtest: error informatively if executed on intercept-only model (also for such models: do not execute pwaldtest in summary.plm/pvcm and do not print pwaldtest in print.summary.plm/pvcm). * mtest: * switched to combination of generic and a method for pgmm. * has information about user-supplied vcov in its return value's method slot (vcov information thus printed as well). * various print methods now return the input object invisible (before returned NULL). * piest, aneweytest: now use demeaning framework by Within() [thus benefiting from fast mode]. ### Vignettes and Other Documentation: * 1st vignette: * In section about panel unit root testing: * added short intro with overview of available functions/tests and added two example cases. * added sub-section about new function phansi. * added a little more information on the use of vcovXX. * 2nd vignette: added formula for nested error component model. * all vignettes: references updated to include Baltagi (2021), the 6th edition of the textbook; fixed a few typos. * pldv: man page extended a little, esp. with examples. * vcovXX: man pages extended with examples how to use with plm's own summary method. ### Dependencies: * Added packages `fixest` and `lfe` to 'Suggests'. *** # plm 2.4-1 * lag: fix export of generic for lag (lost in 2.4-0; the panel-specific lag method was executed anyway if base R's lag() encountered a pseries) ([#3](https://github.com/ycroissant/plm/issues/3)). * model.frame.pdata.frame: errors informatively if any index dimension has NA values. * pdata.frame: warns if NA in index dimension is encountered (before, only a plain message was printed). * Between/between/Sum/Within: Methods which rely on the index attribute (\*.pseries and (if with index attribute) \*.matrix) now error informatively if NA in any index dimension is encountered. * Vignettes: file names renamed to start with "A_", "B_", "C_" so that the Vignettes are sorted on CRAN's plm page in an order better suited for new package users. * checkNA.index: new non-exported helper function to check for NA in index of a pdata.frame or pseries (all dimensions or a specific one). *** # plm 2.4-0 ### Speed up: Significant speed improvement (optional, for the time being): A significant speed-up of the package is available by a newly introduced **option** called 'plm.fast' such that panel model estimations and others run faster. Set option 'plm.fast' to 'TRUE' by `options("plm.fast" = TRUE)` for speed up, switch off by `options("plm.fast" = FALSE)` (switched off speed up is current default). To have it always switched on, put `options("plm.fast" = TRUE)` in your .Rprofile file. See documentation `?plm.fast` for more information and a benchmarked example. Technically, the speed gains are achieved by weaving in the fast data transformation functions provided in Sebastian Krantz' package 'collapse', which needs to be installed ('Suggests' dependency). Basic functions benefiting from speed-up are currently (used heavily in, e.g., plm()): Between, between, Sum, Within. ### Features: * within_intercept: gains argument 'return.model' (default is FALSE and the functions works as previously). If set to TRUE, a full model object is returned which is the input's within model with an intercept (see documentation for more details). * fixef: gained new argument value 'effect = "twoways"' to extract the sum of individual and time effect (for two-way models). * plm/ercomp: random effect model estimation with Nerlove's method extended to unbalanced panels by weighting of the fixed effects (Cottrell (2017)). * Sum: is now exported. * DESCRIPTION file: added line BugReports pointing to a GitHub repository which is currently only used for GitHub's issue tracker feature (). [Since version 2.4-3, GitHub is also used as the development platform hosting the package's source code.] ### Fixes: * fixef: calculation for two-way models fixed; type = "dmean" for unbalanced models fixed (by using weighted.mean()). * between.default: keeps original sequence of elements' occurrence (before, compressed output was sorted by the factor's *level* order) [NB: this was reverted again in plm 2.4-2]. * Between.matrix and (internal) Tapply.matrix: ellipsis (three dots) is passed on, allowing for, e.g., na.rm = TRUE (like already possible for between.matrix etc.). * Within.pseries/matrix: now handle na.rm argument in ellipsis. * index: gives warning if argument 'which' contains "confusing" values. "confusing": an index variable called by user 'id', 'time', or 'group' if it does not refer to the respective index (e.g., time index variable is called 'id' in the user's data frame). * pdata.frame: input 'x' is always pruned by data.frame(x) as a clean data frame is needed. * Access to documentation with a generic defined in another package fixed (such as lag, diff, nobs, ...), so that the help systems offers to access the plm-specific documentation (regression introduced when pkg plm 2.0-0 adopted roxygen2 for documentation). * ercomp: (cosmetic) if one of theta\$id, theta\$time is 0 => theta\$total must be 0 and is set to 0 (before, for some data and platforms, theta$total could be a very small positive or negative number, due to limited computational precision). This leads to nicer printing for summary outputs as well. * plm: fix error when fed with a data frame with one (or more) column(s) having a 'names' attribute (data frames do not have names attribute for columns!), stemming from, e.g., a conversion from a tibble. * as.data.frame.pdata.frame: clarify argument 'row.names' a bit: FALSE will give an integer sequence as row names, TRUE "fancy" row names, and (new) a character will gives row names set to the character's elements (character's length is required to match the number of rows). ### Internals: * Between.\*, between.\*, and Within.\* methods: now use ave() instead of tapply(). * between.matrix and Sum.matrix allow for non-character 'effect' argument in non-index case. * pmg, pcce, cipstest: now use the general Between()/Within() functions of the package (instead of "own" between/within transformation implemented inside the respective function). * ercomp: now faster by saving and re-using intermediate results. * dhat (non-exported function used in vcovXX/vcovG with type = "HC2" to "HC4"): now faster as diagonal of the quadratic form is calculated more efficiently. * pht(., model ="bmc") and plm(., inst.method = "bmc") now error informatively (previously gave warnings) as "bms" is to be used for Breusch-Mizon-Schmidt IV transformation. ### Dependencies: * Added package 'collapse' to 'Suggests'. *** # plm 2.2-5 * Removed duplicated entries in REFERENCES.bib (dependency Rdpack 2.0 warned). *** # plm 2.2-4 * ptransform (internal function): check balancedness before pseries index is removed (fixes some spurious bug, e.g., when package tibble is used). * exported/registered again in NAMESPACE after export/registration lost in plm 2.0-0: fixef.pggls, Math.pseries, Ops.pseries, Complex.pseries and deprecated methods/function formula.dynformula, print.dynformula, pvcovHC. * Ops.pseries: use of is.vector() was too strict, now uses is.atomic() with taking care for additional data types. * pwaldtest: * non-exported function wald() now exported as method pwaldtest.pgmm. * for all plm models use approach via crossprod(solve(vcov(x), coefs), coefs)), not (tss-ssr)/(ssr/df2) anymore. * method for pvcm models now allows for pvcm's "within" specification, returning a data.frame with test results for each regression. * pcdtest.pseries: NA values in input variable are now removed before any further processing. A warning is issued in case of NA removal. * mtest, sargan, pwaldtest, piest, aneweytest: added for each a string for alternative hypothesis. ### Dependencies: * Removed package 'clubSandwich' from 'Suggests' as it was removed from CRAN (archived) [the package was re-added to CRAN at a later point in time but not made a 'Suggests' dependency for plm again]. *** # plm 2.2-3 * IGNORE_RDIFF_BEGIN/END added on tests and man pages. *** # plm 2.2-1 * purtest: * tests now support unbalanced panel data, where applicable. * gained argument 'ips.stat' to select statistic for IPS test, default is "Wtbar" (as before), added "Ztbar" and "tbar". * if package 'urca' is available, p-values used in individual (augmented) Dicker-Fuller regressions are (for applicable tests) based on MacKinnon (1996) instead of MacKinnon (1994) yielding better p-value approximations for tau distribution (via urca::punitroot). * return value's element 'idres' contains p-values of individual ADF-regressions (p.trho) and p-values printed in summary (where applicable). * for Levin/Lin/Chu test, object and summary contain short-run and long-run variance. * for Hadri's test, summary is now applicable. * index.pindex: fixed bug when individual index variable is called "group". ### Minor items: * print.fixef: respects / forwards arguments supplied to generic print method. * Grunfeld data doc: URL for overview of various Grunfeld data sets updated to . ### Dependencies: * Package 'urca' added to "Suggests". *** # plm 2.2-0 * Methods for plm.list were not exported, now exported. * lagt is changed so that it can deal with time factors which cannot be coerced to numeric (ex "1950-54", "1955-59", ...). * cortab was not exported, now exported. * pvcm failed for random effect models when there are some NA coefficients for some individual level OLS regressions, fixed. *** # plm 2.1-0 * Problems with vignettes fixed (full text was in italics). * In test file 'test_Estimators.R', L256, tolerance lowered to 1E-04. *** # plm 2.0-2 * vcovXX.pcce functions exported again (export was lost in plm 2.0-0). * summary.pcce gained argument 'vcov', summary.pcce object carries robust vcov in element 'rvcov'. * Vignettes switched from bookdown::html_document2 to html_vignette. *** # plm 2.0-1 * Minor update: tests updated to pacify CRAN's testing procedure with OpenBLAS. * Bug fix in model.frame.pdata.frame: dot previously set to "separate" now set to "previous". *** # plm 2.0-0 * class 'pFormula' is deprecated and will be removed soon. * model.frame now has a pdata.frame method (instead of a pFormula method) and model.matrix has a pdata.frame method (a pdata.frame with a terms attribute). 'formula' as an argument in model.matrix was unnecessary as the formula can be retrieved from the pdata.frame. * A third vignette was added describing the plm model components (plmModelComponents.Rmd). * plm: the informative error message about the deprecated argument 'instruments' is removed and this argument is no longer supported. * Man pages and NAMESPACE file are now generated using roxygen2. *** # plm 1.7-0 * lag, lead, diff for pseries objects: functions now take care of the time dimension when shifting observations within each individual. Previously, shifting was performed row-wise within each individual (neglecting the time dimension). The argument 'shift' is introduced to control shifting behaviour, possible values are "time" (default) and "row" (behaviour up until and incl. plm 1.6-6). Note that, however, the diff-ing performed in first-difference model estimation by plm(..., model = "fd") is based on row-wise differences of the model matrix per individual. * pbnftest: new function for (modified) BNF statistic (Durbin-Watson test generalised to panels) and Baltagi/Wu's LBI statistic (Bhargava/Franzini/Narendranathan (1982), Baltagi/Wu (1999)). * pcdtest: bias-corrected scaled LM test implemented (test = "bcsclm") as in Baltagi/Feng/Kao (2012). * summary.plm: for all random models and for all instrumental variable models, single coefficient tests are based on std. normal distribution and joint coefficient (Wald) test on Chi-square distribution. * pwaldtest: now handles IV models correctly (Wooldridge (1990)); method for random pvcm models added (and used in summary.pvcm). * pht: fixed estimation (plm 1.6-6 introduced a slight regression). * summary.pht: waldtest now uses Chi-square distribution (was F distribution). * Fixed first-difference models (plm(., model = "fd"), pggls(., model = "fd")) to have an intercept by default again (disappeared in plm 1.6-6). * Between.matrix: bug fixed, so that the transformation can be correctly performed for a matrix without index attribute. * make.pconsecutive for pseries: for consecutive pseries, the argument 'balanced' was not respected. * pwfdtest: fixed error when one individual has one observation only. * pmodel.response, fitted.plm, residuals.plm: for "between" and "fd" models, a pure numeric is returned, not an 'illegal' pseries anymore (these models compress data where having an index/pseries is useless and misleading). * Between and Within methods for matrices are now exported. * plm object: gained element 'weights' if weighted estimation was performed. * groupGenerics now used for 'pseries' objects, implemented as a wrapper for methods in groups 'Math', 'Ops' and 'Complex' (see ?groupGeneric). Thus, propagation to a higher or lower data type works correctly when performed on pseries, e.g., c("pseries", "integer") is propagated to c("pseries", "numeric") if an operation returns a decimal. * Vignettes: translated package's original vignette to Rmd format and renamed to plmPackage.Rmd; added vignette plmFunction.Rmd for further explanation about the estimation of error components models with the plm function; in plmPackage.Rmd fixed typo in formula for cross-sectional dependence scaled LM test. ### Deprecated/renamed: * pht, plm(., model = "ht"/"am"/"bms"): both uses deprecated, better use instead plm(., model="random", random.method ="ht", inst.method="baltagi"/"am"/"bms") to estimate Hausman-Taylor-type models. * summary.plm: removed support for ill-named argument '.vcov', instead use 'vcov'. '.vcov' has been deprecated in plm 1.6-4 on CRAN since 2016-11-30. * pvcovHC: function deprecated, use vcovHC for same functionality. * plm: using the 'instruments' argument errors now (gave deprecation warning). * dynformula: the long deprecated function now gives a deprecation warning. * detect.lindep: previously named detect_lin_dep; renamed for consistency in function naming (back-compatible solution implemented) [back compatibility removed in plm 2.6-0]. ### Minor items: * pvar: added method for pseries. * pgrangertest: better detection of infeasibility if a series is too short. * pdata.frame: fixed bug so that pdata.frames with only one column can be created if drop.index = TRUE is set. * pgmm object: removed element 'df.residual' for now as it contained the function of the same name rather than a number; fixed handling of argument 'lost.ts''s second element. * as.data.frame.pdata.frame gained argument 'keep.attributes'. * [.pdata.frame: in case a single column, i.e., a pseries is returned, this pseries now has names (now consistent to extraction by \$.pdata.frame and [[.pdata.frame). * is.pseries: added function to check if an object qualifies as a pseries. * (internal) is.index, has.index: new non-exported functions to check if an object is or has a proper index (in the sense of the plm package). * pvcm object: element 'residuals' is now of class c("pseries", "numeric") (was: "numeric" for within model); element 'coefficients' is numeric for random model (was "matrix" with one column); element 'df.residuals' renamed to 'df.residual' (as is standard, cf. lm, plm, ...). * print.pseries: prettier printing for c("pseries", "complex"). * print.summary.plm: more informative for perfect fits (all residuals are 0). * plm/ercomp: informative error messages for non-estimable 'swar' and 'amemiya' models when between model lacks observations ('swar') and individual or time dimension lacks within variation ('amemiya'). * plm/model.matrix.pFormula: informative error message for non-finite values. * summary.purtest: give informative error message when run on purtest object containing result for Hadri's test. * pcce, pht, pmg, pggls models: proper names in printed summary's topline. * pcce models: pooled model's element 'coefficients' is numeric (was 1x1 matrix). * pwaldtest: in all cases, htest object's 'statistic' element is a numeric (was 1x1 matrix for some cases). * Data set 'Crime' extended with pre-computed log values as in original data. ### Dependencies: * Added to 'Suggests': knitr, rmarkdown, bookdown. *** # plm 1.6-6 * ercomp: * re-written to be a more general framework. * (internal) returned ercomp object: component 'sigma2' is now a numeric; component 'theta' is now either a numeric (balanced models) or a list with numerics (unbalanced models), the numerics being of length 1 (one-way models) or of length equal to the number of observations (two-ways models). * model.matrix.*: gained new argument 'cstcovar.rm' to remove specific columns. * pmodel.response: now returns object of class c("pseries", "numeric") [was "numeric"]. * plm: * random effect models: some random methods extended to unbalanced two-ways case (Nerlove's method only supports balanced one-way, two-ways), thanks to the more general ercomp framework. * nested random effects model implemented (Baltagi/Song/Jung (2001)), use effect = "nested", see example in ?plm. * two-way fixed effects model for unbalanced panels is faster. * new argument 'weights' added. * fix backward compatibility for the (deprecated!) argument 'instruments' to estimate IV models (but rather use 2-part formulae for IV models). * plm gives an informative error message if all terms are dropped in an estimation due to aliasing. * argument 'inst.method': value "bmc" renamed to "bms" for the Breusch-Mizon-Schmidt method ("bmc" was a typo, back-compatible solution implemented). * pht: argument 'model': value "bmc" renamed to "bms" (cf. plm). * purtest: * for test = * "madwu": Maddala-Wu test statistic used to be computed using p-values from the normal distribution, fixed now, by using approximated p-values for the tau distribution described by MacKinnon (1994). * "hadri": * fixed p-value (now based on one-sided test). * fixed statistic in non-heteroskedasticity case (Hcons = FALSE). * degrees of freedom correction implemented (set dfcor = TRUE). * "ips", "levinlin": p-values fixed (now one-sided to the left). * new tests: Choi (2001) modified P ("Pm"), inverse normal ("invnormal"), logit ("logit"). * cosmetic: when argument 'lags' is not specified by user, the returned object does not contain all three possible values in 'args\$lags' anymore. * cipstest: for the truncated version of the test, the constants used in the calculation were mixed up for type = "none" and "trend". * pldv: new function to compute fixed and random effects models for truncated or censored dependent variable. * pgrangertest: added Granger causality test for panels (Dumitrescu/Hurlin (2012)). * pbsytest: * test = "j": [joint test by Baltagi/Li(1991)]: fixed degrees of freedom (now df = 2 instead of df = 1). * unbalanced version of all statistics implemented (Sosa-Escudero/Bera (2008)). * new argument 're.normal' (only relevant for test = "re"): allows to compute the two-sided RE test when set to FALSE (default is TRUE which gives the one-sided RE test as before). * plm.data: * use discouraged now (gives warning), use pdata.frame instead. * function internally uses pdata.frame now and then adjusts to get a "plm.dim" object as before. This way, plm.data benefits from bug fixes made previously to pdata.frame. * pdata.frame: * by default, the resulting pdata.frame is now closer to the original data: * columns with constant values and all-NA values are not removed anymore, * non-finite values are not substituted with NAs anymore, * unused factor levels are not dropped anymore (except for those variables serving to construct the index). * arguments 'drop.NA.series', 'drop.const.series', 'replace.non.finite', 'drop.unused.levels' introduced to remove/replace columns/values as described 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 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 (in plm 1.7-0 this was replaced by the more general approach using groupGenerics). * ranef: new function to calculate random effects from RE model objects, like fixef for FE models. * aneweytest: changed to use the residuals of the one-way individual within model (was: two-ways within model). * cortab: new function to compute cross-sectional correlation matrix. * pwartest, pwfdtest: * statistics are labelled as F statistics. * calculations now done without car::linearHypothesis(). * diff.pseries: * logicals can now be diff'ed (result is integer, mimics base::diff). * does not warn anymore if argument 'lag' has length > 1. * difft.pseries (note the "t") implemented (non-exported), diff-ing with taking the value of the time dimension into account, analogous to already implemented (non-exported) functions lagt.pseries/leadt.pseries. * punbalancedness: extended to calculate unbalancedness measures of nested panel structures as in Baltagi/Song/Jung (2001). * mtest, sargan: return values gained data.name element. * pbltest: now accepts pdata.frames with index not in first two columns. * pwartest.formula (only formula interface): fixed: ellipsis ("dots") was not passed on. * pwaldtest: fix detection of vcovs generated by package 'clubSandwich' for models with an intercept. * summary.pseries: better handling of characters, logicals, factors (use base methods). * summary.piest, summary.pht: table headings now have "z-value" and "Pr(>|z|)" as the numbers are based on standard normal distribution. * make.pbalanced: argument 'balanced.type': * 'shared' renamed to 'shared.times' (with a back-compatible solution), * 'shared.individuals' added as additional option (symmetric case). * print.pseries: prettier printing for integers. * print.summary.plm: prints information about dropped coefficients due to singularities (mimics print.summary.lm). * cosmetic: some print functions now have better aligned whitespacing. ### Dependencies: * R version >= 3.1.0 required now. * 'Imports': maxLik added, function maxLik::maxLik is re-exported by plm. * moved from 'Imports' to 'Suggests': car. * 'Suggests': added pcse, clusterSEs, clubSandwich, pglm, spdep, splm, statmod, Ecdat, pder, stargazer, texreg, foreign. *** # plm 1.6-5 * pFtest: disable input model check due to reverse dependency of package AER (and to allow arbitrary model comparisons); check was erroneously enabled in plm version 1.6-4. *** # plm 1.6-4 * Argument for supplying a variance-covariance matrix is now consistently named 'vcov' across all functions. The old argument '.vcov' of summary.plm is marked as deprecated. Deprecation warnings are only issued for those functions which where on CRAN with the now deprecated argument '.vcov' (i.e., just for summary.plm, no warnings for functions pwaldtest, fixef, within_intercept). * Snesp.Rd, LaborSupply.Rd: broken links fixed. * Vignette: updated contact details. *** # plm 1.6-3 * Function Ftest renamed to pwaldtest (there was never a CRAN release with Ftest exported, thus no deprecation warning). * summary.plm: F statistic uses adjusted df2 parameter in case of robust vcov. *** # plm 1.6-2 * pcdtest optimized for speed. 'preshape()' added to pcdtest.R to take care of reshaping in wide form prior to applying 'cor()'. *** # plm 1.6-1 * vcovG and vcovBK: added compliance with instrumental variables models (through two-parts formulae). * plm.Rd: added note on the intercept in 'fd' models, and how to eliminate it. * make.pbalanced: gained argument 'balance.type' which allows to select whether to balance by filling in NA values ("fill", like before) or (now new) also by keeping only time periods shared among all individuals ("shared" [in v1.6-6 renamed to "shared.times"]). * pbsytest: issue warning when applied to an unbalanced model (unbalanced tests still in preparation). * print.summary.plm: for "between" models: print the no. of obs used in estimation (like for "fd" models since 1.5-24). * pcdtest: * returned htest object has correct data.name value now. * NaN stemming from non-intersecting periods or only one shared period of pairs of individuals avoided by omission from calculation. * pcdtest(some_var ~ 1, data) does not error anymore. * NEWS file: order of entries changed: latest entries now at top of file. * pdim.pseries: added method. * is.pbalanced.*: methods added to determine balancedness for convenience. Same as pdim()\$balanced, but avoids calculations performed by pdim() which are not necessary to determine (just) the balancedness. * some functions little more efficient by using is.pbalanced() instead of pdim()\$balanced. *** # plm 1.5-35 * pbltest.plm: plm interface now respects the 'alternative' argument. * summary.plm: summary.plm objects gained new component 'df' to mimic summary.lm objects more closely. * gettvalue() added as (internal) function to quickly extract one or more t values from an estimated model (so one can avoid a call to summary() with all the other unnecessary computations). *** # plm 1.5-34 * Ftest: support for vcovs from package clubSandwich to allow df2 adjustment in robust F test (new func trans_clubSandwich_vcov added for this purpose). * (internal) model.matrix.pFormula: case "pooling" added to twoways/unbalanced condition; for unknown cases, give meaningful error. * alias.plm, alias.pFormula: added functions to complement the generic stats::alias to detect linear dependence (much like detect_lin_dep). * detect_lin_dep.plm: added (complementing previously added detect_lin_dep methods from version 1.5-15). [function was renamed to detect.lindep in version 1.7-0]. * plm objects gained element 'aliased' (a named logical) to indicate any aliased coefficients that are silently dropped during estimation by plm (cf. summary.lm objects). * fix: vcovXX.plm / vcovG framework now handle plm models with aliased coefficients (linear dependent columns in model matrix). * phtest: * better support for between models. * for method="aux", argument 'effect' is now extracted from dots. *** # plm 1.5-33 * (internal) pdiff gained 'effect' argument and thus is more general. * plm: trying to estimate first-difference (FD) models with effect="time" or "twoways" is now prevented with meaningful error messages; footnote 3 in vignette slightly adapted to reflect this. *** # plm 1.5-32 * pcdtest: fixed p-value for cross-sectional dependence scaled LM test (pcdtest(..., test = "sclm")). *** # plm 1.5-31 * fixef: return value is now class c("fixef", "numeric") ("numeric" added). * summary.fixef: return value is now of class c("summary.fixef", "matrix") ("matrix" added); type and df.residual added as attributes. Both class additions allow easier further processing of the return values. *** # plm 1.5-30 * lagt.pseries (experimental, non exported function): now handles NA values in time index. * pdata.frame: warning about NA in time index turned into a note being printed. *** # plm 1.5-29 * print.pdata.frame: workaround to prevent error when printing pdata.frames with duplicated row names (original row names are suppressed for printing in this case). *** # plm 1.5-28 * phtest (regression based): if only one regressor in formula, the test does not stop anymore. *** # plm 1.5-27 * model.matrix.pFormula: little speed up of within transformation in the two-ways unbalanced case. * model.matrix.pFormula: little speed up for some more transformations by using .colMeans instead of apply(X, 2, mean). *** # plm 1.5-26 * residuals.plm: residuals extracted by residuals(plm_object) now have class c("pseries", "numeric") (was just "pseries" before). *** # plm 1.5-25 * fixef: * summary.fixef: t distribution is used for p-value calculation (like the heading states). * fixef: for the t distribution to be applied for p-value calculation, objects of class "fixef" gained a "df.residual" element. *** # plm 1.5-24 * print.summary.plm: for FD models: now also prints number of observations used during estimation, because these differ from the number of observations (rows) in the model frame due to diff-ing. * pres: fixed handling of pggls' FD models and, thus, summary on pggls' FD models does not error anymore. * pbltest: now has a plm interface (besides the formula interface). *** # plm 1.5-23 * make.pconsecutive: new function to make a (p)data.frame or pseries consecutive, meaning having consecutive time periods, t, t+1, t+2, ..., where t is an integer (fills in missing time periods). Optionally, by argument 'balanced', (p)data.frames or pseries can be made consecutive and at the same time also balanced. * make.pbalanced: new function to make a (p)data.frame or pseries balanced (but not consecutive) (fills in missing time periods). *** # plm 1.5-22 * pdata.frames are now more consistent after subsetting: => identical(pdataframe, pdataframe[1:nrow(pdataframe), ]) yields TRUE now * fixed: after subsetting unnecessary information was added to the resulting pdata.frame. * fixed: mode of index attribute was changed (unintentionally "simplified"). * pdata.frame is now a little more informative about NA values in either individual or time index (a warning is issued when such a pdata.frame is created). * [.pdata.frame: indexing a pdata.frame is now fully consistent to indexing a data.frame (as documented): * fixed: special case of indexing by [i] (missing j) which erroneously returned rows instead of columns. * pdata.frame's warnings: * if duplicate couples or NA values in the index variables are found while creating a pdata.frame, the warning now gives users a hint how to find those (table(index(your_pdataframe), useNA = "ifany"). * printed is now "id-time" (was: "time-id") to be consistent with order of index variables. *** # plm 1.5-21 * new function as.list.pdata.frame: Default behaviour is to act identical to as.list.data.frame (some code relies on this, do not change!). By setting arg 'keep.attributes = TRUE', one gets a list of pseries and can operate (e.g., 'lapply') over this list as one would expect for operations on the columns of a pdata.frame, e.g., to lag over more than one column and get a list of lagged columns back, use: lapply(as.list(pdataframe[ , your_cols], keep.attributes = TRUE), lag). *** # plm 1.5-20 * vcovXX.pcce methods added by copying the vcovXX.plm ones; work just the same, sandwiching the appropriate "meat" in transformed data. General reference is Wooldridge, Ch. 7. *** # plm 1.5-19 * pcce now supports model.matrix and pmodel.response methods, extracting the transformed data so that the estimator can be replicated by lm(pmodel.response(model) ~ model.matrix(model)); this is needed both for vcovXX functions and for cluster bootstrapping. * summary.pcce outputs the R2 calculated according to Holly, Pesaran and Yamagata instead of RSS/TSS. *** # plm 1.5-18 * pcdtest: small efficiency enhancement (calc only lower.tri of rhos). * pos.index (internal, not exported): new function to determine column numbers of index vars in a pdata.frame. * cosmetics: * some extraction/subsetting functions doubled 'pseries' in the class of returned value (fixed now). * extraction methods for pdata.frame and pseries now preserve order of attributes. * class "pindex" for attribute index not lost anymore after subsetting a pdata.frame. *** # plm 1.5-17 * lagt.pseries: new method respecting "content" of time periods [not yet exported due to testing]. * is.pconsecutive: default method exported so it can be used for arbitrary vectors. *** # plm 1.5-16 * plmtest: * fixed p-values [for type="kw" and "ghm"], * unbalanced version of all test statistics implemented, * doc update with literature references to unbalanced tests, * if requested, the "kw" statistic is now also calculated as one-way ("individual" or "time"), albeit it coincides with the respective "bp" statistic. * pwtest: formula interface respects 'effect' argument, 'effect' argument now mentioned in doc. * data set 'Wages': factor 'sex' re-leveled to c("male", "female") to match use in original paper. * print.summary.plm: suppress printing of 'effects' argument in top line in case of 'pooling' model. * doc for between, Between, Within extended; doc for lag, lead, diff in separate file now (lag_lead_diff.Rd) * pdata.frame: * fixed bug: do not assume a specific order of data when only individual index is supplied, * resulting pdata.frame is ordered by individual, then time index, * when duplicate couples (id-time) are created, a warning is issued, * new argument 'stringAsFactors'. * pvar: * fixed warning about var on factor variable (var on factors is deprecated as of R 3.2.3), * fixed corner case with one group being all NA and other non-varying, * print.pvar: better handling of NA values. * lag/lead: fixed bug with dropped factor levels, added testfile tests/test_lag_lead_factor_levels.R. * is.pconsecutive: * new function to check if time periods are consecutive per individual, * better NA handling by added argument 'rm.na.tindex'. * pgmm: fixed bugs affecting the instrument matrix in the following cases: * GMM instruments are collapsed and restricted in lag length; * first lags are used as GMM instruments; * GMM instruments are collapsed in system GMM; * GMM instruments are restricted in lag length in system GMM. * punbalancedness: data frame interface gains 'index' argument. * within_intercept: new function to calculate an overall intercept along its standard error for FE models a la Stata and gretl, accepts argument '.vcov' for user defined vcov. * added help topic on package as a whole (?`plm-package`) for sake of completeness. * summary.plm: * argument '.vcov' can also be a function (before, only matrix was possible). * internal: the furnished vcov is saved in the summary.plm object in object\$rvcov (vcov function name in attr(object\$rvcov, which="rvcov.name"). * Ftest: * gained '.vcov' argument, which enables robust F test and chi-sq test computations [robust versions not yet weaved in summary.plm]. * now exported and has documentation (.Rd file). * returned htest object has vcov's name in 'method' element (if vcov was supplied). * Ftest later renamed to pwaldtest (in version 1.6-3). * (internal) vcovXX functions: furnished vcovs gain attribute "cluster" which give info about clustering, e.g., "group" or "time". * fixef: gains new argument '.vcov'. *** # plm 1.5-15 * punbalancedness: new function for unbalancedness measures for panel data as in Ahrens/Pincus (1981); added doc and testfile for punbalancedness. * DESCRIPTION: added URLs for package on CRAN and package on R-Forge. * model.matrix.pFormula and plm.fit: include 'assign' and 'contrasts' attributes (if any) in model fit * Vignette: summary(lme_mod)\$coef\$fixed -> summary(lme_mod)\$coefficients\$fixed to avoid partial matching of 'coef' to 'coefficients' by "\$" operator. * r.squared: adjusted R squared fixed (at least for models with intercept). * model.matrix.pFormula and pmodel.response: ensured that 'data' gets reduced to the corresponding model frame if not already a model frame (now mimics stats::model.matrix in this regard); fixes corner cases with specific NA patterns when model.matrix.pFormula or pmodel.response are called directly and 'data' not being a model frame (despite being required so) [see tests/test_model.matrix_pmodel.response_NA.R]. * detect_lin_dep: new function as a little helper function to detect linear dependent columns, esp. in model matrices; incl. doc with two examples about how linear dependent columns can be induced by the within transformation [function was renamed to detect.lindep in version 1.7-0]. * doc pFormula.Rd extended (especially examples) and split up in two files to better accommodate different return values and input values in the documentation (new file added: man/model.frame_model.matrix.Rd). *** # plm 1.5-14 * lag.pseries: modified to handle negative lags (=leading values). * lead.pseries: added function as a wrapper for lag.pseries(x, k = -1) for convenience, i.e., lag(x, k = -1) == lead(x, k = 1). * pmodel.response.pFormula: make sure supplied formula is a pFormula before we continue (coerce to pFormula), fixes "bugs" (rather unexpected, but documented behaviour) like: pmodel.response.pFormula(regular_formula, data = dat, model = "pooling") # Error in names(y) <- namesy : # 'names' attribute [482] must be the same length as the vector [0] * diff.pseries: prevented negative lags as input to avoid confusion. * doc for pseries functions are made available under their name, e.g., ?lag now displays helpfile for lag.pseries in the help overview (besides, e.g., stats::lag). * pdim.default: make error message "duplicate couples (time-id)" printed as proper error message (removed cat() around the message in stop(), was printed as regular string on screen before). * plm.data: slight improvement for printed outputs (spelling and spacing). * indexes: fixed return value (was always NULL). * doc updates: ?pdim: added section about possible different return values for pdim(pdata.frame) and pdim(panelmodel_object); others: linkage to base functions enabled, spelling. * mylm: added commented (i.e., inactive) warning about dropped coefficients in estimation. * fitted.plm: added commented (i.e., inactive) warning in about dropped coefficients in estimated model compared to specified model.matrix. * added testfile tests/test_fitted.plm.R (some of those test currently do not run (commented, i.e., inactive)). * some testfiles: fixed wired encodings. *** # plm 1.5-13 * fixed bug in vcovHC(..., method="white") from degenerating diag() if any group has only 1 element. * vcovG framework: reintroduced "white2" method. *** # plm 1.5-12 * dataset Produc: added variable 'region' as 3rd column and fixed variable descriptions: 'pcap' is public capital (not private) while 'pc' is private capital (not public). * added importFrom as per CRAN check for submission. *** # plm 1.5-11 * added RiceFarms to datasets to eliminate non-CRAN dependencies, (temporarily) removed 'pder' from suggested, uncommented (fixed) example in pdwtest.Rd. *** # plm 1.5-9 * fixed bug in vcovG for lagged White terms (make pseudo-diagonal in E(u,v)); affected vcovNW. * documentation updates (mostly text books of Baltagi and Wooldridge to latest editions, references are also more specific now). * pbgtest: fixed/enabled type="F" (F test of lmtest::bgtest) in wrapper pbgtest() and fixed/enabled passing of argument 'order.by' [additional argument in lmtest::bgtest] [tests/testpbgtest.R added, docs updated and extended]. * phtest(., method="aux") [Hausman regression-based test]: fixed bug when data contain more cases than there are used in model estimation (due to NA values); avoid calc. of RE model a second time; phtest now also works with between model correctly (fixed degrees of freedom) tests/test_phtest_Hausman_regression.R added. * plm(): original row names of input data are preserved in plm_object\$model, so functions like pmodel.response(), model.frame(), model.matrix(), residuals() return the original row names (and thus fancy row names if those were to be computed by pdata.frame) * as.data.frame.pdata.frame(): respects 'row.names' argument. *** # plm 1.5-8 * phtest (Hausman test): introduced new regression-based test, allowing for robust vcov (via argument method = "aux"). * fixed bugs in pdwtest. *** # plm 1.5-6 * pruned 'require' calls to 'lmtest', 'car', 'lattice' and substituted them with proper entries in NAMESPACE. * temporarily commented problematic examples in pbgtest and pdwtest. *** # plm 1.5-5 * fixed bug affecting vcovG on unbalanced datasets (thx Liviu Andronic) from propagation of NAs in final by-group matrix multiplication. *** # plm 1.5-4 * fixed testErrors.R with plm.data instead of pdata.frame. *** # plm 1.5-3 * reintroduced plm.data eliminated by mistake. *** # plm 1.5-1 * fixed "already a pdata.frame" bug in pcdtest.formula. * implemented fixef() method for objects estimated by pggls(). *** # plm 1.5-0 * added generic building block and high-level wrappers vcovNW and vcovDC to the namespace. * dataset Parity added to /data. *** # plm 1.4-0 * substituted vcovHC, vcovSCC with the new framework based on vcovG and wrapper functions. *** # plm 1.3-1 * a 'subset' argument is added to print.summary.plm and summary.pht so that a subset of coefficients may be selected. * fixed a small problem on the printing of the typology of the variables for pht models. * the "name" of the tests is now the formula truncated so that it prints on only one line. * 'restrict.matrix' argument added to deal with linear restrictions. * a 'vcov' argument is added to summary.plm so that a variance matrix can be supplied. * the deviance method for panelmodel objects is now exported (12/02). * the Hausman-Taylor now supports the Amemiya-MaCurdy and the Breusch-Mizon-Schmidt version. * a small bug is fixed on the var2lev function to deal the case when there are no factors. *** # plm 1.3-0 * an update method for panelmodel objects is provided. * the Wages example is removed from the pvar man page because it's time consuming. *** # plm 1.2-10 * for unbalanced Hausman-Taylor model, the printing of the error components was wrong, it is now fixed. * the printing of the removed variables (cst or NA) is improved. * the pgmm function has been improved to deal correctly with holes in the cross-sections ; a 'collapse' argument is added to limit the number of GMM instruments. * the CoefTable element of summary.pgmm objects is renamed to coefficients, so that it can easily be extracted using the coef method. * the default value for robust is now TRUE in the summary.pgmm method. * a new argument 'lost.ts' is added to pgmm to select manually the number of lost time series. * almost null columns of instruments are removed (this happens when within/between transformation is performed on between/within series. * plm now accepts three part formulas, the last part being for instruments introduced only in the within form. * the predict method for panelmodel objects is now exported. * plm now estimates systems of equations if a list of formulas is provided as the first argument. *** # plm 1.2-9 * the pccep function, estimating CCEP models a la Pesaran, has been added together with summary and print.summary methods. The function generates objects of a class of their own ("pccep"), much like 'pggls', together with 'panelmodel' ['pccep' was later renamed to 'pcce'.] * the pmg function, estimating MG, DMG and CCEMG models a la Pesaran, has been added together with summary and print.summary methods. The function generates objects of a class of their own ("pmg"), much like 'pggls', together with 'panelmodel'. In the future must consider possible merger with 'pvcm'. * the new cipstest function performs a second-generation CIPS test for unit roots on pseries objects. * the new (non-exported) function pmerge is used internally by cipstest to merge lags and differences of a pseries into the original pdata.frame. Will possibly be added to the user space in the future. *** # plm 1.2-8 * an index method is added for panelmodel, pdata.frame and pseries. * a bug in the typology of the variables in pht is fixed. * a bug in vcovBK (matrices degenerating into vectors) is fixed (thx to David Hugh-Jones for bug report). * the Between function now returns a pseries object. * the resid and fitted method now return a pseries object. * the pgmm method has been rewritten; the data frame is first balanced and NAs are then overwritten by 0s. *** # plm 1.2-7 * a typo is corrected in the man page of plm.data. * package AER is now suggested. *** # plm 1.2-6 * a bug in mtest for pgmm models with effect="individual" and transformation="ld" *and* for the wald test for time.dummies for model with effect="twoways" and transformation="ld" is fixed by modifying namest in pgmm. * there was a bug in pgmm for models with different lags for GMM instruments. The number of time series lost is now the min (and not the max) of the first lags for GMM instruments. * some parts of summary.pgmm only worked correctly for models with time-dummies. It now deals correctly for models with 'individual' effects. * the *.rda files are now compressed. * p-values for the two-tailed versions of plmtest() were wrong and have been fixed. They were divided by 2 instead of multiplied. *** # plm 1.2-5 * fixed error in pggls, model="within" (FEGLS). Added model="fd" (FDGLS). * changed dependency from package 'kinship' to 'bdsmatrix' (as suggested by Terry Therneau after his reorganization of the packages). * fixed DESCRIPTION and NAMESPACE accordingly. * fixed the example in pggls.Rd. *** # plm 1.2-4 * bug corrected in pgmm: ud <- cbind(ud, td.gmm.level) is relevant only for twoways models. * in fitted.plm, the extraction of the index is updated. * the residuals.plm method now has a 'model' argument. * new function r.squared introduced. * pmodel.response.plm is modified: no explicit 'effect' and 'model' arguments anymore (like in model.matrix.plm). *** # plm 1.2-3 * lag.pseries now returns relevant names for the returned factor. * pFormula is modified so that it can handle correctly Formula objects, and not only formula. * pgmm has been completely rewritten with a new 'Formula' interface. Old formula and dynformula interfaces are kept for backward compatibility but won't be maintained in the future. * 'subset' and 'na.action' are added to the list of arguments of pgmm and oldpgmm. * lag.pseries is now able to deal with vector arguments for lags, e.g., lag(x, c(1,3)). * suml(x) is replaced by Reduce("+", x). *** # plm 1.2-2 * the documentation has been improved. * the pvalue for purtest(..., type = "madwu") was in error (by a factor of 2). * in formula(dynformula), a bug is fixed so that the endog variable doesn't appear on the RHS if there are no lags. * in pgmm, the extract.data has been rewritten and is *much* faster. * two new functions vcovBK and vcovSCC have been added. * a 'model' argument is added to pgmm.sys and pgmm.diff (previously, the model name was extracted from the call). * in pgmm, Kt is fixed to 0 when effect="individual". *** # plm 1.2-1 * a new purtest function to perform panel unit root tests. * [[.pdata.frame is modified so that NULL (and not an error message) is returned if an unknown column is selected. *** # plm 1.2-0 * the as.matrix and print methods for pserie objects are now exported. * in summary.plm, the p-value is now computed using a Student distribution and not a normal one. * 'pserie' is renamed 'pseries'. * the lag.pseries method is modified so that it deals correctly with factors, and not only with numeric vectors. The diff.pseries method returns an error if its argument is not numeric. * the instruments-"backward compatibility" stuff in plm is simplified thanks to the new features of Formula. * a THANKS file is added. * the `[.pdata.frame` function is modified so that [, j] returns a pseries and not a pdata.frame when j is a single integer, and a backward compatibility feature is added for the "index" attribute. *** Change since version 1-1.4 * an 'args' argument is added to plm objects, and the internal function relies now on it (and not on the call as previously). * more attention is paid when one of the estimated components of the variance is negative (warning or error messages result). * pdata.frame objects are re-introduced. They are used to compute model.frames. Extraction from pdata.frames results in 'pserie' objects which have an index attribute. * the print method of ercomp is now exported. * the first argument of pgmm may now be a formula. A lag.form must be provided in this case. * Hausman-Taylor estimation is now performed by the pht function. For backward compatibility reasons, it is still possible to estimate this model with plm. *** # plm 1-1.3 * a relevant error message is added when a within model is estimated with no time-varying variable. * the formula method for dynformula objects is now exported. * a misleading notation was corrected for plm.ht model. * the definition of sigma2\$id for unbalanced ht model is corrected, a harmonic mean of Ti being used. * the definition of tss.default is simplified. * the fitted.values element was missing for plm objects and has been added. *** # plm 1-1.2 * the /inst directory was missing, it has been added again. *** # plm 1-1.1 * part of the "details" section of the fixef.plm man page is removed. * a fitted.value method is now available for plm objects. It returns the fitted values of the untransformed response. * in pdiff, a drop=FALSE is added. This omission was responsible for a bug while estimating a model like plm(inv~value-1, data = Grunfeld, model = "fd"). * the lev2var is changed so that it doesn't result in an error when the data.frame contains no factor: this was responsible for a bug in plm.ht. *** # plm 1-1.0 * in fixef, the 'effect' argument default is now NULL: fixef(model_with_time_effect) now works correctly. * in pFtest, the error message "the arguments should be a within and a pooling model" is removed so that two within models may be provided. * for backward compatibility reasons, function pvcovHC is reintroduced. * for backward compatibility reasons, argument 'test' of pbsytest may be indicated in upper case. * we switched back to old names for two arguments of plm ercomp -> random.methods ivar -> inst.method -> ivar. * amemiya method is not implemented for unbalanced panels: an error message is now returned. *** # plm 1-0.1 * the plm function has been completely rewritten. * the names of some arguments have changed (random.methods -> ercomp, inst.method -> ivar), the old names are accepted with a warning. * the 'instruments' argument is removed, instrumental variable estimation is performed using extended formula. The 'instruments' argument is still accepted with a warning. * the 'model' element of plm objects are now ordinary data.frame, and not data.frame with elements y and X. Moreover, this data.frame contains untransformed data. * the data sets which are relevant for panel data estimation that where previously in the 'Ecdat' package are now in the plm package. * in pvcm a bug when the estimation was made on a subset is fixed. * ercomp is a stand alone function which returns the estimation of the components of the variance of the errors. * the estimation of two-ways within model is now implemented for unbalanced panels. * the fixef method is much improved, the fixed effects may be computed in levels, in deviation from the first level, and in deviation from the overall mean. * in pbsytest, the arguments test are now in lowercase. * the pvcovHC function is replaced by suitable vcovHC methods for panelmodel and pgmm models. *** # plm 1-0.0 * lag and diff methods for pseries are now exported and therefore behave correctly. * for two-ways within models with instrumental variables, K is replaced by K+1 for the computation of the overall mean matrix of the instruments. Time fixef are now computed. The error message "impossible ..." is removed. * a bug in the time random effect model is corrected. * a model.matrix method for panelmodel is provided. * models without intercept (-1 in the formula) should now be consistently estimated with plm, pggls and pvcm. * plm depends now on the 'Formula' package which provides useful tools for formula with two parts. *** # plm 0-3.2 * a lot of typos of the man pages have been fixed. * functions pcdtest, pcdres have been added. * for Hausman-Taylor model, summary now prints the variables and not the effects. * the estimation of a model with only one explanatory variable using plm with method = "fd" is now working correctly. *** # plm 0-3.1 * in plm.formula, [int.row.names] is replaced by [as.character(int.row.names)]. * the degrees of freedom for a within time effect model was wrong and has been corrected. * the arguments 'type' and 'weights' in pvcovHC.panelmodel are renamed to 'method' and 'type', respectively. The default method (type in previous versions) is "arellano"" and not "white1". * honda is now the default option for plmtest. *** # plm 0-2.2 * the coefficients method for objects of class pgmm is now exported. * a bug in the plm method of plmtest has been fixed. * in plmtest, for argument 'effect' value "id" is renamed "individual". * three testing functions are added : pbsytest (Bera, Sosa-Escudero and Yoon test), pARtest (Breusch-Godfrey test) and pDWtest (Durbin-Watson test) (later renamed to pdwtest), pwartest, pBGtest (later renamed to pbgtest), pwtest, and pbltest. * plm, pvcm and pggls now have arguments "subset" and "na.action". * phtest, pFtest, plmtest now have a formula method. * a bug is fixed for the vcov of the within model. * the pdata.frame function and class is suppressed. The package now use ordinary data.frames. *** # plm 0-2.1 * pdata.frame is much faster thanks to a modification of the pvar function. * series with only NA values or with constants values are now removed by pdata.frame. * observations are ordered by id and time by pdata.frame. * a pfix function is added to edit a pdata.frame [at some later point this function was removed from the package]. * a as.data.frame function is provided to coerce a pdata.frame to a data.frame. * the dependency to the 'Matrix' package has been removed and pgmm is much faster now. * phtest has been fixed to return only positive values of the statistic. * pgmm objects now inherit from panelmodel like other estimators and print correctly. * a bug in summary.pgmm has been fixed. *** # plm 0-1.2 * Models with only one explanatory variable resulted in an error. This has been fixed. * Estimation methods are now available with these four functions : plm, pvcm, pggls, and pgmm instead of one (plm) in the previous version. * pvcm is a new function which estimates variable coefficients models. The "nopool" model is now part of it. * pggls is a new function which enables the estimation of general FGLS. * pgmm is a new function for general method of moments estimator. * for all estimation functions, the first four arguments are now 'formula', 'data', 'effect', 'model'. * robust inference is now provided by the pvcovHC function. plm/MD50000644000176200001440000003625314200107742011360 0ustar liggesusers042a48dbc40ffd4efbc5f3de025ca5b3 *DESCRIPTION d14ff30eacf9c619521bacf0025ced14 *NAMESPACE 18063daa91487541f1aa7a637e04d06f *NEWS.md cdfd11bb6786bcccfabb765461d36346 *R/deprecated.R 60f809f66370d409208fb7c595c0d6a3 *R/detect_lin_dep_alias.R 151e32ae80579ec5d5e5c7ed6a760e22 *R/est_cce.R c98846879ea4ba7a229dd0d56f050da2 *R/est_ggls.R 3cf1b0cfe00816a3fb16be1f4f177bac *R/est_gmm.R 4068c49a7854f0af1a1c862762c0db6c *R/est_ldv.R 1c073530405124d913c5e56e3f4f33b5 *R/est_mg.R e04d85a56de6a5ea25a1607dd15e681c *R/est_pi.R de51097287819599b632c7e07c8dfe9a *R/est_plm.R fdc9e85e729ca7fdd668c79c0b3097cc *R/est_plm.list.R b0a795ad8c6c958f264ca27de7ced755 *R/est_vcm.R af22ef5e665d146b1825c822b603e473 *R/experimental.R 50969521fcb8c17cc6aa125788b5b07d *R/groupGenerics_pseries.R 8b41a27e193907ada8519abd9fa768a3 *R/is.pconsecutive_pbalanced.R 98039333daad016375f14fc0c783847b *R/make.pconsecutive_pbalanced.R 8cbb91b7bac0a024825ee1175ff8d9a7 *R/plm-package.R 6a25032c037d2611abe07ba5583e413d *R/test_cd.R 7b97f2369fa1f1537ae37e8385e9adcd *R/test_cips.R 206b498ebc4693c09af1d6df6a577af3 *R/test_general.R 27868043e33de2f9562428e54c30c676 *R/test_granger.R 38f531d763ef2c5437bf5ae35f79a380 *R/test_serial.R 38dfc9921e04deabbd835fe2b2cdc6a7 *R/test_uroot.R 8b8361908eb743bb128109700bf999b3 *R/tool_argvalues.R 11b665561e64dc18ff504c43c96d43d6 *R/tool_ercomp.R db65b3b94642d361f73c36c8165c312d *R/tool_methods.R db05074a9da19d3cefd4baa8326bd981 *R/tool_misc.R 1ca2d8cb4df818ef07516bfe3cc0b22a *R/tool_model.extract.R 4d03c1978a97dec8cfa2fafd1e04f87b *R/tool_pdata.frame.R 469942e6f5f820e9a8b1d24c3530b6ee *R/tool_ranfixef.R d84b481d8c7826d81ee1356b4149aad9 *R/tool_transformations.R 140a831a185f5cc44ee73089fc29caae *R/tool_transformations_collapse.R 780da965636b68f4fb236fa10bd70808 *R/tool_vcovG.R befed7aa7e171041ed0371db067c106f *README.md b4114b5735502bc42106f4c57e4df1b6 *THANKS 05af81b6c7f92f6c3b174893ee132baa *build/partial.rdb 3b0e348996652f54db48908071509c8d *build/vignette.rds 64a0b1f81e7e59d72fe3d95cc39421b8 *data/Cigar.rda ffe29c0740dd0f297a6e03257f6d2c76 *data/Crime.rda 878bb03f6783f631b1479c5498551d92 *data/EmplUK.rda b1f8bdb5bbc23ee9295c20d9e3c86417 *data/Gasoline.rda e481aa0aed87e6449453bdb41b631d10 *data/Grunfeld.rda 4d32fb308d211b683c42fc299df43e6b *data/Hedonic.rda 4ed4eadec85ffa07af12d3706a57f344 *data/LaborSupply.rda 02a3fea3cc3a87f5a409b8733fc28ae5 *data/Males.rda d644f2f15753f28e20c6f29142816327 *data/Parity.rda 72c0e834cc150edcc6f5cc840a20e552 *data/Produc.rda 39f0ddf3f2283db1b93c24078f26b36e *data/RiceFarms.rda d970a865d86827db547548b196af8f25 *data/Snmesp.rda df5e3356d643dcabbf3e670679f41276 *data/SumHes.rda 0d0e46e15e0d943fa4d3eb218e87e187 *data/Wages.rda 3a09888e3da962d6407572264cc11ac8 *inst/CITATION 75802e7cd199a082d1137b562598b29d *inst/REFERENCES.bib 1ae29d16d92c80fdc043b3e4d1918a97 *inst/doc/A_plmPackage.R 7a5127474c86a7e36061efec04c48af4 *inst/doc/A_plmPackage.Rmd 98264616428967c8557e48633813605b *inst/doc/A_plmPackage.html 0d62273ecc2f4006a4b78ccea4a72e47 *inst/doc/B_plmFunction.R 2919f300e5e4628f01b31d419e698fab *inst/doc/B_plmFunction.Rmd a655565e78905134633de5da03fb94fc *inst/doc/B_plmFunction.html cada247f2da080ce5b1ec21a94986b9f *inst/doc/C_plmModelComponents.R 61e470020391967f87ed178d64db0a56 *inst/doc/C_plmModelComponents.Rmd 6ea1a6b43e2340a94aed414fe60226af *inst/doc/C_plmModelComponents.html eea0b0b39df949f8baa0d19bde063a83 *inst/removed/dynformula.Rd 30e18cc284b09043ca04f6c2577a158b *inst/removed/pFormula.Rd d1ada564a8468ad760ff1d10c4f2233c *inst/removed/plm.data.Rd f6be51cea29f243b91a663a4fabb61c4 *inst/removed/test_model.matrix_pmodel.response_NA.R 8868df3d78b55e8c38c5c81b688d2bb6 *inst/removed/unused.R c17c713fcb5465cdbe6154c579187d15 *inst/tests/test_Chow.R 1286f88783d18c7b329c074e38b267bf *inst/tests/test_Chow.Rout.save c110c3f809248df15e5084cc9dfea0df *inst/tests/test_Errors.R 2b1d874fbe6b41e5ce32651f88d1d30b *inst/tests/test_Errors.Rout.save fcd6235d071ba91433c6e60f346d12c6 *inst/tests/test_Estimators.R 3e006a8bdc96b9756e809b9dcd015c26 *inst/tests/test_Estimators.Rout.save 2f8451b91ef32e3654a32ef2dd192848 *inst/tests/test_EstimatorsIV.R fd1b41b93d04c6ed67ef170396010e44 *inst/tests/test_EstimatorsIV.Rout.save feaef901b91beeeb7ebf0f7dfd655827 *inst/tests/test_EstimatorsNested.R d6001aedb38e16184afe3a0c04e5ae8d *inst/tests/test_EstimatorsNested.Rout.save 577588f7fc649cb0edfa226a0be72706 *inst/tests/test_FD_models.R 3f4f44ea153c43472ce054ce3941517e *inst/tests/test_FD_models.Rout.save 170eaac811f65bfa276adbf02186dcb4 *inst/tests/test_R2_adj_R2.R c6c6c589834a477573b878c06e637eb9 *inst/tests/test_as.data.frame_as.matrix.R 69f03762e8d1e8c90ad53eb30d678b9c *inst/tests/test_as.list.pdata.frame.R f7f6abd1a40202f757e6650064d1dd6f *inst/tests/test_cipstest.R 1803089da994d68323a3793725b6692c *inst/tests/test_cipstest.Rout.save c01a7eed23abbb981369b621a4a6df18 *inst/tests/test_clubSandwich_interoperability.R 42cba265483ed030ddff24dff05f316c *inst/tests/test_detect_lin_dep_alias.R 886ac321dee14a6e325aa1e491ef4558 *inst/tests/test_fitted.plm.R 9dfe9c5d062dcb7e5939d952365bf8c5 *inst/tests/test_fixef.R 5b800bf4893e7d38e837a43a2d2c87da *inst/tests/test_fixef.Rout.save e15686e8d82f04ae0289b4d54cbf5bac *inst/tests/test_fixef2.R 0ef68c6f470bab0a69fb490b05399376 *inst/tests/test_fixef2.Rout.save 7ce495db78627a86e0bea4c6cc841451 *inst/tests/test_fixef_comp_lm_plm.R 228b08eafae891145700ff01c78204d2 *inst/tests/test_fixef_comp_lm_plm.Rout.save ce4797a4dc341ac07bf00dfab9b3a1f9 *inst/tests/test_groupGenerics_pseries.R 3b651a06f9da4cf9a81d0d65b13b3442 *inst/tests/test_groupGenerics_pseries.Rout.save 606a3dbf3841d5e81b1d90e8dcac9487 *inst/tests/test_is.pconsecutive.R 922626f7fe969cd67e3ddaea87723d54 *inst/tests/test_is.pconsecutive.Rout.save 6adfd11517a87ea532735f764a4faae9 *inst/tests/test_lag_lead.R 179c317349dab3ca3a4cdac6757ab826 *inst/tests/test_lag_lead.Rout.save 4ed39862d70d2ad12d05001f81f25fe1 *inst/tests/test_lagt_leadt.R 0b7d9b130210053ad3df3d9af0b31b96 *inst/tests/test_lagt_leadt.Rout.save f169d706cd84f9741d56bec65888ea7e *inst/tests/test_make.pconsecutive_pbalanced.R b518bef87bd72b8ac187d9908f005a8c *inst/tests/test_make.pconsecutive_pbalanced.Rout.save 43350a599601ebec6e5cd3c0101cd7f3 *inst/tests/test_misc.R e28c7985cb7b2b7b020351ba9d30b5e4 *inst/tests/test_misc.Rout.save 7d03a053cec6ba109c3f280bf17c6a83 *inst/tests/test_model.frame.R 89e5d0a9746b33794e93629b1daec6b9 *inst/tests/test_model.frame.Rout.save 148e3d5419e96dfa41aabaffb4f752cc *inst/tests/test_model.matrix_effects.R 87f3e92d8d197ae8da41310793197d4c *inst/tests/test_model.matrix_effects.Rout.save ad56c8012a1fddf99d87d302202aaa11 *inst/tests/test_model.matrix_pmodel.response.R b284f8714cdf871954a33817031db89e *inst/tests/test_model.matrix_pmodel.response.Rout.save a243f44b23b8ea745508fc5816ace276 *inst/tests/test_order_between_fixef_ranef.R 76ef69b6c796f8990238b227416131b6 *inst/tests/test_order_between_fixef_ranef.Rout.save cdc553c72e9975e206abf2f2cbcbeab6 *inst/tests/test_pFtest.R 28785f36dcc6d09eec6c133b5ca744cc *inst/tests/test_pFtest.Rout.save 9f220f0dc1793a77007b23f8102e44c0 *inst/tests/test_pbgtest.R 9bc6a1b638066e2a92a17156f8b64c95 *inst/tests/test_pbnftest.R 1773b40616f0c51a0ff7cdcb4d17cc9f *inst/tests/test_pbnftest.Rout.save 97523b155b3b1fc0b8b0fd0b427ab35d *inst/tests/test_pbsytest_unbalanced.R 69654baf4fb0502ced260dfb9e30eac6 *inst/tests/test_pbsytest_unbalanced.Rout.save 4005807a1d08ecb8bb6d59a9108e9e7c *inst/tests/test_pcdtest.R 02024b2be940b8c376073fc5529eaadf *inst/tests/test_pcdtest.Rout.save 12761e5edd1d90bea834b331bc66e407 *inst/tests/test_pdata.frame_const_allNA_nonfinite.R aff2fd64e1777c6d0852ea3ef98cdb7b *inst/tests/test_pdata.frame_extract_class_est_mod.R 1886ccdf2a9fa2b8873afcaeb53b2fa0 *inst/tests/test_pdata.frame_id_index_more.R 2f938f12a0c269af9e09360cd46a0bb9 *inst/tests/test_pdata.frame_id_index_more.Rout.save 7e52a4440c90d9077e382bc9c964d8c8 *inst/tests/test_pdata.frame_print_duplicated_rownames.R 8325994677d6a930f8405a12234eb83d *inst/tests/test_pdata.frame_pseriesfy.R 6e70102b93fe8a3887bf951893599095 *inst/tests/test_pdata.frame_pseriesfy.Rout.save 5676e774edfd7177b8aaf41bd147e852 *inst/tests/test_pdata.frame_subsetting.R 6fbbf2828c8626999ec67b7f9cb85cae *inst/tests/test_pdata.frame_subsetting.Rout.save c16883215c3ea0bdd033dab099a29c37 *inst/tests/test_pdata.frame_unused_levels.R 1ed8ae09cd68b9576fc44c544c3ed0b8 *inst/tests/test_pdiff_fd.R 7f38e395c11eef031d90957805629781 *inst/tests/test_pdiff_fd.Rout.save 318663a0bb47aa2f4669fa6455fd0fba *inst/tests/test_pdwtest.R e7724043cbca5bb9f0616c2e918a2e01 *inst/tests/test_pdwtest.Rout.save aca28ef672382a069f23c9100f55ad5d *inst/tests/test_pggls.R 3a1bd11209ed9ba45f493a0385bc38a8 *inst/tests/test_pggls.Rout.save 6fa717034aacf1ed5d21a36a909ca98f *inst/tests/test_pgmm.R 39f91edb6ded55f81c762e4964e0bb57 *inst/tests/test_pgmm.Rout.save e10f1c6063bb1cb9d206c99bc50e1771 *inst/tests/test_pgrangertest.R e5524a5e21ca4c1bfb57c6d55a252dea *inst/tests/test_pgrangertest.Rout.save 0659ec2d5b15273daf7eb23fed25c0f9 *inst/tests/test_pht.R aa9aa1089f6bac090f643d852681937d *inst/tests/test_pht.Rout.save 7bece33d3630691567d2a787b7024344 *inst/tests/test_phtest_Hausman_regression.R 497d93960491479b3885d017a6a5e4a7 *inst/tests/test_phtest_Hausman_regression.Rout.save 7341e572b079ebdd98df4632f42064a8 *inst/tests/test_plm.data.R c45f6be607485bc3a910c3b351bdca2e *inst/tests/test_plm_na.action.R 4ad545e3809ebc50c9ca19042888c2f0 *inst/tests/test_plmtest_unbalanced.R 459b66df2b992f9be11984598b0d0a28 *inst/tests/test_plmtest_unbalanced.Rout.save a9dddaa0141b988559a67785250d57f9 *inst/tests/test_preserve_rownames.R 7ac01a5032497f2a57e0335ff27ad1fa *inst/tests/test_pseries_subsetting.R 07537f44b29c7d0faaeae29e48bc653d *inst/tests/test_punbalancedness.R 085f8fad20bf369394404955514649a8 *inst/tests/test_purtest.R cd84da70729ec0cdc135d6bba941efa8 *inst/tests/test_purtest.Rout.save 95321b56da6a2e4c9cdd53b5baec593b *inst/tests/test_pvar.R 7588399e82129e32a14ecae462634c77 *inst/tests/test_pvar.Rout.save 41490dbed65e386b2dbeeddfb9a19be9 *inst/tests/test_pvcm.R 2aa6533fe0c9be31db285ede6fda8b2c *inst/tests/test_pvcm.Rout.save 3c78d8e8bc2312892b105edfa3104f0c *inst/tests/test_pwaldtest.R 0b7718a8a1252f29ac596996d107c13a *inst/tests/test_pwaldtest.Rout.save 0519318167f8197bb3a87cb570dc1c28 *inst/tests/test_pwaldtest_vcovG_attr_cluster.R 4f88e0498f623bf18f31f25e8b0ac738 *inst/tests/test_pwaldtest_vcovG_attr_cluster.Rout.save 4e58058c02bcbd57f207ff86e7669aae *inst/tests/test_pwfdtest_pwartest.R 4ea658a9cd5dfb4d99f830b6178356dc *inst/tests/test_pwtest.R e265e6607e7aec88624179f9ea396b48 *inst/tests/test_ranef.R 323f8bad3994cb564126caa0c0a0dec0 *inst/tests/test_ranef.Rout.save e1120e9d2762b4f0598b51b7cb47df7e *inst/tests/test_residuals_overall_fitted_exp.R 1d01abdc9f1c0d524729eab352634a4c *inst/tests/test_summary.plm_vcov.R 6f37e40fd5ad6dc885732aac9bd5c5de *inst/tests/test_summary.pseries_character_logical_factor.R c0a9ecc23f4b6031cab90a76bb1e2c94 *inst/tests/test_transformations.R bc21c6ee86cf6caaee909ba7a01d5966 *inst/tests/test_transformations_collapse.R 89b70b813de281aa9fc8a6ba225c7646 *inst/tests/test_vcovG_lin_dep.R 6710c0e61352fbb164d3360b203b1c78 *inst/tests/test_within_intercept.R d44e0395abd70268397c6a41cc6ef13d *inst/tests/test_within_intercept.Rout.save 1b297cd5f6693970fde4f29a2dd4df45 *man/Cigar.Rd f78f15d8753ac15c670a1140f21bfe43 *man/Crime.Rd 8bc89d97818327867b6ca8a5982d5d72 *man/EmplUK.Rd 6ff67d106926a43e70f9a37eede5e7c8 *man/Gasoline.Rd d012c8e6f0cac3fd938d94bceaf09ca8 *man/Grunfeld.Rd 3594b021c65985fef094dc15c9a15ab3 *man/Hedonic.Rd a32cd54a8bd8f57af5ca2f8dff06c7de *man/LaborSupply.Rd 78c351dac8a8f8d25df5f5b5529ec17b *man/Males.Rd 4c235aebdaa2632623549175be954790 *man/Parity.Rd b158db3cbfd38650cc079515489a4cbf *man/Produc.Rd e59e8d48ea330b43ffac56af7d7834cd *man/RiceFarms.Rd 92922fe66474edd0ee544e4b9277e184 *man/Snmesp.Rd 01172247babfe765971704fa7afa4f51 *man/SumHes.Rd 886f7ce02f12e8e09ee6fdc6d14057e5 *man/Wages.Rd 431d2c83d72f787eb2746b3c7b1bed05 *man/aneweytest.Rd 8faa6ce16a02a0aeabde9d0412f35a1c *man/cipstest.Rd 5adacaed491b737b260a39b4aea3f304 *man/cortab.Rd a4e7ad4e4ed3aa52a80d0f478f42584d *man/detect.lindep.Rd 6bda570e0ab9b8c775423a943da807d7 *man/ercomp.Rd d8bd8291d26f149233562b8a71ca89c5 *man/fixef.plm.Rd 31b422595e6206cc1d31b545e85aab05 *man/has.intercept.Rd 56c1bc73056d4db751f39728fb6177b4 *man/index.plm.Rd 2df28017ba6a989981333ce5e4e6ea9b *man/is.pbalanced.Rd caf7cb134311a227fc5fff23cc0310a0 *man/is.pconsecutive.Rd 600395679fd85cc1d4abc7c74c54031b *man/is.pseries.Rd 2619d20f1bf44ddd8ffd82fe3c810bc0 *man/lag.plm.Rd 8292f17423e5daf8763117368d5967b7 *man/make.dummies.Rd fbf4715f73029959cd522cf0ad809f12 *man/make.pbalanced.Rd cfca1b7b1c1d671a33fec12cb9f5c556 *man/make.pconsecutive.Rd 0359e3919c391f4c97d97e4b6340cb44 *man/model.frame.pdata.frame.Rd 45164b5b5169ce750874ef90d59c1242 *man/mtest.Rd 2b09519eb8848e7d118016b2b325707a *man/nobs.plm.Rd ea2110a4546367b24f4992e1afaa007c *man/pFtest.Rd a834662943c53710e7af60bd1463e575 *man/pbgtest.Rd 0bee3736df0fcfdb4fe996e7d97c7f6a *man/pbltest.Rd 756ede8656fcef5ee3f0504be8dc245f *man/pbnftest.Rd b5603aa2711e45ff6db320c4f2369024 *man/pbsytest.Rd a2a0c3350aa7f3829b8f889a94fb1b87 *man/pcce.Rd c79dde2a1f3aa288db30e349c175e1ac *man/pcdtest.Rd 76925b872390b46c205b5ea98fb645aa *man/pdata.frame.Rd 77ba60e946c9506429ea6d10a0694bba *man/pdim.Rd b8a4a6e1d53ea4786918350dea1234a4 *man/pdwtest.Rd e28224d99c7aeee99ac85a442afa9b54 *man/pggls.Rd 5143a67c5f0419ef9593073ba465008b *man/pgmm.Rd 3e458ccc84667734323d36d71202885d *man/pgrangertest.Rd 06ce6288d8748b8127828e14ac19eb51 *man/phansitest.Rd 8eed0bb06910908520315a3c0a9b8498 *man/pht.Rd 5f84cb97d952e3141fc1c863e16f6793 *man/phtest.Rd 53df600520383e1283d586e5752eebf6 *man/piest.Rd 1b88bb6797562b3bd00b9f46c3ad3dfe *man/pldv.Rd 21e34de5e5f0ced70d0823fd62f64011 *man/plm-deprecated.Rd bf18576bcfd3d43bfe43778d49e02b47 *man/plm-package.Rd 43c584871db0c7d984e67984898f9ce2 *man/plm.Rd 103373044afcdb592cd95ec687dbc5ac *man/plm.fast.Rd f3849580095209c0e3a441d7db738e2a *man/plmtest.Rd e2a92a830a3190f6d2ca0c38a10f0524 *man/pmg.Rd 1d7edcd9981eb65d02a7678d2a70cd8f *man/pmodel.response.Rd d146e78ca6edfd387d5712f2df38f85f *man/pooltest.Rd 98e9f749d4405eace243a8ac73104db2 *man/pseries.Rd 79230b6f879e065fd83edf5ec113321a *man/pseriesfy.Rd 8ad0fa74676dd9c4ff698a3dcb304cb1 *man/punbalancedness.Rd 3d0fb634c149423955570282da5f74db *man/purtest.Rd 936e07f3f4be70df9858ab755d0dca6d *man/pvar.Rd faaaca9f39142f9e1f3a81b261785dec *man/pvcm.Rd 8248c631aa5f0d21359f9a59804d1780 *man/pwaldtest.Rd 0045cd7febe5350383a1fd61a9784768 *man/pwartest.Rd ed707bd9ef96d9b1d0db4984bb2bf4a2 *man/pwfdtest.Rd 4bce4eee7c171a6027367a78b36d5692 *man/pwtest.Rd 01242cb07d62e1e59ac9e426c9718b73 *man/r.squared.Rd fa1e59bf0a043ac2cbf20c90f31fa7b6 *man/ranef.plm.Rd 94b78c3c8cc83de1ba1534d1afb1314f *man/re-export_functions.Rd fd703b544956fc7c537270ea1b6c47da *man/sargan.Rd 7317be14145a6927b6f81154eaf27ef3 *man/summary.plm.Rd 7cd38fdaa45a9aefed8c8ccad0fff6fd *man/vcovBK.Rd 52ce877e4aa93516a7bdb978f7260086 *man/vcovDC.Rd 213fbc396efe900a7b1be31b20355320 *man/vcovG.Rd 817feb0b32f8853f55a61b9e96995c80 *man/vcovHC.plm.Rd cf697f6487478d7613f799e7386d7f53 *man/vcovNW.Rd 4de54d7ea83c062a6aedef40d6e391ce *man/vcovSCC.Rd 906b82935efdbcb4cb698eaadd9ed6d0 *man/within_intercept.Rd de8d974064d4dc8f29862ecd428e7b78 *tests/test_Evaluation.R 7a5127474c86a7e36061efec04c48af4 *vignettes/A_plmPackage.Rmd 2919f300e5e4628f01b31d419e698fab *vignettes/B_plmFunction.Rmd 61e470020391967f87ed178d64db0a56 *vignettes/C_plmModelComponents.Rmd plm/inst/0000755000176200001440000000000014177501551012025 5ustar liggesusersplm/inst/REFERENCES.bib0000644000176200001440000041074014174456313014134 0ustar liggesusers@article{AMEM:71, author={T. Amemiya}, title={The Estimation of the Variances in a Variance--Components Model}, journal={International Economic Review}, volume={12}, year={1971}, pages={1--13} } @article{ANDE:HSIA:81, author={T.W. Anderson and C. Hsiao}, title={Estimation of Dynamic Models With Error Components}, journal={Journal of the American Statistical Association}, volume={76}, year={1981}, pages={598--606} } @Article{ANDE:HSIA:82, author = {T.W. Anderson and C. Hsiao}, title = {Formulation and estimation of dynamic models using panel data}, journal = {Journal of Econometrics}, year = {1982}, OPTkey = {}, volume = {18}, OPTnumber = {}, pages = {47-82}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{AREL:BOND:91, author={M. Arellano and S. Bond}, title={Some Tests of Specification for Panel Data : Monte Carlo Evidence and an Application to Employment Equations}, journal={Review of Economic Studies}, volume={58}, year={1991}, pages={277--297} } @book{AREL:03, author={M. Arellano}, title={Panel Data Econometrics}, publisher={Oxford University press}, year={2003} } @article{BALE:VARA:87, author={P. Balestra and J. Varadharajan--Krishnakumar}, title={Full Information Estimations of a System of Simultaneous Equations With Error Components}, journal={Econometric Theory}, volume={3}, year={1987}, pages={223--246} } @article{BALT:81, author={B.H Baltagi}, title={Simultaneous Equations With Error Components}, journal={Journal of Econometrics}, volume={17}, year={1981}, pages={21--49} } @book{BALT:01, author={B.H. Baltagi}, title={Econometric Analysis of Panel Data}, publisher={John Wiley and Sons ltd}, year={2001}, edition={3rd} } @book{BALT:03, author={B.H. Baltagi}, title={Econometric Analysis of Panel Data}, publisher={John Wiley and Sons ltd}, year={2003}, edition={4th} } @Book{PFAFF:08, title = {Analysis of Integrated and Cointegrated Time Series with R}, author = {Bernhard Pfaff}, publisher = {Springer}, edition = {Second}, address = {New York}, year = {2008}, note = {ISBN 0-387-27960-1}, url = {https://CRAN.r-project.org/package=urca}, } @Book{SEVE:02, author = {Patrick Sevestre}, ALTeditor = {}, title = {Econom\'etrie des donn\'ees de panel}, publisher = {Dunod}, year = {2002}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Book{PIRO:11, author = {Alain Pirotte}, ALTeditor = {}, title = {Econom\'etrie des donn\'ees de panel}, publisher = {Economica}, year = {2011}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Book{HSIA:03, author = {C. Hsiao}, ALTeditor = {}, title = {Analysis of Panel Data}, publisher = {Cambridge University Press}, year = {2003}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, address = {Cambridge}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @book{HSIA:14, place={Cambridge}, edition={3}, series={Econometric Society Monographs}, title={Analysis of Panel Data}, DOI={10.1017/CBO9781139839327}, publisher={Cambridge University Press}, author={Hsiao, Cheng}, year={2014}, collection={Econometric Society Monographs} } @article{BLUN:BOND:98, author={R. Blundell and S. Bond}, title={Initital Conditions and Moment Restrictions in Dynamic Panel Data Models}, journal={Journal of Econometrics}, volume={87}, year={1998}, pages={115--143} } @article{BREU:PAGA:80, author={T.S. Breusch and A.R. Pagan}, title={The Lagrange Multiplier Test and Its Applications to Model Specification in Econometrics}, journal={Review of Economic Studies}, volume={47}, year={1980}, pages={239--253} } @article{CRIB:04, author={F. Cribari--Neto}, title={Asymptotic Inference Under Heteroskedasticity of Unknown Form}, journal={Computational Statistics \& Data Analysis}, volume={45}, year={2004}, pages={215--233} } @article{GOUR:HOLL:MONF:82, author={C. Gourieroux and A. Holly and A. Monfort}, title={Likelihood Ratio Test, Wald Test, and Kuhn--Tucker Test in Linear Models With Inequality Constraints on the Regression Parameters}, journal={Econometrica}, volume={50}, year={1982}, pages={63--80} } @book{GREE:03, author={W.H. Greene}, title={Econometric Analysis}, publisher={Prentice Hall}, year={2003}, edition={5th} } @book{GREE:12, author={W.H. Greene}, title={Econometric Analysis}, publisher={Prentice Hall}, year={2012}, edition={7th} } @article{HAUS:78, author={J.A. Hausman}, title={Specification Tests in Econometrics}, journal={Econometrica}, volume={46}, year={1978}, pages={1251--1271} } @article{HAUS:TAYL:81, author={J.A. Hausman and W.E. Taylor}, title={Panel Data and Unobservable Individual Effects}, journal={Econometrica}, volume={49}, year={1981}, pages={1377--1398} } @article{HOLT:NEWE:ROSE:88, author={D. Holtz--Eakin and W. Newey and H.S. Rosen}, title={Estimating Vector Autoregressions With Panel Data}, journal={Econometrica}, volume={56}, year={1988}, pages={1371--1395} } @article{HOND:85, author={Y. Honda}, title={Testing the Error Components Model With Non--Normal Disturbances}, journal={Review of Economic Studies}, volume={52}, year={1985}, pages={681--690} } @article{KING:WU:97, author={M.L. King and P.X. Wu}, title={Locally Optimal One--Sided Tests for Multiparameter Hypothese}, journal={Econometric Reviews}, volume={33}, year={1997}, pages={523--529} } @article{MACK:WHIT:85, author={J.G. MacKinnon and H. White}, title={Some Heteroskedasticity--Consistent Covariance Matrix Estimators With Improved Finite Sample Properties}, journal={Journal of Econometrics}, volume={29}, year={1985}, pages={305--325} } @article{NERLO:71, author={M. Nerlove}, title={Further Evidence on the Estimation of Dynamic Economic Relations from a Time--Series of Cross--Sections}, journal={Econometrica}, volume={39}, year={1971}, pages={359--382} } @book{STOC:WATS:07, title={Introduction to econometrics}, author={Stock, James H and Watson, Mark W}, year={2007}, publisher={Pearson/Addison Wesley Boston} } @article{SWAM:70, author={P.A.V.B. Swamy}, title={Efficient Inference in a Random Coefficient Regression Model}, journal={Econometrica}, volume={38}, year={1970}, pages={311--323} } @article{SWAM:AROR:72, author={P.A.V.B. Swamy and S.S Arora}, title={The Exact Finite Sample Properties of the Estimators of Coefficients in the Error Components Regression Models}, journal={Econometrica}, volume={40}, year={1972}, pages={261--275} } @article{WALL:HUSS:69, author={T.D. Wallace and A. Hussain}, title={The Use of Error Components Models in Combining Cross Section With Time Series Data}, journal={Econometrica}, volume={37}, year={1969}, pages={55--72}, number={1} } @book{WOOL:02, author={J.M. Wooldridge}, title={Econometric Analysis of Cross--Section and Panel Data}, year={2002}, publisher={MIT Press} } @book{WOOL:10, author={J.M. Wooldridge}, title={Econometric Analysis of Cross--Section and Panel Data}, year={2010}, edition={2nd}, publisher={MIT Press}, } @book{WOOL:13, author={J.M. Wooldridge}, title={Introductory Econometrics: a modern approach}, publisher={South-Western (Cengage Learning)}, edition={5th}, year={2013} } @article{ZEIL:04, author={A. Zeileis}, title={Econometric Computing With {HC} and {HAC} Covariance Matrix Estimators}, journal={Journal of Statistical Software}, volume={11}, year={2004}, pages={1--17}, number={10}, url={https://www.jstatsoft.org/article/view/v011i10} } @article{WHIT:80, title={A heteroskedasticity-consistent covariance matrix estimator and a direct test for heteroskedasticity}, author={White, Halbert}, journal={Econometrica}, volume={48}, number={4}, pages={817--838}, year={1980}, publisher={JSTOR} } @article{WIND:05, author={F. Windmeijer}, title={A Finite Sample Correction for the Variance of Linear Efficient Two--Steps {GMM} Estimators}, journal={Journal of Econometrics}, year={2005}, volume={126}, pages={25--51} } @article{MUNN:90, author={A. Munnell}, title={Why Has Productivity Growth Declined? Productivity and Public Investment}, journal={New England Economic Review}, year={1990}, pages={3--22} } @article{BERA:SOSA:YOON:01, author={A.K. Bera and W. Sosa--Escudero and M. Yoon}, title={Tests for the Error Component Model in the Presence of Local Misspecification}, journal={Journal of Econometrics}, volume={101}, year={2001}, pages={1--23} } @article{BALT:LI:91, author={B. Baltagi and Q. Li}, title={A Joint Test for Serial Correlation and Random Individual Effects}, journal={Statistics and Probability Letters}, volume={11}, year={1991}, pages={277--280} } @article{BALT:LI:95, author={B. Baltagi and Q. Li}, title={Testing {AR}(1) Against {MA}(1) Disturbances in an Error Component Model}, journal={Journal of Econometrics}, volume={68}, year={1995}, pages={133--151} } @article{BALT:LI:97, author={B. Baltagi and Q. Li}, title={Monte Carlo Results on Pure and Pretest Estimators of an Error Components Model With Autocorrelated Disturbances}, journal={Annales d'Economie et de Statistique}, volume={48}, year={1997}, pages={69--82} } @article{LAIR:WARE:82, author={N.M. Laird and J.H. Ware}, title={Random--Effects Models for Longitudinal Data}, journal={Biometrics}, volume={38}, year={1982}, pages={963--974} } @article{BATE:04, author={Douglas Bates}, title={Least Squares Calculations in \proglang{R}}, journal={\proglang{R}--news}, volume={4}, year={2004}, pages={17--20}, number={1} } @article{MUND:78, author={Yair Mundlak}, title={On the Pooling of Time Series and Cross Section Data}, journal={Econometrica}, volume={46}, year={1978}, pages={69--85}, number={1} } @book{FOX:02, author={John Fox}, title={An \proglang{R} and \proglang{S--plus} Companion to Applied Regression}, publisher={Sage}, year={2002} } @booklet{STOC:WATS:06, author={James Stock and Mark Watson}, title={Heteroskedasticity--Robust Standard Errors for Fixed Effects Panel Data Regression}, howpublished={NBER WP 0323}, year={2006} } @article{STOC:WATS:08, author={James H. Stock and Mark W. Watson}, title={Heteroskedasticity--Robust Standard Errors for Fixed Effects Panel Data Regression }, journal={Econometrica }, volume={76}, year={2008}, pages={155--174}, number={1} } @manual{ATKI:THER:07, author={Beth Atkinson and Terry Therneau}, title={\pkg{kinship}: Mixed--Effects Cox Models, Sparse Matrices, and Modeling Data from Large Pedigrees}, year={2007}, note={\proglang{R} package version 1.1.0-18}, url={https://CRAN.R-project.org} } @manual{KOEN:NG:2016, author={Roger Koenker and Pin Ng}, title={\pkg{SparseM}: Sparse Linear Algebra }, year={2016}, note={\proglang{R} package version 1.72}, url={https://CRAN.R-project.org/package=SparseM} } @manual{BATE:MAEC:2016, author={Douglas Bates and Martin Maechler}, title={\pkg{Matrix}: Sparse and Dense Matrix Classes and Methods }, year={2016}, note={\proglang{R} package version 1.2-7.1}, url={https://CRAN.R-project.org/package=Matrix} } @manual{BATE:MAEC:07, author={Douglas Bates and Martin Maechler}, title={\pkg{matrix}: A Matrix Package for \proglang{R}}, year={2007}, note={\proglang{R} package version 0.99875-2}, url={https://CRAN.R-project.org/package=Matrix} } @manual{KOEN:NG:07, author={Roger Koenker and Pin Ng}, title={\pkg{SparseM}: Sparse Linear Algebra}, year={2007}, note={\proglang{R} package version 0.74}, url={https://CRAN.r-project.org/package=SparseM} } @manual{CROI:06, author={Yves Croissant}, title={\pkg{Ecdat}: Data Sets for Econometrics}, year={2006}, note={\proglang{R} package version 0.1-5}, url={https://CRAN.r-project.org/package=Ecdat} } @manual{FOX:06, author={John Fox}, title={\pkg{car}: Companion to Applied Regression}, year={2007}, note={\proglang{R} package version 1.2-5}, url={https://CRAN.r-project.org/package=car, http://socserv.socsci.mcmaster.ca/jfox/} } @manual{FOX:2016, author={John Fox}, title={\pkg{car}: Companion to Applied Regression }, year={2016}, note={\proglang{R} package version 2.1-3}, url={https://CRAN.R-project.org/package=car} } @article{ZEIL:HOTH:02, author={Achim Zeileis and Torsten Hothorn}, title={Diagnostic Checking in Regression Relationships}, journal={\proglang{R} News}, volume={2}, year={2002}, pages={7--10}, number={3}, url={https://CRAN.R-project.org/doc/Rnews/} } @misc{HOTH:ZEIL:MILL:MITC:07, author={T. Hothorn and A. Zeileis and G. Millo and D. Mitchell}, title={\pkg{lmtest}: Testing Linear Regression Models}, year={2007}, howpublished={\proglang{R} package version 0.9-19}, url={https://CRAN.R-project.org/package=lmtest} } @manual{HOTH:ZEIL:FARE:CUMM:MILL:MITC:2015, author={T. Hothorn and A. Zeileis and R. W. Farebrother and C. Cummins and G. Millo and D. Mitchell}, title={\pkg{lmtest}: Testing Linear Regression Models }, year={2015}, note={\proglang{R} package version 0.9-34}, url={https://CRAN.R-project.org/package=lmtest} } @misc{LUML:ZEIL:07, author={T. Lumley and A. Zeileis}, title={\pkg{sandwich}: Model--Robust Standard Error Estimation for Cross--Sectional, Time Series and Longitudinal Data}, year={2007}, howpublished={\proglang{R} package version 2.0-2}, url={https://CRAN.R-project.org} } @manual{LUML:ZEIL:2015, author={T. Lumley and A. Zeileis}, title={\pkg{sandwich}: Robust Covariance Matrix Estimators }, year={2015}, note={\proglang{R} package version 2.3-4}, url={https://CRAN.R-project.org/package=sandwich} } @manual{PINH:BATE:DEBR:SARK:07, author={Jose Pinheiro and Douglas Bates and Saikat DebRoy and Deepayan Sarkar the \proglang{R} Core team}, title={\pkg{nlme}: Linear and Nonlinear Mixed Effects Models}, year={2007}, note={\proglang{R} package version 3.1-86}, url={https://CRAN.r-project.org/package=nlme} } @manual{BATE:07, author={Douglas Bates}, title={\pkg{lme4}: Linear Mixed--Effects Models Using \proglang{S4} Classes}, year={2007}, note={\proglang{R} package version 0.99875-9}, url={https://CRAN.r-project.org/package=lme4} } @article{CORN:RUPE:88, author={C. Cornwell and P. Rupert}, title={Efficient Estimation With Panel Data: an Empirical Comparison of Instrumental Variables Estimators}, journal={Journal of Applied Econometrics}, volume={3}, year={1988}, pages={149--155} } @article{DRUK:03, author={D.M. Drukker}, title={Testing for Serial Correlation in Linear Panel--Data Models}, journal={The Stata Journal}, volume={3}, year={2003}, pages={168-177}, number={2} } @book{PINH:BATE:00, author={J.C. Pinheiro and D. Bates}, title={Mixed--Effects Models in \proglang{S} and \proglang{S-plus}}, publisher={Springer-Verlag}, year={2000} } @unpublished{PESA:04, author={Pesaran, M.H.}, title={General Diagnostic Tests for Cross Section Dependence in Panels}, note={CESifo Working Paper Series, 1229}, year={2004}, } @article{DEHO:SARA:06, author={De Hoyos, R.E. and Sarafidis, V.}, title={Testing for Cross--Sectional Dependence in Panel--Data Models}, journal={The Stata Journal}, volume={6}, year={2006}, pages={482-496}, number={4} } @Manual{BIVA:08, title = {spdep: Spatial Dependence: Weighting Schemes, Statistics and Models}, author = {Roger Bivand}, year = {2008}, note = {R package version 0.4-17}, } @Manual{R:2008, title = {\proglang{R}: {A} Language and Environment for Statistical Computing}, author = {{\proglang{R} Development Core Team}}, organization = {\proglang{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2008}, note = {{ISBN} 3-900051-07-0}, url = {https://www.r-project.org/} } @Book{KLEI:ZEIL:08, title = {Applied Econometrics with {R}}, author = {Christian Kleiber and Achim Zeileis}, year = {2008}, publisher = {Springer-Verlag}, address = {New York}, note = {{ISBN} 978-0-387-77316-2}, url = {https://CRAN.R-project.org/package=AER}, } @Article{HARR:RUBI:78, author = {Harrison, D. and Rubinfeld, D.L.}, title = {Hedonic housing prices and the demand for clean air}, journal = {Journal of Environmental Economics and Management}, year = {1978}, OPTkey = {}, volume = {5}, OPTnumber = {}, pages = {81-102}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:CHAN:94, author = {Baltagi, B.H. and Chang, Y.J.}, title = {Incomplete panels: a comparative study of alternative estimators for the unbalanced one-way error component regression model}, journal = {Journal of Econometrics}, year = {1994}, OPTkey = {}, volume = {62}, OPTnumber = {2}, pages = {67-89}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ACEMO:JOHNO:ROBIN:YARED:08, author = {A Daron Acemoglu and Simon Johnson and James A. Robinson and Pierre Yared}, title = {Income and democracy}, journal = {American Economic Review}, year = {2008}, OPTkey = {}, volume = {98(3)}, OPTnumber = {}, pages = {808-842}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{EGGER:PFAFF:04, author = {Peter Egger and Michael Pfaffermayr}, title = {Distance, Trade, and {FDI}: A {H}ausman-{T}aylor {SUR} Approach}, journal = {Journal of Applied Econometrics}, year = {2004}, OPTkey = {}, volume = {19(2)}, OPTnumber = {}, pages = {227-46}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KESSL:HANSE:LESSM:11, author = {Anke S. Kessler and Nico A. Hansen and Christian Lessman}, title = {Interregional redistribution and mobility in federations : a positive approach}, journal = {The Review of Economic Studies}, year = {2011}, OPTkey = {}, volume = {78}, OPTnumber = {}, pages = {1345-78}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BREND:DRAZE:08, author = {Adi Brender and Allan Drazen}, title = {Budget deficits and economic growth affect reelection prospects? Evidence froma large panel of countries}, journal = {American Economic Review}, year = {2008}, OPTkey = {}, volume = {98(5)}, OPTnumber = {}, pages = {2203-2220}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{Croissant:Millo:2008, author = {Yves Croissant and Giovanni Millo}, title = {Panel Data Econometrics in \proglang{R}: The \pkg{plm} Package}, journal = {Journal of Statistical Software}, year = {2008}, volume = {27}, number = {2}, pages = {1-43}, url = {https://www.jstatsoft.org/article/view/v027i02} } @Article{RAUX:SOUCH:CROIS:09, author = {Charles Raux and St\'ephanie Souche and Yves Croissant}, title = {How fair is pricing perceived to be? An empirical study}, journal = {Public Choice}, year = {2009}, OPTkey = {}, volume = {139(1)}, OPTnumber = {}, pages = {227-240}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KESSL:HANSE:12, author = {Anke S. Kessler and Nico A. Hansen}, title = {Interregional redistribution and mobility in federations: a positive approach}, journal = {Review of Economic Studies}, year = {2012}, OPTkey = {}, volume = {78(4)}, OPTnumber = {}, pages = {1345-1378}, month = {march}, OPTnote = {}, OPTannote = {} } @Article{DRAK:07, author = {Konstantinos Drakos}, title = {The size of under-reporting bias in recorded transational terrorist activity}, journal = {Journal of the Royal Statistical Society, Series A (Statistics in Society)}, year = {2007}, OPTkey = {}, volume = {170(4)}, OPTnumber = {}, pages = {909-921}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{PORTO:REVEL:12, author = {Edoardo Di Porto and Federico Revelli}, title = {Tax limited reaction functions}, journal = {Journal of applied econometrics}, year = {2012}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTpages = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{MADDA:WU:99, author = {G.S. Maddala and S. Wu}, title = {A comparative study of unit root tests with panel data and a new simple test}, journal = {Oxford Bulletin of Economics and Statistics}, year = {1999}, OPTkey = {}, volume = {61}, OPTnumber = {}, pages = {631-52}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{LEVIN:LIN:CHU:02, author = {A. Levin and C.F. Lin and C.S.J. Chu}, title = {Unit root tests in panel data : asymptotic and finite-sample properties}, journal = {Journal of Econometrics}, year = {2002}, OPTkey = {}, volume = {108}, OPTnumber = {}, pages = {1-24}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{IM:PESAR:SHIN:03, author = {K.S. Im and M.H. Pesaran and Y. Shin}, title = {Testing for unit roots in heterogenous panels}, journal = {Journal of Econometrics}, year = {2003}, OPTkey = {}, volume = {115(1)}, OPTnumber = {}, pages = {53-74}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HANS:82, author = {L.P. Hansen}, title = {Large sample properties of generalized method moments estimators}, journal = {Econometrica}, year = {1982}, OPTkey = {}, volume = {50}, OPTnumber = {}, pages = {1029-1054}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ROOD:09, author = {David Roodman}, title = {How to do xtabond2: An introduction to difference and system {GMM} in Stata}, journal = {The Stata Journal}, year = {2009}, OPTkey = {}, volume = {9}, OPTnumber = {1}, pages = {86-136}, OPTmonth = {}, OPTnote = {}, OPTannote = {}, url = {https://www.stata-journal.com/article.html?article=st0159} } @Article{AREL:BOVE:95, author = {M. Arellano and O. Bover}, title = {Another look at the at the instrumental variables estimation of error components}, journal = {Journal of Econometrics}, year = {1995}, OPTkey = {}, volume = {68}, OPTnumber = {}, pages = {29-51}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{SARG:58, author = {J.D. Sargan}, title = {The estimation of economic relationships using instrumental variables}, journal = {Econometrica}, year = {1958}, OPTkey = {}, volume = {26}, OPTnumber = {}, pages = {393-415}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ROOD:09b, author = {David Roodman}, title = {A note on the theme of too many instruments}, journal = {Oxford Bulletin of Economics and Statistics}, year = {2009}, OPTkey = {}, volume = {71}, OPTnumber = {}, pages = {135-158}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{CASEL:ESQU:LEFO:96, author = {Francesco Caselli and Gerardo Esquivel and Fernando Lefort}, title = {Reopening the convergence debate: a new look at cross-country growth empirics}, journal = {Journal of Economic Growth}, year = {1996}, OPTkey = {}, volume = {1}, OPTnumber = {}, pages = {363-389}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BOND:HOEF:TEMP:01, author = {Stephen R. Bond and Anke Hoeffler and Jonathan Temple}, title = {{GMM} estimation of empirical growth model}, journal = {CEPR Discussion Paper}, year = {2001}, OPTkey = {}, volume = {3048}, OPTnumber = {}, OPTpages = {1-33}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BOND:02, author = {Stephen R. Bond}, title = {Dynamic panel data models: a guide to micro data methods and practice}, journal = {Portugese Economic Journal}, year = {2002}, OPTkey = {}, volume = {1}, OPTnumber = {}, pages = {141-162}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BLUN:BOND:00, author = {Richard Blundell and Stephen Bond}, title = {{GMM} estimation with persistent panel data: an application to production functions}, journal = {Econometric Reviews}, year = {2000}, OPTkey = {}, volume = {19}, number = {3}, pages = {321-340}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ALON:AREL:99, author = {C. Alonso-Borrego and M. Arellano}, title = {Symmetrically Normalized Instrumental-Variable Estimation Using Panel Data}, journal = {Journal of Business and Economic Statistics}, year = {1999}, OPTkey = {}, volume = {17}, number = {1}, pages = {36-49}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{LEVI:LOAY:BECK:00, author = {Ross Levine and Norman Loayza and Thorsten Beck}, title = {Financial intermediation and growth: causalty and causes}, journal = {Journal of Monetary Economics}, year = {2000}, OPTkey = {}, volume = {46}, OPTnumber = {}, pages = {31-77}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{FORB:00, author = {Kristin J. Forbes}, title = {A reassessment of the relation between inequality and growth}, journal = {American Economic Review}, year = {2000}, OPTkey = {}, volume = {90}, number = {4}, pages = {869-887}, month = {september}, OPTnote = {}, OPTannote = {} } @InCollection{MAIR:HALL:96, author = {J. Mairesse and B.H Hall}, title = {Estimating the productivity of research and development in French and US manufacturing firms: an exploration of simultaneity issues with {GMM} methods}, booktitle = {International productivity differences and their explanations}, OPTcrossref = {}, OPTkey = {}, pages = {285-315}, publisher = {Elsevier Science}, year = {1996}, editor = {K. Wagner and B. Van-Ark}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTchapter = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{NICK:81, author = {S.J. Nickel}, title = {Biaises in dynamic models with fixed effects}, journal = {Econometrica}, year = {1981}, OPTkey = {}, volume = {49}, OPTnumber = {}, pages = {1417-1426}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALE:NERL:66, author = {Pietro Balestra and Marc Nerlove}, title = {Pooling cross-section and time-series data in the estimation of dynamic models: The demand for natural gas}, journal = {Econometrica}, year = {1966}, OPTkey = {}, volume = {34}, OPTnumber = {}, pages = {585-612}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KIVI:95, author = {Jan F. Kiviet}, title = {On bias, inconsistency, and efficiency of various estimators in dynamic panel data models}, journal = {Journal of Econometrics}, year = {1995}, OPTkey = {}, volume = {68}, OPTnumber = {}, pages = {53-78}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ZEIL:CROI:10, title = {Extended Model Formulas in {R}: Multiple Parts and Multiple Responses}, author = {Achim Zeileis and Yves Croissant}, journal = {Journal of Statistical Software}, year = {2010}, volume = {34}, number = {XYZ}, pages = {1--12}, url = {https://www.jstatsoft.org/article/view/v034i01}, } @InCollection{HARR:MATY:SEVE:08, author = {Mark N. Harris and Laszlo Matyas and Patrick Sevestre}, title = {Dynamic models for short panels}, booktitle = {The Econometrics of Panel Data}, OPTcrossref = {}, OPTkey = {}, pages = {249-278}, editor = {Laszlo Matyas and Patrick Sevestre}, year = {2008}, publisher = {Springer}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTchapter = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KINA:LAHI:93, author = {Kinal, T. and Lahiri, K.}, title = {On the estimation of simultaneous-equations error-components models with an application to a model of developing country foreign trade}, journal = {Journal of Applied Econometrics}, year = {1993}, OPTkey = {}, volume = {8}, OPTnumber = {}, pages = {81-92}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KHAN:KNIG:88, author = {Khan, M. S. and Knight, M. D.}, title = {Import compression and export performance in developing countries}, journal = {Review of Economics and Statistics}, year = {1988}, OPTkey = {}, volume = {70}, number = {2}, pages = {315-321}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{COHE:EINA:03, author={Alma Cohen and Liran Einav}, title={The Effects of Mandatory Seat Belt Laws on Driving Behavior and Traffic Fatalities}, journal={The Review of Economics and Statistics}, year=2003, volume={85}, number={4}, pages={828-843}, month={November}, keywords={} } @Article{PELT:75, author={Peltzman, Sam}, title={The Effects of Automobile Safety Regulation}, journal={Journal of Political Economy}, year=1975, volume={83}, number={4}, pages={677-725}, month={August}, keywords={}, abstract={No abstract is available for this item.} } @Article{AMEM:MACU:86, author={Amemiya, Takeshi and MaCurdy, Thomas E}, title={Instrumental-Variable Estimation of an Error-Components Model}, journal={Econometrica}, year=1986, volume={54}, number={4}, pages={869-80}, month={July} } @Article{BREU:MIZO:SCHM:89, author={Breusch, Trevor S and Mizon, Grayham E and Schmidt, Peter}, title={Efficient Estimation Using Panel Data}, journal={Econometrica}, year=1989, volume={57}, number={3}, pages={695-700}, month={May} } @Article{CORN:SCHM:WYHO:92, author={Cornwell, Christopher and Schmidt, Peter and Wyhowski, Donald}, title={Simultaneous equations and panel data}, journal={Journal of Econometrics}, year=1992, volume={51}, number={1-2}, pages={151-181} } @Article{BALT:LIU:09, author={Baltagi, Badi H. and Liu, Long}, title={A note on the application of EC2SLS and EC3SLS estimators in panel data models}, journal={Statistics \& Probability Letters}, year=2009, volume={79}, number={20}, pages={2189-2192}, month={October} } @InBook{WHIT:86, author = {White, H.}, ALTeditor = {}, title = {Advances in statistical analysis and statistical computing, vol. 1}, chapter = {Instrumental variables analogs of generalized least squares estimators}, publisher = {Mariano, R.S.}, year = {1986}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTtype = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTpages = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:LI:92, author={Baltagi, Badi H. and Li, Qi}, title={A Note on the Estimation of Simultaneous Equations with Error Components}, journal={Econometric Theory}, year=1992, volume={8}, number={01}, pages={113-119}, month={March} } @Article{ZELL:62, author = {Zellner, A.}, title = {An efficient method of estimating seemingly unrelated regressions and tests of aggregation bias}, journal = {Journal of the American Statistical Association}, year = {1962}, OPTkey = {}, volume = {57}, OPTnumber = {}, pages = {500-509}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:80, author = {Baltagi, B.H.}, title = {On seemingly unrelated regressions with error components}, journal = {Econometrica}, year = {1980}, OPTkey = {}, volume = {48}, OPTnumber = {}, pages = {1547-1551}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{AVER:77, author = {Avery, R.B.}, title = {Error components and seemingly unrelated regressions}, journal = {Econometrica}, year = {1977}, OPTkey = {}, volume = {45}, OPTnumber = {}, pages = {199-209}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KINA:LAHI:90, author = {Kinal, T. and Lahiri, K.}, title = {A computational algorithm for multiple equation models with panel data}, journal = {Economic Letters}, year = {1990}, OPTkey = {}, volume = {34}, OPTnumber = {}, pages = {143-146}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{KUMB:96, author = {Kumbhakar, S.C.}, title = {Estimation of cost efficiency with heteroscedasticity: an application to electric utilities}, journal = {Journal of the Royal Statistical Society, series D}, year = {1996}, OPTkey = {}, volume = {45}, OPTnumber = {}, pages = {319-335}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HORRA:SCHMI:96, author = {Horrace, W.C. and Schmidt, P.}, title = {Confidence statements for efficiency estimates from stochastic frontier models}, journal = {Journal of Productivity Analysis}, year = {1996}, OPTkey = {}, volume = {7}, OPTnumber = {}, pages = {257-282}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HORRA:SCHMI:00, author = {Horrace, W.C. and Schmidt, P.}, title = {Multiple Comparisons with the Best, with Economic Applications}, journal = {Journal of Applied Econometrics}, year = {2000}, OPTkey = {}, volume = {15}, number = {1}, pages = {1-26}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ELGA:INAN:05, author = {El-Gamal, Mahmoud and Inanoglu, Hulusi}, title = {Inefficiency and heterogeneity in Turkish banking: 1990-2000}, journal = {Journal of Applied Econometrics}, year = {2005}, OPTkey = {}, volume = {20}, number = {5}, pages = {641-664}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{SCHA/90, author = {Schaller, Huntley}, title = {A re-examination of the Q theory of investment using {US} firm data}, journal = {Journal of Applied Econometrics}, year = {1990}, OPTkey = {}, volume = {5(4)}, OPTnumber = {}, pages = {309--325}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{TOBI/69, author = {Tobin, James}, title = {A general equilibrium approach to monetary theory}, journal = {Journal of Money, Credit and Banking}, year = {1969}, OPTkey = {}, volume = {1}, OPTnumber = {1}, pages = {15--29}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Manual{HLAV:13, title = {stargazer: LaTeX code for well-formatted regression and summary statistics tables}, author = {Marek Hlavac}, year = {2013}, note = {R package version 3.0.1}, organization = {Harvard University}, address = {Cambridge, USA}, url = {https://CRAN.R-project.org/package=stargazer}, } @Article{VELL:VERB:98, author = {Vella, F. and Verbeek, M.}, title = {Whose wages do unions raise? A dynamic model of unionism and wage rate determination for young men}, journal = {Journal of Applied Econometrics}, year = {1998}, OPTkey = {}, volume = {13}, OPTnumber = {}, pages = {163--183}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{CHAM:82, author = {Chamberlain, Gary}, title = {Multivariate regression models for panel data}, journal = {Journal of Econometrics}, year = {1982}, OPTkey = {}, volume = {18}, OPTnumber = {}, pages = {5--46}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{BALT:SONG:KOH:03, title={Testing panel data regression models with spatial error correlation}, author={Baltagi, Badi H and Song, Seuck Heun and Koh, Won}, journal={Journal of Econometrics}, volume={117}, number={1}, pages={123--150}, year={2003}, publisher={Elsevier} } @article{BALT:SONG:JUNG:KOH:07, title={Testing for serial correlation, spatial autocorrelation and random effects using panel data}, author={Baltagi, Badi H and Heun Song, Seuck and Cheol Jung, Byoung and Koh, Won}, journal={Journal of Econometrics}, volume={140}, number={1}, pages={5--51}, year={2007}, publisher={Elsevier} } @article{GODF:78, title={Testing against general autoregressive and moving average error models when the regressors include lagged dependent variables}, author={Godfrey, Leslie G}, journal={Econometrica}, pages={1293--1301}, volume = {46}, number = {6}, year={1978}, publisher={JSTOR} } @article{BREU:78, title={Testing for autocorrelation in dynamic linear models}, author={Breusch, Trevor S}, journal={Australian Economic Papers}, volume={17}, number={31}, pages={334--355}, year={1978}, publisher={Wiley Online Library} } @article{FRAN:HAYS:07, title={Spatial econometric models of cross-sectional interdependence in political science panel and time-series-cross-section data}, author={Franzese, Robert J and Hays, Jude C}, journal={Political Analysis}, volume={15}, number={2}, pages={140--164}, year={2007}, publisher={SPM-PMSAPSA} } @article{FRAN:HAYS:06, title={Strategic Interaction among EU Governments in Active Labor Market Policy-making Subsidiarity and Policy Coordination under the European Employment Strategy}, author={Franzese, Robert J and Hays, Jude C}, journal={European Union Politics}, volume={7}, number={2}, pages={167--189}, year={2006}, publisher={SAGE Publications} } @article{FRAN:HAYS:08, title={Interdependence in Comparative Politics Substance, Theory, Empirics, Substance}, author={Franzese, Robert J and Hays, Jude C}, journal={Comparative Political Studies}, volume={41}, number={4-5}, pages={742--780}, year={2008}, publisher={Sage Publications} } @article{HOLL:PESA:YAMA:10, title={A spatio-temporal model of house prices in the USA}, author={Holly, Sean and Pesaran, M Hashem and Yamagata, Takashi}, journal={Journal of Econometrics}, volume={158}, number={1}, pages={160--173}, year={2010}, publisher={Elsevier} } @book{LESA:PACE:10, title={Introduction to spatial econometrics}, author={LeSage, James and Pace, Robert Kelley}, year={2010}, publisher={CRC press} } @article{ELHO:10, title={Applied spatial econometrics: raising the bar}, author={Elhorst, J Paul}, journal={Spatial Economic Analysis}, volume={5}, number={1}, pages={9--28}, year={2010}, publisher={Taylor \& Francis} } @inproceedings{HALL:ELHO:13, title={On spatial econometric models, spillover effects, and W}, author={Vega, Solmaria Halleck and Elhorst, J Paul}, booktitle={53rd ERSA conference, Palermo}, year={2013} } @article{MANS:93, title={Identification of endogenous social effects: The reflection problem}, author={Manski, Charles F}, journal={The review of economic studies}, volume={60}, number={3}, pages={531--542}, year={1993}, publisher={Oxford University Press} } @article{GIBB:OVER:12, title={MOSTLY POINTLESS SPATIAL ECONOMETRICS?}, author={Gibbons, Stephen and Overman, Henry G}, journal={Journal of Regional Science}, volume={52}, number={2}, pages={172--191}, year={2012}, publisher={Wiley Online Library} } @article{CHEN:LIN:REED:09, title={A Monte Carlo Evaluation of the Efficiency of the PCSE Estimator}, author={Chen, Xiujian and Lin, Shu and Reed, W Robert}, journal={Applied Economics Letters}, volume={17}, number={1}, pages={7--10}, year={2009}, publisher={Taylor \& Francis} } @article{PARK:67, title={Efficient Estimation of a System of Regression Equations when Disturbances are both Serially and Contemporaneously Correlated}, author={Parks, Richard W}, journal={Journal of the American Statistical Association}, volume={62}, number={318}, pages={500--509}, year={1967}, publisher={Taylor \& Francis} } @article{DRIS:KRAA:98, title={Consistent covariance matrix estimation with spatially dependent panel data}, author={Driscoll, John C and Kraay, Aart C}, journal={Review of economics and statistics}, volume={80}, number={4}, pages={549--560}, year={1998}, publisher={MIT Press} } @article{BECK:KATZ:95, title={What to do (and not to do) with time-series cross-section data}, author={Beck, Nathaniel and Katz, Jonathan N}, journal={American Political Science Review}, volume={89}, number={03}, pages={634--647}, year={1995}, publisher={Cambridge Univ Press} } @article{ALVA:GARR:LANG:91, title={Government partisanship, labor organization, and macroeconomic performance}, author={Alvarez, R Michael and Garrett, Geoffrey and Lange, Peter}, journal={The American Political Science Review}, volume = {85}, number = {2}, pages={539--556}, year={1991}, publisher={JSTOR} } @article{KIEF:80, title={Estimation of fixed effect models for time series of cross-sections with arbitrary intertemporal covariance}, author={Kiefer, Nicholas M}, journal={Journal of Econometrics}, volume={14}, number={2}, pages={195--202}, year={1980}, publisher={Elsevier} } @article{DRUS:HORR:04, title={Generalized moments estimation for spatial panel data: Indonesian rice farming}, author={Druska, Viliam and Horrace, William C}, journal={American Journal of Agricultural Economics}, volume={86}, number={1}, pages={185--198}, year={2004}, publisher={Oxford University Press} } @article{EBER:HELM:STRA:13, title={Do spillovers matter when estimating private returns to R\&D?}, author={Eberhardt, Markus and Helmers, Christian and Strauss, Hubert}, journal={Review of Economics and Statistics}, volume={95}, number={2}, pages={436--448}, year={2013}, publisher={MIT Press} } @article{ANGR:NEWE:91, title={Over-identification tests in earnings functions with fixed effects}, author={Angrist, Joshua D and Newey, Whitney K}, journal={Journal of Business \& Economic Statistics}, volume={9}, number={3}, pages={317--323}, year={1991}, publisher={Taylor \& Francis} } @article{HOTH:HORN:VAND:ZEIL:06, title={A Lego system for conditional inference}, author={Hothorn, Torsten and Hornik, Kurt and Van De Wiel, Mark A and Zeileis, Achim}, journal={The American Statistician}, volume={60}, number={3}, year={2006} } @article{MOUL:86, title={Random group effects and the precision of regression estimates}, author={Moulton, Brent R}, journal={Journal of Econometrics}, volume={32}, number={3}, pages={385--397}, year={1986}, publisher={Elsevier} } @article{THOM:11, title={Simple formulas for standard errors that cluster by both firm and time}, author={Thompson, Samuel B}, journal={Journal of Financial Economics}, volume={99}, number={1}, pages={1--10}, year={2011}, publisher={Elsevier} } @misc{NEWE:WEST:86, title={A simple, positive semi-definite, heteroskedasticity and autocorrelationconsistent covariance matrix}, author={Newey, Whitney K and West, Kenneth D}, year={1986}, publisher={National Bureau of Economic Research Cambridge, Mass., USA} } @article{NEWE:WEST:87, title={A Simple, Positive Semi-definite, Heteroskedasticity and Autocorrelation Consistent Covariance Matrix}, author={Newey, Whitney K and West, Kenneth D}, journal={Econometrica}, volume={55}, number={3}, pages={703--08}, year={1987}, publisher={Econometric Society} } @article{FROO:89, title={Consistent covariance matrix estimation with cross-sectional dependence and heteroskedasticity in financial data}, author={Froot, Kenneth A}, journal={Journal of Financial and Quantitative Analysis}, volume={24}, number={03}, pages={333--355}, year={1989}, publisher={Cambridge Univ Press} } @article{AREL:87, title={Computing Robust Standard Errors for Within-groups Estimators}, author={Arellano, Manuel}, journal={Oxford bulletin of Economics and Statistics}, volume={49}, number={4}, pages={431--434}, year={1987}, publisher={Wiley Online Library} } @article{LIAN:ZEGE:86, title={Longitudinal data analysis using generalized linear models}, author={Liang, Kung-Yee and Zeger, Scott L}, journal={Biometrika}, volume={73}, number={1}, pages={13--22}, year={1986}, publisher={Biometrika Trust} } @article{MOUL:90, title={An illustration of a pitfall in estimating the effects of aggregate variables on micro units}, author={Moulton, Brent R}, journal={The Review of Economics and Statistics}, pages={334--338}, year={1990}, volume = {72}, number = {2}, publisher={JSTOR} } @article{ZEIL:06, author = {Achim Zeileis}, title = {Object-Oriented Computation of Sandwich Estimators}, year = {2006}, journal = {Journal of Statistical Software}, volume = {16}, number = {9}, pages = {1--16}, url = {https://www.jstatsoft.org/article/view/v016i09} } @article{ZEIL:06b, title={Implementing a class of structural change tests: An econometric computing approach}, author={Zeileis, Achim}, journal={Computational Statistics \& Data Analysis}, volume={50}, number={11}, pages={2987--3008}, year={2006}, publisher={Elsevier} } @article{ROGE:93, title={Regression standard errors in clustered samples}, author={Rogers, W.H.}, journal={Stata Technical Bulletin}, volume={13}, pages={19--23}, year={1993}, publisher={Stata Corporation} } @article{PETE:09, title={Estimating standard errors in finance panel data sets: Comparing approaches}, author={Petersen, Mitchell A}, journal={Review of financial studies}, volume={22}, number={1}, pages={435--480}, year={2009}, publisher={Soc Financial Studies} } @article{CAME:GELB:MILL:11, title={Robust inference with multiway clustering}, author={Cameron, A Colin and Gelbach, Jonah B and Miller, Douglas L}, journal={Journal of Business \& Economic Statistics}, volume={29}, number={2}, year={2011} } @article{PESA:06, title={Estimation and inference in large heterogeneous panels with a multifactor error structure}, author={Pesaran, M Hashem}, journal={Econometrica}, volume={74}, number={4}, pages={967--1012}, year={2006}, publisher={Wiley Online Library} } @article{BECK:KATZ:96, title={Nuisance vs. substance: Specifying and estimating time-series-cross-section models}, author={Beck, Nathaniel and Katz, Jonathan N}, journal={Political analysis}, volume={6}, number={1}, pages={1--36}, year={1996}, publisher={SPM-PMSAPSA} } @article{CHUD:PESA:TOSE:11, title={Weak and strong cross-section dependence and estimation of large panels}, author={Chudik, Alexander and Pesaran, M Hashem and Tosetti, Elisa}, journal={The Econometrics Journal}, volume={14}, number={1}, pages={C45--C90}, year={2011}, publisher={Wiley Online Library} } @article{CROI:MILL:08, title={Panel data econometrics in R: The plm package}, author={Croissant, Yves and Millo, Giovanni}, journal={Journal of Statistical Software}, volume={27}, number={2}, pages={1--43}, year={2008} } @article{BECK:KATZ:ALVA:GARR:LANG:93, title={Government Partisanship, Labor Organization, and Macroeconomic Performance: A Corrigendum.}, author={Beck, Nathaniel and Katz, Jonathan N and Alvarez, R Michael and Garrett, Geoffrey and Lange, Peter}, journal={American Political Science Review}, volume={87}, number={04}, pages={945--948}, year={1993}, publisher={Cambridge Univ Press} } @article{BAIL:KATZ:11, title={Implementing Panel-Corrected Standard Errors in R: The pcse Package}, author={Bailey, Delia and Katz, Jonathan N}, journal={Journal of Statistical Software}, volume={42}, number={CS1}, pages={1--11}, year={2011}, publisher={University of California, Los Angeles} } @article{GOLD:PICC:08, title={Pork-Barrel Politics in Postwar Italy, 1953--94}, author={Golden, Miriam A and Picci, Lucio}, journal={American Journal of Political Science}, volume={52}, number={2}, pages={268--289}, year={2008}, publisher={Wiley Online Library} } @article{COAK:FUER:SMIT:06, title={Unobserved heterogeneity in panel time series models}, author={Coakley, Jerry and Fuertes, Ana-Maria and Smith, Ron}, journal={Computational Statistics \& Data Analysis}, volume={50}, number={9}, pages={2361--2380}, year={2006}, publisher={Elsevier} } @Book{CAR:11, title = {An {R} Companion to Applied Regression}, edition = {2nd}, author = {John Fox and Sanford Weisberg}, year = {2011}, publisher = {Sage}, address = {Thousand Oaks {CA}}, url = {http://socserv.socsci.mcmaster.ca/jfox/Books/Companion} } @book{CHAM:98, title={Programming with data: A guide to the S language}, author={Chambers, John M}, year={1998}, publisher={Springer} } @article{MUND:61, title={Empirical production function free of management bias}, author={Mundlak, Yair}, journal={Journal of Farm Economics}, volume={43}, number={1}, pages={44--56}, year={1961}, publisher={Oxford University Press} } @inproceedings{LEIS:02, title={Sweave: Dynamic generation of statistical reports using literate data analysis}, author={Leisch, Friedrich}, booktitle={Compstat}, pages={575--580}, year={2002}, organization={Springer} } @Article{SERL:SHIN:07, author = {Serlenga, Laura and Shin, Yongcheol}, title = {Gravity models of intra-EU trade: application of the CCEP-HT estimation in heterogeneous panels with unobserved common time-specific factors}, journal = {Journal of Applied Econometrics}, year = {2007}, OPTkey = {}, volume = {22}, OPTnumber = {}, pages = {361--381}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:10, author = {Baltagi, Badi}, title = {Narrow replication of Serlenga and Shin (2007) Gravity models of intra-EU trade: application of the CCEP-HT estimation in heterogeneous panels within unobserved common time-specific factors}, journal = {Journal of Applied Econometrics}, year = {2012}, OPTkey = {}, volume = {25}, OPTnumber = {}, pages = {505--506}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HUTC:NOY:05, author = {Hutchison, Michael M. and Noy, Ilan}, title = {How bad are twins? Output costs of currency and banking crises}, journal = {Journal of Money, Credit and Banking}, year = {2005}, OPTkey = {}, volume = {4}, OPTnumber = {}, pages = {725--752}, month = {august}, OPTnote = {}, OPTannote = {} } @Article{LEIF:13, title = {{texreg}: Conversion of Statistical Model Output in {R} to {\LaTeX} and HTML Tables}, author = {Philip Leifeld}, journal = {Journal of Statistical Software}, year = {2013}, volume = {55}, number = {8}, pages = {1--24}, url = {https://www.jstatsoft.org/article/view/v055i08}, } @article{SARA:WANS:12, title={Cross-sectional dependence in panel data analysis}, author={Sarafidis, Vasilis and Wansbeek, Tom}, journal={Econometric Reviews}, volume={31}, number={5}, pages={483--531}, year={2012}, publisher={Taylor \& Francis} } @Article{BALT:KHAN:90, title = {On efficient estimation with panel data: an empirical comparison of instrumental variables estimators}, author = {Baltagi, Badi H. and Khanti-Akom, Sophon}, journal = {Journal of Applied Econometrics}, year = {1990}, OPTkey = {}, volume = {5}, number = {4}, OPTpages = {401--406}, month = {Oct. - Dec.}, OPTnote = {}, OPTannote = {} } @Article{CORN:TRUM:94, author = {Cornwell, C. and Trumbull, W.N.}, title = {Estimating the economic model of crime with panel data}, journal = {Review of Economics and Statistics}, year = {1994}, OPTkey = {}, volume = {76}, OPTnumber = {}, pages = {360--366}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:06, author = {Baltagi, B.H.}, title = {Estmating an economic model of crime using panel data from North Carolina}, journal = {Journal of Applied Econometrics}, year = {2006}, OPTkey = {}, volume = {21}, number = {4}, OPTpages = {543--547}, month = {May - June}, OPTnote = {}, OPTannote = {} } @Article{BALT:LI:93, author = {Baltagi, Badi H. and Li, Qi}, title = {A note on the estimation of simultaneous equations with error components}, journal = {Econometric Theory}, year = {1992}, OPTkey = {}, volume = {8}, number = {1}, pages = {113--119}, month = {March}, OPTnote = {}, OPTannote = {} } @Book{WHIT:84b, author = {White, H.}, ALTeditor = {}, title = {Asymptotic Theory for Econometricians}, publisher = {New York: Academic press}, year = {1984}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @book{BALT:05, author={B.H. Baltagi}, title={Econometric Analysis of Panel Data }, publisher={John Wiley and Sons ltd}, year={2005}, edition={3rd} } @book{BALT:13, author={B.H. Baltagi}, title={Econometric Analysis of Panel Data}, publisher={John Wiley and Sons ltd}, year={2013}, edition={5th} } @book{BALT:21, author={B.H. Baltagi}, title={Econometric Analysis of Panel Data}, publisher={Springer}, year={2021}, edition={6th} } @book{BALT:09, author={B.H. Baltagi}, title={A Companion to Econometric Analysis of Panel Data}, publisher={John Wiley and Sons ltd}, year={2009}, edition={} } @Article{BALT:SONG:JUNG:01, author = {Baltagi, B.H. and Song, S.H. and Jung, B.C.}, title = {The unbalanced nested error component regression model}, journal = {Journal of Econometrics}, year = {2001}, OPTkey = {}, volume = {101}, OPTnumber = {}, pages = {357-381}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:PINN:95, author = {Baltagi, Badi H. and Pinnoi, Nat}, title = {Public capital stock and state productivity growth: further evidence from an error components model}, journal = {Empirical Economics}, year = {1995}, OPTkey = {}, volume = {20}, OPTnumber = {}, pages = {351-359}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{CECC:86, author = {Cecchetti, Stephen G.}, title = {The frequency of price adjustment, a study of the newsstand prices of magazines}, journal = {Journal of Econometrics}, year = {1986}, OPTkey = {}, volume = {31}, OPTnumber = {}, pages = {255-274}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{WILL:06, author = {Willis, Jonathan L.}, title = {Magazine prices revisited}, journal = {Journal of Applied Econometrics}, year = {2006}, OPTkey = {}, volume = {21}, number = {3}, pages = {337-344}, month = {april}, OPTnote = {}, OPTannote = {} } @Article{CHAM:80, author = {Chamberlain, G.}, title = {Analysis of covariance with qualitative data}, journal = {Review of Economic Studies}, year = {1980}, OPTkey = {}, volume = {47}, OPTnumber = {}, pages = {225-238}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{FURM:STER:11, author = {Furman, Jeffrey L. and Stern, Scott}, title = {Climbing atop the shoulders of giants: the impact of institutions on cumulative research}, journal = {American Economic Review}, year = {2011}, OPTkey = {}, volume = {101}, number = {5}, pages = {1933-1963}, month = {august}, OPTnote = {}, OPTannote = {} } @Book{CAME:TRIV:98, author = {Cameron, A. Colin and Trivedi, Pravin K.}, ALTeditor = {}, title = {Regression analysis of count data}, publisher = {Cambridge}, year = {1998}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HAUS:HALL:GRIL:84, author = {Hausman, J.A. and Hall, B.H. and Griliches, Z.}, title = {Econometric models for count data with and application to the patents--{R} and {D} relationship}, journal = {Econometrica}, year = {1984}, OPTkey = {}, volume = {52}, OPTnumber = {}, pages = {909-938}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{POWE:86, author = {Powell, J.}, title = {Symmetrically trimmed least squares estimation for tobit models}, journal = {Econometrica}, year = {1986}, OPTkey = {}, volume = {54}, OPTnumber = {}, pages = {1435--1460}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HONO:92, author = {Honor\'e, Bo E.}, title = {Trimmed LAD and least squares estimation of truncated and censored regression models with fixed effects}, journal = {Econometrica}, year = {1992}, OPTkey = {}, volume = {60}, number = {3}, OPTpages = {533-565}, month = {may}, OPTnote = {}, OPTannote = {} } @Article{HONO:02, author="Honor{\'e}, Bo E.", title="Nonlinear models with panel data", journal="Portuguese Economic Journal", year="2002", volume="1", number="2", pages="163--179", issn="1617-9838", doi="10.1007/s10258-002-0007-y", url="http://dx.doi.org/10.1007/s10258-002-0007-y" } @Article{TOBI:58, author = {Tobin, James}, title = {Estimation of Relationships for Limited Dependent Variables}, journal = {Econometrica}, year = {1958}, optkey = {}, volume = {26}, number = {1}, pages = {24-36}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HAUS:WISE:76, author = {Hausman, J.A. and Wise, D.A.}, title = {Social experimentation, truncated distributions, and efficient estimation}, journal = {Econometrica}, year = {1976}, OPTkey = {}, volume = {45}, number = {4}, pages = {919--938}, month = {may}, OPTnote = {}, OPTannote = {} } @Article{ANDE:LASS:NIEL:12, author = {Andersen, Asger Lau and Lassen, David Dreyer and Nielsen, Lasse Holboll Westh}, title = {Late budgets}, journal = {American Economic Journal, Economic Policy}, year = {2012}, OPTkey = {}, volume = {4}, number = {4}, pages = {1-40}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{LAND:LANG:LIST:PRIC:RUPP:10, author = {Landry, Craig E. and Lange, Andreas an List, John A. and Price, Michael K. and Rupp, Nicholas G.}, title = {Is a donor in hand better than two in the bush? Evidence from a natural field experiment}, journal = {American Economic Review}, year = {2012}, OPTkey = {}, volume = {100}, number = {3}, pages = {958-983}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{rac12, title={RStudio: A Platform-Independent {IDE} for {R} and {S}weave}, author={Racine, Jeffrey S}, journal={Journal of Applied Econometrics}, volume={27}, number={1}, pages={167--172}, year={2012}, publisher={Wiley Online Library} } @article{koezei09, title={On reproducible econometric research}, author={Koenker, Roger and Zeileis, Achim}, journal={Journal of Applied Econometrics}, volume={24}, number={5}, pages={833--847}, year={2009}, publisher={Wiley Online Library} } @article{pen11, title={Reproducible research in computational science}, author={Peng, Roger D}, journal={Science (New York, Ny)}, volume={334}, number={6060}, pages={1226--1227}, year={2011}, publisher={NIH Public Access} } @article{thezei08, author = {Stefan Theu{\ss}l and Achim Zeileis}, title = {Collaborative Software Development Using {R}-{F}orge}, journal = {The {R} Journal}, year = {2009}, volume = {1}, number = {1}, pages = {9--14}, month = {May} } @article{yalyal10, title={Should Economists Use Open Source Software for Doing Research?}, author={Yalta, A Talha and Yalta, A Yasemin}, journal={Computational Economics}, volume={35}, number={4}, pages={371--394}, year={2010}, publisher={Springer} } @article{yalluc08, title={The {GNU/L}inux platform and freedom respecting software for economists}, author={Yalta, A Talha and Lucchetti, Riccardo}, journal={Journal of Applied Econometrics}, volume={23}, number={2}, pages={279--286}, year={2008}, publisher={Wiley Online Library} } @article{yalyal07, title={GRETL 1.6. 0 and its numerical accuracy}, author={Yalta, A Talha and Yalta, A Yasemin}, journal={Journal of Applied Econometrics}, volume={22}, number={4}, pages={849--854}, year={2007}, publisher={Wiley Online Library} } @misc{GRETL:2021, title = {Gretl User’s Guide}, author = {Cottrell, Allin and Lucchetti, Riccardo}, month = {September}, year = {2021}, url = {http://gretl.sourceforge.net/} } @article{RACI:HYND:02, title={Using {R} to teach econometrics}, author={Racine, Jeff and Hyndman, Rob}, journal={Journal of Applied Econometrics}, volume={17}, number={2}, pages={175--189}, year={2002}, publisher={Wiley Online Library} } @book{mur09, title={Introduction to Data Technologies}, author={Murrell, Paul}, year={2010}, publisher={CRC Press} } @article{mil14, title={Maximum likelihood estimation of spatially and serially correlated panels with random effects}, author={Millo, Giovanni}, journal={Computational Statistics \& Data Analysis}, volume={71}, pages={914--933}, year={2014}, publisher={Elsevier} } @article{kappesyam11, title={Panels with non-stationary multifactor error structures}, author={Kapetanios, George and Pesaran, M Hashem and Yamagata, Takashi}, journal={Journal of Econometrics}, volume={160}, number={2}, pages={326--348}, year={2011}, publisher={Elsevier} } @Manual{spdep, title = {spdep: Spatial dependence: weighting schemes, statistics and models}, author = {Roger Bivand and with contributions by Micah Altman and Luc Anselin and Renato Assunção and Olaf Berke and Andrew Bernat and Guillaume Blanchet and Eric Blankmeyer and Marilia Carvalho and Bjarke Christensen and Yongwan Chun and Carsten Dormann and Stéphane Dray and Rein Halbersma and Elias Krainski and Pierre Legendre and Nicholas Lewin-Koh and Hongfei Li and Jielai Ma and Giovanni Millo and Werner Mueller and Hisaji Ono and Pedro Peres-Neto and Gianfranco Piras and Markus Reder and Michael Tiefelsdorf and Danlin Yu.}, year = {2012}, note = {R package version 0.5-46}, url = {https://CRAN.R-project.org/package=spdep}, } @article{ebe12, title={Estimating panel time-series models with heterogeneous slopes}, author={Eberhardt, Markus}, journal={Stata Journal}, volume={12}, number={1}, pages={61--71}, year={2012}, publisher={StataCorp LP} } @article{ebe11, title={XTCD: Stata module to investigate Variable/Residual Cross-Section Dependence}, author={Eberhardt, Markus}, journal={Statistical Software Components}, year={2011}, publisher={Boston College Department of Economics} } @article{lew07, title={PESCADF: Stata module to perform Pesaran's CADF panel unit root test in presence of cross section dependence}, author={Lewandowski, Piotr}, journal={Statistical Software Components}, year={2007}, publisher={Boston College Department of Economics} } @article{pes06, title={Estimation and inference in large heterogeneous panels with a multifactor error structure}, author={Pesaran, M Hashem}, journal={Econometrica}, volume={74}, number={4}, pages={967--1012}, year={2006}, publisher={Wiley Online Library} } @article{merrac09, title={Towards reproducible econometric research: the Sweave framework}, author={Meredith, Evan and Racine, Jeffrey S}, journal={Journal of Applied Econometrics}, volume={24}, number={2}, pages={366--374}, year={2009}, publisher={Wiley Online Library} } @article{arebon91, title={Some tests of specification for panel data: Monte Carlo evidence and an application to employment equations}, author={Arellano, Manuel and Bond, Stephen}, journal={The Review of Economic Studies}, volume={58}, number={2}, pages={277--297}, year={1991}, publisher={Oxford University Press} } @TechReport{pes04, title={General diagnostic tests for cross section dependence in panels}, author={Pesaran, M Hashem}, year={2004}, institution={CESifo working paper series} } @Manual{Rsoft, title = {R: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2014}, url = {http://www.R-project.org/}, } @article{dru03, title={Testing for serial correlation in linear panel-data models}, author={Drukker, David M}, journal={Stata Journal}, volume={3}, number={2}, pages={168--177}, year={2003} } @article{blubon98, title={Initial conditions and moment restrictions in dynamic panel data models}, author={Blundell, Richard and Bond, Stephen}, journal={Journal of econometrics}, volume={87}, number={1}, pages={115--143}, year={1998}, publisher={Elsevier} } @article{ebe13, title={Estimating panel time-series models with heterogeneous slopes}, author={Eberhardt, Markus}, journal={Stata Journal}, volume={12}, number={1}, pages={61--71}, year={2012}, publisher={StataCorp LP} } @Manual{xtable, title = {xtable: Export tables to LaTeX or HTML}, author = {David B. Dahl}, year = {2014}, note = {R package version 1.7-4}, url = {https://CRAN.R-project.org/package=xtable}, } @Article{lmtest, title = {Diagnostic Checking in Regression Relationships}, author = {Achim Zeileis and Torsten Hothorn}, journal = {R News}, year = {2002}, volume = {2}, number = {3}, pages = {7--10}, url = {https://CRAN.R-project.org/doc/Rnews/}, } @article{are87, title={Computing Robust Standard Errors for Within Estimators}, author={Arellano, Manuel}, journal={Oxford bulletin of Economics and Statistics}, volume={49}, number = {4}, pages={431--434}, year={1987} } @article{whi80, title={A heteroskedasticity-consistent covariance matrix estimator and a direct test for heteroskedasticity}, author={White, Halbert}, journal={Econometrica}, pages={817--838}, year={1980}, publisher={JSTOR} } @article{pes07, title={A simple panel unit root test in the presence of cross-section dependence}, author={Pesaran, M Hashem}, journal={Journal of Applied Econometrics}, volume={22}, number={2}, pages={265--312}, year={2007}, publisher={Wiley Online Library} } @article{pessmi95, title={Estimating long-run relationships from dynamic heterogeneous panels}, author={Pesaran, M Hashem and Smith, Ron}, journal={Journal of Econometrics}, volume={68}, number={1}, pages={79--113}, year={1995}, publisher={Elsevier} } @article{saryamrob09, title={A test of cross section dependence for a linear dynamic panel model with regressors}, author={Sarafidis, Vasilis and Yamagata, Takashi and Robertson, Donald}, journal={Journal of econometrics}, volume={148}, number={2}, pages={149--161}, year={2009}, publisher={Elsevier} } @article{fre95, title={Assessing cross-sectional correlation in panel data}, author={Frees, Edward W}, journal={Journal of econometrics}, volume={69}, number={2}, pages={393--414}, year={1995}, publisher={Elsevier} } @article{mil15, title={Narrow Replication of 'A Spatio-Temporal Model of House Prices in the USA' Using R}, author={Millo, Giovanni}, journal={Journal of Applied Econometrics}, volume={30}, number={4}, pages={703--704}, year={2015}, publisher={Wiley Online Library} } @article{phimoo99, title={Linear regression limit theory for nonstationary panel data}, author={Phillips, Peter CB and Moon, Hyungsik R}, journal={Econometrica}, volume={67}, number={5}, pages={1057--1111}, year={1999}, publisher={Wiley Online Library} } @incollection{balbrepir08, title={To pool or not to pool?}, author={Baltagi, Badi H and Bresson, Georges and Pirotte, Alain}, booktitle={The econometrics of panel data}, pages={517--546}, year={2008}, publisher={Springer} } @article{balgrixio00, title={To pool or not to pool: Homogeneous versus heterogeneous estimators applied to cigarette demand}, author={Baltagi, Badi H and Griffin, James M and Xiong, Weiwen}, journal={The Review of Economics and Statistics}, volume={82}, number={1}, pages={117--126}, year={2000}, publisher={MIT Press} } @article{balgri97, title={Pooled estimators vs. their heterogeneous counterparts in the context of dynamic demand for gasoline}, author={Baltagi, Badi H and Griffin, James M}, journal={Journal of Econometrics}, volume={77}, number={2}, pages={303--327}, year={1997}, publisher={Elsevier} } @article{balgripir02, title={Homogeneous, heterogeneous or shrinkage estimators? Some empirical evidence from French regional gasoline consumption}, author={Baltagi, Badi H and Bresson, Georges and Griffin, James M and Pirotte, Alain}, journal={Empirical Economics}, volume={28}, number={4}, pages={795--811}, year={2003}, publisher={Springer} } @incollection{hsipes08, title={Random coefficient models}, author={Hsiao, Cheng and Pesaran, M Hashem}, booktitle={The econometrics of panel data}, pages={185--213}, year={2008}, publisher={Springer} } @article{pestos11, title={Large panels with common factors and spatial correlation}, author={Pesaran, M Hashem and Tosetti, Elisa}, journal={Journal of Econometrics}, volume={161}, number={2}, pages={182--202}, year={2011}, publisher={Elsevier} } @article{sto87, title={Asymptotic properties of least squares estimators of cointegrating vectors}, author={Stock, James H}, journal={Econometrica}, pages={1035--1056}, volume = {55}, number = {5}, year={1987}, publisher={JSTOR} } @article{granew74, title={Spurious regressions in econometrics}, author={Granger, Clive WJ and Newbold, Paul}, journal={Journal of Econometrics}, volume={2}, number={2}, pages={111--120}, year={1974}, publisher={Elsevier} } @article{phisul03, title={Dynamic panel estimation and homogeneity testing under cross section dependence}, author={Phillips, Peter CB and Sul, Donggyu}, journal={The Econometrics Journal}, volume={6}, number={1}, pages={217--259}, year={2003}, publisher={Wiley Online Library} } @article{mil17, title={A simple randomization test for spatial correlation in the presence of common factors and serial correlation}, author={Millo, Giovanni}, journal={Regional Science and Urban Economics}, volume={66}, number={}, pages={28--38}, year={2017}, publisher={Elsevier} } @article{griarb10, title={Detecting negative spatial autocorrelation in georeferenced random variables}, author={Griffith, Daniel A and Arbia, Giuseppe}, journal={International Journal of Geographical Information Science}, volume={24}, number={3}, pages={417--437}, year={2010}, publisher={Taylor \& Francis} } @article{elhzig14, title={Competition in research activity among economic departments: Evidence by negative spatial autocorrelation}, author={Elhorst, J Paul and Zigova, Katarina}, journal={Geographical Analysis}, volume={46}, number={2}, pages={104--125}, year={2014}, publisher={Wiley Online Library} } @article{balgri01, title={The econometrics of rational addiction: the case of cigarettes}, author={Baltagi, Badi H and Griffin, James M}, journal={Journal of Business \& Economic Statistics}, volume={19}, number={4}, pages={449--454}, year={2001}, publisher={Taylor \& Francis} } @article{elh09, title={Evidence of political yardstick competition in France using a two-regime spatial Durbin model with fixed effects}, author={Elhorst, J Paul and Fr{\'e}ret, Sandy}, journal={Journal of Regional Science}, volume={49}, number={5}, pages={931--951}, year={2009}, publisher={Wiley Online Library} } @article{belboc00, title={Applying the generalized-moments estimation approach to spatial problems involving micro-level data}, author={Bell, Kathleen P and Bockstael, Nancy E}, journal={The review of economics and statistics}, volume={82}, number={1}, pages={72--82}, year={2000}, publisher={MIT Press} } @inproceedings{Anselinetal:08, author={Anselin, L. and Le Gallo, J. and Jayet, H.}, title={Spatial Panel Econometrics}, booktitle={The Econometrics of Panel Data, Fundamentals and Recent Developments in Theory and Practice (3rd Edition)}, year={2008}, publisher={Springer-Verlag, Berlin Heidelberg}, editor={Matyas, L. and Sevestre, P.}, pages={624 -- 660} } @article{Elhorst:03, author={Elhorst, J.P.}, title={Specification and estimation of spatial panel data models}, journal={International Regional Sciences Review}, volume={26}, year={2003}, pages={244--268}, number={3} } @article{LeeYu:10b, author={Lee, L.F. and Yu, J.}, title={Estimation of spatial autoregressive panel data models with fixed effects}, journal={Journal of Econometrics}, volume={154}, year={2010}, pages={165--185}, number={2} } @article{LeeYu:10c, author={Lee, L.F. and Yu, J.}, title={Some recent developments in spatial panel data models}, journal={Regional Science and Urban Economics}, volume={40}, year={2010}, pages={255--271}, number={5} } @article{LeeYu:12, author={Lee,L. and Yu,J.}, title={Spatial panels: random components versus fixed effects}, journal={International Economic Review}, volume={53}, year={2012}, pages={1369--1412}, month={November}, number={4} } @article{milpir12, title={splm: Spatial Panel Data Models in {R}}, author={Millo, Giovanni and Piras, Gianfranco}, journal={Journal of Statistical Software}, volume={47}, number={1}, pages={1--38}, year={2012} } @article{Case:91, author={Case, A.C.}, title={Spatial Patterns in household demand}, journal={Econometrica}, volume={59}, year={1991}, pages={953--965}, number={4} } @article{Kapooretal:07, author={Kapoor, M. and Kelejian, H.H. and Prucha, I.R.}, title={Panel data model with spatially correlated error components}, journal={Journal of Econometrics}, volume={140}, year={2007}, pages={97--130}, number={1} } @article{MutlPfaffermayr:11, author={Mutl, J. and Pfaffermayr, M.}, title={The {H}ausman test in a Cliff and Ord panel model}, journal={Econometrics Journal}, volume={14}, year={2011}, pages={48--76}, number={1} } @book{ANSE:88, title={Spatial econometrics: methods and models}, author={Anselin, Luc}, volume={4}, year={1988}, publisher={Springer} } @article{Magnus:78, author={Magnus, J.}, title={Maximum likelihood estimation of the GLS model with unknown parameters in the disturbance covariance matrix}, journal={Journal of Econometrics}, volume={7}, year={1978}, pages={281-- 312} } @article{Elhorst:08, author={Elhorst, J.P.}, title={Serial and Spatial error correlation}, journal={Economics Letters}, volume={100}, year={2008}, pages={422--424}, number={3} } @article{OberhoferKmenta:74, author={Oberhofer, W. and Kmenta, J.}, title={A general procedure for obtaining maximum likelihood estimates in generalized regression models}, journal={Econometrica}, volume={42}, year={1974}, pages={579--590}, number={3} } @article{KelejianPrucha:98, author={Kelejian, H.H. and Prucha, I.R.}, title={A Generalized Spatial Two Stages Least Square Procedure for Estimating a Spatial Autoregressive Model with Autoregressive Disturbances}, journal={Journal of Real Estate Finance and Economics}, volume={17}, year={1998}, pages={99--121}, number={1} } @article{KelejianPrucha:99, author={Kelejian, H.H. and Prucha, I.R.}, title={A Generalized Moments Estimator for the Autoregressive Parameter in a Spatial Model}, journal={International Economic Review}, volume={40}, year={1999}, pages={509--533}, number={2} } @article{bur80, title={On the Cliff-Ord test for spatial correlation}, author={Burridge, Peter}, journal={Journal of the Royal Statistical Society. Series B (Methodological)}, pages={107--108}, volume = {42}, number = {1}, year={1980}, publisher={JSTOR} } @article{Fingleton:08, author={Fingleton, B.}, title={A Generalized Method of Moments estimator for a spatial panel model with an endogenous spatial lag and spatial moving average errors}, journal={Spatial Economic Analysis}, volume={3}, year={2008}, pages={27--44}, number={1} } @article{Baltagietal:13, author={Baltagi, B.H. and Egger, P. and Pfaffermayr, M.}, title={A generalized spatial panel data model with random effects}, journal={Econometric Reviews}, volume={32}, year={2013}, pages={650--685}, issue={5-6} } @article{ans88a, title={Lagrange multiplier test diagnostics for spatial dependence and spatial heterogeneity}, author={Anselin, Luc}, journal={Geographical analysis}, volume={20}, number={1}, pages={1--17}, year={1988}, publisher={Wiley Online Library} } @article{beryoo93, title={Specification testing with locally misspecified alternatives}, author={Bera, Anil K and Yoon, Mann J}, journal={Econometric theory}, volume={9}, number={04}, pages={649--658}, year={1993}, publisher={Cambridge Univ Press} } @article{ansberfloyoo96, title={Simple diagnostic tests for spatial dependence}, author={Anselin, Luc and Bera, Anil K and Florax, Raymond and Yoon, Mann J}, journal={Regional Science and Urban Economics}, volume={26}, number={1}, pages={77--104}, year={1996}, publisher={Elsevier} } @article{flofolrey03, title={Specification searches in spatial econometrics: the relevance of Hendry's methodology}, author={Florax, Raymond JGM and Folmer, Hendrik and Rey, Sergio J}, journal={Regional Science and Urban Economics}, volume={33}, number={5}, pages={557--579}, year={2003}, publisher={Elsevier} } @article{elh10, title={Applied spatial econometrics: raising the bar}, author={Elhorst, J Paul}, journal={Spatial Economic Analysis}, volume={5}, number={1}, pages={9--28}, year={2010}, publisher={Taylor \& Francis} } @incollection{elh14a, title={Spatial panel data models}, author={Elhorst, J Paul}, booktitle={Spatial Econometrics}, pages={37--93}, year={2014}, publisher={Springer} } @article{bermonsos09, title={Testing under local misspecification and artificial regressions}, author={Bera, Anil K and Montes-Rojas, Gabriel and Sosa-Escudero, Walter}, journal={Economics Letters}, volume={104}, number={2}, pages={66--68}, year={2009}, publisher={Elsevier} } @article{debert10, title={Testing for spatial autocorrelation in a fixed effects panel data model}, author={Debarsy, Nicolas and Ertur, Cem}, journal={Regional Science and Urban Economics}, volume={40}, number={6}, pages={453--470}, year={2010}, publisher={Elsevier} } @article{balsonjunkoh07, author={Baltagi, B.H. and Song, S.H. and Jung,B.C. and Koh,W.}, title={Testing for serial correlation, spatial autocorrelation and random effects using panel data}, journal={Journal of Econometrics}, volume={140}, year={2007}, pages={5--51}, number={1} } @article{mil17b, author={Millo, G.}, title={Robust standard error estimators for panel models: A unifying approach}, journal={Journal of Statistical Software}, volume={82}, year={2017}, pages={1--27}, number={3} } @Article{BALT:LI:90, author = {Baltagi, B.H. and Li, Q.}, title = {A Lagrange multiplier test for the error components model with incomplete panels}, journal = {Econometric Reviews}, year = {1990}, OPTkey = {}, volume = {9}, OPTnumber = {}, pages = {103--107}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BALT:CHAN:LI:92, author = {Baltagi, B.H. and Chang, Y.J. and Li, Q.}, title = {Monte Carlo results on several new and existing tests for the error components model}, journal = {Journal of Econometrics}, year = {1992}, OPTkey = {}, volume = {54}, OPTnumber = {}, pages = {95--120}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{OBOJ:ETAL:15, title={Vegetation effects on the water balance of mountain grasslands depend on climatic conditions}, author={Obojes, N and Bahn, M and Tasser, E and Walde, J and Inauen, Nicole and Hiltbrunner, Erika and Saccone, P and Lochet, J and Cl{\'e}ment, JC and Lavorel, S and others}, journal={Ecohydrology}, volume={8}, number={4}, pages={552--569}, year={2015}, publisher={Wiley Online Library} } @Article{CAUD:FORD:KASE:95, author = {Caudill, Steven B. and Ford, Jon M. and Kaserman, David L.}, title = {Certificate-of-need regulation and the diffusion of innovations: a random coefficient model}, journal = {Journal of Applied Econometrics}, year = {1995}, OPTkey = {}, volume = {10}, number = {1}, OPTpages = {73--78}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{HALL:94, title={Testing for a unit root in time series with pretest data-based model selection}, author={Hall, Alastair}, journal={Journal of Business \& Economic Statistics}, volume={12}, number={4}, pages={461--470}, year={1994}, publisher={Taylor \& Francis} } @Manual{foreign, title = {foreign: Read Data Stored by 'Minitab', 'S', 'SAS', 'SPSS', 'Stata', 'Systat', 'Weka', 'dBase', ...}, author = {{R Core Team}}, year = {2017}, note = {R package version 0.8-69}, url = {https://CRAN.R-project.org/package=foreign}, } @Book{XIE:15, title = {Dynamic Documents with {R} and knitr}, author = {Yihui Xie}, publisher = {Chapman and Hall/CRC}, address = {Boca Raton, Florida}, year = {2015}, edition = {2nd}, note = {ISBN 978-1498716963}, url = {http://yihui.name/knitr/}, } @Book{WICK:09, author = {Hadley Wickham}, title = {ggplot2: Elegant Graphics for Data Analysis}, publisher = {Springer-Verlag New York}, year = {2009}, isbn = {978-0-387-98140-6}, url = {http://ggplot2.org}, } @manual{tantau:2013a, author = {Till Tantau}, year = {2013}, title = {The TikZ and PGF Packages}, subtitle = {Manual for version 3.0.0}, url = {http://sourceforge.net/projects/pgf/}, date = {2013-12-20}, } @Article{ROSS:HEIL:04, author = {Rossini, A.J. and Heiberger, R.M. and Sparapani, R.A. and Maechler, M. and Hornik, K.}, title = {Emacs Speaks Statistics: a multiplatform, multipackage development environment for statistical analysis}, journal = {Journal of Computational and Graphical Statistics}, year = {2004}, OPTkey = {}, OPTvolume = {13}, OPTnumber = {1}, OPTpages = {247-261}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Manual{fiftystater, title = {fiftystater: Map Data to Visualize the Fifty U.S. States with Alaska and Hawaii Insets}, author = {William Murphy}, year = {2016}, note = {R package version 1.0.1}, url = {https://CRAN.R-project.org/package=fiftystater}, } @Article{MICH:PAPA:16, author = {Michalopoulos, Stelios and Papaioannou, Elias}, title = {The long-run effects of the scramble for Africa}, journal = {American Economic Review}, year = {2016}, OPTkey = {}, volume = {106}, number = {7}, pages = {1802-1848}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{CHAR:VILL:09, author = {Charness, Gary and Villeval, Marie-Claire}, title = {Cooperation and competition in intergenerational experiments in the field and the laboratory}, journal = {American Economic Review}, year = {2009}, OPTkey = {}, volume = {99}, number = {3}, pages = {956-978}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BARD:MOOK:10, author = {Bardhan, Pranab and Mookherjee, Dilip}, title = {Determinants of redistributive politics: an empirical analysis of land reform in west Bengal, India}, journal = {American Economic Review}, year = {2010}, OPTkey = {}, volume = {100}, number = {4}, pages = {1572-1600}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{REIN:REIN:TREB:16, author = {Reinhart, Carmen M. and Reinhart, Vincent and Trebesch, Christoph}, title = {Global cycles: capital flows, commodities, and sovereign defaults, 1815-2015}, journal = {American Economic Review}, year = {2016}, OPTkey = {}, volume = {106}, number = {5}, pages = {574-580}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BRAN:COOP:06, author = {Brandts, Jordi and Cooper, David J.}, title = {A change would do you good... An experimental study on how to overcome coordination failure in organizations}, journal = {American Economic Review}, year = {2006}, OPTkey = {}, volume = {96}, number = {3}, pages = {669-693}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{BAZZI:17, author = {Bazzi, Samuel}, title = {Wealth heterogeneity and the income elasticity of migration}, journal = {American Economic Journal, Applied Economics}, year = {2017}, OPTkey = {}, volume = {9}, number = {2}, pages = {219-255}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{FARB:SILV:WACH:16, author = {Farber, Henry S. and Silverman, Dan and von Wachter, Till}, title = {Determinants of callbacks to job applications: an audit study}, journal = {American Economic Review}, year = {2016}, OPTkey = {}, volume = {106}, number = {5}, pages = {314-318}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ALAN:HONO:HU:LETH:13, author = {Alan, Sule and Honor\'e, Bo E. and Hu, Luojia and Leth-Petersen, Soren}, title = {Estimation of panel data regression model with two-sided censoring or truncation}, journal = {Journal of Econometric Methods}, year = {2013}, OPTkey = {}, volume = {3}, number = {1}, pages = {1-20}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HAUS:HALL:GRIL:86, author = {Hausman, J. and Hall, B.H. and Griliches, Z.}, title = {Patents and {R\&D}: is there a lag?}, journal = {International Economic Review}, year = {1986}, OPTkey = {}, OPTvolume = {27}, OPTnumber = {}, pages = {265-283}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{CINC:97, author = {Cincer, Michele}, title = {Patents, {R\&D}, and technological spillovers at the firm level: some evidence from econometric count models for panel data}, journal = {Journal of Applied Econometrics}, year = {1997}, OPTkey = {}, volume = {12}, number = {3}, OPTpages = {265-280}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{ACCO:CORS:SIMO:14, author = {Acconcia, Antonio and Corsetti, Giancarlo and Simonelli, Saverio}, title = {Mafia and public spending: evidence on the fiscal multiplier from a quasi-experiment}, journal = {American Economic Review}, year = {2014}, OPTkey = {}, volume = {104}, OPTnumber = {7}, pages = {2185-2209}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Manual{CROI:MILL:17, title = {pder: Panel Data Econometrics with R}, author = {Yves Croissant and Giovanni Millo}, year = {2017}, note = {R package version 1.0-0}, url = {http://www.r-project.org}, } @Manual{CROI:17, title = {pglm: panel generalized linear model}, author = {Yves Croissant}, year = {2017}, note = {R package version 0.2-0}, url = {http://www.r-project.org}, } @Manual{CROI:ZEIL:16, title = {truncreg: Truncated Gaussian Regression Models}, author = {Yves Croissant and Achim Zeileis}, year = {2016}, note = {R package version 0.2-4}, url = {https://CRAN.R-project.org/package=truncreg}, } @Book{survival-book, title = {Modeling Survival Data: Extending the {C}ox Model}, author = {Therneau, Terry M. and Grambsch, Patricia M.}, year = {2000}, publisher = {Springer}, address = {New York}, isbn = {0-387-98784-3}, } @Manual{HENN:17, title = {censReg: Censored Regression (Tobit) Models}, author = {Arne Henningsen}, year = {2017}, note = {R package version 0.5-26}, url = {https://CRAN.R-project.org/package=censReg}, } @Book{VENA:RIPL:02, title = {Modern Applied Statistics with S}, author = {W. N. Venables and B. D. Ripley}, publisher = {Springer}, edition = {4th}, address = {New York}, year = {2002}, note = {ISBN 0-387-95457-0}, url = {http://www.stats.ox.ac.uk/pub/MASS4}, } @Manual{PINH:17, title = {{nlme}: Linear and Nonlinear Mixed Effects Models}, author = {Jose Pinheiro and Douglas Bates and Saikat DebRoy and Deepayan Sarkar and {R Core Team}}, year = {2017}, note = {R package version 3.1-131}, url = {https://CRAN.R-project.org/package=nlme}, } @Article{JACK:11, title = {Multi-State Models for Panel Data: The {msm} Package for {R}}, author = {Christopher H. Jackson}, journal = {Journal of Statistical Software}, year = {2011}, volume = {38}, number = {8}, pages = {1--29}, url = {https://www.jstatsoft.org/article/view/v038i08}, } @Manual{WICK:FRAN:16, title = {dplyr: A Grammar of Data Manipulation}, author = {Hadley Wickham and Romain Francois}, year = {2016}, note = {R package version 0.5.0}, url = {https://CRAN.R-project.org/package=dplyr}, } @Manual{BDSM:14, title = {bdsmatrix: Routines for Block Diagonal Symmetric matrices}, author = {Terry Therneau}, year = {2014}, note = {R package version 1.3-2}, url = {https://CRAN.R-project.org/package=bdsmatrix}, } @Article{SPAM:10, title = {{spam}: A Sparse Matrix {R} Package with Emphasis on {MCMC} Methods for {G}aussian {M}arkov Random Fields}, author = {Reinhard Furrer and Stephan R. Sain}, journal = {Journal of Statistical Software}, year = {2010}, volume = {36}, number = {10}, pages = {1--25}, url = {https://www.jstatsoft.org/article/view/v036i10}, } @Manual{MATR:16, title = {Matrix: Sparse and Dense Matrix Classes and Methods}, author = {Douglas Bates and Martin Maechler}, year = {2016}, note = {R package version 1.2-4}, url = {https://CRAN.R-project.org/package=Matrix}, } @Article{MAXL:11, title = {maxLik: A package for maximum likelihood estimation in {R}}, author = {Arne Henningsen and Ott Toomet}, journal = {Computational Statistics}, year = {2011}, volume = {26}, number = {3}, pages = {443-458}, doi = {10.1007/s00180-010-0217-1}, url = {http://dx.doi.org/10.1007/s00180-010-0217-1}, } @article{BALT:GRIF:83, title = "Gasoline demand in the OECD: An application of pooling and testing procedures", journal = "European Economic Review", volume = "22", number = "2", pages = "117 - 137", year = "1983", issn = "0014-2921", OPTdoi = "https://doi.org/10.1016/0014-2921(83)90077-6", url = "https://www.sciencedirect.com/science/article/pii/0014292183900776", author = "Badi H. Baltagi and James M. Griffin", abstract = "This study utilizes a pooled inter-country data set, finding the long-run price-elasticity falls in the range −0.55 to −0.9, depending on the choice of pooled estimators. The estimators included the OLS, within-, and between-country estimators, plus five feasible GLS estimators. Even allowing for a ten-year distributed lag on price to reflect changes in auto-efficiency characteristics, the within-country estimator yields appreciably more inelastic estimates than did the O:S estimator, which was heavily influenced by the between- or inter-country variation. This difference raises intriguing questions for future research." } @PhdThesis{GRUN:58, title = {The determinants of corporate investment}, year = {1958}, school = {Department of Economics, University of Chicago}, author = {Grunfeld, Yehuda} } @ARTICLE{KLEI:ZEIL:10, title = {The Grunfeld Data at 50}, author = {Kleiber, Christian and Zeileis, Achim}, year = {2010}, journal = {German Economic Review}, volume = {11}, pages = {404-417}, abstract = {This paper revisits Grunfeld's well-known investment data, one of the most widely used datasets in all of applied econometrics, on the occasion of their 50th anniversary. It presents, apparently for the first time after the publication of the original Chicago Ph.D. thesis, the full dataset, points out errors and inconsistencies in several currently available versions, and also revisits a number of empirical studies from the literature of the last five decades. Our findings provide a cautionary tale on the use of widely known data and underline the need for mandatory data and code archives. Copyright 2010 The Author. German Economic Review 2010 Verein für Socialpolitik.}, url = {https://onlinelibrary.wiley.com/doi/abs/10.1111/j.1468-0475.2010.00513.x} } @book{BESL:KUH:WELS:80, title = {Regression diagnostics: identifying influential data and sources of collinearity}, author= {Besley, David A. and Kuh, Edwin and Welsch, Roy E.}, year = {1980}, publisher={John Wiley and Sons ltd}, note = {Wiley series in probability and statistics} } @book{CAME:TRIV:05, author = {Colin Cameron, Adrian and K. Trivedi, Pravin}, year = {2005}, title = {Microeconometrics: Methods and Applications}, publisher = {Cambridge University Press}, isbn = {0521848059}, doi = {10.1017/CBO9780511811241} } @article{ZILI:97, ISSN = {07350015}, OPTURL = {https://www.jstor.org/stable/1392488}, abstract = {I examine the empirical performance of instrumental variables estimators with predetermined instruments in an application to life-cycle labor supply under uncertainty. The estimators studied are two-stage least squares, generalized method-of-moments (GMM), forward filter, independently weighted GMM, and split-sample instrumental variables. I compare the bias/efficiency trade-off for the estimators using bootstrap algorithms suggested by Freedman and by Brown and Newey. Results indicate that the downward bias in GMM is quite severe as the number of moment conditions expands, outweighing the gains in efficiency. The forward-filter estimator, however, has lower bias and is more efficient than two-stage least squares.}, author = {James P. Ziliak}, journal = {Journal of Business & Economic Statistics}, number = {4}, pages = {419--431}, publisher = {[American Statistical Association, Taylor & Francis, Ltd.]}, title = {Efficient Estimation with Panel Data When Instruments Are Predetermined: An Empirical Comparison of Moment-Condition Estimators}, volume = {15}, year = {1997} } @book{VERB:04, author = {Verbeek, Marno}, year = {2004}, title = {A Guide to Modern Econometrics}, edition = {2nd}, publisher = {Wiley} } @article{FENG:HORR:12, author = {Feng, Qu and Horrace, William C.}, title = {Alternative technical efficiency measures: Skew, bias and scale}, journal = {Journal of Applied Econometrics}, volume = {27}, number = {2}, pages = {253-268}, doi = {10.1002/jae.1190}, url = {https://onlinelibrary.wiley.com/doi/abs/10.1002/jae.1190}, eprint = {https://onlinelibrary.wiley.com/doi/pdf/10.1002/jae.1190}, abstract = {SUMMARY In the fixed-effects stochastic frontier model an efficiency measure relative to the best firm in the sample is universally employed. This paper considers a new measure relative to the worst firm in the sample. We find that estimates of this measure have smaller bias than those of the traditional measure when the sample consists of many firms near the efficient frontier. Moreover, a two-sided measure relative to both the best and the worst firms is proposed. Simulations suggest that the new measures may be preferred depending on the skewness of the inefficiency distribution and the scale of efficiency differences. Copyright 2010 John Wiley \& Sons, Ltd.}, year = {2012} } @book{HAYA:00, author = {Hayashi, F.}, year = 2000, publisher = {Princeton University Press}, title = Econometrics } @article{SUMM:HEST:91, author = {Summers, Robert and Heston, Alan}, year = {1991}, month = {02}, pages = {327-68}, title = {The Penn World Table (Mark 5): An Expanded Set of International Comparisons, 1950–1988}, volume = {106}, journal = {The Quarterly Journal of Economics}, doi = {10.2307/2937941} } @ARTICLE{BALT:LEVI:92, title = {Cigarette taxation: Raising revenues and reducing consumption}, author = {Baltagi, Badi and Levin, Dan}, year = {1992}, journal = {Structural Change and Economic Dynamics}, volume = {3}, number = {2}, pages = {321-335}, url = {https://EconPapers.repec.org/RePEc:eee:streco:v:3:y:1992:i:2:p:321-335} } @article{BALT:GRIF:XION:00, author = {Baltagi, Badi H. and Griffin, James M. and Xiong, Weiwen}, title = {To Pool or Not to Pool: Homogeneous Versus Heterogeneous Estimators Applied to Cigarette Demand}, journal = {The Review of Economics and Statistics}, volume = {82}, number = {1}, pages = {117-126}, year = {2000}, doi = {10.1162/003465300558551}, URL = {https://doi.org/10.1162/003465300558551}, eprint = {https://doi.org/10.1162/003465300558551}, abstract = { This paper reexamines the benefits of pooling and, in addition, contrasts the performance of newly proposed heterogeneous estimators. The analysis utilizes a panel data set from 46 American states over the period 1963 to 1992 and a dynamic demand specification for cigarettes. Also, the forecast performance of the various estimators is compared.} } @article{IM:SEUN:SCHM:WOOL:99, title = "Efficient estimation of panel data models with strictly exogenous explanatory variables", journal = "Journal of Econometrics", volume = "93", number = "1", pages = "177 - 201", year = "1999", issn = "0304-4076", OPTdoi = "https://doi.org/10.1016/S0304-4076(99)00008-1", url = "https://www.sciencedirect.com/science/article/pii/S0304407699000081", author = "Kyung So Im and Seung C. Ahn and Peter Schmidt and Jeffrey M. Wooldridge", keywords = "Panel data, Strict exogeneity, Efficiency, Redundancy", abstract = "With panel data, exogeneity assumptions imply many more moment conditions than standard estimators use. However, many of the moment conditions may be redundant, in the sense that they do not increase efficiency; if so, we may establish the standard estimators’ efficiency. We prove efficiency results for GLS in a model with unrestricted error covariance matrix, and for 3SLS in models where regressors and errors are correlated, such as the Hausman–Taylor model. For models with correlation between regressors and errors, and with unrestricted error covariance structure, we provide a simple estimator based on a GLS generalization of deviations from means." } @unpublished{AREL:BOND:98, author={Arellano, M. and Bond, S.}, title={Dynamic panel data estimation using DPD98 for GAUSS: a guide for users}, year={1998}, note = {unpublished} } @unpublished{DOOR:AREL:BOND:12, author={Arellano, M. and Bond, S.}, title={Panel data estimation using DPD for Ox}, year={2012}, url = {https://www.doornik.com/download/oxmetrics7/Ox_Packages/dpd.pdf}, note = {unpublished} } @article{BALT:FENG:KAO:12, title = "A Lagrange Multiplier test for cross-sectional dependence in a fixed effects panel data model", journal = "Journal of Econometrics", volume = "170", number = "1", pages = "164 - 177", year = "2012", issn = "0304-4076", OPTdoi = "https://doi.org/10.1016/j.jeconom.2012.04.004", url = "https://www.sciencedirect.com/science/article/pii/S030440761200098X", author = "Badi H. Baltagi and Qu Feng and Chihwa Kao", keywords = " test, Cross-sectional dependence, Fixed effects, High dimensional inference, John test, Panel data", abstract = "It is well known that the standard Breusch and Pagan (1980) LM test for cross-equation correlation in a SUR model is not appropriate for testing cross-sectional dependence in panel data models when the number of cross-sectional units (n) is large and the number of time periods (T) is small. In fact, a scaled version of this LM test was proposed by Pesaran (2004) and its finite sample bias was corrected by Pesaran et al. (2008). This was done in the context of a heterogeneous panel data model. This paper derives the asymptotic bias of this scaled version of the LM test in the context of a fixed effects homogeneous panel data model. This asymptotic bias is found to be a constant related to n and T, which suggests a simple bias corrected LM test for the null hypothesis. Additionally, the paper carries out some Monte Carlo experiments to compare the finite sample properties of this proposed test with existing tests for cross-sectional dependence." } @article{PESA:15, author = { M. Hashem Pesaran}, title = {Testing Weak Cross-Sectional Dependence in Large Panels}, journal = {Econometric Reviews}, volume = {34}, number = {6-10}, pages = {1089-1117}, year = {2015}, publisher = {Taylor & Francis}, doi = {10.1080/07474938.2014.956623}, URL = {https://doi.org/10.1080/07474938.2014.956623}, eprint = {https://doi.org/10.1080/07474938.2014.956623} } @article{KANG:85, title = "A note on the equivalence of specification tests in the two-factor multivariate variance components model", journal = "Journal of Econometrics", volume = "28", number = "2", pages = "193 - 203", year = "1985", issn = "0304-4076", OPTdoi = "https://doi.org/10.1016/0304-4076(85)90119-8", url = "https://www.sciencedirect.com/science/article/pii/0304407685901198", author = "Suk Kang", abstract = "This note offers a generalization of Hausman and Taylor's equivalence of specification tests in the single-equation variance (error) components model to the two-factor multivariate variance components case. The relationship between the specification tests and the hypothesis test in the model proposed by Mundlak is also discussed." } @article{BALT:CHAN:LI:98, author = {Baltagi, Badi and Chang, YA and Li, Q}, year = {1998}, month = {01}, pages = {1-20}, journal = "Advances in econometrics", title = {Testing for random individual and time effects using unbalanced panel data}, volume = {13} } @book{ANDR:GOLS:SCMI:13, author = {Andre\ss, Hans-Jürgen and Golsch, Katrin and Schmidt-Catran, Alexander}, year = {2013}, month = {01}, publisher = {Springer}, title = {Applied Panel Data Analysis for Economic and Social Surveys}, doi = {10.1007/978-3-642-32914-2} } @Article{CAME:MILL:15, author={A. Colin Cameron and Douglas L. Miller}, title={A Practitioner's Guide to Cluster-Robust Inference}, journal={Journal of Human Resources}, year=2015, volume={50}, number={2}, pages={317-372}, month={}, keywords={}, doi={}, abstract={We consider statistical inference for regression when data are grouped into clusters, with regression model errors independent across clusters but correlated within clusters. Examples include data on individuals with clustering on village or region or other category such as industry, and state-year differences-in-differences studies with clustering on state. In such settings, default standard errors can greatly overstate estimator precision. Instead, if the number of clusters is large, statistical inference after OLS should be based on cluster-robust standard errors. We outline the basic method as well as many complications that can arise in practice. These include cluster-specific fixed effects, few clusters, multiway clustering, and estimators other than OLS.}, url={https://ideas.repec.org/a/uwp/jhriss/v50y2015i2p317-372.html} } @article{GRAN:69, ISSN = {00129682, 14680262}, OPTURL = {https://www.jstor.org/stable/1912791}, abstract = {There occurs on some occasions a difficulty in deciding the direction of causality between two related variables and also whether or not feedback is occurring. Testable definitions of causality and feedback are proposed and illustrated by use of simple two-variable models. The important problem of apparent instantaneous causality is discussed and it is suggested that the problem often arises due to slowness in recording information or because a sufficiently wide class of possible causal variables has not been used. It can be shown that the cross spectrum between two variables can be decomposed into two parts, each relating to a single causal arm of a feedback situation. Measures of causal lag and causal strength can then be constructed. A generalisation of this result with the partial cross spectrum is suggested.}, author = {C. W. J. Granger}, journal = {Econometrica}, number = {3}, pages = {424--438}, publisher = {[Wiley, Econometric Society]}, title = {Investigating Causal Relations by Econometric Models and Cross-spectral Methods}, volume = {37}, year = {1969} } @Article{LOPE:WEBE:17, author={Luciano Lopez and Sylvain Weber}, title={{Testing for Granger causality in panel data}}, journal={Stata Journal}, year=2017, volume={17}, number={4}, pages={972-984}, month={December}, keywords={xtgcause; Granger causality; panel datasets; bootstrap}, doi={}, abstract={With the development of large and long panel databases, the theory surrounding panel causality evolves quickly, and empirical researchers might find it difficult to run the most recent techniques developed in the literature. In this article, we present the community-contributed command xtgcause, which imple- ments a procedure proposed by Dumitrescu and Hurlin (2012, Economic Modelling 29: 1450–1460) for detecting Granger causality in panel datasets. Thus, it con- stitutes an effort to help practitioners understand and apply the test. xtgcause offers the possibility of selecting the number of lags to include in the model by minimizing the Akaike information criterion, Bayesian information criterion, or Hannan–Quinn information criterion, and it offers the possibility to implement a bootstrap procedure to compute p-values and critical values.}, url={https://www.stata-journal.com/article.html?article=st0507} } @article{DUMI:HURL:12, title = "Testing for Granger non-causality in heterogeneous panels", journal = "Economic Modelling", volume = "29", number = "4", pages = "1450 - 1460", year = "2012", issn = "0264-9993", OPTdoi = "https://doi.org/10.1016/j.econmod.2012.02.014", url = "https://www.sciencedirect.com/science/article/pii/S0264999312000491", author = "Elena-Ivona Dumitrescu and Christophe Hurlin", keywords = "Granger non-causality, Panel data, Wald test", abstract = "This paper proposes a very simple test of Granger (1969) non-causality for heterogeneous panel data models. Our test statistic is based on the individual Wald statistics of Granger non causality averaged across the cross-section units. First, this statistic is shown to converge sequentially to a standard normal distribution. Second, the semi-asymptotic distribution of the average statistic is characterized for a fixed T sample. A standardized statistic based on an approximation of the moments of Wald statistics is hence proposed. Third, Monte Carlo experiments show that our standardized panel statistics have very good small sample properties, even in the presence of cross-sectional dependence." } @article{SOSA:BERA:08, author = {Walter Sosa-Escudero and Anil K. Bera}, title ={Tests for Unbalanced Error-Components Models under Local Misspecification}, journal = {The Stata Journal}, volume = {8}, number = {1}, pages = {68-78}, year = {2008}, doi = {10.1177/1536867X0800800105}, URL = {https://doi.org/10.1177/1536867X0800800105}, eprint = {https://doi.org/10.1177/1536867X0800800105}, abstract = { This paper derives unbalanced versions of the test statistics for first-order serial correlation and random individual effects summarized in Sosa-Escudero and Bera (2001, Stata Technical Bulletin Reprints, vol. 10, pp. 307–311), and updates their xttest1 routine. The derived test statistics should be useful for applied researchers faced with the increasing availability of panel information where not every individual or country is observed for the full time span. The test statistics proposed here are based on ordinary least-squares residuals and hence are computationally very simple.} } @article{DURB:WATS:50, ISSN = {00063444}, OPTURL = {https://www.jstor.org/stable/2332391}, author = {J. Durbin and G. S. Watson}, journal = {Biometrika}, number = {3/4}, pages = {409--428}, publisher = {[Oxford University Press, Biometrika Trust]}, title = {Testing for Serial Correlation in Least Squares Regression: I}, volume = {37}, year = {1950} } @article{DURB:WATS:71, ISSN = {00063444}, OPTURL = {https://www.jstor.org/stable/2334313}, abstract = {The paper considers a number of problems arising from the test of serial correlation based on the d statistic proposed earlier by the authors (Durbin & Watson, 1950, 1951). Methods of computing the exact distribution of d are investigated and the exact distribution is compared with six approximations to it for four sets of published data. It is found that approximations suggested by Theil and Nagar and by Hannan are too inaccurate for practical use but that the beta approximation proposed in the 1950 and 1951 papers and a new approximation, called by us the a + bdU approximation and based, like the beta approximation, on the exact first two moments of d, both perform well. The power of the d test is compared with that of certain exact tests proposed by Theil, Durbin, Koerts and Abrahamse from the standpoint of invariance theory. It is shown that the d test is locally most powerful invariant but that the other tests are not. There are three appendices. The first gives an account of the exact distribution of d. The second derives the mean and variance to a second order of approximation of a modified maximum likelihood statistic closely related to d. The third sets out details of the computations required for the a + bdU approximation.}, author = {J. Durbin and G. S. Watson}, journal = {Biometrika}, number = {1}, pages = {1--19}, publisher = {[Oxford University Press, Biometrika Trust]}, title = {Testing for Serial Correlation in Least Squares Regression. III}, volume = {58}, year = {1971} } @article{DURB:WATS:51, author = {Durbin, J. and Watson, G. S.}, title = "{Testing for serial correlation in least sqares regression. II}", journal = {Biometrika}, volume = {38}, number = {1-2}, pages = {159-178}, year = {1951}, month = {06}, issn = {0006-3444}, doi = {10.1093/biomet/38.1-2.159}, url = {https://doi.org/10.1093/biomet/38.1-2.159} } @article{BALT:WU:99, ISSN = {02664666, 14694360}, OPTURL = {https://www.jstor.org/stable/3533276}, abstract = {This paper deals with the estimation of unequally spaced panel data regression models with AR(1) remainder disturbances. A feasible generalized least squares (GLS) procedure is proposed as a weighted least squares that can handle a wide range of unequally spaced panel data patterns. This procedure is simple to compute and provides natural estimates of the serial correlation and variance ctomponents parameters. The paper also provides a locally best invariant test for zero first-order serial correlation against positive or negative serial correlation in case of unequally spaced panel data.}, author = {Badi H. Baltagi and Ping X. Wu}, journal = {Econometric Theory}, number = {6}, pages = {814--823}, publisher = {Cambridge University Press}, title = {Unequally Spaced Panel Data Regressions with AR(1) Disturbances}, volume = {15}, year = {1999} } @article{BHAR:FRAN:NARE:82, ISSN = {00346527, 1467937X}, OPTURL = {https://www.jstor.org/stable/2297285}, abstract = {This paper generalizes the Durbin-Watson type statistics to test the OLS residuals from the fixed effects model for serial independence. Also generalized are the tests proposed by Sargan and Bhargava for the hypothesis that the residuals form a random walk. A method for efficient estimation of the parameters is also developed. Finally, an earnings function is estimated using the Michigan Survey of Income Dynamics in order to illustrate the uses of the tests and the estimation procedures developed in this paper.}, author = {A. Bhargava and L. Franzini and W. Narendranathan}, journal = {The Review of Economic Studies}, number = {4}, pages = {533--549}, publisher = {[Oxford University Press, Review of Economic Studies, Ltd.]}, title = {Serial Correlation and the Fixed Effects Model}, volume = {49}, year = {1982} } @article{MACK:94, ISSN = {07350015}, OPTURL = {https://www.jstor.org/stable/1391481}, abstract = {This article uses Monte Carlo experiments and response surface regressions in a novel way to calculate approximate asymptotic distribution functions for several well-known unit-root and cointegration test statistics. These allow empirical workers to calculate approximate P values for these tests. The results of the article are based on an extensive set of Monte Carlo experiments, which yield finite-sample quantiles for several sample sizes. Based on these, response surface regressions are used to obtain asymptotic quantiles for many different test sizes. Then approximate distribution functions with simple functional forms are estimated from these asymptotic quantiles.}, author = {James G. MacKinnon}, journal = {Journal of Business & Economic Statistics}, number = {2}, pages = {167--176}, publisher = {[American Statistical Association, Taylor & Francis, Ltd.]}, title = {Approximate Asymptotic Distribution Functions for Unit-Root and Cointegration Tests}, volume = {12}, year = {1994} } @article{MACK:96, ISSN = {08837252}, OPTURL = {https://www.jstor.org/stable/2285154}, author = {James G. MacKinnon}, journal = {Journal of Applied Econometrics}, number = {6}, pages = {601--618}, title = {Numerical Distribution Functions for Unit Root and Cointegration Tests}, volume = {11}, year = {1996} } @article{KWIA:PHIL:SCHM:SHIN:92, title = "Testing the null hypothesis of stationarity against the alternative of a unit root: How sure are we that economic time series have a unit root?", journal = "Journal of Econometrics", volume = "54", number = "1", pages = "159 - 178", year = "1992", issn = "0304-4076", OPTdoi = "https://doi.org/10.1016/0304-4076(92)90104-Y", url = "https://www.sciencedirect.com/science/article/pii/030440769290104Y", author = "Denis Kwiatkowski and Peter C.B. Phillips and Peter Schmidt and Yongcheol Shin", abstract = "We propose a test of the null hypothesis that an observable series is stationary around a deterministic trend. The series is expressed as the sum of deterministic trend, random walk, and stationary error, and the test is the LM test of the hypothesis that the random walk has zero variance. The asymptotic distribution of the statistic is derived under the null and under the alternative that the series is difference-stationary. Finite sample size and power are considered in a Monte Carlo experiment. The test is applied to the Nelson-Plosser data, and for many of these series the hypothesis of trend stationarity cannot be rejected." } @article{AHRE:PINC:81, author = {Ahrens, H. and Pincus, R.}, title = {On Two Measures of Unbalancedness in a One-Way Model and Their Relation to Efficiency}, journal = {Biometrical Journal}, volume = {23}, number = {3}, pages = {227-235}, doi = {10.1002/bimj.4710230302}, url = {https://onlinelibrary.wiley.com/doi/abs/10.1002/bimj.4710230302}, eprint = {https://onlinelibrary.wiley.com/doi/pdf/10.1002/bimj.4710230302}, abstract = {Abstract This paper discusses two measures of unbalancedness in a one-way model and shows that for a given statistical procedure they may serve as measures of efficiency of a design. They also allow to compare for example estimation methods for variance components in designs with a fixed level of unbalancedness.}, year = {1981} } @article{BALT:SONG:JUNG:02, ISSN = {13684221, 1368423X}, OPTURL = {https://www.jstor.org/stable/23114905}, abstract = {This paper considers the unbalanced two-way error component model studied by Wansbeek and Kapteyn (1989). Alternative analysis of variance (ANOVA), minimum norm quadratic unbiased and restricted maximum likelihood (REML) estimation procedures are proposed. The mean squared error performance of these estimators are compared using Monte Carlo experiments. Results show that for the estimates of the variance components, the computationally more demanding maximum likelihood (ML) and minimum variance quadratic unbiased (MIVQUE) estimators are recommended, especially if the unbalanced pattern is severe. However, focusing on the regression coefficient estimates, the simple ANOVA methods perform just as well as the computationally demanding ML and MIVQUE methods and are recommended.}, author = {Badi H. Baltagi and Seuck H. Song and Byoung C. Jung}, journal = {The Econometrics Journal}, number = {2}, pages = {480--493}, publisher = {[Royal Economic Society, Wiley]}, title = {A comparative study of alternative estimators for the unbalanced two-way error component regression model}, volume = {5}, year = {2002} } @misc{GOUL:13, author = "Gould, W.", year = 2013, url = {https://www.stata.com/support/faqs/statistics/intercept-in-fixed-effects-model/}, title = {How can there be an intercept in the fixed-effects model estimated by xtreg, fe?} } @Article{HOEC:07, author={Daniel Hoechle}, title={{Robust standard errors for panel regressions with cross-sectional dependence}}, journal={Stata Journal}, year=2007, volume={7}, number={3}, pages={281-312}, month={September}, keywords={xtscc; robust standard errors; nonparametric covariance estimation}, doi={}, abstract={I present a new Stata program, xtscc, that estimates pooled ordinary least-squares/weighted least-squares regression and fixed-effects (within) regression models with Driscoll and Kraay (Review of Economics and Statistics 80: 549–560) standard errors. By running Monte Carlo simulations, I compare the finite-sample properties of the cross-sectional dependence-consistent Driscoll-Kraay estimator with the properties of other, more commonly used covariance matrix estimators that do not account for cross-sectional dependence. The results indicate that Driscol-Kraay standard errors are well calibrated when cross-sectional dependence is present. However, erroneously ignoring cross-sectional correlation in the estimation of panel models can lead to severely biased statistical results. I illustrate the xtscc program by considering an application from empirical finance. Thereby, I also propose a Hausman-type test for fixed effects that is robust to general forms of cross-sectional and temporal dependence. Copyright 2007 by StataCorp LP.}, url={https://ideas.repec.org/a/tsj/stataj/v7y2007i3p281-312.html} } @manual{THER:14, author={Terry Therneau}, title={\pkg{bdsmatrix}: Routines for Block Diagonal Symmetric matrices}, year={2014}, note={\proglang{R} package version 1.3-2}, url={https://CRAN.R-project.org/package=bdsmatrix} } @Article{COTT:2017, author = {Cottrell, A.}, title = {Random effects estimators for unbalanced panel data: a Monte Carlo analysis}, journal = {gretl working papers}, year = {2017}, number = {4}, url = {https://EconPapers.repec.org/RePEc:anc:wgretl:4} } @article{CHOI:01, title = "Unit root tests for panel data", journal = "Journal of International Money and Finance", volume = "20", number = "2", pages = "249 - 272", year = "2001", issn = "0261-5606", OPTdoi = "https://doi.org/10.1016/S0261-5606(00)00048-6", url = "https://www.sciencedirect.com/science/article/pii/S0261560600000486", author = "In Choi", keywords = "Unit root test, Panel data, Meta-analysis, Purchasing power parity", abstract = "This paper develops unit root tests for panel data. These tests are devised under more general assumptions than the tests previously proposed. First, the number of groups in the panel data is assumed to be either finite or infinite. Second, each group is assumed to have different types of nonstochastic and stochastic components. Third, the time series spans for the groups are assumed to be all different. Fourth, the alternative where some groups have a unit root and others do not can be dealt with by the tests. The tests can also be used for the null of stationarity and for cointegration, once relevant changes are made in the model, hypotheses, assumptions and underlying tests. The main idea for our unit root tests is to combine p-values from a unit root test applied to each group in the panel data. Combining p-values to formulate tests is a common practice in meta-analysis. This paper also reports the finite sample performance of our combination unit root tests and Im et al.'s [Mimeo (1995)] t-bar test. The results show that most of the combination tests are more powerful than the t-bar test in finite samples. Application of the combination unit root tests to the post-Bretton Woods US real exchange rate data provides some evidence in favor of the PPP hypothesis." } @article{HADR:00, ISSN = {13684221, 1368423X}, OPTURL = {https://www.jstor.org/stable/23114886}, abstract = {This paper proposes a residual-based Lagrange multiplier (LM) test for a null that the individual observed series are stationary around a deterministic level or around a deterministic trend against the alternative of a unit root in panel data. The tests which are asymptotically similar under the null, belong to the locally best invariant (LBI) test statistics. The asymptotic distributions of the statistics are derived under the null and are shown to be normally distributed. Finite sample sizes and powers are considered in a Monte Carlo experiment. The empirical sizes of the tests are close to the true size even in small samples. The testing procedure is easy to apply, including, to panel data models with fixed effects, individual deterministic trends and heterogeneous errors across cross-sections. It is also shown how to apply the tests to the more general case of serially correlated disturbance terms.}, author = {Kaddour Hadri}, journal = {The Econometrics Journal}, number = {2}, pages = {148--161}, publisher = {[Royal Economic Society, Wiley]}, title = {Testing for stationarity in heterogeneous panel data}, volume = {3}, year = {2000} } @book{CROI:MILL:18, title = {Panel Data Econometrics with R}, author={Croissant, Yves and Millo, Giovanni}, publisher={John Wiley and Sons ltd}, year={2018}, edition={1st} } @Article{HANCK:13, author = {Christoph Hanck}, title = {An Intersection Test for Panel Unit Roots}, journal = {Econometric Reviews}, year = {2013}, OPTkey = {}, volume = {32}, OPTnumber = {2}, pages = {183-203}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{SIMES:86, author = {R. J. Simes}, title = {An improved Bonferroni procedure for multiple tests of significance}, journal = {Biometrika}, year = {1986}, OPTkey = {}, volume = {73}, OPTnumber = {3}, pages = {751-754}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @Article{HOMM:88, author = {G. Hommel}, title = {A stage wise rejective multiple test procedure based on a modified Bonferroni test}, journal = {Biometrika}, year = {1988}, OPTkey = {}, volume = {75}, OPTnumber = {2}, pages = {383-386}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } plm/inst/doc/0000755000176200001440000000000014177501551012572 5ustar liggesusersplm/inst/doc/C_plmModelComponents.R0000644000176200001440000000604514177501551017003 0ustar liggesusers## ----setup, echo=FALSE-------------------------------------------------------- library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ## ----------------------------------------------------------------------------- library("plm") data("SeatBelt", package = "pder") SeatBelt$occfat <- with(SeatBelt, log(farsocc / (vmtrural + vmturban))) pSB <- pdata.frame(SeatBelt) ## ----------------------------------------------------------------------------- formols <- occfat ~ log(usage) + log(percapin) mfols <- model.frame(pSB, formols) Xols <- model.matrix(mfols) y <- pmodel.response(mfols) coef(lm.fit(Xols, y)) ## ----------------------------------------------------------------------------- coef(plm(formols, SeatBelt, model = "pooling")) ## ----------------------------------------------------------------------------- formiv1 <- occfat ~ log(usage) + log(percapin) | log(percapin) + ds + dp + dsp formiv2 <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp ## ----------------------------------------------------------------------------- mfSB1 <- model.frame(pSB, formiv1) X1 <- model.matrix(mfSB1, rhs = 1) W1 <- model.matrix(mfSB1, rhs = 2) head(X1, 3) ; head(W1, 3) ## ----------------------------------------------------------------------------- library("Formula") head(model.frame(Formula(formiv2), SeatBelt), 3) head(model.frame(Formula(formiv2), SeatBelt, dot = "previous"), 3) ## ----------------------------------------------------------------------------- mfSB2 <- model.frame(pSB, formiv2) X2 <- model.matrix(mfSB2, rhs = 1) W2 <- model.matrix(mfSB2, rhs = 2) head(X2, 3) ; head(W2, 3) ## ----------------------------------------------------------------------------- HX1 <- lm.fit(W1, X1)$fitted.values head(HX1, 3) ## ----------------------------------------------------------------------------- coef(lm.fit(HX1, y)) ## ----------------------------------------------------------------------------- coef(plm(formiv1, SeatBelt, model = "pooling")) ## ----------------------------------------------------------------------------- coef(AER::ivreg(formiv1, data = SeatBelt)) ## ----eval = FALSE, include = FALSE-------------------------------------------- # X2 <- model.matrix(Formula(form1), mfSB, rhs = 2, dot = "previous") # # formols <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp # # form1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + # log(precentb) + log(precenth) + log(densrur) + log(densurb) + # log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + # log(fueltax) + lim65 + lim70p + mlda21 + bac08 # form2 <- . ~ . | . - log(usage) + ds + dp +dsp # # jorm1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + # log(precentb) + log(precenth) + log(densrur) + log(densurb) + # log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + # log(fueltax) + lim65 + lim70p + mlda21 + bac08 | . - log(usage) + # ds + dp + dsp # jorm2 <- noccfat ~ . | . plm/inst/doc/A_plmPackage.R0000644000176200001440000003135014177501537015227 0ustar liggesusers## ----echo=FALSE,results='hide'------------------------------------------------ options(prompt= "R> ", useFancyQuotes = FALSE, scipen = 999) library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ## ----echo=TRUE, results='hide'------------------------------------------------ library("plm") ## ----------------------------------------------------------------------------- data("EmplUK", package="plm") data("Produc", package="plm") data("Grunfeld", package="plm") data("Wages", package="plm") ## ----setdata1----------------------------------------------------------------- head(Grunfeld) E <- pdata.frame(EmplUK, index=c("firm","year"), drop.index=TRUE, row.names=TRUE) head(E) head(attr(E, "index")) ## ----------------------------------------------------------------------------- summary(E$emp) head(as.matrix(E$emp)) ## ----------------------------------------------------------------------------- head(lag(E$emp, 0:2)) ## ----------------------------------------------------------------------------- head(diff(E$emp), 10) head(lag(E$emp, 2), 10) head(Within(E$emp)) head(between(E$emp), 4) head(Between(E$emp), 10) ## ----results='hide'----------------------------------------------------------- emp ~ wage + capital | lag(wage, 1) + capital emp ~ wage + capital | . -wage + lag(wage, 1) ## ----fe_re-------------------------------------------------------------------- grun.fe <- plm(inv~value+capital, data = Grunfeld, model = "within") grun.re <- plm(inv~value+capital, data = Grunfeld, model = "random") ## ----summary_re--------------------------------------------------------------- summary(grun.re) ranef(grun.re) ## ----------------------------------------------------------------------------- fixef(grun.fe, type = "dmean") ## ----------------------------------------------------------------------------- summary(fixef(grun.fe, type = "dmean")) ## ----------------------------------------------------------------------------- grun.twfe <- plm(inv~value+capital, data=Grunfeld, model="within", effect="twoways") fixef(grun.twfe, effect = "time") ## ----------------------------------------------------------------------------- grun.amem <- plm(inv~value+capital, data=Grunfeld, model="random", random.method="amemiya") ## ----------------------------------------------------------------------------- ercomp(inv~value+capital, data=Grunfeld, method = "amemiya", effect = "twoways") ## ----2RE-amemiya-------------------------------------------------------------- grun.tways <- plm(inv~value+capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "amemiya") summary(grun.tways) ## ----hedonic------------------------------------------------------------------ data("Hedonic", package = "plm") Hed <- plm(mv~crim+zn+indus+chas+nox+rm+age+dis+rad+tax+ptratio+blacks+lstat, data = Hedonic, model = "random", index = "townid") summary(Hed) ## ----hedonic-punbal----------------------------------------------------------- punbalancedness(Hed) ## ----G2SLS-------------------------------------------------------------------- data("Crime", package = "plm") cr <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random") summary(cr) ## ----hausman-taylor----------------------------------------------------------- ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, model = "random", random.method = "ht", inst.method = "baltagi") summary(ht) ## ----grunfeld.within---------------------------------------------------------- grun.varw <- pvcm(inv~value+capital, data=Grunfeld, model="within") grun.varr <- pvcm(inv~value+capital, data=Grunfeld, model="random") summary(grun.varr) ## ----gmm---------------------------------------------------------------------- emp.gmm <- pgmm(log(emp)~lag(log(emp), 1:2)+lag(log(wage), 0:1)+log(capital)+ lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(emp.gmm) ## ----gmm2--------------------------------------------------------------------- z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) ## ----pggls-------------------------------------------------------------------- zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="pooling") summary(zz) ## ----------------------------------------------------------------------------- zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="within") ## ----------------------------------------------------------------------------- znp <- pvcm(inv ~ value + capital, data = Grunfeld, model = "within") zplm <- plm(inv ~ value + capital, data = Grunfeld, model = "within") pooltest(zplm, znp) ## ----results='hide'----------------------------------------------------------- pooltest(inv ~ value + capital, data = Grunfeld, model = "within") ## ----------------------------------------------------------------------------- g <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") plmtest(g, effect="twoways", type="ghm") ## ----results='hide'----------------------------------------------------------- plmtest(inv~value+capital, data=Grunfeld, effect="twoways", type="ghm") ## ----------------------------------------------------------------------------- gw <- plm(inv ~ value + capital, data=Grunfeld, effect="twoways", model="within") gp <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") pFtest(gw, gp) ## ----results='hide'----------------------------------------------------------- pFtest(inv~value+capital, data=Grunfeld, effect="twoways") ## ----------------------------------------------------------------------------- gw <- plm(inv ~ value + capital, data = Grunfeld, model="within") gr <- plm(inv ~ value + capital, data = Grunfeld, model="random") phtest(gw, gr) ## ----------------------------------------------------------------------------- phtest(inv ~ value + capital, data = Grunfeld, method = "aux", vcov = vcovHC) ## ----wtest-------------------------------------------------------------------- pwtest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ## ----pbsytestJoint------------------------------------------------------------ pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="j") ## ----pbsytestAR--------------------------------------------------------------- pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ## ----pbsytestRE--------------------------------------------------------------- pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="re") ## ----pbltest------------------------------------------------------------------ pbltest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, alternative="onesided") ## ----generalAR---------------------------------------------------------------- pbgtest(grun.fe, order = 2) ## ----pwartest----------------------------------------------------------------- pwartest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ## ----pwfdtest1---------------------------------------------------------------- pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ## ----pwfdtest2---------------------------------------------------------------- pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK, h0="fe") ## ----pcdtest1----------------------------------------------------------------- pcdtest(inv~value+capital, data=Grunfeld) ## ----pcdtest2----------------------------------------------------------------- pcdtest(inv~value+capital, data=Grunfeld, model="within") ## ----levinlin----------------------------------------------------------------- data("HousePricesUS", package = "pder") lprice <- log(pdata.frame(HousePricesUS)$price) (lev <- purtest(lprice, test = "levinlin", lags = 2, exo = "trend")) summary(lev) ### gives details ## ----ips---------------------------------------------------------------------- purtest(lprice, test = "ips", lags = 2, exo = "trend") ## ----phansitest1-------------------------------------------------------------- ### input is numeric (p-values), replicates Hanck (2013), Table 11 (left side) pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050, 0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475) countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France", "Germany","Belgium","U.K.","Brazil","Australia","Netherlands", "Portugal","Canada", "Spain","Denmark","Switzerland","Japan") names(pvals) <- countries h <- phansitest(pvals) print(h) h$rejected # logical indicating the individuals with rejected individual H0 ## ----phansitest2, results='hide'---------------------------------------------- ### input is a (suitable) purtest object / different example y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu") phansitest(obj, alpha = 0.06) # test with significance level set to 6 % ## ----vcovHC1------------------------------------------------------------------ re <- plm(inv~value+capital, data = Grunfeld, model = "random") summary(re, vcov = vcovHC) # gives usual summary output but with robust test statistics library("lmtest") coeftest(re, vcovHC, df = Inf) ## ----vcovHC2, results='hide'-------------------------------------------------- summary(re, vcov = vcovHC(re, method="white2", type="HC3")) coeftest(re, vcovHC(re, method="white2", type="HC3"), df = Inf) ## ----waldtest-vcovHC---------------------------------------------------------- waldtest(re, update(re, . ~ . -capital), vcov=function(x) vcovHC(x, method="white2", type="HC3")) ## ----car-vcovHC--------------------------------------------------------------- library("car") linearHypothesis(re, "2*value=capital", vcov. = vcovHC) ## ----re2---------------------------------------------------------------------- library(nlme) reGLS <- plm(inv~value+capital, data=Grunfeld, model="random") reML <- lme(inv~value+capital, data=Grunfeld, random=~1|firm) coef(reGLS) summary(reML)$coefficients$fixed ## ----vcmrand------------------------------------------------------------------ vcm <- pvcm(inv~value+capital, data=Grunfeld, model="random", effect="time") vcmML <- lme(inv~value+capital, data=Grunfeld, random=~value+capital|year) coef(vcm) summary(vcmML)$coefficients$fixed ## ----vcmfixed----------------------------------------------------------------- vcmf <- pvcm(inv~value+capital, data=Grunfeld, model="within", effect="time") vcmfML <- lmList(inv~value+capital|year, data=Grunfeld) ## ----gglsre------------------------------------------------------------------- sGrunfeld <- Grunfeld[Grunfeld$firm %in% 4:6, ] ggls <- pggls(inv~value+capital, data=sGrunfeld, model="pooling") gglsML <- gls(inv~value+capital, data=sGrunfeld, correlation=corSymm(form=~1|year)) coef(ggls) summary(gglsML)$coefficients ## ----lmAR1-------------------------------------------------------------------- Grunfeld$year <- as.numeric(as.character(Grunfeld$year)) lmAR1ML <- gls(inv~value+capital,data=Grunfeld, correlation=corAR1(0,form=~year|firm)) ## ----reAR1-------------------------------------------------------------------- reAR1ML <- lme(inv~value+capital, data=Grunfeld,random=~1|firm, correlation=corAR1(0,form=~year|firm)) ## ----fetchcoefs--------------------------------------------------------------- summary(reAR1ML)$coefficients$fixed coef(reAR1ML$modelStruct$corStruct, unconstrained=FALSE) ## ----LRar--------------------------------------------------------------------- lmML <- gls(inv~value+capital, data=Grunfeld) anova(lmML, lmAR1ML) ## ----LRarsubRE---------------------------------------------------------------- anova(reML, reAR1ML) ## ----LRre--------------------------------------------------------------------- anova(lmML, reML) ## ----LRresubAR---------------------------------------------------------------- anova(lmAR1ML, reAR1ML) plm/inst/doc/A_plmPackage.Rmd0000644000176200001440000032454614162650253015556 0ustar liggesusers--- output: rmarkdown::html_vignette bibliography: ../inst/REFERENCES.bib abstract: | This introduction to the `plm` package is a modified and extended version of @Croissant:Millo:2008, published in the *Journal of Statistical Software*. Panel data econometrics is obviously one of the main fields in the statistics profession, but most of the models used are difficult to estimate with only plain `R`. `plm` is a package for `R` which intends to make the estimation of linear panel models straightforward. `plm` provides functions to estimate a wide variety of models and to make (robust) inference. title: 'Panel data econometrics in R:' subtitle: 'the plm package' author: - name: Yves Croissant - name: Giovanni Millo vignette: > %\VignetteIndexEntry{Panel data econometrics in R: the plm package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction Panel data econometrics is a continuously developing field. The increasing availability of data observed on cross-sections of units (like households, firms, countries etc.) *and* over time has given rise to a number of estimation approaches exploiting this double dimensionality to cope with some of the typical problems associated with economic data, first of all that of unobserved heterogeneity. Timewise observation of data from different observational units has long been common in other fields of statistics (where they are often termed *longitudinal* data). In the panel data field as well as in others, the econometric approach is nevertheless peculiar with respect to experimental contexts, as it is emphasizing model specification and testing and tackling a number of issues arising from the particular statistical problems associated with economic data. Thus, while a very comprehensive software framework for (among many other features) maximum likelihood estimation of linear regression models for longitudinal data, packages `nlme` [@PINH:BATE:DEBR:SARK:07] and `lme4` [@BATE:07], is available in the `R` (@R:2008) environment and can be used, e.g., for estimation of random effects panel models, its use is not intuitive for a practicing econometrician, and maximum likelihood estimation is only one of the possible approaches to panel data econometrics. Moreover, economic panel data sets often happen to be *unbalanced* (i.e., they have a different number of observations between groups), which case needs some adaptation to the methods and is not compatible with those in `nlme`. Hence the need for a package doing panel data "from the econometrician's viewpoint" and featuring at a minimum the basic techniques econometricians are used to: random and fixed effects estimation of static linear panel data models, variable coefficients models, generalized method of moments estimation of dynamic models; and the basic toolbox of specification and misspecification diagnostics. Furthermore, we felt there was a need for automation of some basic data management tasks such as lagging, summing and, more in general, `apply`ing (in the `R` sense) functions to the data, which, although conceptually simple, become cumbersome and error-prone on two-dimensional data, especially in the case of unbalanced panels. This paper is organized as follows: Section [linear panel model](#linear-panel-model) presents a very short overview of the typical model taxonomy^[Comprehensive treatments are to be found in many econometrics textbooks, e.g., @BALT:05, @BALT:13, @BALT:21 or @WOOL:02, @WOOL:10: the reader is referred to these, especially to the first 9 chapters of @BALT:05, @BALT:13, @BALT:21.]. Section [software approach](#software-approach) discusses the software approach used in the package. The next three sections present the functionalities of the package in more detail: data management (Section [managing data and formulae](#managing-data-and-formulae)), estimation (Section [model estimation](#model-estimation)) and testing (Section [tests](#tests)), giving a short description and illustrating them with examples. Section [plm vs nlme and lme4](#nlme) compares the approach in `plm` to that of `nlme` and `lme4`, highlighting the features of the latter two that an econometrician might find most useful. Section [conclusion](#conclusions) concludes the paper. # The linear panel model{#linear-panel-model} The basic linear panel models used in econometrics can be described through suitable restrictions of the following general model: \begin{equation*} y_{it}=\alpha_{it} + \beta_{it}^\top x_{it} + u_{it} \end{equation*} where $i=1, ..., n$ is the individual (group, country ...) index, $t=1, ..., T$ is the time index and $u_{it}$ a random disturbance term of mean $0$. Of course $u_{it}$ is not estimable with $N = n \times T$ data points. A number of assumptions are usually made about the parameters, the errors and the exogeneity of the regressors, giving rise to a taxonomy of feasible models for panel data. The most common one is parameter homogeneity, which means that $\alpha_{it}=\alpha$ for all $i,t$ and $\beta_{it}=\beta$ for all $i,t$. The resulting model \begin{equation*} y_{it}=\alpha + \beta^\top x_{it} + u_{it} \end{equation*} is a standard linear model pooling all the data across $i$ and $t$. To model individual heterogeneity, one often assumes that the error term has two separate components, one of which is specific to the individual and doesn't change over time^[For the sake of exposition we are considering only the individual effects case here. There may also be time effects, which is a symmetric case, or both of them, so that the error has three components: $u_{it}=\mu_{i}+\lambda_{t}+\epsilon_{it}$.]. This is called the unobserved effects model: \begin{equation} (\#eq:errcomp) y_{it}=\alpha + \beta^\top x_{it} + \mu_i + \epsilon_{it} \end{equation} The appropriate estimation method for this model depends on the properties of the two error components. The idiosyncratic error $\epsilon_{it}$ is usually assumed well-behaved and independent of both the regressors $x_{it}$ and the individual error component $\mu_i$. The individual component may be in turn either independent of the regressors or correlated. If it is correlated, the ordinary least squares (OLS) estimator of $\beta$ would be inconsistent, so it is customary to treat the $\mu_i$ as a further set of $n$ parameters to be estimated, as if in the general model $\alpha_{it}=\alpha_{i}$ for all $t$. This is called the fixed effects (a.k.a. *within* or *least squares dummy variables*) model, usually estimated by OLS on transformed data, and gives consistent estimates for $\beta$. If the individual-specific component $\mu_i$ is uncorrelated with the regressors, a situation which is usually termed *random effects*, the overall error $u_{it}$ also is, so the OLS estimator is consistent. Nevertheless, the common error component over individuals induces correlation across the composite error terms, making OLS estimation inefficient, so one has to resort to some form of feasible generalized least squares (GLS) estimators. This is based on the estimation of the variance of the two error components, for which there are a number of different procedures available. If the individual component is missing altogether, pooled OLS is the most efficient estimator for $\beta$. This set of assumptions is usually labelled *pooling* model, although this actually refers to the errors' properties and the appropriate estimation method rather than the model itself. If one relaxes the usual hypotheses of well-behaved, white noise errors and allows for the idiosyncratic error $\epsilon_{it}$ to be arbitrarily heteroskedastic and serially correlated over time, a more general kind of feasible GLS is needed, called the *unrestricted* or *general* GLS. This specification can also be augmented with individual-specific error components possibly correlated with the regressors, in which case it is termed *fixed effects* GLS. Another way of estimating unobserved effects models through removing time-invariant individual components is by first-differencing the data: lagging the model and subtracting, the time-invariant components (the intercept and the individual error component) are eliminated, and the model \begin{equation*} \Delta y_{it}= \beta^\top \Delta x_{it} + \Delta u_{it} \end{equation*} (where $\Delta y_{it}=y_{it}-y_{i,t-1}$, $\Delta x_{it}=x_{it}-x_{i,t-1}$ and, from \@ref(eq:errcomp), $\Delta u_{it}=u_{it}-u_{i,t-1}=\Delta \epsilon_{it}$ for $t=2,...,T$) can be consistently estimated by pooled OLS. This is called the *first-difference* or FD estimator. Its relative efficiency, and so reasons for choosing it against other consistent alternatives, depends on the properties of the error term. The FD estimator is usually preferred if the errors $u_{it}$ are strongly persistent in time, because then the $\Delta u_{it}$ will tend to be serially uncorrelated. Lastly, the *between* model, which is computed on time (group) averages of the data, discards all the information due to intragroup variability but is consistent in some settings (e.g., non-stationarity) where the others are not, and is often preferred to estimate long-run relationships. Variable coefficients models relax the assumption that $\beta_{it}=\beta$ for all $i,t$. Fixed coefficients models allow the coefficients to vary along one dimension, like $\beta_{it}=\beta_i$ for all $t$. Random coefficients models instead assume that coefficients vary randomly around a common average, as $\beta_{it}=\beta+\eta_{i}$ for all $t$, where $\eta_{i}$ is a group-- (time--) specific effect with mean zero. The hypotheses on parameters and error terms (and hence the choice of the most appropriate estimator) are usually tested by means of: - *pooling* tests to check poolability, i.e., the hypothesis that the same coefficients apply across all individuals, - if the homogeneity assumption over the coefficients is established, the next step is to establish the presence of unobserved effects, comparing the null of spherical residuals with the alternative of group (time) specific effects in the error term, - the choice between fixed and random effects specifications is based on Hausman-type tests, comparing the two estimators under the null of no significant difference: if this is not rejected, the more efficient random effects estimator is chosen, - even after this step, departures of the error structure from sphericity can further affect inference, so that either screening tests or robust diagnostics are needed. Dynamic models and in general lack of strict exogeneity of the regressors, pose further problems to estimation which are usually dealt with in the generalized method of moments (GMM) framework. These were, in our opinion, the basic requirements of a panel data econometrics package for the `R` language and environment. Some, as often happens with `R`, were already fulfilled by packages developed for other branches of computational statistics, while others (like the fixed effects or the between estimators) were straightforward to compute after transforming the data, but in every case there were either language inconsistencies w.r.t. the standard econometric toolbox or subtleties to be dealt with (like, for example, appropriate computation of standard errors for the demeaned model, a common pitfall), so we felt there was need for an "all in one" econometrics-oriented package allowing to make specification searches, estimation and inference in a natural way. # Software approach{#software-approach} ## Data structure Panel data have a special structure: each row of the data corresponds to a specific individual and time period. In `plm` the `data` argument may be an ordinary `data.frame` but, in this case, an argument called `index` has to be added to indicate the structure of the data. This can be: - `NULL` (the default value), it is then assumed that the first two columns contain the individual and the time index and that observations are ordered by individual and by time period, - a character string, which should be the name of the individual index, - a character vector of length two containing the names of the individual and the time index, - an integer which is the number of individuals (only in case of a balanced panel with observations ordered by individual). The `pdata.frame` function is then called internally, which returns a `pdata.frame` which is a `data.frame` with an attribute called index. This attribute is a `data.frame` that contains the individual and the time indexes. It is also possible to use directly the `pdata.frame` function and then to use the `pdata.frame` in the estimation functions. ## Interface ### Estimation interface Package `plm` provides various functions for panel data estimation, among them: - `plm`: estimation of the basic panel models and instrumental variable panel models, *i.e.*, between and first-difference models and within and random effect models. Models are estimated internally using the `lm` function on transformed data, - `pvcm`: estimation of models with variable coefficients, - `pgmm`: estimation of generalized method of moments models, - `pggls`: estimation of general feasible generalized least squares models, - `pmg`: estimators for mean groups (MG), demeaned MG (DMG) and common correlated effects MG (CCEMG) for heterogeneous panel models, - `pcce`: estimators for common correlated effects mean groups (CCEMG) and pooled (CCEP) for panel data with common factors, - `pldv`: panel estimators for limited dependent variables. The interface of these functions is consistent with the `lm()` function. Namely, their first two arguments are `formula` and `data` (which should be a `data.frame` and is mandatory). Three additional arguments are common to these functions: - `index`: this argument enables the estimation functions to identify the structure of the data, *i.e.*, the individual and the time period for each observation, - `effect`: the kind of effects to include in the model, *i.e.*, individual effects, time effects or both^[Although in most models the individual and time effects cases are symmetric, there are exceptions: estimating the *first-difference* model on time effects is meaningless because cross-sections do not generally have a natural ordering, so trying `effect = "time"` stops with an error message as does `effect = "twoways"` which is not defined for first-difference models.], - `model`: the kind of model to be estimated, most of the time a model with fixed effects or a model with random effects. The results of these four functions are stored in an object which class has the same name of the function. They all inherit from class `panelmodel`. A `panelmodel` object contains: `coefficients`, `residuals`, `fitted.values`, `vcov`, `df.residual` and `call` and functions that extract these elements are provided. ### Testing interface The diagnostic testing interface provides both `formula` and `panelmodel` methods for most functions, with some exceptions. The user may thus choose whether to employ results stored in a previously estimated `panelmodel` object or to re-estimate it for the sake of testing. Although the first strategy is the most efficient one, diagnostic testing on panel models mostly employs OLS residuals from pooling model objects, whose estimation is computationally inexpensive. Therefore most examples in the following are based on `formula` methods, which are perhaps the cleanest for illustrative purposes. ## Computational approach to estimation The feasible GLS methods needed for efficient estimation of unobserved effects models have a simple closed-form solution: once the variance components have been estimated and hence the covariance matrix of errors $\hat{V}$, model parameters can be estimated as \begin{equation} (\#eq:naive) \hat{\beta}=(X^\top \hat{V}^{-1} X)^{-1} (X^\top \hat{V}^{-1} y) \end{equation} Nevertheless, in practice plain computation of $\hat{\beta}$ has long been an intractable problem even for moderate-sized data sets because of the need to invert the $N\times N$ $\hat{V}$ matrix. With the advances in computer power, this is no more so, and it is possible to program the "naive" estimator \@ref(eq:naive) in `R` with standard matrix algebra operators and have it working seamlessly for the standard "guinea pigs", e.g., the Grunfeld data. Estimation with a couple of thousands of data points also becomes feasible on a modern machine, although excruciatingly slow and definitely not suitable for everyday econometric practice. Memory limits would also be very near because of the storage needs related to the huge $\hat{V}$ matrix. An established solution exists for the random effects model which reduces the problem to an ordinary least squares computation. ### The (quasi--)demeaning framework The estimation methods for the basic models in panel data econometrics, the pooled OLS, random effects and fixed effects (or within) models, can all be described inside the OLS estimation framework. In fact, while pooled OLS simply pools data, the standard way of estimating fixed effects models with, say, group (time) effects entails transforming the data by subtracting the average over time (group) to every variable, which is usually termed *time-demeaning*. In the random effects case, the various feasible GLS estimators which have been put forth to tackle the issue of serial correlation induced by the group-invariant random effect have been proven to be equivalent (as far as estimation of $\beta$s is concerned) to OLS on *partially demeaned* data, where partial demeaning is defined as: \begin{equation} (\#eq:ldemmodel) y_{it} - \theta \bar{y}_i = ( X_{it} - \theta \bar{X}_{i} ) \beta + ( u_{it} - \theta \bar{u}_i ) \end{equation} where $\theta=1-[\sigma_u^2 / (\sigma_u^2 + T \sigma_e^2)]^{1/2}$, $\bar{y}$ and $\bar{X}$ denote time means of $y$ and $X$, and the disturbance $v_{it} - \theta \bar{v}_i$ is homoskedastic and serially uncorrelated. Thus the feasible RE estimate for $\beta$ may be obtained estimating $\hat{\theta}$ and running an OLS regression on the transformed data with `lm()`. The other estimators can be computed as special cases: for $\theta=1$ one gets the fixed effects estimator, for $\theta=0$ the pooled OLS one. Moreover, instrumental variable estimators of all these models may also be obtained using several calls to `lm()`. For this reason the three above estimators have been grouped inside the same function. On the output side, a number of diagnostics and a very general coefficients' covariance matrix estimator also benefits from this framework, as they can be readily calculated applying the standard OLS formulas to the demeaned data, which are contained inside `plm` objects. This will be the subject of subsection [inference in the panel model](#inference). ### The object oriented approach to general GLS computations The covariance matrix of errors in general GLS models is too generic to fit the quasi-demeaning framework, so this method calls for a full-blown application of GLS as in \@ref(eq:naive). On the other hand, this estimator relies heavily on $n$--asymptotics, making it theoretically most suitable for situations which forbid it computationally: e.g., "short" micropanels with thousands of individuals observed over few time periods. `R` has general facilities for fast matrix computation based on object orientation: particular types of matrices (symmetric, sparse, dense etc.) are assigned the relevant class and the additional information on structure is used in the computations, sometimes with dramatic effects on performance (see @BATE:04) and packages `Matrix` (see @BATE:MAEC:2016) and `SparseM` (see @KOEN:NG:2016). Some optimized linear algebra routines are available in the `R` package `bdsmatrix` (see @THER:14) which exploit the particular block-diagonal and symmetric structure of $\hat{V}$ making it possible to implement a fast and reliable full-matrix solution to problems of any practically relevant size. The $\hat{V}$ matrix is constructed as an object of class `bdsmatrix`. The peculiar properties of this matrix class are used for efficiently storing the object in memory and then by ad-hoc versions of the `solve` and `crossprod` methods, dramatically reducing computing times and memory usage. The resulting matrix is then used "the naive way" as in \@ref(eq:naive) to compute $\hat{\beta}$, resulting in speed comparable to that of the demeaning solution. ## Inference in the panel model{#inference} General frameworks for restrictions and linear hypotheses testing are available in the `R` environment^[See packages `lmtest` (@HOTH:ZEIL:FARE:CUMM:MILL:MITC:2015) and `car` (@FOX:2016).]. These are based on the Wald test, constructed as $\hat{\beta}^\top \hat{V}^{-1} \hat{\beta}$, where $\hat{\beta}$ and $\hat{V}$ are consistent estimates of $\beta$ and $V(\beta)$, The Wald test may be used for zero-restriction (i.e., significance) testing and, more generally, for linear hypotheses in the form $(R \hat{\beta} - r)^\top [R \hat{V} R^\top ]^{-1} (R \hat{\beta} - r)$^[Moreover, `coeftest()` provides a compact way of looking at coefficient estimates and significance diagnostics.]. To be applicable, the test functions require extractor methods for coefficients' and covariance matrix estimates to be defined for the model object to be tested. Model objects in `plm` all have `coef()` and `vcov()` methods and are therefore compatible with the above functions. In the same framework, robust inference is accomplished substituting ("plugging in") a robust estimate of the coefficient covariance matrix into the Wald statistic formula. In the panel context, the estimator of choice is the White system estimator. This called for a flexible method for computing robust coefficient covariance matrices *à la White* for `plm` objects. A general White system estimator for panel data is: \begin{equation*} \hat{V}_R(\beta)=(X^\top X)^{-1} \sum_{i=1}^n{X_i^\top E_i X_i} (X^\top X)^{-1} \end{equation*} where $E_i$ is a function of the residuals $\hat{e}_{it}, \; t=1, \dots T$ chosen according to the relevant heteroskedasticity and correlation structure. Moreover, it turns out that the White covariance matrix calculated on the demeaned model's regressors and residuals (both part of `plm` objects) is a consistent estimator of the relevant model's parameters' covariance matrix, thus the method is readily applicable to models estimated by random or fixed effects, first difference or pooled OLS methods. Different pre-weighting schemes taken from package `sandwich` (see @ZEIL:04; @LUML:ZEIL:2015) are also implemented to improve small-sample performance. Robust estimators with any combination of covariance structures and weighting schemes can be passed on to the testing functions. # Managing data and formulae{#dataformula} The package is now illustrated by application to some well-known examples. It is loaded using ```{r echo=FALSE,results='hide'} options(prompt= "R> ", useFancyQuotes = FALSE, scipen = 999) library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` ```{r echo=TRUE, results='hide'} library("plm") ``` The four data sets used are `EmplUK` which was used by @AREL:BOND:91, the `Grunfeld` data [@KLEI:ZEIL:08] which is used in several econometric books, the `Produc` data used by @MUNN:90 and the `Wages` used by @CORN:RUPE:88. ```{r } data("EmplUK", package="plm") data("Produc", package="plm") data("Grunfeld", package="plm") data("Wages", package="plm") ``` ## Data structure As observed above, the current version of `plm` is capable of working with a regular `data.frame` without any further transformation, provided that the individual and time indexes are in the first two columns, as in all the example data sets but `Wages`. If this weren't the case, an `index` optional argument would have to be passed on to the estimating and testing functions. ```{r setdata1} head(Grunfeld) E <- pdata.frame(EmplUK, index=c("firm","year"), drop.index=TRUE, row.names=TRUE) head(E) head(attr(E, "index")) ``` Two further arguments are logical: `drop.index = TRUE` drops the indexes from the `data.frame` and `row.names = TRUE` computes "fancy" row names by pasting the individual and the time indexes. While extracting a series from a `pdata.frame`, a `pseries` is created, which is the original series with the index attribute. This object has specific methods, like `summary` and `as.matrix`. The former indicates the total variation of the variable and the shares of this variation due to the individual and the time dimensions. The latter gives the matrix representation of the series, with, by default, individuals as rows and times as columns. ```{r } summary(E$emp) head(as.matrix(E$emp)) ``` ## Data transformation Panel data estimation requires to apply different transformations to raw series. If $x$ is a series of length $nT$ (where $n$ is the number of individuals and $T$ is the number of time periods), the transformed series $\tilde{x}$ is obtained as $\tilde{x}=Mx$ where $M$ is a transformation matrix. Denoting $j$ a vector of one of length $T$ and $I_n$ the identity matrix of dimension $n$, we get: - the between transformation: $P=\frac{1}{T}I_n\otimes jj'$ returns a vector containing the individual means. The `Between` and `between` functions perform this operation, the first one returning a vector of length $nT$, the second one a vector of length $n$, - the within transformation: $Q=I_{nT}-P$ returns a vector containing the values in deviation from the individual means. The `Within` function performs this operation. - the first difference transformation $D=I_n \otimes d$ where $d=\left( \begin{array}{ccccccc} 1 & -1 & 0 & 0 & ... & 0 & 0 \\ 0 & 1 & -1 & 0 & ... & 0 & 0 \\ 0 & 0 & 1 & -1 & ... & 0 & 0 \\ \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & 1 & -1 \\ \end{array} \right)$ is of dimension $(T-1,T)$. Note that `R`'s `diff()` and `lag()` functions don't compute correctly these transformations for panel data because they are unable to identify when there is a change in individual in the data. Therefore, specific methods for `pseries` objects have been written in order to handle correctly panel data. Note that compared to the `lag()` method for `ts` objects, the order of lags are indicated by a positive integer. Moreover, 0 is a relevant value and a vector argument may be provided: ```{r } head(lag(E$emp, 0:2)) ``` Further functions called `Between`, `between` and `Within` are also provided to compute the between and the within transformation. The `between` returns unique values, whereas `Between` duplicates the values and returns a vector which length is the number of observations. ```{r } head(diff(E$emp), 10) head(lag(E$emp, 2), 10) head(Within(E$emp)) head(between(E$emp), 4) head(Between(E$emp), 10) ``` ## Formulas In some circumstances, standard `formula`s are not very useful to describe a model, notably while using instrumental variable like estimators: to deal with these situations, we use the `Formula` package. The `Formula` package provides a class which enables to construct multi-part formula, each part being separated by a pipe sign (`|`). The two formulas below are identical: ```{r results='hide'} emp ~ wage + capital | lag(wage, 1) + capital emp ~ wage + capital | . -wage + lag(wage, 1) ``` In the second case, the `.` means the previous parts which describes the covariates and this part is "updated". This is particularly interesting when there are a few external instruments. # Model estimation{#modelestimation} ## Estimation of the basic models with plm Several models can be estimated with `plm` by filling the `model` argument: - the fixed effects model (`"within"`), the default, - the pooling model (`"pooling"`), - the first-difference model (`"fd"`), - the between model (`"between"`), - the error components model (`"random"`). The basic use of `plm` is to indicate the model formula, the data and the model to be estimated. For example, the fixed effects model and the random effects model are estimated using: ```{r fe_re} grun.fe <- plm(inv~value+capital, data = Grunfeld, model = "within") grun.re <- plm(inv~value+capital, data = Grunfeld, model = "random") ``` Methods to display a sumamry of the model estimation are available via `summary`. For example, for a `random` model, the `summary` method gives information about the variance of the components of the errors and some test statistics. Random effects of the estimated model can be extracted via `ranef`. ```{r summary_re} summary(grun.re) ranef(grun.re) ``` The fixed effects of a fixed effects model may be extracted easily using `fixef`. An argument `type` indicates how fixed effects should be computed: in levels by `type = "level"` (the default), in deviations from the overall mean by `type = "dmean"` or in deviations from the first individual by `type = "dfirst"`. ```{r } fixef(grun.fe, type = "dmean") ``` The `fixef` function returns an object of class `fixef`. A summary method is provided, which prints the effects (in deviation from the overall intercept), their standard errors and the test of equality to the overall intercept. ```{r } summary(fixef(grun.fe, type = "dmean")) ``` In case of a two-ways fixed effect model, argument `effect` is relevant in function `fixef` to extract specific effect fixed effects with possible values `"individual"` for individual fixed effects (default for two-ways fixed effect models), `"time"` for time fixed effects, and `"twoways"` for the sum of individual and time fixed effects. Example to extract the time fixed effects from a two-ways model: ```{r } grun.twfe <- plm(inv~value+capital, data=Grunfeld, model="within", effect="twoways") fixef(grun.twfe, effect = "time") ``` ## More advanced use of plm ### Random effects estimators As observed above, the random effect model is obtained as a linear estimation on quasi-demeaned data. The parameter of this transformation is obtained using preliminary estimations. Four estimators of this parameter are available, depending on the value of the argument `random.method`: - `"swar"`: from @SWAM:AROR:72, the default value, - `"walhus"`: from @WALL:HUSS:69, - `"amemiya"`: from @AMEM:71, - `"nerlove"`: from @NERLO:71. - `"ht"`: for Hausman-Taylor-type instrumental variable (IV) estimation, discussed later, see Section [Instrumental variable estimator](#instrumental-variable-est). For example, to use the `amemiya` estimator: ```{r } grun.amem <- plm(inv~value+capital, data=Grunfeld, model="random", random.method="amemiya") ``` The estimation of the variance of the error components are performed using the `ercomp` function, which has a `method` and an `effect` argument, and can be used by itself: ```{r } ercomp(inv~value+capital, data=Grunfeld, method = "amemiya", effect = "twoways") ``` ### Introducing time or two-ways effects The default behavior of `plm` is to introduce individual effects. Using the `effect` argument, one may also introduce: - time effects (`effect = "time"`), - individual and time effects (`effect = "twoways"`). For example, to estimate a two-ways effect model for the `Grunfeld` data: ```{r 2RE-amemiya} grun.tways <- plm(inv~value+capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "amemiya") summary(grun.tways) ``` In the "effects" section of the printed summary of the result, the variance of the three elements of the error term and the three parameters used in the transformation are printed. ### Unbalanced panels Estimations by `plm` support unbalanced panel models. The following example is using data used by @HARR:RUBI:78 to estimate an hedonic housing prices function. It is reproduced in @BALT:CHAN:94, table 2 (and in @BALT:05, pp. 172/4; @BALT:13, pp. 195/7 tables 9.1/3). ```{r hedonic} data("Hedonic", package = "plm") Hed <- plm(mv~crim+zn+indus+chas+nox+rm+age+dis+rad+tax+ptratio+blacks+lstat, data = Hedonic, model = "random", index = "townid") summary(Hed) ``` Measures for the unbalancedness of a panel data set or the data used in estimated models are provided by function `punbalancedness`. It gives the measures $\gamma$ and $\nu$ from @AHRE:PINC:81 where for both 1 represents balanced data and the more unbalanced the data the lower the value. ```{r hedonic-punbal} punbalancedness(Hed) ``` ### Instrumental variable estimators{#instrumental-variable-est} All of the models presented above may be estimated using instrumental variables. The instruments are specified at the end of the formula after a `|` sign (pipe). The instrumental variables estimator used is indicated with the `inst.method` argument: - `"bvk"`, from @BALE:VARA:87, the default value, - `"baltagi"`, from @BALT:81, - `"am"`, from @AMEM:MACU:86, - `"bms"`, from @BREU:MIZO:SCHM:89. An illustration is in the following example from @BALT:05, p. 120; @BALT:13, p. 137; @BALT:21, p. 165, table 7.3 ("G2SLS"). ```{r G2SLS} data("Crime", package = "plm") cr <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random") summary(cr) ``` The Hausman-Taylor model (see @HAUS:TAYL:81) may be estimated with the `plm`^[Function `pht` is a deprecated way to estimate this type of model: `ht <- pht(lwage~wks+south+smsa+married+exp+I(exp^2)+ bluecol+ind+union+sex+black+ed | sex+black+bluecol+south+smsa+ind, data=Wages,index=595)`.] function by setting parameters `random.method = "ht"` and `inst.method = "baltagi"` like in the example below. The following replicates @BALT:05, pp. 129/30; @BALT:13, pp. 145/6, tables 7.4/5; @BALT:21, pp. 174/5 tables 7.5/6: ```{r hausman-taylor} ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), data = Wages, index = 595, model = "random", random.method = "ht", inst.method = "baltagi") summary(ht) ``` ## Variable coefficients model The `pvcm` function enables the estimation of variable coefficients models. Time or individual effects are introduced if argument `effect` is fixed to `"time"` or `"individual"` (the default value). Coefficients are assumed to be fixed if `model="within"` or random if `model="random"`. In the first case, a different model is estimated for each individual (or time period). In the second case, the Swamy model (see @SWAM:70) model is estimated. It is a generalized least squares model which uses the results of the previous model. Denoting $\hat{\beta}_i$ the vectors of coefficients obtained for each individual, we get: \begin{equation*} \hat{\beta}=\left(\sum_{i=1}^n \left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\right)\left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\hat{\beta}_i \end{equation*} where $\hat{\sigma}_i^2$ is the unbiased estimator of the variance of the errors for individual $i$ obtained from the preliminary estimation and: \begin{equation*} \hat{\Delta}=\frac{1}{n-1}\sum_{i=1}^n\left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right) \left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right)^\top -\frac{1}{n}\sum_{i=1}^n\hat{\sigma}_i^2(X_i^\top X_i)^{-1} \end{equation*} If this matrix is not positive-definite, the second term is dropped. With the `Grunfeld` data, we get: ```{r grunfeld.within} grun.varw <- pvcm(inv~value+capital, data=Grunfeld, model="within") grun.varr <- pvcm(inv~value+capital, data=Grunfeld, model="random") summary(grun.varr) ``` ## Generalized method of moments estimator The generalized method of moments is mainly used in panel data econometrics to estimate dynamic models [@AREL:BOND:91; @HOLT:NEWE:ROSE:88]. \begin{equation*} y_{it}=\rho y_{it-1}+\beta^\top x_{it}+\mu_i+\epsilon_{it} \end{equation*} The model is first differenced to get rid of the individual effect: \begin{equation*} \Delta y_{it}=\rho \Delta y_{it-1}+\beta^\top \Delta x_{it}+\Delta \epsilon_{it} \end{equation*} Least squares are inconsistent because $\Delta \epsilon_{it}$ is correlated with $\Delta y_{it-1}$. $y_{it-2}$ is a valid, but weak instrument (see @ANDE:HSIA:81). The GMM estimator uses the fact that the number of valid instruments is growing with $t$: - $t=3$: $y_1$, - $t=4$: $y_1,y_2$, - $t=5$: $y_1,y_2,y_3$. For individual $i$, the matrix of instruments is then: \begin{equation*} W_i=\left( \begin{array}{ccccccccccccc} y_1 & 0 & 0 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i3} \\ 0 & y_1 & y_2 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i4} \\ 0 & 0 & 0 & y_1 & y_2 & y_3 & ... & 0 & 0 & 0 & 0 & x_{i5} \\ \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & ... & ... & y_1 & y_2 & ... & y_{t-2} & x_{iT-2} &\\ \end{array} \right) \end{equation*} The moment conditions are: $\sum_{i=1}^n W_i^\top e_i(\beta)$ where $e_i(\beta)$ is the vector of residuals for individual $i$. The GMM estimator minimizes: \begin{equation*} \left(\sum_{i=1}^n e_i(\beta)^\top W_i\right) A \left(\sum_{i=1}^n W_i^\top e_i(\beta)\right) \end{equation*} where $A$ is the weighting matrix of the moments. One-step estimators are computed using a known weighting matrix. For the model in first differences, one uses: \begin{equation*} A^{(1)}=\left(\sum_{i=1}^n W_i^\top H^{(1)}W_i\right)^{-1} \end{equation*} with: \begin{equation*} H^{(1)}=d^\top d=\left( \begin{array}{ccccc} 2 & -1 & 0 & ... & 0\\ -1 & 2 & -1 & ... & 0\\ 0 & -1 & 2 & ... & 0\\ \vdots & \vdots & \vdots & \vdots & \vdots \\ 0 & 0 & 0 & -1 & 2\\ \end{array} \right) \end{equation*} Two-steps estimators are obtained using $H^{(2)}_i=\sum_{i=1}^n e^{(1)}_i e^{(1)\top }_i$ where $e_i^{(1)}$ are the residuals of the one step estimate. @BLUN:BOND:98 show that with weak hypothesis on the data generating process, supplementary moment conditions exist for the equation in level: $$ y_{it} = \gamma y_{it-1}+\mu_i+\eta_{it} $$ More precisely, they show that $\Delta y_{it-2}=y_{it-2}-y_{it-3}$ is a valid instrument. The estimator is obtained using the residual vector in difference and in level: $$ e^+_i=(\Delta e_i, e_i) $$ and the matrix of augmented moments: $$ Z_i^+=\left( \begin{array}{ccccc} Z_i & 0 & 0 & ... & 0 \\ 0 & \Delta y_{i2} & 0 & ... & 0 \\ 0 & 0 & \Delta y_{i3} & ... & 0 \\ 0 & 0 & 0 & ... & \Delta y_{iT-1} \end{array} \right) $$ The moment conditions are then \begin{eqnarray*} \left(\sum_{i=1}^n Z_i^{+\top} \left(\begin{array}{c}\bar{e}_i(\beta)\\ e_i(\beta)\end{array}\right)\right)^\top = \left(\sum_{i=1}^n y_{i1} \bar{e}_{i3},\sum_{i=1}^n y_{i1}\bar{e}_{i4},\sum_{i=1}^n y_{i2}\bar{e}_{i4}, ..., \right.\\ \left. \sum_{i=1}^n y_{i1} \bar{e}_{iT}, \sum_{i=1}^n y_{i2} \bar{e}_{iT}, ...,\sum_{i=1}^n y_{iT-2} \bar{e}_{iT}, \sum_{i=1}^n \sum_{t=3}^T x_{it} \bar{e}_{it}\right.\\ \left.\sum_{i=1}^n e_{i3} \Delta y_{i2}, \sum_{i=1}^n e_{i4} \Delta y_{i3}, ... , \sum_{i=1}^n e_{iT} \Delta y_{iT-1} \right)^\top \end{eqnarray*} The GMM estimator is provided by the `pgmm` function. By using a multi-part formula, the variables of the model and the lag structure are described. In a GMM estimation, there are "normal instruments" and "GMM instruments". GMM instruments are indicated in the second part of the formula. By default, all the variables of the model that are not used as GMM instruments are used as normal instruments, with the same lag structure; "normal" instruments may also be indicated in the third part of the formula. The `effect` argument is either `NULL`, `"individual"` (the default), or `"twoways"`. In the first case, the model is estimated in levels. In the second case, the model is estimated in first differences to get rid of the individuals effects. In the last case, the model is estimated in first differences and time dummies are included. The `model` argument specifies whether a one-step or a two-steps model is requested (`"onestep"` or `"twosteps"`). The following example is from @AREL:BOND:91. Employment is explained by past values of employment (two lags), current and first lag of wages and output and current value of capital. ```{r gmm} emp.gmm <- pgmm(log(emp)~lag(log(emp), 1:2)+lag(log(wage), 0:1)+log(capital)+ lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(emp.gmm) ``` The following example is from @BLUN:BOND:98. The "sys" estimator is obtained using `transformation = "ld"` for level and difference. The `robust` argument of the `summary` method enables to use the robust covariance matrix proposed by @WIND:05. For all pgmm models, `robust = TRUE` is the default (but set in this example explicitly). ```{r gmm2} z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) ``` ## General FGLS models General FGLS estimators are based on a two-step estimation process: first an OLS model is estimated, then its residuals $\hat{u}_{it}$ are used to estimate an error covariance matrix more general than the random effects one for use in a feasible-GLS analysis. Formally, the estimated error covariance matrix is $\hat{V}=I_n \otimes \hat{\Omega}$, with $$\hat{\Omega}=\sum_{i=1}^n \frac{\hat{u}_{it} \hat{u}_{it}^\top }{n} $$ (see @WOOL:02 10.4.3 and 10.5.5). This framework allows the error covariance structure inside every group (if `effect = "individual"`) of observations to be fully unrestricted and is therefore robust against any type of intragroup heteroskedasticity and serial correlation. This structure, by converse, is assumed identical across groups and thus general FGLS is inefficient under groupwise heteroskedasticity. Cross-sectional correlation is excluded a priori. Moreover, the number of variance parameters to be estimated with $N=n\times T$ data points is $T(T+1)/2$, which makes these estimators particularly suited for situations where $n>>T$, as e.g., in labour or household income surveys, while problematic for "long" panels, where $\hat{V}$ tends to become singular and standard errors therefore become biased downwards. In a pooled time series context (`effect = "time"`), symmetrically, this estimator is able to account for arbitrary cross-sectional correlation, provided that the latter is time-invariant (see @GREE:03 13.9.1--2, pp. 321--2). In this case serial correlation has to be assumed away and the estimator is consistent with respect to the time dimension, keeping $n$ fixed. The function `pggls` estimates general FGLS models, with either fixed or "random" effects^[The "random effect" is better termed "general FGLS" model, as in fact it does not have a proper random effects structure, but we keep this terminology for general language consistency.]. The "random effect" general FGLS is estimated by: ```{r pggls} zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="pooling") summary(zz) ``` The fixed effects `pggls` (see @WOOL:02, p. 276) is based on the estimation of a within model in the first step; the rest follows as above. It is estimated by: ```{r } zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="within") ``` The `pggls` function is similar to `plm` in many respects. An exception is that the estimate of the group covariance matrix of errors (`zz$sigma`, a matrix, not shown) is reported in the model objects instead of the usual estimated variances of the two error components. # Tests{#tests} As sketched in Section [linear panel model](#linear-panel-model), specification testing in panel models involves essentially testing for poolability, for individual or time unobserved effects and for correlation between these latter and the regressors (Hausman-type tests). As for the other usual diagnostic checks, we provide a suite of serial correlation tests, while not touching on the issue of heteroskedasticity testing. Instead, we provide heteroskedasticity-robust covariance estimators, to be described in subsection [robust covariance matrix estimation](#robust). ## Tests of poolability `pooltest` tests the hypothesis that the same coefficients apply to each individual. It is a standard F test, based on the comparison of a model obtained for the full sample and a model based on the estimation of an equation for each individual. The first argument of `pooltest` is a `plm` object. The second argument is a `pvcm` object obtained with `model="within"`. If the first argument is a pooling model, the test applies to all the coefficients (including the intercepts), if it is a within model, different intercepts are assumed. To test the hypothesis that all the coefficients in the `Grunfeld` example, excluding the intercepts, are equal, we use : ```{r } znp <- pvcm(inv ~ value + capital, data = Grunfeld, model = "within") zplm <- plm(inv ~ value + capital, data = Grunfeld, model = "within") pooltest(zplm, znp) ``` The same test can be computed using a formula as first argument of the `pooltest` function: ```{r results='hide'} pooltest(inv ~ value + capital, data = Grunfeld, model = "within") ``` ## Tests for individual and time effects `plmtest` implements Lagrange multiplier tests of individual or/and time effects based on the results of the pooling model. Its main argument is a `plm` object (the result of a pooling model) or a formula. Two additional arguments can be added to indicate the kind of test to be computed. The argument `type` is one of: - `"honda"`: @HOND:85, the default value, - `"bp"`: @BREU:PAGA:80, - `"kw"`: @KING:WU:97^[NB: Oneway King-Wu (`"kw"`) statistics (`"individual"` and `"time"`) coincide with the respective Honda statistics (`"honda"`); however, the twoway statistics of `"kw"` and `"honda"` differ.], - `"ghm"`: @GOUR:HOLL:MONF:82. The effects tested are indicated with the `effect` argument (one of `"individual"`, `"time"`, or `"twoways"`). The test statistics implemented are also suitable for unbalanced panels.^[The `"bp"` test for unbalanced panels was derived in @BALT:LI:90, the `"kw"` test for unbalanced panels in @BALT:CHAN:LI:98. The `"ghm"` test and the `"kw"` test were extended to two--way effects in @BALT:CHAN:LI:92. For a concise overview of all these statistics see @BALT:13 Sec. 4.2, pp. 68--76 (for balanced panels) and Sec. 9.5, pp. 200--203 (for unbalanced panels) or @BALT:21, Sec. 4.2, pp. 81-84 (balanced), Sec. 9.6, pp. 243-246 (unbalanced).] To test the presence of individual and time effects in the `Grunfeld` example, using the @GOUR:HOLL:MONF:82 test, we use: ```{r } g <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") plmtest(g, effect="twoways", type="ghm") ``` or ```{r results='hide'} plmtest(inv~value+capital, data=Grunfeld, effect="twoways", type="ghm") ``` `pFtest` computes F tests of effects based on the comparison of the within and the pooling model. Its main arguments are either two `plm` objects (a pooling and a within model) or a formula. ```{r } gw <- plm(inv ~ value + capital, data=Grunfeld, effect="twoways", model="within") gp <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") pFtest(gw, gp) ``` ```{r results='hide'} pFtest(inv~value+capital, data=Grunfeld, effect="twoways") ``` ## Hausman test `phtest` computes the Hausman test (at times also called Durbin--Wu--Hausman test) which is based on the comparison of two sets of estimates (see @HAUS:78). Its main arguments are two `panelmodel` objects or a formula. A classical application of the Hausman test for panel data is to compare the fixed and the random effects models: ```{r } gw <- plm(inv ~ value + capital, data = Grunfeld, model="within") gr <- plm(inv ~ value + capital, data = Grunfeld, model="random") phtest(gw, gr) ``` The command also supports the auxiliary-regression-based version as described in, e.g., @WOOL:10 Sec.10.7.3 by using the formula interface and setting argument `test = "aux"`. This auxiliary-regression-based version can be robustified by specifying a robust covariance estimator as a function through the argument `vcov`: ```{r } phtest(inv ~ value + capital, data = Grunfeld, method = "aux", vcov = vcovHC) ``` ## Tests of serial correlation{#serialcor} A model with individual effects has composite errors that are serially correlated by definition. The presence of the time-invariant error component^[Here we treat fixed and random effects alike, as components of the error term, according with the modern approach in econometrics (see @WOOL:02, @WOOL:10).] gives rise to serial correlation which does not die out over time, thus standard tests applied on pooled data always end up rejecting the null of spherical residuals^[Neglecting time effects may also lead to serial correlation in residuals (as observed in @WOOL:02 10.4.1).]. There may also be serial correlation of the "usual" kind in the idiosyncratic error terms, e.g., as an AR(1) process. By "testing for serial correlation" we mean testing for this latter kind of dependence. For these reasons, the subjects of testing for individual error components and for serially correlated idiosyncratic errors are closely related. In particular, simple (*marginal*) tests for one direction of departure from the hypothesis of spherical errors usually have power against the other one: in case it is present, they are substantially biased towards rejection. *Joint* tests are correctly sized and have power against both directions, but usually do not give any information about which one actually caused rejection. *Conditional* tests for serial correlation that take into account the error components are correctly sized under presence of both departures from sphericity and have power only against the alternative of interest. While most powerful if correctly specified, the latter, based on the likelihood framework, are crucially dependent on normality and homoskedasticity of the errors. In `plm` we provide a number of joint, marginal and conditional ML-based tests, plus some semiparametric alternatives which are robust vs. heteroskedasticity and free from distributional assumptions. ### Unobserved effects test The unobserved effects test *à la Wooldridge* (see @WOOL:02 10.4.4), is a semiparametric test for the null hypothesis that $\sigma^2_{\mu}=0$, i.e. that there are no unobserved effects in the residuals. Given that under the null the covariance matrix of the residuals for each individual is diagonal, the test statistic is based on the average of elements in the upper (or lower) triangle of its estimate, diagonal excluded: $n^{-1/2} \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is}$ (where $\hat{u}$ are the pooled OLS residuals), which must be "statistically close" to zero under the null, scaled by its standard deviation: $$W=\frac{ \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} }{ [{ \sum_{i=1}^n ( \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} } )^2 ]^{1/2} }$$ This test is ($n$-) asymptotically distributed as a standard normal regardless of the distribution of the errors. It does also not rely on homoskedasticity. It has power both against the standard random effects specification, where the unobserved effects are constant within every group, as well as against any kind of serial correlation. As such, it "nests" both random effects and serial correlation tests, trading some power against more specific alternatives in exchange for robustness. While not rejecting the null favours the use of pooled OLS, rejection may follow from serial correlation of different kinds, and in particular, quoting @WOOL:02, "should not be interpreted as implying that the random effects error structure *must* be true". Below, the test is applied to the data and model in @MUNN:90: ```{r wtest} pwtest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ``` ### Locally robust tests for serial correlation or random effects The presence of random effects may affect tests for residual serial correlation, and the opposite. One solution is to use a joint test, which has power against both alternatives. A joint LM test for random effects *and* serial correlation under normality and homoskedasticity of the idiosyncratic errors has been derived by @BALT:LI:91 and @BALT:LI:95 and is implemented as an option in `pbsytest`: ```{r pbsytestJoint} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="j") ``` Rejection of the joint test, though, gives no information on the direction of the departure from the null hypothesis, i.e.: is rejection due to the presence of serial correlation, of random effects or of both? @BERA:SOSA:YOON:01 (hereafter BSY) derive locally robust tests both for individual random effects and for first-order serial correlation in residuals as "corrected" versions of the standard LM test (see `plmtest`). While still dependent on normality and homoskedasticity, these are robust to *local* departures from the hypotheses of, respectively, no serial correlation or no random effects. The authors observe that, although suboptimal, these tests may help detecting the right direction of the departure from the null, thus complementing the use of joint tests. Moreover, being based on pooled OLS residuals, the BSY tests are computationally far less demanding than likelihood-based conditional tests. On the other hand, the statistical properties of these "locally corrected" tests are inferior to those of the non-corrected counterparts when the latter are correctly specified. If there is no serial correlation, then the optimal test for random effects is the likelihood-based LM test of Breusch and Godfrey (with refinements by Honda, see `plmtest`), while if there are no random effects the optimal test for serial correlation is, again, Breusch-Godfrey's test^[$LM_3$ in @BALT:LI:95.]. If the presence of a random effect is taken for granted, then the optimal test for serial correlation is the likelihood-based conditional LM test of @BALT:LI:95 (see `pbltest`). The serial correlation version is the default: ```{r pbsytestAR} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc) ``` The BSY test for random effects is implemented in the one-sided version^[Corresponding to $RSO^*_{\mu}$ in the original paper.], which takes heed that the variance of the random effect must be non-negative: ```{r pbsytestRE} pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="re") ``` ### Conditional LM test for AR(1) or MA(1) errors under random effects @BALT:LI:91 and @BALT:LI:95 derive a Lagrange multiplier test for serial correlation in the idiosyncratic component of the errors under (normal, heteroskedastic) random effects. Under the null of serially uncorrelated errors, the test turns out to be identical for both the alternative of AR(1) and MA(1) processes. One- and two-sided versions are provided, the one-sided having power against positive serial correlation only. The two-sided is the default, while for the other one must specify the `alternative` option to `"onesided"`: ```{r pbltest} pbltest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, alternative="onesided") ``` As usual, the LM test statistic is based on residuals from the maximum likelihood estimate of the restricted model (random effects with serially uncorrelated errors). In this case, though, the restricted model cannot be estimated by OLS anymore, therefore the testing function depends on `lme()` in the `nlme` package for estimation of a random effects model by maximum likelihood. For this reason, the test is applicable only to balanced panels. No test has been implemented to date for the symmetric hypothesis of no random effects in a model with errors following an AR(1) process, but an asymptotically equivalent likelihood ratio test is available in the `nlme` package (see Section [plm versus nlme and lme4](#nlme)). ### General serial correlation tests A general testing procedure for serial correlation in fixed effects (FE), random effects (RE) and pooled-OLS panel models alike can be based on considerations in @WOOL:02, 10.7.2. Recall that `plm` model objects are the result of OLS estimation performed on "demeaned" data, where, in the case of individual effects (else symmetric), this means time-demeaning for the FE (`within`) model, quasi-time-demeaning for the RE (`random`) model and original data, with no demeaning at all, for the pooled OLS (`pooling`) model (see Section [software approach](#software-approach)). For the random effects model, @WOOL:02 observes that under the null of homoskedasticity and no serial correlation in the idiosyncratic errors, the residuals from the quasi-demeaned regression must be spherical as well. Else, as the individual effects are wiped out in the demeaning, any remaining serial correlation must be due to the idiosyncratic component. Hence, a simple way of testing for serial correlation is to apply a standard serial correlation test to the quasi-demeaned model. The same applies in a pooled model, w.r.t. the original data. The FE case needs some qualification. It is well-known that if the original model's errors are uncorrelated then FE residuals are negatively serially correlated, with $cor(\hat{u}_{it}, \hat{u}_{is})=-1/(T-1)$ for each $t,s$ (see @WOOL:02 10.5.4). This correlation clearly dies out as T increases, so this kind of AR test is applicable to `within` model objects only for T "sufficiently large"^[Baltagi and Li derive a basically analogous T-asymptotic test for first-order serial correlation in a FE panel model as a Breusch-Godfrey LM test on within residuals (see @BALT:LI:95 par. 2.3 and formula 12). They also observe that the test on within residuals can be used for testing on the RE model, as "the within transformation [time-demeaning, in our terminology] wipes out the individual effects, whether fixed or random". Generalizing the Durbin-Watson test to FE models by applying it to fixed effects residuals is documented in @BHAR:FRAN:NARE:82, a (modified) version for unbalanced and/or non-consecutive panels is implemented in `pbnftest` as is Baltagi-Wu's LBI statistic (for both see @BALT:WU:99).]. On the converse, in short panels the test gets severely biased towards rejection (or, as the induced correlation is negative, towards acceptance in the case of the one-sided DW test with `alternative="greater"`). See below for a serial correlation test applicable to "short" FE panel models. `plm` objects retain the "demeaned" data, so the procedure is straightforward for them. The wrapper functions `pbgtest` and `pdwtest` re-estimate the relevant quasi-demeaned model by OLS and apply, respectively, standard Breusch-Godfrey and Durbin-Watson tests from package `lmtest`: ```{r generalAR} pbgtest(grun.fe, order = 2) ``` The tests share the features of their OLS counterparts, in particular the `pbgtest` allows testing for higher-order serial correlation, which might turn useful, e.g., on quarterly data. Analogously, from the point of view of software, as the functions are simple wrappers towards `bgtest` and `dwtest`, all arguments from the latter two apply and may be passed on through the ellipsis (the `...` argument). ### Wooldridge's test for serial correlation in "short" FE panels For the reasons reported above, under the null of no serial correlation in the errors, the residuals of a FE model must be negatively serially correlated, with $cor(\hat{\epsilon}_{it}, \hat{\epsilon}_{is})=-1/(T-1)$ for each $t,s$. Wooldridge suggests basing a test for this null hypothesis on a pooled regression of FE residuals on themselves, lagged one period: $$\hat{\epsilon}_{i,t}=\alpha + \delta \hat{\epsilon}_{i,t-1} + \eta_{i,t}$$ Rejecting the restriction $\delta = -1/(T-1)$ makes us conclude against the original null of no serial correlation. The building blocks available in `plm` make it easy to construct a function carrying out this procedure: first the FE model is estimated and the residuals retrieved, then they are lagged and a `pooling` AR(1) model is estimated. The test statistic is obtained by applying the above restriction on $\delta$ and supplying a heteroskedasticity- and autocorrelation-consistent covariance matrix (`vcovHC` with the appropriate options, in particular `method="arellano"`)^[see subsection [robust covariance matrix estimation](#robust).]. ```{r pwartest} pwartest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ``` The test is applicable to any FE panel model, and in particular to "short" panels with small $T$ and large $n$. ### Wooldridge's first-difference-based test In the context of the first difference model, @WOOL:02, 10.6.3 proposes a serial correlation test that can also be seen as a specification test to choose the most efficient estimator between fixed effects (`within`) and first difference (`fd`). The starting point is the observation that if the idiosyncratic errors of the original model $u_{it}$ are uncorrelated, the errors of the (first) differenced model^[Here, $e_{it}$ for notational simplicity (and as in Wooldridge): equivalent to $\Delta \epsilon_{it}$ in the general notation of the paper.] $e_{it} \equiv u_{it}-u_{i,t-1}$ will be correlated, with $cor(e_{it}, e_{i,t-1})=-0.5$, while any time-invariant effect, "fixed" or "random", is wiped out in the differencing. So a serial correlation test for models with individual effects of any kind can be based on estimating the model $$\hat{u}_{i,t}= \delta \hat{u}_{i,t-1} + \eta_{i,t}$$ and testing the restriction $\delta = -0.5$, corresponding to the null of no serial correlation. @DRUK:03 provides Monte Carlo evidence of the good empirical properties of the test. On the other extreme (see @WOOL:02 10.6.1), if the differenced errors $e_{it}$ are uncorrelated, as by definition $u_{it} = u_{i,t-1} + e_{it}$, then $u_{it}$ is a random walk. In this latter case, the most efficient estimator is the first difference (`fd`) one; in the former case, it is the fixed effects one (`within`). The function `pwfdtest` allows testing either hypothesis: the default behaviour `h0="fd"` is to test for serial correlation in *first-differenced* errors: ```{r pwfdtest1} pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK) ``` while specifying `h0="fe"` the null hypothesis becomes no serial correlation in *original* errors, which is similar to the `pwartest`. ```{r pwfdtest2} pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK, h0="fe") ``` Not rejecting one of the two is evidence in favour of using the estimator corresponding to `h0`. Should the truth lie in the middle (both rejected), whichever estimator is chosen will have serially correlated errors: therefore it will be advisable to use the autocorrelation-robust covariance estimators from the subsection [robust covariance matrix estimation](#robust) in inference. ## Tests for cross-sectional dependence Next to the more familiar issue of serial correlation, over the last years a growing body of literature has been dealing with cross-sectional dependence (henceforth: XSD) in panels, which can arise, e.g., if individuals respond to common shocks (as in the literature on *factor models*) or if spatial diffusion processes are present, relating individuals in a way depending on a measure of distance (*spatial models*). The subject is huge, and here we touch only some general aspects of misspecification testing and valid inference. If XSD is present, the consequence is, at a minimum, inefficiency of the usual estimators and invalid inference when using the standard covariance matrix^[This is the case, e.g., if in an unobserved effects model when XSD is due to an unobservable factor structure, with factors that are uncorrelated with the regressors. In this case the within or random estimators are still consistent, although inefficient (see @DEHO:SARA:06).]. The plan is to have in `plm` both misspecification tests to detect XSD and robust covariance matrices to perform valid inference in its presence, like in the serial dependence case. For now, though, only misspecification tests are included. ### CD and LM-type tests for global cross-sectional dependence The function `pcdtest` implements a family of XSD tests which can be applied in different settings, ranging from those where $T$ grows large with $n$ fixed to "short" panels with a big $n$ dimension and a few time periods. All are based on (transformations of--) the product-moment correlation coefficient of a model's residuals, defined as $$ \hat{\rho}_{ij}=\frac{\sum_{t=1}^T \hat{u}_{it} \hat{u}_{jt}}{(\sum_{t=1}^T \hat{u}^2_{it})^{1/2} (\sum_{t=1}^T \hat{u}^2_{jt})^{1/2} } $$ i.e., as averages over the time dimension of pairwise correlation coefficients for each pair of cross-sectional units. The Breusch-Pagan [@BREU:PAGA:80] LM test, based on the squares of $\rho_{ij}$, is valid for $T \rightarrow \infty$ with $n$ fixed; defined as $$LM=\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2$$ where in the case of an unbalanced panel only pairwise complete observations are considered, and $T_{ij}=min(T_i,T_j)$ with $T_i$ being the number of observations for individual $i$; else, if the panel is balanced, $T_{ij}=T$ for each $i,j$. The test is distributed as $\chi^2_{n(n-1)/2}$. It is inappropriate whenever the $n$ dimension is "large". A scaled version, applicable also if $T \rightarrow \infty$ and *then* $n \rightarrow \infty$ (as in some pooled time series contexts), is defined as $$SCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1 )$$ and distributed as a standard normal (see @PESA:04). A bias-corrected scaled version, $BCSCLM$, for the *fixed effect model with individual effects* only is also available which is simply the $SCLM$ with a term correcting for the bias (@BALT:FENG:KAO:12)^[The unbalanced version of this statistic uses max(Tij) for T in the bias-correction term.]. This statistic is also asymptotically distributed as standard normal. $$BCSCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1)-\frac{n}{2(T-1)}$$ Pesaran's (@PESA:04, @PESA:15) $CD$ test $$CD=\sqrt{\frac{2}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} \sqrt{T_{ij}} \hat{\rho}_{ij} )$$ based on $\rho_{ij}$ without squaring (also distributed as a standard normal) is appropriate both in $n$-- and in $T$--asymptotic settings. It has remarkable properties in samples of any practically relevant size and is robust to a variety of settings. The only big drawback is that the test loses power against the alternative of cross-sectional dependence if the latter is due to a factor structure with factor loadings averaging zero, that is, some units react positively to common shocks, others negatively. The default version of the test is `"cd"` yielding Pesaran's $CD$ test. These tests are originally meant to use the residuals of separate estimation of one time-series regression for each cross-sectional unit, so this is the default behaviour of `pcdtest`. ```{r pcdtest1} pcdtest(inv~value+capital, data=Grunfeld) ``` If a different model specification (`within`, `random`, ...) is assumed consistent, one can resort to its residuals for testing^[This is also the only solution when the time dimension's length is insufficient for estimating the heterogeneous model.] by specifying the relevant `model` type. The main argument of this function may be either a model of class `panelmodel` or a `formula` and a `data.frame`; in the second case, unless `model` is set to `NULL`, all usual parameters relative to the estimation of a `plm` model may be passed on. The test is compatible with any consistent `panelmodel` for the data at hand, with any specification of `effect`. E.g., specifying `effect = "time"` or `effect = "twoways"` allows to test for residual cross-sectional dependence after the introduction of time fixed effects to account for common shocks. ```{r pcdtest2} pcdtest(inv~value+capital, data=Grunfeld, model="within") ``` If the time dimension is insufficient and `model=NULL`, the function defaults to estimation of a `within` model and issues a warning. ### CD(p) test for local cross-sectional dependence A *local* variant of the $CD$ test, called $CD(p)$ test [@PESA:04], takes into account an appropriate subset of *neighbouring* cross-sectional units to check the null of no XSD against the alternative of *local* XSD, i.e. dependence between neighbours only. To do so, the pairs of neighbouring units are selected by means of a binary proximity matrix like those used in spatial models. In the original paper, a regular ordering of observations is assumed, so that the $m$-th cross-sectional observation is a neighbour to the $(m-1)$-th and to the $(m+1)$-th. Extending the $CD(p)$ test to irregular lattices, we employ the binary proximity matrix as a selector for discarding the correlation coefficients relative to pairs of observations that are not neighbours in computing the $CD$ statistic. The test is then defined as $$CD=\sqrt{\frac{1}{\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} w(p)_{ij}}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} [w(p)]_{ij} \sqrt{T_{ij}}\hat{\rho}_{ij} )$$ where $[w(p)]_{ij}$ is the $(i,j)$-th element of the $p$-th order proximity matrix, so that if $h,k$ are not neighbours, $[w(p)]_{hk}=0$ and $\hat{\rho}_{hk}$ gets "killed"; this is easily seen to reduce to formula (14) in Pesaran [@PESA:04] for the special case considered in that paper. The same can be applied to the $LM$, $SCLM$, and $BCSCLM$ tests. Therefore, the *local* version of either test can be computed supplying an $n \times n$ matrix (of any kind coercible to `logical`), providing information on whether any pair of observations are neighbours or not, to the `w` argument. If `w` is supplied, only neighbouring pairs will be used in computing the test; else, `w` will default to `NULL` and all observations will be used. The matrix needs not really be binary, so commonly used "row-standardized" matrices can be employed as well: it is enough that neighbouring pairs correspond to nonzero elements in `w` ^[The very comprehensive package `spdep` for spatial dependence analysis (see @BIVA:08) contains features for creating, lagging and manipulating *neighbour list* objects of class `nb`, that can be readily converted to and from proximity matrices by means of the `nb2mat` function. Higher orders of the $CD(p)$ test can be obtained by lagging the corresponding `nb`s through `nblag`.]. ## Panel unit root tests ### Overview of functions for panel unit root testing Below, first an overview is provided which tests are implemented per functions. A theoretical treatment is given for a few of those tests later on. The package `plm` offers several panel unit root tests contained in three functions: - `purtest` (Levin-Lin-Chu test, IPS test, several Fisher-type tests, Hadri's test), - `cipstest` (cross-sectionally augmented IPS test), and - `phansitest` (Simes' test). While `purtest` implements various tests which can be selected via its `test` argument, `cipstest` and `phansitest` are functions for a specific test each. Function `purtest` offers the following tests by setting argument `test` to: - `"levinlin"` (default), for the Levin-Lin-Chu test (@LEVIN:LIN:CHU:02), see below for a theoretical exposition ([Levin-Lin-Chu test](#levinlin))), - `"ips"`, for Im-Pesaran-Shin (IPS) test by @IM:PESAR:SHIN:03, see below for a theoretical exposition ([Im-Pesaran-Shin test](#ips))), - `"madwu"`, is the inverse $\chi^2$ test by @MADDA:WU:99, also called P test by @CHOI:01, - `"Pm"`, is the modified P test proposed by @CHOI:01 for large N, - `"invnormal"`, is the inverse normal test (@CHOI:01), - `"logit"`, is the logit test (@CHOI:01), - `"hadri"`, for Hadri's test (@HADR:00). The tests in `purtest` are often called first generation panel unit root tests as they do assume absence of cross-sectional correlation; all these, except Hadri's test, are based on the estimation of augmented Dickey-Fuller (ADF) regressions for each time series. A statistic is then computed using the t-statistics associated with the lagged variable. I a different manner, the Hadri residual-based LM statistic is the cross-sectional average of individual KPSS statistics (@KWIA:PHIL:SCHM:SHIN:92), standardized by their asymptotic mean and standard deviation. Among the tests in `purtest`, `"madwu"`, `"Pm"`, `"invormal"`, and `"logit"` are Fisher-type tests.^[The individual p-values for the Fisher-type tests are approximated as described in @MACK:96 if the package `urca` (@PFAFF:08) is available, otherwise as described in @MACK:94.] `purtest` returns an object of class `"purtest"` which contains details about the test performed, among them details about the individual regressions/statistics for the test. Associated `summary` and `print.summary` methods can be used to extract/display the additional information. Function `cipstest` implements Pesaran's (@pes07) cross-sectionally augmented version of the Im-Pesaran-Shin panel unit root test and is a so-called second-generation panel unit root test. Function `phansitest` implements the idea of @HANCK:13 to apply Simes' testing approach for intersection of individual hypothesis tests to panel unit root testing, see below for a more thorough treatment of [Simes’ approach for intersecting hypotheses](#phansitest). ### Preliminary results We consider the following model: $$ y_{it} = \delta y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} $$ The unit root hypothesis is $\rho = 1$. The model can be rewritten in difference: $$ \Delta y_{it} = \rho y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} $$ So that the unit-root hypothesis is now $\rho = 0$. Some of the unit-root tests for panel data are based on preliminary results obtained by running the above Augmented Dickey-Fuller (ADF) regression. First, we have to determine the optimal number of lags $p_i$ for each time-series. Several possibilities are available. They all have in common that the maximum number of lags have to be chosen first. Then, $p_i$ can be chosen by using: - the Schwarz information criterion (SIC) (also known as Bayesian information criterion (BIC)), - the Akaike information criterion (AIC), - the Hall's method, which consist in removing the higher lags while they are not significant. The ADF regression is run on $T-p_i-1$ observations for each individual, so that the total number of observations is $n\times \tilde{T}$ where $\tilde{T}=T-p_i-1$ $\bar{p}$ is the average number of lags. Call $e_{i}$ the vector of residuals. Estimate the variance of the $\epsilon_i$ as: $$ \hat{\sigma}_{\epsilon_i}^2 = \frac{\sum_{t=p_i+1}^{T} e_{it}^2}{df_i} $$ ### Levin-Lin-Chu model{#levinlin} Then, as per @LEVIN:LIN:CHU:02, compute artificial regressions of $\Delta y_{it}$ and $y_{it-1}$ on $\Delta y_{it-L}$ and $d_{mt}$ and get the two vectors of residuals $z_{it}$ and $v_{it}$. Standardize these two residuals and run the pooled regression of $z_{it}/\hat{\sigma}_i$ on $v_{it}/\hat{\sigma}_i$ to get $\hat{\rho}$, its standard deviation $\hat{\sigma}({\hat{\rho}})$ and the t-statistic $t_{\hat{\rho}}=\hat{\rho}/\hat{\sigma}({\hat{\rho}})$. Compute the long run variance of $y_i$ : $$ \hat{\sigma}_{yi}^2 = \frac{1}{T-1}\sum_{t=2}^T \Delta y_{it}^2 + 2 \sum_{L=1}^{\bar{K}}w_{\bar{K}L}\left[\frac{1}{T-1}\sum_{t=2+L}^T \Delta y_{it} \Delta y_{it-L}\right] $$ Define $\bar{s}_i$ as the ratio of the long and short term variance and $\bar{s}$ the mean for all the individuals of the sample $$ s_i = \frac{\hat{\sigma}_{yi}}{\hat{\sigma}_{\epsilon_i}} $$ $$ \bar{s} = \frac{\sum_{i=1}^n s_i}{n} $$ $$ t^*_{\rho}=\frac{t_{\rho}- n \bar{T} \bar{s} \hat{\sigma}_{\tilde{\epsilon}}^{-2} \hat{\sigma}({\hat{\rho}}) \mu^*_{m\tilde{T}}}{\sigma^*_{m\tilde{T}}} $$ follows a normal distribution under the null hypothesis of stationarity. $\mu^*_{m\tilde{T}}$ and $\sigma^*_{m\tilde{T}}$ are given in table 2 of the original paper and are also available in the package. An example how the Levin-Lin-Chu test is performed with `purtest` using a lag of 2 and intercept and a time trend as exogenous variables in the ADF regressions is: ```{r levinlin} data("HousePricesUS", package = "pder") lprice <- log(pdata.frame(HousePricesUS)$price) (lev <- purtest(lprice, test = "levinlin", lags = 2, exo = "trend")) summary(lev) ### gives details ``` ### Im-Pesaran-Shin (IPS) test{#ips} This test by @IM:PESAR:SHIN:03 does not require that $\rho$ is the same for all the individuals. The null hypothesis is still that all the series have an unit root, but the alternative is that some may have a unit root and others have different values of $\rho_i <0$. The test is based on the average of the student statistic of the $\rho$ obtained for each individual: $$ \bar{t}=\frac{1}{n}\sum_{i=1}^n t_{\rho i} $$ The statistic is then: $$ z = \frac{\sqrt{n}\left(\bar{t}- E(\bar{t})\right)}{\sqrt{V(\bar{t})}} $$ $\mu^*_{m\tilde{T}}$ and $\sigma^*_{m\tilde{T}}$ are given in table 2 of the original paper and are also available in the package. An example of the IPS test with `purtest` with the same settings as in the previously performed Levin-Lin-Chu test is: ```{r ips} purtest(lprice, test = "ips", lags = 2, exo = "trend") ``` ### Simes' approach: intersecting hypotheses{#phansitest} A different approach to panel unit root testing can be drawn from the general Simes' test for intersection of individual hypothesis tests [@SIMES:86]. @HANCK:13 suggests to apply the approach for panel unit root testing: The tests works by combining p-values from single hypothesis tests (individual unit root tests) with a global (intersected) hypothesis and controls for the multiplicity in testing. Thus, it works "on top" of any panel unit root test which yield a p-value for each individual series. Unlike most other panel unit root tests, this approach allows to discriminate between individuals for which the individual H0 (unit root present for individual series) is rejected/is not rejected and requires a pre-specified significance level. Further, the test is robust versus general patterns of cross-sectional dependence. The function `phansitest` for this test takes as main input object either a numeric containing p-values of individual tests or a `"purtest"` object as produced by function `purtest` which holds a suitable pre-computed panel unit root test (one that produces p-values per individual series). The significance level is set by argument `alpha` (default 5 %). The function's return value is a list with detailed evaluation of the applied Simes test. The associated print method gives a verbal evaluation. The following examples shows both accepted ways of input, the first example replicates @HANCK:13, table 11 (left side), who applied some panel unit root test for a Purchasing Power Parity analysis per country (individual H0 hypotheses per series) to get the individual p-values and then used Simes' approach for testing the global (intersecting) hypothesis for the whole panel. ```{r phansitest1} ### input is numeric (p-values), replicates Hanck (2013), Table 11 (left side) pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050, 0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475) countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France", "Germany","Belgium","U.K.","Brazil","Australia","Netherlands", "Portugal","Canada", "Spain","Denmark","Switzerland","Japan") names(pvals) <- countries h <- phansitest(pvals) print(h) h$rejected # logical indicating the individuals with rejected individual H0 ``` ```{r phansitest2, results='hide'} ### input is a (suitable) purtest object / different example y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu") phansitest(obj, alpha = 0.06) # test with significance level set to 6 % ``` ## Robust covariance matrix estimation{#robust} Robust estimators of the covariance matrix of coefficients are provided, mostly for use in Wald-type tests, and this section provides some basics and examples. A more comprehensive exposition of the theory and the capabilities that come with the plm package is given in @mil17b. `vcovHC` estimates three "flavours" of White's heteroskedasticity-consistent covariance matrix^[See @WHIT:80 and @WHIT:84b.] (known as the *sandwich* estimator). Interestingly, in the context of panel data the most general version also proves consistent vs. serial correlation. All types assume no correlation between errors of different groups while allowing for heteroskedasticity across groups, so that the full covariance matrix of errors is $V=I_n \otimes \Omega_i; i=1,..,n$. As for the *intragroup* error covariance matrix of every single group of observations, `"white1"` allows for general heteroskedasticity but no serial correlation, *i.e.* \begin{equation} (\#eq:omegaW1) \Omega_i= \left[ \begin{array}{c c c c} \sigma_{i1}^2 & \dots & \dots & 0 \\ 0 & \sigma_{i2}^2 & & \vdots \\ \vdots & & \ddots & 0 \\ 0 & ... & ... & \sigma_{iT}^2 \\ \end{array} \right] \end{equation} while `"white2"` is `"white1"` restricted to a common variance inside every group, estimated as $\sigma_i^2=\sum_{t=1}^T{\hat{u}_{it}^2}/T$, so that $\Omega_i=I_T \otimes \sigma_i^2$ (see @GREE:03, 13.7.1--2 and @WOOL:02, 10.7.2; `"arellano"` (see ibid. and the original ref. @AREL:87) allows a fully general structure w.r.t. heteroskedasticity and serial correlation: \begin{equation} (\#eq:omegaArellano) \Omega_i= \left[ \begin{array}{c c c c c} \sigma_{i1}^2 & \sigma_{i1,i2} & \dots & \dots & \sigma_{i1,iT} \\ \sigma_{i2,i1} & \sigma_{i2}^2 & & & \vdots \\ \vdots & & \ddots & & \vdots \\ \vdots & & & \sigma_{iT-1}^2 & \sigma_{iT-1,iT} \\ \sigma_{iT,i1} & \dots & \dots & \sigma_{iT,iT-1} & \sigma_{iT}^2 \\ \end{array} \right] \end{equation} The latter is, as already observed, consistent w.r.t. timewise correlation of the errors, but on the converse, unlike the White 1 and 2 methods, it relies on large $n$ asymptotics with small $T$. The fixed effects case, as already observed in Section [tests of serial correlation](#serialcor) on serial correlation, is complicated by the fact that the demeaning induces serial correlation in the errors. The original White estimator (`"white1"`) turns out to be inconsistent for fixed $T$ as $n$ grows, so in this case it is advisable to use the `"arellano"` version (see @STOC:WATS:08). The errors may be weighted according to the schemes proposed by @MACK:WHIT:85 and @CRIB:04 to improve small-sample performance^[The HC3 and HC4 weighting schemes are computationally expensive and may hit memory limits for $nT$ in the thousands, where on the other hand it makes little sense to apply small sample corrections.]. The main use of `vcovHC` (and the other variance-covariance estimators provided in the package `vcovBK`, `vcovNW`, `vcovDC`, `vcovSCC`) is to pass it to plm's own functions like `summary`, `pwaldtest`, and `phtest` or together with testing functions from the `lmtest` and `car` packages. All of these typically allow passing the `vcov` or `vcov.` parameter either as a matrix or as a function (see also @ZEIL:04). If one is happy with the defaults, it is easiest to pass the function itself^[For `coeftest` set `df = Inf` to have the coefficients' tests be performed with standard normal distribution instead of t distribution as we deal with a random effects model here. For these types of models, the precise distribution of the coefficients estimates is unknown.]: ```{r vcovHC1} re <- plm(inv~value+capital, data = Grunfeld, model = "random") summary(re, vcov = vcovHC) # gives usual summary output but with robust test statistics library("lmtest") coeftest(re, vcovHC, df = Inf) ``` else one may do the covariance computation inside the call, thus passing on a matrix: ```{r vcovHC2, results='hide'} summary(re, vcov = vcovHC(re, method="white2", type="HC3")) coeftest(re, vcovHC(re, method="white2", type="HC3"), df = Inf) ``` For some tests, e.g., for multiple model comparisons by `waldtest`, one should always provide a function^[Joint zero-restriction testing still allows providing the `vcov` of the unrestricted model as a matrix, see the documentation of package `lmtest`.]. In this case, optional parameters are provided as shown below (see also @ZEIL:04, p. 12): ```{r waldtest-vcovHC} waldtest(re, update(re, . ~ . -capital), vcov=function(x) vcovHC(x, method="white2", type="HC3")) ``` Moreover, `linearHypothesis` from package `car` may be used to test for linear restrictions: ```{r car-vcovHC} library("car") linearHypothesis(re, "2*value=capital", vcov. = vcovHC) ``` A specific methods are also provided for `pcce` and `pgmm` objects, for the latter `vcovHC` provides the robust covariance matrix proposed by @WIND:05 for generalized method of moments estimators. # plm versus nlme and lme4{#nlme} The models termed *panel* by the econometricians have counterparts in the statistics literature on *mixed* models (or *hierarchical models*, or *models for longitudinal data*), although there are both differences in jargon and more substantial distinctions. This language inconsistency between the two communities, together with the more complicated general structure of statistical models for longitudinal data and the associated notation in the software, is likely to scare some practicing econometricians away from some potentially useful features of the `R` environment, so it may be useful to provide here a brief reconciliation between the typical panel data specifications used in econometrics and the general framework used in statistics for mixed models^[This discussion does not consider GMM models. One of the basic reasons for econometricians not to choose maximum likelihood methods in estimation is that the strict exogeneity of regressors assumption required for consistency of the ML models reported in the following is often inappropriate in economic settings.]. `R` is particularly strong on mixed models' estimation, thanks to the long-standing `nlme` package (see @PINH:BATE:DEBR:SARK:07) and the more recent `lme4` package, based on S4 classes (see @BATE:07)^[The standard reference on the subject of mixed models in `S`/`R` is @PINH:BATE:00.]. In the following we will refer to the more established `nlme` to give some examples of "econometric" panel models that can be estimated in a likelihood framework, also including some likelihood ratio tests. Some of them are not feasible in `plm` and make a useful complement to the econometric "toolbox" available in `R`. ## Fundamental differences between the two approaches Econometrics deal mostly with non-experimental data. Great emphasis is put on specification procedures and misspecification testing. Model specifications tend therefore to be very simple, while great attention is put on the issues of endogeneity of the regressors, dependence structures in the errors and robustness of the estimators under deviations from normality. The preferred approach is often semi- or non-parametric, and heteroskedasticity-consistent techniques are becoming standard practice both in estimation and testing. For all these reasons, although the maximum likelihood framework is important in testing^[Lagrange Multiplier tests based on the likelihood principle are suitable for testing against more general alternatives on the basis of a maintained model with spherical residuals and find therefore application in testing for departures from the classical hypotheses on the error term. The seminal reference is @BREU:PAGA:80.] and sometimes used in estimation as well, panel model estimation in econometrics is mostly accomplished in the generalized least squares framework based on Aitken's Theorem and, when possible, in its special case OLS, which are free from distributional assumptions (although these kick in at the diagnostic testing stage). On the contrary, longitudinal data models in `nlme` and `lme4` are estimated by (restricted or unrestricted) maximum likelihood. While under normality, homoskedasticity and no serial correlation of the errors OLS are also the maximum likelihood estimator, in all the other cases there are important differences. The econometric GLS approach has closed-form analytical solutions computable by standard linear algebra and, although the latter can sometimes get computationally heavy on the machine, the expressions for the estimators are usually rather simple. ML estimation of longitudinal models, on the contrary, is based on numerical optimization of nonlinear functions without closed-form solutions and is thus dependent on approximations and convergence criteria. For example, the "GLS" functionality in `nlme` is rather different from its "econometric" counterpart. "Feasible GLS" estimation in `plm` is based on a single two-step procedure, in which an inefficient but consistent estimation method (typically OLS) is employed first in order to get a consistent estimate of the errors' covariance matrix, to be used in GLS at the second step; on the converse, "GLS" estimators in `nlme` are based on iteration until convergence of two-step optimization of the relevant likelihood. ## Some false friends The *fixed/random effects* terminology in econometrics is often recognized to be misleading, as both are treated as random variates in modern econometrics (see, e.g., @WOOL:02 10.2.1). It has been recognized since Mundlak's classic paper (@MUND:78) that the fundamental issue is whether the unobserved effects are correlated with the regressors or not. In this last case, they can safely be left in the error term, and the serial correlation they induce is cared for by means of appropriate GLS transformations. On the contrary, in the case of correlation, "fixed effects" methods such as least squares dummy variables or time-demeaning are needed, which explicitly, although inconsistently^[For fixed effects estimation, as the sample grows (on the dimension on which the fixed effects are specified) so does the number of parameters to be estimated. Estimation of individual fixed effects is $T$-- (but not $n$--) consistent, and the opposite.], estimate a group-- (or time--) invariant additional parameter for each group (or time period). Thus, from the point of view of model specification, having *fixed effects* in an econometric model has the meaning of allowing the intercept to vary with group, or time, or both, while the other parameters are generally still assumed to be homogeneous. Having *random effects* means having a group-- (or time--, or both) specific component in the error term. In the mixed models literature, on the contrary, *fixed effect* indicates a parameter that is assumed constant, while *random effects* are parameters that vary randomly around zero according to a joint multivariate normal distribution. So, the FE model in econometrics has no counterpart in the mixed models framework, unless reducing it to OLS on a specification with one dummy for each group (often termed *least squares dummy variables*, or LSDV model) which can trivially be estimated by OLS. The RE model is instead a special case of a mixed model where only the intercept is specified as a random effect, while the "random" type variable coefficients model can be seen as one that has the same regressors in the fixed and random sets. The unrestricted generalized least squares can in turn be seen, in the `nlme` framework, as a standard linear model with a general error covariance structure within the groups and errors uncorrelated across groups. ## A common taxonomy To reconcile the two terminologies, in the following we report the specification of the panel models in `plm` according to the general expression of a mixed model in Laird-Ware form [see the web appendix to @FOX:02] and the `nlme` estimation commands for maximum likelihood estimation of an equivalent specification^[In doing so, we stress that "equivalence" concerns only the specification of the model, and neither the appropriateness nor the relative efficiency of the relevant estimation techniques, which will of course be dependent on the context. Unlike their mixed model counterparts, the specifications in `plm` are, strictly speaking, distribution-free. Nevertheless, for the sake of exposition, in the following we present them in the setting which ensures consistency and efficiency (e.g., we consider the hypothesis of spherical errors part of the specification of pooled OLS and so forth).]. ### The Laird-Ware representation for mixed models A general representation for the linear mixed effects model is given in @LAIR:WARE:82. $$ \begin{array}{rcl} y_{it} & = & \beta_1 x_{1ij} + \dots + \beta_p x_{pij} \\ & & b_1 z_{1ij} + \dots + b_p z_{pij} + \epsilon_{ij} \\ b_{ik} & \sim & N(0,\psi^2_k), \phantom{p} Cov(b_k,b_{k'}) = \psi_{kk'} \\ \epsilon_{ij} & \sim & N(0,\sigma^2 \lambda_{ijj}), \phantom{p} Cov(\epsilon_{ij},\epsilon_{ij'}) = \sigma^2 \lambda_{ijj'} \\ \end{array} $$ where the $x_1, \dots x_p$ are the fixed effects regressors and the $z_1, \dots z_p$ are the random effects regressors, assumed to be normally distributed across groups. The covariance of the random effects coefficients $\psi_{kk'}$ is assumed constant across groups and the covariances between the errors in group $i$, $\sigma^2 \lambda_{ijj'}$, are described by the term $\lambda_{ijj'}$ representing the correlation structure of the errors within each group (e.g., serial correlation over time) scaled by the common error variance $\sigma^2$. ### Pooling and Within The *pooling* specification in `plm` is equivalent to a classical linear model (i.e., no random effects regressor and spherical errors: $b_{iq}=0 \phantom{p} \forall i,q, \phantom{p} \lambda_{ijj}=\sigma^2$ for $j=j'$, $0$ else). The *within* one is the same with the regressors' set augmented by $n-1$ group dummies. There is no point in using `nlme` as parameters can be estimated by OLS which is also ML. ### Random effects In the Laird and Ware notation, the RE specification is a model with only one random effects regressor: the intercept. Formally, $z_{1ij}=1 \phantom{p}\forall i,j, \phantom{p} z_{qij}=0 \phantom{p} \forall i, \forall j, \forall q \neq 1$ $\lambda_{ij}=1$ for $i=j$, $0$ else). The composite error is therefore $u_{ij}=1b_{i1} + \epsilon_{ij}$. Below we report coefficients of Grunfeld's model estimated by GLS and then by ML: ```{r re2} library(nlme) reGLS <- plm(inv~value+capital, data=Grunfeld, model="random") reML <- lme(inv~value+capital, data=Grunfeld, random=~1|firm) coef(reGLS) summary(reML)$coefficients$fixed ``` ### Variable coefficients, "random" Swamy's variable coefficients model [@SWAM:70] has coefficients varying randomly (and independently of each other) around a set of fixed values, so the equivalent specification is $z_{q}=x_{q} \phantom{p} \forall q$, i.e. the fixed effects and the random effects regressors are the same, and $\psi_{kk'}=\sigma_\mu^2 I_N$, and $\lambda_{ijj}=1$, $\lambda_{ijj'}=0$ for $j \neq j'$, that's to say they are not correlated. Estimation of a mixed model with random coefficients on all regressors is rather demanding from the computational side. Some models from our examples fail to converge. The below example is estimated on the Grunfeld data and model with time effects. ```{r vcmrand} vcm <- pvcm(inv~value+capital, data=Grunfeld, model="random", effect="time") vcmML <- lme(inv~value+capital, data=Grunfeld, random=~value+capital|year) coef(vcm) summary(vcmML)$coefficients$fixed ``` ### Variable coefficients, "within" This specification actually entails separate estimation of $T$ different standard linear models, one for each group in the data, so the estimation approach is the same: OLS. In `nlme` this is done by creating an `lmList` object, so that the two models below are equivalent (output suppressed): ```{r vcmfixed} vcmf <- pvcm(inv~value+capital, data=Grunfeld, model="within", effect="time") vcmfML <- lmList(inv~value+capital|year, data=Grunfeld) ``` ### General FGLS The general, or unrestricted, feasible GLS (FGLS), `pggls` in the `plm` nomenclature, is equivalent to a model with no random effects regressors ($b_{iq}=0 \phantom{p} \forall i,q$) and an error covariance structure which is unrestricted within groups apart from the usual requirements. The function for estimating such models with correlation in the errors but no random effects is `gls()`. This very general serial correlation and heteroskedasticity structure is not estimable for the original Grunfeld data, which have more time periods than firms, therefore we restrict them to firms 4 to 6. ```{r gglsre} sGrunfeld <- Grunfeld[Grunfeld$firm %in% 4:6, ] ggls <- pggls(inv~value+capital, data=sGrunfeld, model="pooling") gglsML <- gls(inv~value+capital, data=sGrunfeld, correlation=corSymm(form=~1|year)) coef(ggls) summary(gglsML)$coefficients ``` The *within* case is analogous, with the regressor set augmented by $n-1$ group dummies. ## Some useful "econometric" models in nlme Finally, amongst the many possible specifications estimable with `nlme`, we report a couple cases that might be especially interesting to applied econometricians. ### AR(1) pooling or random effects panel Linear models with groupwise structures of time-dependence^[Take heed that here, in contrast to the usual meaning of serial correlation in time series, we always speak of serial correlation *between the errors of each group*.] may be fitted by `gls()`, specifying the correlation structure in the `correlation` option^[note that the time index is coerced to numeric before the estimation.]: ```{r lmAR1} Grunfeld$year <- as.numeric(as.character(Grunfeld$year)) lmAR1ML <- gls(inv~value+capital,data=Grunfeld, correlation=corAR1(0,form=~year|firm)) ``` and analogously the random effects panel with, e.g., AR(1) errors (see @BALT:05; @BALT:13; @BALT:21, ch. 5), which is a very common specification in econometrics, may be fit by `lme` specifying an additional random intercept: ```{r reAR1} reAR1ML <- lme(inv~value+capital, data=Grunfeld,random=~1|firm, correlation=corAR1(0,form=~year|firm)) ``` The regressors' coefficients and the error's serial correlation coefficient may be retrieved this way: ```{r fetchcoefs} summary(reAR1ML)$coefficients$fixed coef(reAR1ML$modelStruct$corStruct, unconstrained=FALSE) ``` Significance statistics for the regressors' coefficients are to be found in the usual `summary` object, while to get the significance test of the serial correlation coefficient one can do a likelihood ratio test as shown in the following. ### An LR test for serial correlation and one for random effects A likelihood ratio test for serial correlation in the idiosyncratic residuals can be done as a nested models test, by `anova()`, comparing the model with spherical idiosyncratic residuals with the more general alternative featuring AR(1) residuals. The test takes the form of a zero restriction test on the autoregressive parameter. This can be done on pooled or random effects models alike. First we report the simpler case. We already estimated the pooling AR(1) model above. The GLS model without correlation in the residuals is the same as OLS, and one could well use `lm()` for the restricted model. Here we estimate it by `gls()`. ```{r LRar} lmML <- gls(inv~value+capital, data=Grunfeld) anova(lmML, lmAR1ML) ``` The AR(1) test on the random effects model is to be done in much the same way, using the random effects model objects estimated above: ```{r LRarsubRE} anova(reML, reAR1ML) ``` A likelihood ratio test for random effects compares the specifications with and without random effects and spherical idiosyncratic errors: ```{r LRre} anova(lmML, reML) ``` The random effects, AR(1) errors model in turn nests the AR(1) pooling model, therefore a likelihood ratio test for random effects sub AR(1) errors may be carried out, again, by comparing the two autoregressive specifications: ```{r LRresubAR} anova(lmAR1ML, reAR1ML) ``` whence we see that the Grunfeld model specification doesn't seem to need any random effects once we control for serial correlation in the data. # Conclusions{#conclusions} With `plm` we aim at providing a comprehensive package containing the standard functionalities that are needed for the management and the econometric analysis of panel data. In particular, we provide: functions for data transformation; estimators for pooled, random and fixed effects static panel models and variable coefficients models, general GLS for general covariance structures, and generalized method of moments estimators for dynamic panels; specification and diagnostic tests. Instrumental variables estimation is supported. Most estimators allow working with unbalanced panels. While among the different approaches to longitudinal data analysis we take the perspective of the econometrician, the syntax is consistent with the basic linear modeling tools, like the `lm` function. On the input side, `formula` and `data` arguments are used to specify the model to be estimated. Special functions are provided to make writing formulas easier, and the structure of the data is indicated with an `index` argument. On the output side, the model objects (of the new class `panelmodel`) are compatible with the general restriction testing frameworks of packages `lmtest` and `car`. Specialized methods are also provided for the calculation of robust covariance matrices; heteroskedasticity- and correlation-consistent testing is accomplished by passing these on to testing functions, together with a `panelmodel` object. The main functionalities of the package have been illustrated here by applying them on some well-known data sets from the econometric literature. The similarities and differences with the maximum likelihood approach to longitudinal data have also been briefly discussed. # Acknowledgments {-} While retaining responsibility for any error, we thank Jeffrey Wooldridge, Achim Zeileis and three anonymous referees for useful comments. We also acknowledge kind editing assistance by Lisa Benedetti. # Bibliography {-} plm/inst/doc/B_plmFunction.Rmd0000644000176200001440000004314314124132276015776 0ustar liggesusers--- title: "Estimation of error components models with the plm function" author: - name: Yves Croissant date: '`r Sys.Date()`' output: rmarkdown::html_vignette bibliography: ../inst/REFERENCES.bib vignette: > %\VignetteIndexEntry{Estimation of error component models with the plm function} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, echo=FALSE} library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` ```{r texreg, echo = FALSE, results = "hide"} library("texreg") extract.plm <- function(model, include.rsquared = TRUE, include.adjrs = TRUE, include.nobs = TRUE, include.ercomp = TRUE, ...) { s <- summary(model, ...) coefficient.names <- rownames(coef(s)) coefficients <- coef(s)[ , 1L] standard.errors <- coef(s)[ , 2L] significance <- coef(s)[ , 4L] rs <- s$r.squared[1L] adj <- s$r.squared[2L] n <- length(model$residuals) gof <- numeric() gof.names <- character() gof.decimal <- logical() if (include.ercomp == TRUE){ if (model$args$model == "random"){ se <- sqrt(ercomp(model)$sigma) gof <- c(gof, se) gof.names <- c(gof.names, paste("s_", names(se), sep = "")) gof.decimal <- c(gof.decimal, rep(TRUE, length(se))) } } if (include.rsquared == TRUE) { gof <- c(gof, rs) gof.names <- c(gof.names, "R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.adjrs == TRUE) { gof <- c(gof, adj) gof.names <- c(gof.names, "Adj.\ R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.nobs == TRUE) { gof <- c(gof, n) gof.names <- c(gof.names, "Num.\ obs.") gof.decimal <- c(gof.decimal, FALSE) } tr <- createTexreg( coef.names = coefficient.names, coef = coefficients, se = standard.errors, pvalues = significance, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal ) return(tr) } setMethod("extract", signature = className("plm", "plm"), definition = extract.plm) ``` `plm` is a very versatile function which enable the estimation of a wide range of error component models. Those models can be written as follows : $$ y_{nt}=\alpha + \beta^\top x_{nt} + \epsilon_{nt} = \alpha + \beta^\top x_{nt} + \eta_n + \mu_t + \nu_{nt} $$ where $n$ and $t$ are the individual and time indexes, $y$ the response, $x$ a vector of covariates, $\alpha$ the overall intercept and $\beta$ the vector of parameters of interest that we are willing to estimate. The error term $\epsilon_{nt}$ is composed of three elements (in the two-way case): - $\eta_n$ is the individual effect, - $\mu_t$ is the time effect, - $\nu_{nt}$ is the idiosyncratic error. # Basic use of `plm` The first two arguments of `plm` are, like for most of the estimation functions of `R` a `formula` which describes the model to be estimated and a `data.frame`. `subset`, `weights`, and `na.action` are also available and have the same behavior as in the `lm` function. Three more main arguments can be set : - `index` helps `plm` to understand the structure of the data : if `NULL`, the first two columns of the data are assumed to contain the individual or the time index. Otherwise, supply the column names of the individual and time index as a character, e.g., use something like `c("firm", "year")` or just `"firm"` if there is no explicit time index. - `effect` indicates the effects that should be taken into account ; this is one of `"individual"`, `"time"`, and `"twoways"`. - `model` indicates the model to be estimated : `"pooling"` is just the OLS estimation (equivalent to a call to `lm`), `"between"` performs the estimation on the individual or time means, `"within"` on the deviations from the individual or/and time mean, `"fd"` on the first differences and `"random"` perform a feasible generalized least squares estimation which takes into account the correlation induced by the presence of individual and/or time effects. The estimation of all but the last model is straightforward, as it requires only the estimation by *OLS* of obvious transformations of the data. The *GLS* model requires more explanation. In most of the cases, the estimation is obtained by quasi-differencing the data from the individual and/or the time means. The coefficients used to perform this quasi-difference depends on estimators of the variance of the components of the error, namely $\sigma^2_\nu$, $\sigma^2_\eta$ in case of individual effects and $\sigma^2_\mu$ in case of time effects. The most common technique used to estimate these variance is to use the following result : $$ \frac{\mbox{E}(\epsilon^\top W \epsilon)}{N(T-1)} = \sigma_\nu^2 $$ and $$ \frac{\mbox{E}(\epsilon^\top B \epsilon)}{N} = T \sigma_\eta^2 + \sigma_\nu^2 $$ where $B$ and $W$ are respectively the matrices that performs the individual (or time) means and the deviations from these means. Consistent estimators can be obtained by replacing the unknown errors by the residuals of a consistent preliminary estimation and by dropping the expecting value operator. Some degree of freedom correction can also be introduced. `plm` calls the general function `ercomp` to estimate the variances. Important arguments to `ercomp` are: - `models` indicates which models are estimated in order to calculate the two quadratic forms ; for example `c("within", "Between")`. Note that when only one model is provided in `models`, this means that the same residuals are used to compute the two quadratic forms. - `dfcor` indicates what kind of degrees of freedom correction is used : if `0`, the quadratic forms are divided by the number of observations, respectively $N\times T$ and $N$ ; if `1`, the numerators of the previous expressions are used ($N\times (T-1)$ and $N$) ; if `2`, the number of estimated parameters in the preliminary estimate $K$ is deducted. Finally, if `3`, the unbiased version is computed, which is based on much more complex computations, which relies on the calculus of the trace of different cross-products which depends on the preliminary models used. - `method` is an alternative to the `models` argument; it is one of : * `"walhus"` (equivalent to setting `models = c("pooling")`), @WALL:HUSS:69, * `"swar"` (equivalent to `models = c("within", "Between")`), @SWAM:AROR:72, * `"amemiya"` (equivalent to `models = c("within")`), @AMEM:71, * `"nerlove"`, which is a specific method which doesn't fit to the quadratic form methodology described above (@NERLO:71) and uses an within model for the variance estimation as well, * `"ht"` is an slightly modified version of `"amemiya"`: when there are time-invariant covariates, the @AMEM:71 estimator of the individual component of the variance under-estimates as the time-invariant covariates disappear in the within regression. In this case, @HAUS:TAYL:81 proposed to regress the estimation of the individual effects on the time-invariant covariates and use the residuals in order to estimate the components of the variance. Note that for `plm`, the arguments are `random.models`, `random.dfcor`, and `random.method` and correspond to arguments `models`, `method`, and `random.dfcor` of function `ercomp` with the same values as above, respectively. To illustrate the use of `plm`, we use examples reproduced in @BALT:13, p. 21; @BALT:21, p. 31, table 2.1 presents EViews' results of the estimation on the `Grunfeld` data set : ```{r grunfeld} library("plm") data("Grunfeld", package = "plm") ols <- plm(inv ~ value + capital, Grunfeld, model = "pooling") between <- update(ols, model = "between") within <- update(ols, model = "within") walhus <- update(ols, model = "random", random.method = "walhus", random.dfcor = 3) amemiya <- update(walhus, random.method = "amemiya") swar <- update(amemiya, random.method = "swar") ``` Note that the `random.dfcor` argument is set to `3`, which means that the unbiased version of the estimation of the error components is used. We use the `texreg` package to present the results : ```{r grunfeldresults, echo = TRUE} library("texreg") screenreg(list(ols = ols, between = between, within = within, walhus = walhus, amemiya = amemiya, swar = swar), digits = 5, omit.coef = "(Intercept)") ``` The estimated variance can be extracted using the `ercomp` function. For example, for the `amemiya` model : ```{r ercompamemiya} ercomp(amemiya) ``` @BALT:13, p. 27; @BALT:21, p. 31 presents the Stata estimation of the Swamy-Arora estimator ; the Swamy-Arora estimator is the same if `random.dfcor` is set to `3` or `2` (the quadratic forms are divided by $\sum_n T_n - K - N$ and by $N - K - 1$), so I don't know what is the behaviour of Stata for the other estimators for which the unbiased estimators differs from the simple one. ```{r produc} data("Produc", package = "plm") PrSwar <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "swar", random.dfcor = 3) summary(PrSwar) ``` # The twoways effect model The two-ways effect model is obtained by setting the `effect` argument to `"twoways"`. @BALT:13 pp. 51-53; @BALT:21, pp. 61-62, tables 3.1-3.3, presents EViews' output for the Grunfeld data set. ```{r grunfeld2ways} Grw <- plm(inv ~ value + capital, Grunfeld, model = "random", effect = "twoways", random.method = "walhus", random.dfcor = 3) Grs <- update(Grw, random.method = "swar") Gra <- update(Grw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Grw, "Swamy-Arora" = Grs, "Amemiya" = Gra), digits = 5) ``` The estimated variance of the time component is negative for the Wallace-Hussain as well as the Swamy-Arora models and `plm` sets it to 0. @BALT:09 pp. 60-62, presents EViews' output for the `Produc` data. ```{r produc2ways} data("Produc", package = "plm") Prw <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "walhus", effect = "twoways", random.dfcor = 3) Prs <- update(Prw, random.method = "swar") Pra <- update(Prw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Prw, "Swamy-Arora" = Prs, "Amemiya" = Pra), digits = 5) ``` # Unbalanced panels Two difficulties arise with unbalanced panels : - There are no obvious denominators for the quadratic forms of the residuals that are used to estimate the components of the variance. The strategy is then to compute the expected value and equate it to the actual quadratic forms. Detailed formula are omitted here, they depend on the preliminary estimator. - For the one-way effect model, the estimator is still obtained by applying *OLS* on demeaned data (the individual **and** the time means are now deducted) for the within model and on quasi-demeaned data for the random effects model ; this is not the case for the two-ways effects model. @BALT:21, @BALT:13, and @BALT:09 present results of the estimation of the @SWAM:AROR:72 model with the `Hedonic` data set. @BALT:13, p. 195; @BALT:21, p. 237, table 9.1, presents the Stata output and @BALT:09, p. 211 presents EViews' output. EViews' Wallace-Hussain estimator is reported in @BALT:09, p. 210. ```{r hedonic} data("Hedonic", package = "plm") form <- mv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + blacks + lstat HedStata <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "between")) HedEviews <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "Between")) HedEviewsWH <- update(HedEviews, random.models = "pooling") screenreg(list(EViews = HedEviews, Stata = HedStata, "Wallace-Hussain" = HedEviewsWH), digits = 5, single.row = TRUE) ``` The difference is due to the fact that Stata uses a between regression on $N$ observations while EViews uses a between regression on $\sum_n T_n$ observations, which are not the same on unbalanced panels. Note the use of between with or without the B capitalized (`"Between"` and `"between"`) in the `random.models` argument. `plm`'s default is to use the between regression with $\sum_n T_n$ observations when setting `model = "random", random.method = "swar"`. The default employed is what the original paper for the unbalanced one-way Swamy-Arora estimator defined (in @BALT:CHAN:94, p. 73). A more detailed analysis of Stata's Swamy-Arora estimation procedure is given by @COTT:2017. # Instrumental variable estimators All of the models presented above may be estimated using instrumental variables (IV). The instruments are specified using two- or three-part formulas, each part being separated by a `|` sign : - the first part contains the covariates, - the second part contains the "double-exogenous" instruments, *i.e.*, variables that can be used twice as instruments, using their within and the between transformation, - the third part contains the "single-exogenous" instruments, *i.e.*, variables for which only the within transformation can be used as instruments, those variables being correlated with the individual effects. The instrumental variables estimator used is indicated with the `inst.method` argument: - `"bvk"`, from @BALE:VARA:87, the default value : in this case, all the instruments are introduced in quasi-differences, using the same transformation as for the response and the covariates, - `"baltagi"`, from @BALT:81, the instruments of the *second* part are introduced twice by using the between and the within transformation and instruments of the *third* part are introduced with only the within transformation, - `"am"`, from @AMEM:MACU:86, in addition to the instrument set of `"baltagi"`, the within transformation of the variables of the *second* part for each period are also included as instruments, - `"bms"`, from @BREU:MIZO:SCHM:89, in addition to the instrument set of `"baltagi"`, the within transformation of the variables of the *second* and the *third* part for each period are included as instruments. The various possible values of the `inst.method` argument are not relevant for fixed effect IV models as there is only one method for this type of IV models but many for random effect IV models. The instrumental variable estimators are illustrated in the following example from @BALT:05, pp. 117/120; @BALT:13, pp. 133/137; @BALT:21, pp. 162/165, tables 7.1, 7.3. ```{r IV} data("Crime", package = "plm") crbalt <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random", inst.method = "baltagi") crbvk <- update(crbalt, inst.method = "bvk") crwth <- update(crbalt, model = "within") crbe <- update(crbalt, model = "between") screenreg(list(FE2SLS = crwth, BE2SLS = crbe, EC2SLS = crbalt, G2SLS = crbvk), single.row = FALSE, digits = 5, omit.coef = "(region)|(year)", reorder.coef = c(1:16, 19, 18, 17)) ``` The Hausman-Taylor model (@HAUS:TAYL:81) may be estimated with the `plm` function by setting argument `random.method = "ht"` and `inst.method = "baltagi"`. The following example is from @BALT:05, p. 130; @BALT:13, pp. 145-7, tables 7.4-7.6; @BALT:21, pp. 174-6 , tables 7.5-7.7. ```{r IV-HT} data("Wages", package = "plm") ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + exp + I(exp^2) + union, data = Wages, index = 595, inst.method = "baltagi", model = "random", random.method = "ht") am <- update(ht, inst.method = "am") bms <- update(ht, inst.method = "bms") screenreg(list("Hausman-Taylor" = ht, "Amemiya-MaCurdy" = am, "Breusch-Mizon-Schmidt" = bms), digits = 5, single.row = FALSE) ``` # Nested error component model This section shows how the nested error component model as per @BALT:SONG:JUNG:01 can be estimated. The model is given by : $$ y_{nt}=\alpha + \beta^\top x_{jnt} + u_{jnt} = \alpha + \beta^\top x_{jnt} + \mu_{j} + \nu_{jn} + \epsilon_{jnt} $$ where $n$ and $t$ are the individual and time indexes and $j$ is the group index in which the individuals are nested. The error $u_{jnt}$ consists of three components : - $\mu_j$ is the group effect, - $\nu_{jn}$ the nested effect of the individual nested in group $j$ - $\epsilon_{jnt}$ is the idiosyncratic error. In the estimated examples below (replication of @BALT:SONG:JUNG:01, p. 378, table 6; @BALT:21, p. 248, table 9.1), states are nested within regions. The group index is given in the 3rd position of the `index` argument to `pdata.frame` or to `plm` directly and `plm`'s argument `effect` is set to `"nested"`: ```{r nestedRE} data("Produc", package = "plm") swar <- plm(form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp, Produc, index = c("state", "year", "region"), model = "random", effect = "nested", random.method = "swar") walhus <- update(swar, random.method = "walhus") amem <- update(swar, random.method = "amemiya") screenreg(list("Swamy-Arora" = swar, "Wallace-Hussain" = walhus, "Amemiya" = amem), digits = 5) ``` # Bibliography plm/inst/doc/B_plmFunction.R0000644000176200001440000001466014177501547015470 0ustar liggesusers## ----setup, echo=FALSE-------------------------------------------------------- library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ## ----texreg, echo = FALSE, results = "hide"----------------------------------- library("texreg") extract.plm <- function(model, include.rsquared = TRUE, include.adjrs = TRUE, include.nobs = TRUE, include.ercomp = TRUE, ...) { s <- summary(model, ...) coefficient.names <- rownames(coef(s)) coefficients <- coef(s)[ , 1L] standard.errors <- coef(s)[ , 2L] significance <- coef(s)[ , 4L] rs <- s$r.squared[1L] adj <- s$r.squared[2L] n <- length(model$residuals) gof <- numeric() gof.names <- character() gof.decimal <- logical() if (include.ercomp == TRUE){ if (model$args$model == "random"){ se <- sqrt(ercomp(model)$sigma) gof <- c(gof, se) gof.names <- c(gof.names, paste("s_", names(se), sep = "")) gof.decimal <- c(gof.decimal, rep(TRUE, length(se))) } } if (include.rsquared == TRUE) { gof <- c(gof, rs) gof.names <- c(gof.names, "R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.adjrs == TRUE) { gof <- c(gof, adj) gof.names <- c(gof.names, "Adj.\ R$^2$") gof.decimal <- c(gof.decimal, TRUE) } if (include.nobs == TRUE) { gof <- c(gof, n) gof.names <- c(gof.names, "Num.\ obs.") gof.decimal <- c(gof.decimal, FALSE) } tr <- createTexreg( coef.names = coefficient.names, coef = coefficients, se = standard.errors, pvalues = significance, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal ) return(tr) } setMethod("extract", signature = className("plm", "plm"), definition = extract.plm) ## ----grunfeld----------------------------------------------------------------- library("plm") data("Grunfeld", package = "plm") ols <- plm(inv ~ value + capital, Grunfeld, model = "pooling") between <- update(ols, model = "between") within <- update(ols, model = "within") walhus <- update(ols, model = "random", random.method = "walhus", random.dfcor = 3) amemiya <- update(walhus, random.method = "amemiya") swar <- update(amemiya, random.method = "swar") ## ----grunfeldresults, echo = TRUE--------------------------------------------- library("texreg") screenreg(list(ols = ols, between = between, within = within, walhus = walhus, amemiya = amemiya, swar = swar), digits = 5, omit.coef = "(Intercept)") ## ----ercompamemiya------------------------------------------------------------ ercomp(amemiya) ## ----produc------------------------------------------------------------------- data("Produc", package = "plm") PrSwar <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "swar", random.dfcor = 3) summary(PrSwar) ## ----grunfeld2ways------------------------------------------------------------ Grw <- plm(inv ~ value + capital, Grunfeld, model = "random", effect = "twoways", random.method = "walhus", random.dfcor = 3) Grs <- update(Grw, random.method = "swar") Gra <- update(Grw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Grw, "Swamy-Arora" = Grs, "Amemiya" = Gra), digits = 5) ## ----produc2ways-------------------------------------------------------------- data("Produc", package = "plm") Prw <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, model = "random", random.method = "walhus", effect = "twoways", random.dfcor = 3) Prs <- update(Prw, random.method = "swar") Pra <- update(Prw, random.method = "amemiya") screenreg(list("Wallace-Hussain" = Prw, "Swamy-Arora" = Prs, "Amemiya" = Pra), digits = 5) ## ----hedonic------------------------------------------------------------------ data("Hedonic", package = "plm") form <- mv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + blacks + lstat HedStata <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "between")) HedEviews <- plm(form, Hedonic, model = "random", index = "townid", random.models = c("within", "Between")) HedEviewsWH <- update(HedEviews, random.models = "pooling") screenreg(list(EViews = HedEviews, Stata = HedStata, "Wallace-Hussain" = HedEviewsWH), digits = 5, single.row = TRUE) ## ----IV----------------------------------------------------------------------- data("Crime", package = "plm") crbalt <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, data = Crime, model = "random", inst.method = "baltagi") crbvk <- update(crbalt, inst.method = "bvk") crwth <- update(crbalt, model = "within") crbe <- update(crbalt, model = "between") screenreg(list(FE2SLS = crwth, BE2SLS = crbe, EC2SLS = crbalt, G2SLS = crbvk), single.row = FALSE, digits = 5, omit.coef = "(region)|(year)", reorder.coef = c(1:16, 19, 18, 17)) ## ----IV-HT-------------------------------------------------------------------- data("Wages", package = "plm") ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + exp + I(exp^2) + union, data = Wages, index = 595, inst.method = "baltagi", model = "random", random.method = "ht") am <- update(ht, inst.method = "am") bms <- update(ht, inst.method = "bms") screenreg(list("Hausman-Taylor" = ht, "Amemiya-MaCurdy" = am, "Breusch-Mizon-Schmidt" = bms), digits = 5, single.row = FALSE) ## ----nestedRE----------------------------------------------------------------- data("Produc", package = "plm") swar <- plm(form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp, Produc, index = c("state", "year", "region"), model = "random", effect = "nested", random.method = "swar") walhus <- update(swar, random.method = "walhus") amem <- update(swar, random.method = "amemiya") screenreg(list("Swamy-Arora" = swar, "Wallace-Hussain" = walhus, "Amemiya" = amem), digits = 5) plm/inst/doc/C_plmModelComponents.Rmd0000644000176200001440000001574314154734502017330 0ustar liggesusers--- title: Model components for fitted models with plm author: - name: Yves Croissant date: '`r Sys.Date()`' output: rmarkdown::html_vignette bibliography: ../inst/REFERENCES.bib vignette: > %\VignetteIndexEntry{Model components for fitted models with plm} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, echo=FALSE} library("knitr") opts_chunk$set(message = FALSE, warning = FALSE) ``` plm tries to follow as close as possible the way models are fitted using `lm`. This relies on the following steps, using the `formula`-`data` with some modifications: - compute internally the `model.frame` by getting the relevant arguments (`formula`, `data`, `subset`, `weights`, `na.action` and `offset`) and the supplementary argument, - extract from the `model.frame` the response `y` (with `pmodel.response`) and the model matrix `X` (with `model.matrix`), - call the (non-exported) estimation function `plm.fit` with `X` and `y` as arguments. Panel data has a special structure which is described by an `index` argument. This argument can be used in the `pdata.frame` function which returns a `pdata.frame` object. A `pdata.frame` can be used as input to the `data` argument of `plm`. If the `data` argument of `plm` is an ordinary `data.frame`, the `index` argument can also be supplied as an argument of `plm`. In this case, the `pdata.frame` function is called internally to transform the data. Next, the `formula`, which is the first and mandatory argument of `plm` is coerced to a `Formula` object. `model.frame` is then called, but with the `data` argument in the first position (a `pdata.frame` object) and the `formula` in the second position. This unusual order of the arguments enables to use a specific `model.frame.pdata.frame` method defined in `plm`. As for the `model.frame.formula` method, a `data.frame` is returned, with a `terms` attribute. Next, the `X` matrix is extracted using `model.matrix`. The usual way to do so is to feed the function with two arguments, a `formula` or a `terms` object and a `data.frame` created with `model.frame`. `lm` uses something like `model.matrix(terms(mf), mf)` where `mf` is a `data.frame` created with `model.frame`. Therefore, `model.matrix` needs actually one argument and not two and we therefore wrote a `model.matrix.pdata.frame` which does the job ; the method first checks that the argument has a `term` attribute, extracts the `terms` (actually the `formula`) and then computes the model's matrix `X`. The response `y` is usually extracted using `model.response`, with a `data.frame` created with `model.frame` as first argument, but it is not generic. We therefore created a generic called `pmodel.response` and provide a `pmodel.response.pdata.frame` method. We illustrate these features using a simplified (in terms of covariates) example with the `SeatBelt` data set: ```{r } library("plm") data("SeatBelt", package = "pder") SeatBelt$occfat <- with(SeatBelt, log(farsocc / (vmtrural + vmturban))) pSB <- pdata.frame(SeatBelt) ``` We start with an OLS (pooling) specification: ```{r } formols <- occfat ~ log(usage) + log(percapin) mfols <- model.frame(pSB, formols) Xols <- model.matrix(mfols) y <- pmodel.response(mfols) coef(lm.fit(Xols, y)) ``` which is equivalent to: ```{r } coef(plm(formols, SeatBelt, model = "pooling")) ``` Next, we use an instrumental variables specification. Variable `usage` is endogenous and instrumented by three variables indicating the law context: `ds`, `dp`, and `dsp`. The model is described using a two-parts formula, the first part of the RHS describing the covariates and the second part the instruments. The following two formulations can be used: ```{r } formiv1 <- occfat ~ log(usage) + log(percapin) | log(percapin) + ds + dp + dsp formiv2 <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp ``` The second formulation has two advantages: - in the common case when a lot of covariates are instruments, these covariates don't need to be indicated in the second RHS part of the formula, - the endogenous variables clearly appear as they are proceeded by a `-` sign in the second RHS part of the formula. The formula is coerced to a `Formula`, using the `Formula` package. `model.matrix.pdata.frame` then internally calls `model.matrix.Formula` in order to extract the covariates and instruments model matrices: ```{r } mfSB1 <- model.frame(pSB, formiv1) X1 <- model.matrix(mfSB1, rhs = 1) W1 <- model.matrix(mfSB1, rhs = 2) head(X1, 3) ; head(W1, 3) ``` For the second (and preferred formulation), the `dot` argument should be set and is passed to the `Formula` methods. `.` has actually two meanings: - all available covariates, - the previous covariates used while updating a formula. which correspond respectively to `dot = "seperate"` (the default) and `dot = "previous"`. See the difference between the following two examples: ```{r } library("Formula") head(model.frame(Formula(formiv2), SeatBelt), 3) head(model.frame(Formula(formiv2), SeatBelt, dot = "previous"), 3) ``` In the first case, all the covariates are returned by `model.frame` as the `.` is understood by default as "everything". In `plm`, the `dot` argument is internally set to `previous` so that the end-user doesn't have to worry about these subtleties. ```{r } mfSB2 <- model.frame(pSB, formiv2) X2 <- model.matrix(mfSB2, rhs = 1) W2 <- model.matrix(mfSB2, rhs = 2) head(X2, 3) ; head(W2, 3) ``` The IV estimator can then be obtained as a 2SLS estimator: First, regress the covariates on the instruments and get the fitted values: ```{r } HX1 <- lm.fit(W1, X1)$fitted.values head(HX1, 3) ``` Next, regress the response on these fitted values: ```{r } coef(lm.fit(HX1, y)) ``` The same can be achieved in one command by using the `formula`-`data` interface with `plm`: ```{r } coef(plm(formiv1, SeatBelt, model = "pooling")) ``` or with the `ivreg` function from package `AER` (or with the newer function `ivreg` in package `ivreg` superseding `AER::ivreg()`): ```{r } coef(AER::ivreg(formiv1, data = SeatBelt)) ``` ```{r eval = FALSE, include = FALSE} X2 <- model.matrix(Formula(form1), mfSB, rhs = 2, dot = "previous") formols <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp form1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + log(precentb) + log(precenth) + log(densrur) + log(densurb) + log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + log(fueltax) + lim65 + lim70p + mlda21 + bac08 form2 <- . ~ . | . - log(usage) + ds + dp +dsp jorm1 <- occfat ~ log(usage) + log(percapin) + log(unemp) + log(meanage) + log(precentb) + log(precenth) + log(densrur) + log(densurb) + log(viopcap) + log(proppcap) + log(vmtrural) + log(vmturban) + log(fueltax) + lim65 + lim70p + mlda21 + bac08 | . - log(usage) + ds + dp + dsp jorm2 <- noccfat ~ . | . ``` plm/inst/doc/C_plmModelComponents.html0000644000176200001440000006477114177501551017560 0ustar liggesusers Model components for fitted models with plm

Model components for fitted models with plm

Yves Croissant

2022-02-05

plm tries to follow as close as possible the way models are fitted using lm. This relies on the following steps, using the formula-data with some modifications:

  • compute internally the model.frame by getting the relevant arguments (formula, data, subset, weights, na.action and offset) and the supplementary argument,
  • extract from the model.frame the response y (with pmodel.response) and the model matrix X (with model.matrix),
  • call the (non-exported) estimation function plm.fit with X and y as arguments.

Panel data has a special structure which is described by an index argument. This argument can be used in the pdata.frame function which returns a pdata.frame object. A pdata.frame can be used as input to the data argument of plm. If the data argument of plm is an ordinary data.frame, the index argument can also be supplied as an argument of plm. In this case, the pdata.frame function is called internally to transform the data.

Next, the formula, which is the first and mandatory argument of plm is coerced to a Formula object.

model.frame is then called, but with the data argument in the first position (a pdata.frame object) and the formula in the second position. This unusual order of the arguments enables to use a specific model.frame.pdata.frame method defined in plm.

As for the model.frame.formula method, a data.frame is returned, with a terms attribute.

Next, the X matrix is extracted using model.matrix. The usual way to do so is to feed the function with two arguments, a formula or a terms object and a data.frame created with model.frame. lm uses something like model.matrix(terms(mf), mf) where mf is a data.frame created with model.frame. Therefore, model.matrix needs actually one argument and not two and we therefore wrote a model.matrix.pdata.frame which does the job ; the method first checks that the argument has a term attribute, extracts the terms (actually the formula) and then computes the model’s matrix X.

The response y is usually extracted using model.response, with a data.frame created with model.frame as first argument, but it is not generic. We therefore created a generic called pmodel.response and provide a pmodel.response.pdata.frame method. We illustrate these features using a simplified (in terms of covariates) example with the SeatBelt data set:

library("plm")
data("SeatBelt", package = "pder")
SeatBelt$occfat <- with(SeatBelt, log(farsocc / (vmtrural + vmturban)))
pSB <- pdata.frame(SeatBelt)

We start with an OLS (pooling) specification:

formols <- occfat ~ log(usage) + log(percapin)
mfols <- model.frame(pSB, formols)
Xols <- model.matrix(mfols)
y <- pmodel.response(mfols)
coef(lm.fit(Xols, y))
##   (Intercept)    log(usage) log(percapin) 
##     7.4193570     0.1657293    -1.1583712

which is equivalent to:

coef(plm(formols, SeatBelt, model = "pooling"))
##   (Intercept)    log(usage) log(percapin) 
##     7.4193570     0.1657293    -1.1583712

Next, we use an instrumental variables specification. Variable usage is endogenous and instrumented by three variables indicating the law context: ds, dp, and dsp.

The model is described using a two-parts formula, the first part of the RHS describing the covariates and the second part the instruments. The following two formulations can be used:

formiv1 <- occfat ~ log(usage) + log(percapin) | log(percapin) + ds + dp + dsp
formiv2 <- occfat ~ log(usage) + log(percapin) | . - log(usage) + ds + dp + dsp

The second formulation has two advantages:

  • in the common case when a lot of covariates are instruments, these covariates don’t need to be indicated in the second RHS part of the formula,
  • the endogenous variables clearly appear as they are proceeded by a - sign in the second RHS part of the formula.

The formula is coerced to a Formula, using the Formula package. model.matrix.pdata.frame then internally calls model.matrix.Formula in order to extract the covariates and instruments model matrices:

mfSB1 <- model.frame(pSB, formiv1)
X1 <- model.matrix(mfSB1, rhs = 1)
W1 <- model.matrix(mfSB1, rhs = 2)
head(X1, 3) ; head(W1, 3)
##    (Intercept) log(usage) log(percapin)
## 8            1 -0.7985077      9.955748
## 9            1 -0.4155154      9.975622
## 10           1 -0.4155154     10.002110
##    (Intercept) log(percapin) ds dp dsp
## 8            1      9.955748  0  0   0
## 9            1      9.975622  1  0   0
## 10           1     10.002110  1  0   0

For the second (and preferred formulation), the dot argument should be set and is passed to the Formula methods. . has actually two meanings:

  • all available covariates,
  • the previous covariates used while updating a formula.

which correspond respectively to dot = "seperate" (the default) and dot = "previous". See the difference between the following two examples:

library("Formula")
head(model.frame(Formula(formiv2), SeatBelt), 3)
##       occfat log(usage) log(percapin) state year farsocc farsnocc usage
## 8  -3.788976 -0.7985077      9.955748    AK 1990      90        8  0.45
## 9  -3.904837 -0.4155154      9.975622    AK 1991      81       20  0.66
## 10 -3.699611 -0.4155154     10.002110    AK 1992      95       13  0.66
##    percapin unemp  meanage   precentb   precenth  densurb   densrur
## 8     21073  7.05 29.58628 0.04157167 0.03252657 1.099419 0.1906836
## 9     21496  8.75 29.82771 0.04077293 0.03280357 1.114670 0.1906712
## 10    22073  9.24 30.21070 0.04192957 0.03331731 1.114078 0.1672785
##         viopcap    proppcap vmtrural vmturban fueltax lim65 lim70p mlda21 bac08
## 8  0.0009482704 0.008367458     2276     1703       8     0      0      1     0
## 9  0.0010787370 0.008940661     2281     1740       8     0      0      1     0
## 10 0.0011257068 0.008366873     2005     1836       8     1      0      1     0
##    ds dp dsp
## 8   0  0   0
## 9   1  0   0
## 10  1  0   0
head(model.frame(Formula(formiv2), SeatBelt, dot = "previous"), 3)
##       occfat log(usage) log(percapin) ds dp dsp
## 8  -3.788976 -0.7985077      9.955748  0  0   0
## 9  -3.904837 -0.4155154      9.975622  1  0   0
## 10 -3.699611 -0.4155154     10.002110  1  0   0

In the first case, all the covariates are returned by model.frame as the . is understood by default as “everything.”

In plm, the dot argument is internally set to previous so that the end-user doesn’t have to worry about these subtleties.

mfSB2 <- model.frame(pSB, formiv2)
X2 <- model.matrix(mfSB2, rhs = 1)
W2 <- model.matrix(mfSB2, rhs = 2)
head(X2, 3) ; head(W2, 3)
##    (Intercept) log(usage) log(percapin)
## 8            1 -0.7985077      9.955748
## 9            1 -0.4155154      9.975622
## 10           1 -0.4155154     10.002110
##    (Intercept) log(percapin) ds dp dsp
## 8            1      9.955748  0  0   0
## 9            1      9.975622  1  0   0
## 10           1     10.002110  1  0   0

The IV estimator can then be obtained as a 2SLS estimator: First, regress the covariates on the instruments and get the fitted values:

HX1 <- lm.fit(W1, X1)$fitted.values
head(HX1, 3)
##    (Intercept) log(usage) log(percapin)
## 8            1 -1.0224257      9.955748
## 9            1 -0.5435055      9.975622
## 10           1 -0.5213364     10.002110

Next, regress the response on these fitted values:

coef(lm.fit(HX1, y))
##   (Intercept)    log(usage) log(percapin) 
##     7.5641209     0.1768576    -1.1722590

The same can be achieved in one command by using the formula-data interface with plm:

coef(plm(formiv1, SeatBelt, model = "pooling"))
##   (Intercept)    log(usage) log(percapin) 
##     7.5641209     0.1768576    -1.1722590

or with the ivreg function from package AER (or with the newer function ivreg in package ivreg superseding AER::ivreg()):

coef(AER::ivreg(formiv1, data = SeatBelt))
##   (Intercept)    log(usage) log(percapin) 
##     7.5641209     0.1768576    -1.1722590
plm/inst/doc/B_plmFunction.html0000644000176200001440000020513414177501550016223 0ustar liggesusers Estimation of error components models with the plm function

Estimation of error components models with the plm function

Yves Croissant

2022-02-05

plm is a very versatile function which enable the estimation of a wide range of error component models. Those models can be written as follows :

\[ y_{nt}=\alpha + \beta^\top x_{nt} + \epsilon_{nt} = \alpha + \beta^\top x_{nt} + \eta_n + \mu_t + \nu_{nt} \]

where \(n\) and \(t\) are the individual and time indexes, \(y\) the response, \(x\) a vector of covariates, \(\alpha\) the overall intercept and \(\beta\) the vector of parameters of interest that we are willing to estimate. The error term \(\epsilon_{nt}\) is composed of three elements (in the two-way case):

  • \(\eta_n\) is the individual effect,
  • \(\mu_t\) is the time effect,
  • \(\nu_{nt}\) is the idiosyncratic error.

Basic use of plm

The first two arguments of plm are, like for most of the estimation functions of R a formula which describes the model to be estimated and a data.frame. subset, weights, and na.action are also available and have the same behavior as in the lm function. Three more main arguments can be set :

  • index helps plm to understand the structure of the data : if NULL, the first two columns of the data are assumed to contain the individual or the time index. Otherwise, supply the column names of the individual and time index as a character, e.g., use something like c("firm", "year") or just "firm" if there is no explicit time index.
  • effect indicates the effects that should be taken into account ; this is one of "individual", "time", and "twoways".
  • model indicates the model to be estimated : "pooling" is just the OLS estimation (equivalent to a call to lm), "between" performs the estimation on the individual or time means, "within" on the deviations from the individual or/and time mean, "fd" on the first differences and "random" perform a feasible generalized least squares estimation which takes into account the correlation induced by the presence of individual and/or time effects.

The estimation of all but the last model is straightforward, as it requires only the estimation by OLS of obvious transformations of the data. The GLS model requires more explanation. In most of the cases, the estimation is obtained by quasi-differencing the data from the individual and/or the time means. The coefficients used to perform this quasi-difference depends on estimators of the variance of the components of the error, namely \(\sigma^2_\nu\), \(\sigma^2_\eta\) in case of individual effects and \(\sigma^2_\mu\) in case of time effects.

The most common technique used to estimate these variance is to use the following result :

\[ \frac{\mbox{E}(\epsilon^\top W \epsilon)}{N(T-1)} = \sigma_\nu^2 \]

and

\[ \frac{\mbox{E}(\epsilon^\top B \epsilon)}{N} = T \sigma_\eta^2 + \sigma_\nu^2 \]

where \(B\) and \(W\) are respectively the matrices that performs the individual (or time) means and the deviations from these means. Consistent estimators can be obtained by replacing the unknown errors by the residuals of a consistent preliminary estimation and by dropping the expecting value operator. Some degree of freedom correction can also be introduced. plm calls the general function ercomp to estimate the variances. Important arguments to ercomp are:

  • models indicates which models are estimated in order to calculate the two quadratic forms ; for example c("within", "Between"). Note that when only one model is provided in models, this means that the same residuals are used to compute the two quadratic forms.
  • dfcor indicates what kind of degrees of freedom correction is used : if 0, the quadratic forms are divided by the number of observations, respectively \(N\times T\) and \(N\) ; if 1, the numerators of the previous expressions are used (\(N\times (T-1)\) and \(N\)) ; if 2, the number of estimated parameters in the preliminary estimate \(K\) is deducted. Finally, if 3, the unbiased version is computed, which is based on much more complex computations, which relies on the calculus of the trace of different cross-products which depends on the preliminary models used.
  • method is an alternative to the models argument; it is one of :
    • "walhus" (equivalent to setting models = c("pooling")), Wallace and Hussain (1969),
    • "swar" (equivalent to models = c("within", "Between")), Swamy and Arora (1972),
    • "amemiya" (equivalent to models = c("within")), T. Amemiya (1971),
    • "nerlove", which is a specific method which doesn’t fit to the quadratic form methodology described above (Nerlove (1971)) and uses an within model for the variance estimation as well,
    • "ht" is an slightly modified version of "amemiya": when there are time-invariant covariates, the T. Amemiya (1971) estimator of the individual component of the variance under-estimates as the time-invariant covariates disappear in the within regression. In this case, Hausman and Taylor (1981) proposed to regress the estimation of the individual effects on the time-invariant covariates and use the residuals in order to estimate the components of the variance.

Note that for plm, the arguments are random.models, random.dfcor, and random.method and correspond to arguments models, method, and random.dfcor of function ercomp with the same values as above, respectively.

To illustrate the use of plm, we use examples reproduced in B. H. Baltagi (2013), p. 21; B. H. Baltagi (2021), p. 31, table 2.1 presents EViews’ results of the estimation on the Grunfeld data set :

library("plm")
data("Grunfeld", package = "plm")
ols <- plm(inv ~ value + capital, Grunfeld, model = "pooling")
between <- update(ols, model = "between")
within <- update(ols, model = "within")
walhus <- update(ols, model = "random", random.method = "walhus", random.dfcor = 3)
amemiya <- update(walhus, random.method = "amemiya")
swar <- update(amemiya, random.method = "swar")

Note that the random.dfcor argument is set to 3, which means that the unbiased version of the estimation of the error components is used. We use the texreg package to present the results :

library("texreg")
screenreg(list(ols = ols, between = between, within = within, 
            walhus = walhus, amemiya = amemiya, swar = swar),
        digits = 5, omit.coef = "(Intercept)")
## 
## =================================================================================================
##            ols            between      within         walhus         amemiya        swar         
## -------------------------------------------------------------------------------------------------
## value        0.11556 ***   0.13465 **    0.11012 ***    0.10979 ***    0.10978 ***    0.10978 ***
##             (0.00584)     (0.02875)     (0.01186)      (0.01052)      (0.01048)      (0.01049)   
## capital      0.23068 ***   0.03203       0.31007 ***    0.30818 ***    0.30808 ***    0.30811 ***
##             (0.02548)     (0.19094)     (0.01735)      (0.01717)      (0.01718)      (0.01718)   
## -------------------------------------------------------------------------------------------------
## R^2          0.81241       0.85777       0.76676        0.76941        0.76954        0.76950    
## Adj. R^2     0.81050       0.81713       0.75311        0.76707        0.76720        0.76716    
## Num. obs.  200            10           200            200            200            200          
## s_idios                                                53.74518       52.76797       52.76797    
## s_id                                                   87.35803       83.52354       84.20095    
## =================================================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

The estimated variance can be extracted using the ercomp function. For example, for the amemiya model :

ercomp(amemiya)
##                   var std.dev share
## idiosyncratic 2784.46   52.77 0.285
## individual    6976.18   83.52 0.715
## theta: 0.8601

B. H. Baltagi (2013), p. 27; B. H. Baltagi (2021), p. 31 presents the Stata estimation of the Swamy-Arora estimator ; the Swamy-Arora estimator is the same if random.dfcor is set to 3 or 2 (the quadratic forms are divided by \(\sum_n T_n - K - N\) and by \(N - K - 1\)), so I don’t know what is the behaviour of Stata for the other estimators for which the unbiased estimators differs from the simple one.

data("Produc", package = "plm")
PrSwar <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, 
           model = "random", random.method = "swar", random.dfcor = 3)
summary(PrSwar)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, 
##     data = Produc, model = "random", random.method = "swar", 
##     random.dfcor = 3)
## 
## Balanced Panel: n = 48, T = 17, N = 816
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 0.001454 0.038137 0.175
## individual    0.006838 0.082691 0.825
## theta: 0.8888
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -0.1067230 -0.0245520 -0.0023694  0.0217333  0.1996307 
## 
## Coefficients:
##                Estimate  Std. Error z-value              Pr(>|z|)    
## (Intercept)  2.13541100  0.13346149 16.0002 < 0.00000000000000022 ***
## log(pcap)    0.00443859  0.02341732  0.1895                0.8497    
## log(pc)      0.31054843  0.01980475 15.6805 < 0.00000000000000022 ***
## log(emp)     0.72967053  0.02492022 29.2803 < 0.00000000000000022 ***
## unemp       -0.00617247  0.00090728 -6.8033      0.00000000001023 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    29.209
## Residual Sum of Squares: 1.1879
## R-Squared:      0.95933
## Adj. R-Squared: 0.95913
## Chisq: 19131.1 on 4 DF, p-value: < 0.000000000000000222

The twoways effect model

The two-ways effect model is obtained by setting the effect argument to "twoways". B. H. Baltagi (2013) pp. 51-53; B. H. Baltagi (2021), pp. 61-62, tables 3.1-3.3, presents EViews’ output for the Grunfeld data set.

Grw <- plm(inv ~ value + capital, Grunfeld, model = "random", effect = "twoways", 
           random.method = "walhus", random.dfcor = 3)
Grs <- update(Grw, random.method = "swar")
Gra <- update(Grw, random.method = "amemiya")
screenreg(list("Wallace-Hussain" = Grw, "Swamy-Arora" = Grs, "Amemiya" = Gra), digits = 5)
## 
## ==========================================================
##              Wallace-Hussain  Swamy-Arora    Amemiya      
## ----------------------------------------------------------
## (Intercept)  -57.81705 *      -57.86538 *    -63.89217 *  
##              (28.63258)       (29.39336)     (30.53284)   
## value          0.10978 ***      0.10979 ***    0.11145 ***
##               (0.01047)        (0.01053)      (0.01096)   
## capital        0.30807 ***      0.30819 ***    0.32353 ***
##               (0.01719)        (0.01717)      (0.01877)   
## ----------------------------------------------------------
## s_idios       55.33298         51.72452       51.72452    
## s_id          87.31428         84.23332       89.26257    
## s_time         0.00000          0.00000       15.77783    
## R^2            0.76956          0.76940        0.74898    
## Adj. R^2       0.76722          0.76706        0.74643    
## Num. obs.    200              200            200          
## ==========================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

The estimated variance of the time component is negative for the Wallace-Hussain as well as the Swamy-Arora models and plm sets it to 0.

B. H. Baltagi (2009) pp. 60-62, presents EViews’ output for the Produc data.

data("Produc", package = "plm")
Prw <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, Produc, 
           model = "random", random.method = "walhus", 
           effect = "twoways", random.dfcor = 3)
Prs <- update(Prw, random.method = "swar")
Pra <- update(Prw, random.method = "amemiya")
screenreg(list("Wallace-Hussain" = Prw, "Swamy-Arora" = Prs, "Amemiya" = Pra), digits = 5)
## 
## ==========================================================
##              Wallace-Hussain  Swamy-Arora    Amemiya      
## ----------------------------------------------------------
## (Intercept)    2.39200 ***      2.36350 ***    2.85210 ***
##               (0.13833)        (0.13891)      (0.18502)   
## log(pcap)      0.02562          0.01785        0.00221    
##               (0.02336)        (0.02332)      (0.02469)   
## log(pc)        0.25781 ***      0.26559 ***    0.21666 ***
##               (0.02128)        (0.02098)      (0.02438)   
## log(emp)       0.74180 ***      0.74490 ***    0.77005 ***
##               (0.02371)        (0.02411)      (0.02584)   
## unemp         -0.00455 ***     -0.00458 ***   -0.00398 ***
##               (0.00106)        (0.00102)      (0.00108)   
## ----------------------------------------------------------
## s_idios        0.03571          0.03429        0.03429    
## s_id           0.08244          0.08279        0.15390    
## s_time         0.01595          0.00984        0.02608    
## R^2            0.92915          0.93212        0.85826    
## Adj. R^2       0.92880          0.93178        0.85756    
## Num. obs.    816              816            816          
## ==========================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

Unbalanced panels

Two difficulties arise with unbalanced panels :

  • There are no obvious denominators for the quadratic forms of the residuals that are used to estimate the components of the variance. The strategy is then to compute the expected value and equate it to the actual quadratic forms. Detailed formula are omitted here, they depend on the preliminary estimator.
  • For the one-way effect model, the estimator is still obtained by applying OLS on demeaned data (the individual and the time means are now deducted) for the within model and on quasi-demeaned data for the random effects model ; this is not the case for the two-ways effects model.

B. H. Baltagi (2021), B. H. Baltagi (2013), and B. H. Baltagi (2009) present results of the estimation of the Swamy and Arora (1972) model with the Hedonic data set. B. H. Baltagi (2013), p. 195; B. H. Baltagi (2021), p. 237, table 9.1, presents the Stata output and B. H. Baltagi (2009), p. 211 presents EViews’ output. EViews’ Wallace-Hussain estimator is reported in B. H. Baltagi (2009), p. 210.

data("Hedonic", package = "plm")
form <- mv ~ crim + zn + indus + chas + nox + rm + 
    age + dis + rad + tax + ptratio + blacks + lstat
HedStata <- plm(form, Hedonic, model = "random", index = "townid", 
                random.models = c("within", "between"))
HedEviews <- plm(form, Hedonic, model = "random", index = "townid", 
                 random.models = c("within", "Between"))
HedEviewsWH <- update(HedEviews, random.models = "pooling")
screenreg(list(EViews = HedEviews, Stata = HedStata, "Wallace-Hussain" = HedEviewsWH), 
          digits = 5, single.row = TRUE)
## 
## ======================================================================================
##              EViews                   Stata                    Wallace-Hussain        
## --------------------------------------------------------------------------------------
## (Intercept)    9.68587 (0.19751) ***    9.67780 (0.20714) ***    9.68443 (0.19922) ***
## crim          -0.00741 (0.00105) ***   -0.00723 (0.00103) ***   -0.00738 (0.00105) ***
## zn             0.00008 (0.00065)        0.00004 (0.00069)        0.00007 (0.00066)    
## indus          0.00156 (0.00403)        0.00208 (0.00434)        0.00165 (0.00409)    
## chasyes       -0.00442 (0.02921)       -0.01059 (0.02896)       -0.00565 (0.02916)    
## nox           -0.00584 (0.00125) ***   -0.00586 (0.00125) ***   -0.00585 (0.00125) ***
## rm             0.00906 (0.00119) ***    0.00918 (0.00118) ***    0.00908 (0.00119) ***
## age           -0.00086 (0.00047)       -0.00093 (0.00046) *     -0.00087 (0.00047)    
## dis           -0.14442 (0.04409) **    -0.13288 (0.04568) **    -0.14236 (0.04439) ** 
## rad            0.09598 (0.02661) ***    0.09686 (0.02835) ***    0.09614 (0.02692) ***
## tax           -0.00038 (0.00018) *     -0.00037 (0.00019) *     -0.00038 (0.00018) *  
## ptratio       -0.02948 (0.00907) **    -0.02972 (0.00975) **    -0.02951 (0.00919) ** 
## blacks         0.56278 (0.10197) ***    0.57506 (0.10103) ***    0.56520 (0.10179) ***
## lstat         -0.29107 (0.02393) ***   -0.28514 (0.02385) ***   -0.28991 (0.02391) ***
## --------------------------------------------------------------------------------------
## s_idios        0.13025                  0.13025                  0.14050              
## s_id           0.11505                  0.12974                  0.12698              
## R^2            0.99091                  0.99029                  0.99081              
## Adj. R^2       0.99067                  0.99004                  0.99057              
## Num. obs.    506                      506                      506                    
## ======================================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

The difference is due to the fact that Stata uses a between regression on \(N\) observations while EViews uses a between regression on \(\sum_n T_n\) observations, which are not the same on unbalanced panels. Note the use of between with or without the B capitalized ("Between" and "between") in the random.models argument. plm’s default is to use the between regression with \(\sum_n T_n\) observations when setting model = "random", random.method = "swar". The default employed is what the original paper for the unbalanced one-way Swamy-Arora estimator defined (in B. H. Baltagi and Chang (1994), p. 73). A more detailed analysis of Stata’s Swamy-Arora estimation procedure is given by Cottrell (2017).

Instrumental variable estimators

All of the models presented above may be estimated using instrumental variables (IV). The instruments are specified using two- or three-part formulas, each part being separated by a | sign :

  • the first part contains the covariates,
  • the second part contains the “double-exogenous” instruments, i.e., variables that can be used twice as instruments, using their within and the between transformation,
  • the third part contains the “single-exogenous” instruments, i.e., variables for which only the within transformation can be used as instruments, those variables being correlated with the individual effects.

The instrumental variables estimator used is indicated with the inst.method argument:

  • "bvk", from Balestra and Varadharajan–Krishnakumar (1987), the default value : in this case, all the instruments are introduced in quasi-differences, using the same transformation as for the response and the covariates,
  • "baltagi", from B. H. Baltagi (1981), the instruments of the second part are introduced twice by using the between and the within transformation and instruments of the third part are introduced with only the within transformation,
  • "am", from Takeshi Amemiya and MaCurdy (1986), in addition to the instrument set of "baltagi", the within transformation of the variables of the second part for each period are also included as instruments,
  • "bms", from Breusch, Mizon, and Schmidt (1989), in addition to the instrument set of "baltagi", the within transformation of the variables of the second and the third part for each period are included as instruments.

The various possible values of the inst.method argument are not relevant for fixed effect IV models as there is only one method for this type of IV models but many for random effect IV models.

The instrumental variable estimators are illustrated in the following example from B. H. Baltagi (2005), pp. 117/120; B. H. Baltagi (2013), pp. 133/137; B. H. Baltagi (2021), pp. 162/165, tables 7.1, 7.3.

data("Crime", package = "plm")
crbalt <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen +
              ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed +
              lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year)
              | . - lprbarr - lpolpc + ltaxpc + lmix,
              data = Crime, model = "random", inst.method = "baltagi")
crbvk <- update(crbalt, inst.method = "bvk")
crwth <- update(crbalt, model = "within")
crbe  <- update(crbalt, model = "between")
screenreg(list(FE2SLS = crwth, BE2SLS = crbe, EC2SLS = crbalt, G2SLS = crbvk), 
          single.row = FALSE, digits = 5, omit.coef = "(region)|(year)",
          reorder.coef = c(1:16, 19, 18, 17))
## 
## ===================================================================
##              FE2SLS      BE2SLS        EC2SLS         G2SLS        
## -------------------------------------------------------------------
## lprbarr       -0.57551   -0.50294 *     -0.41293 ***   -0.41414    
##               (0.80218)  (0.24062)      (0.09740)      (0.22105)   
## lpolpc         0.65753    0.40844 *      0.43475 ***    0.50495 *  
##               (0.84687)  (0.19300)      (0.08970)      (0.22778)   
## lprbconv      -0.42314   -0.52477 ***   -0.32289 ***   -0.34325 ** 
##               (0.50194)  (0.09995)      (0.05355)      (0.13246)   
## lprbpris      -0.25026    0.18718       -0.18632 ***   -0.19005 ** 
##               (0.27946)  (0.31829)      (0.04194)      (0.07334)   
## lavgsen        0.00910   -0.22723       -0.01018       -0.00644    
##               (0.04899)  (0.17851)      (0.02702)      (0.02894)   
## ldensity       0.13941    0.22562 *      0.42903 ***    0.43434 ***
##               (1.02124)  (0.10247)      (0.05485)      (0.07115)   
## lwcon         -0.02873    0.31400       -0.00748       -0.00430    
##               (0.05351)  (0.25910)      (0.03958)      (0.04142)   
## lwtuc          0.03913   -0.19894        0.04545 *      0.04446 *  
##               (0.03086)  (0.19712)      (0.01979)      (0.02154)   
## lwtrd         -0.01775    0.05356       -0.00814       -0.00856    
##               (0.04531)  (0.29600)      (0.04138)      (0.04198)   
## lwfir         -0.00934    0.04170       -0.00364       -0.00403    
##               (0.03655)  (0.30562)      (0.02892)      (0.02946)   
## lwser          0.01859   -0.13543        0.00561        0.01056    
##               (0.03882)  (0.17365)      (0.02013)      (0.02158)   
## lwmfg         -0.24317   -0.04200       -0.20414 *     -0.20180 *  
##               (0.41955)  (0.15627)      (0.08044)      (0.08394)   
## lwfed         -0.45134    0.14803       -0.16351       -0.21346    
##               (0.52712)  (0.32565)      (0.15945)      (0.21510)   
## lwsta         -0.01875   -0.20309       -0.05405       -0.06012    
##               (0.28082)  (0.29815)      (0.10568)      (0.12031)   
## lwloc          0.26326    0.04444        0.16305        0.18354    
##               (0.31239)  (0.49436)      (0.11964)      (0.13968)   
## lpctymle       0.35112   -0.09472       -0.10811       -0.14587    
##               (1.01103)  (0.19180)      (0.13969)      (0.22681)   
## smsayes                  -0.08050       -0.22515       -0.25955    
##                          (0.14423)      (0.11563)      (0.14997)   
## lpctmin                   0.16890 **     0.18904 ***    0.19488 ***
##                          (0.05270)      (0.04150)      (0.04594)   
## (Intercept)              -1.97714       -0.95380       -0.45385    
##                          (4.00081)      (1.28397)      (1.70298)   
## -------------------------------------------------------------------
## R^2            0.44364    0.87385        0.59847        0.59230    
## Adj. R^2       0.32442    0.83729        0.58115        0.57472    
## Num. obs.    630         90            630            630          
## s_idios                                  0.14924        0.14924    
## s_id                                     0.21456        0.21456    
## ===================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

The Hausman-Taylor model (Hausman and Taylor (1981)) may be estimated with the plm function by setting argument random.method = "ht" and inst.method = "baltagi". The following example is from B. H. Baltagi (2005), p. 130; B. H. Baltagi (2013), pp. 145-7, tables 7.4-7.6; B. H. Baltagi (2021), pp. 174-6 , tables 7.5-7.7.

data("Wages", package = "plm")
ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + 
            bluecol + ind + union + sex + black + ed | 
            bluecol + south + smsa + ind + sex + black | 
            wks + married + exp + I(exp^2) + union, 
          data = Wages, index = 595, 
          inst.method = "baltagi", model = "random", 
          random.method = "ht")

am  <- update(ht, inst.method = "am")
bms <- update(ht, inst.method = "bms")
screenreg(list("Hausman-Taylor" = ht, "Amemiya-MaCurdy" = am,
               "Breusch-Mizon-Schmidt" = bms),
          digits = 5, single.row = FALSE)
## 
## ===================================================================
##              Hausman-Taylor  Amemiya-MaCurdy  Breusch-Mizon-Schmidt
## -------------------------------------------------------------------
## (Intercept)     2.91273 ***     2.92734 ***      1.97944 ***       
##                (0.28365)       (0.27513)        (0.26724)          
## wks             0.00084         0.00084          0.00080           
##                (0.00060)       (0.00060)        (0.00060)          
## southyes        0.00744         0.00728          0.01467           
##                (0.03196)       (0.03194)        (0.03188)          
## smsayes        -0.04183 *      -0.04195 *       -0.05204 **        
##                (0.01896)       (0.01895)        (0.01891)          
## marriedyes     -0.02985        -0.03009         -0.03926 *         
##                (0.01898)       (0.01897)        (0.01892)          
## exp             0.11313 ***     0.11297 ***      0.10867 ***       
##                (0.00247)       (0.00247)        (0.00246)          
## exp^2          -0.00042 ***    -0.00042 ***     -0.00049 ***       
##                (0.00005)       (0.00005)        (0.00005)          
## bluecolyes     -0.02070        -0.02085         -0.01539           
##                (0.01378)       (0.01377)        (0.01374)          
## ind             0.01360         0.01363          0.01902           
##                (0.01524)       (0.01523)        (0.01520)          
## unionyes        0.03277 *       0.03248 *        0.03786 *         
##                (0.01491)       (0.01489)        (0.01486)          
## sexfemale      -0.13092        -0.13201         -0.18027           
##                (0.12666)       (0.12660)        (0.12639)          
## blackyes       -0.28575        -0.28590         -0.15636           
##                (0.15570)       (0.15549)        (0.15506)          
## ed              0.13794 ***     0.13720 ***      0.22066 ***       
##                (0.02125)       (0.02057)        (0.01985)          
## -------------------------------------------------------------------
## s_idios         0.15180         0.15180          0.15180           
## s_id            0.94180         0.94180          0.94180           
## R^2             0.60945         0.60948          0.60686           
## Adj. R^2        0.60833         0.60835          0.60572           
## Num. obs.    4165            4165             4165                 
## ===================================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

Nested error component model

This section shows how the nested error component model as per B. H. Baltagi, Song, and Jung (2001) can be estimated. The model is given by :

\[ y_{nt}=\alpha + \beta^\top x_{jnt} + u_{jnt} = \alpha + \beta^\top x_{jnt} + \mu_{j} + \nu_{jn} + \epsilon_{jnt} \] where \(n\) and \(t\) are the individual and time indexes and \(j\) is the group index in which the individuals are nested. The error \(u_{jnt}\) consists of three components :

  • \(\mu_j\) is the group effect,
  • \(\nu_{jn}\) the nested effect of the individual nested in group \(j\)
  • \(\epsilon_{jnt}\) is the idiosyncratic error.

In the estimated examples below (replication of B. H. Baltagi, Song, and Jung (2001), p. 378, table 6; B. H. Baltagi (2021), p. 248, table 9.1), states are nested within regions. The group index is given in the 3rd position of the index argument to pdata.frame or to plm directly and plm’s argument effect is set to "nested":

data("Produc", package = "plm")
swar <- plm(form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp, 
            Produc, index = c("state", "year", "region"), model = "random", effect = "nested", random.method = "swar")
walhus <- update(swar, random.method = "walhus")
amem <- update(swar, random.method = "amemiya")
screenreg(list("Swamy-Arora" = swar, "Wallace-Hussain" = walhus, "Amemiya" = amem), digits = 5)
## 
## ==========================================================
##              Swamy-Arora    Wallace-Hussain  Amemiya      
## ----------------------------------------------------------
## (Intercept)    2.08921 ***    2.08165 ***      2.13133 ***
##               (0.14570)      (0.15035)        (0.16014)   
## log(pc)        0.27412 ***    0.27256 ***      0.26448 ***
##               (0.02054)      (0.02093)        (0.02176)   
## log(emp)       0.73984 ***    0.74164 ***      0.75811 ***
##               (0.02575)      (0.02607)        (0.02661)   
## log(hwy)       0.07274 ***    0.07493 ***      0.07211 ** 
##               (0.02203)      (0.02235)        (0.02363)   
## log(water)     0.07645 ***    0.07639 ***      0.07616 ***
##               (0.01386)      (0.01387)        (0.01402)   
## log(util)     -0.09437 ***   -0.09523 ***     -0.10151 ***
##               (0.01677)      (0.01677)        (0.01705)   
## unemp         -0.00616 ***   -0.00615 ***     -0.00584 ***
##               (0.00090)      (0.00091)        (0.00091)   
## ----------------------------------------------------------
## s_idios        0.03676        0.03762          0.03676    
## s_id           0.06541        0.06713          0.08306    
## s_gp           0.03815        0.05239          0.04659    
## R^2            0.97387        0.97231          0.96799    
## Adj. R^2       0.97368        0.97210          0.96776    
## Num. obs.    816            816              816          
## ==========================================================
## *** p < 0.001; ** p < 0.01; * p < 0.05

Bibliography

Amemiya, T. 1971. “The Estimation of the Variances in a Variance–Components Model.” International Economic Review 12: 1–13.
Amemiya, Takeshi, and Thomas E MaCurdy. 1986. “Instrumental-Variable Estimation of an Error-Components Model.” Econometrica 54 (4): 869–80.
Balestra, P., and J. Varadharajan–Krishnakumar. 1987. “Full Information Estimations of a System of Simultaneous Equations with Error Components.” Econometric Theory 3: 223–46.
Baltagi, B. H. 1981. “Simultaneous Equations with Error Components.” Journal of Econometrics 17: 21–49.
Baltagi, B. H. 2005. Econometric Analysis of Panel Data. 3rd ed. John Wiley; Sons ltd.
———. 2009. A Companion to Econometric Analysis of Panel Data. John Wiley; Sons ltd.
———. 2013. Econometric Analysis of Panel Data. 5th ed. John Wiley; Sons ltd.
———. 2021. Econometric Analysis of Panel Data. 6th ed. Springer.
Baltagi, B. H., and Y. J. Chang. 1994. “Incomplete Panels: A Comparative Study of Alternative Estimators for the Unbalanced One-Way Error Component Regression Model.” Journal of Econometrics 62: 67–89.
Baltagi, B. H., S. H. Song, and B. C. Jung. 2001. “The Unbalanced Nested Error Component Regression Model.” Journal of Econometrics 101: 357–81.
Breusch, Trevor S, Grayham E Mizon, and Peter Schmidt. 1989. “Efficient Estimation Using Panel Data.” Econometrica 57 (3): 695–700.
Cottrell, A. 2017. “Random Effects Estimators for Unbalanced Panel Data: A Monte Carlo Analysis.” Gretl Working Papers, no. 4. https://EconPapers.repec.org/RePEc:anc:wgretl:4.
Hausman, J. A., and W. E. Taylor. 1981. “Panel Data and Unobservable Individual Effects.” Econometrica 49: 1377–98.
Nerlove, M. 1971. “Further Evidence on the Estimation of Dynamic Economic Relations from a Time–Series of Cross–Sections.” Econometrica 39: 359–82.
Swamy, P. A. V. B., and S. S Arora. 1972. “The Exact Finite Sample Properties of the Estimators of Coefficients in the Error Components Regression Models.” Econometrica 40: 261–75.
Wallace, T. D., and A. Hussain. 1969. “The Use of Error Components Models in Combining Cross Section with Time Series Data.” Econometrica 37 (1): 55–72.
plm/inst/doc/A_plmPackage.html0000644000176200001440000073714714177501544016011 0ustar liggesusers Panel data econometrics in R:

Panel data econometrics in R:

the plm package

Yves Croissant

Giovanni Millo

Abstract

This introduction to the plm package is a modified and extended version of Croissant and Millo (2008), published in the Journal of Statistical Software.

Panel data econometrics is obviously one of the main fields in the statistics profession, but most of the models used are difficult to estimate with only plain R. plm is a package for R which intends to make the estimation of linear panel models straightforward. plm provides functions to estimate a wide variety of models and to make (robust) inference.

Introduction

Panel data econometrics is a continuously developing field. The increasing availability of data observed on cross-sections of units (like households, firms, countries etc.) and over time has given rise to a number of estimation approaches exploiting this double dimensionality to cope with some of the typical problems associated with economic data, first of all that of unobserved heterogeneity.

Timewise observation of data from different observational units has long been common in other fields of statistics (where they are often termed longitudinal data). In the panel data field as well as in others, the econometric approach is nevertheless peculiar with respect to experimental contexts, as it is emphasizing model specification and testing and tackling a number of issues arising from the particular statistical problems associated with economic data.

Thus, while a very comprehensive software framework for (among many other features) maximum likelihood estimation of linear regression models for longitudinal data, packages nlme (J. Pinheiro et al. 2007) and lme4 (Bates 2007), is available in the R ( Development Core Team (2008)) environment and can be used, e.g., for estimation of random effects panel models, its use is not intuitive for a practicing econometrician, and maximum likelihood estimation is only one of the possible approaches to panel data econometrics. Moreover, economic panel data sets often happen to be unbalanced (i.e., they have a different number of observations between groups), which case needs some adaptation to the methods and is not compatible with those in nlme. Hence the need for a package doing panel data “from the econometrician’s viewpoint” and featuring at a minimum the basic techniques econometricians are used to: random and fixed effects estimation of static linear panel data models, variable coefficients models, generalized method of moments estimation of dynamic models; and the basic toolbox of specification and misspecification diagnostics.

Furthermore, we felt there was a need for automation of some basic data management tasks such as lagging, summing and, more in general, applying (in the R sense) functions to the data, which, although conceptually simple, become cumbersome and error-prone on two-dimensional data, especially in the case of unbalanced panels.

This paper is organized as follows: Section linear panel model presents a very short overview of the typical model taxonomy1. Section software approach discusses the software approach used in the package. The next three sections present the functionalities of the package in more detail: data management (Section managing data and formulae), estimation (Section model estimation) and testing (Section tests), giving a short description and illustrating them with examples. Section plm vs nlme and lme4 compares the approach in plm to that of nlme and lme4, highlighting the features of the latter two that an econometrician might find most useful. Section conclusion concludes the paper.

The linear panel model

The basic linear panel models used in econometrics can be described through suitable restrictions of the following general model:

\[\begin{equation*} y_{it}=\alpha_{it} + \beta_{it}^\top x_{it} + u_{it} \end{equation*}\]

where \(i=1, ..., n\) is the individual (group, country …) index, \(t=1, ..., T\) is the time index and \(u_{it}\) a random disturbance term of mean \(0\).

Of course \(u_{it}\) is not estimable with \(N = n \times T\) data points. A number of assumptions are usually made about the parameters, the errors and the exogeneity of the regressors, giving rise to a taxonomy of feasible models for panel data.

The most common one is parameter homogeneity, which means that \(\alpha_{it}=\alpha\) for all \(i,t\) and \(\beta_{it}=\beta\) for all \(i,t\). The resulting model

\[\begin{equation*} y_{it}=\alpha + \beta^\top x_{it} + u_{it} \end{equation*}\]

is a standard linear model pooling all the data across \(i\) and \(t\).

To model individual heterogeneity, one often assumes that the error term has two separate components, one of which is specific to the individual and doesn’t change over time2. This is called the unobserved effects model:

\[\begin{equation} (\#eq:errcomp) y_{it}=\alpha + \beta^\top x_{it} + \mu_i + \epsilon_{it} \end{equation}\]

The appropriate estimation method for this model depends on the properties of the two error components. The idiosyncratic error \(\epsilon_{it}\) is usually assumed well-behaved and independent of both the regressors \(x_{it}\) and the individual error component \(\mu_i\). The individual component may be in turn either independent of the regressors or correlated.

If it is correlated, the ordinary least squares (OLS) estimator of \(\beta\) would be inconsistent, so it is customary to treat the \(\mu_i\) as a further set of \(n\) parameters to be estimated, as if in the general model \(\alpha_{it}=\alpha_{i}\) for all \(t\). This is called the fixed effects (a.k.a. within or least squares dummy variables) model, usually estimated by OLS on transformed data, and gives consistent estimates for \(\beta\).

If the individual-specific component \(\mu_i\) is uncorrelated with the regressors, a situation which is usually termed random effects, the overall error \(u_{it}\) also is, so the OLS estimator is consistent. Nevertheless, the common error component over individuals induces correlation across the composite error terms, making OLS estimation inefficient, so one has to resort to some form of feasible generalized least squares (GLS) estimators. This is based on the estimation of the variance of the two error components, for which there are a number of different procedures available.

If the individual component is missing altogether, pooled OLS is the most efficient estimator for \(\beta\). This set of assumptions is usually labelled pooling model, although this actually refers to the errors’ properties and the appropriate estimation method rather than the model itself. If one relaxes the usual hypotheses of well-behaved, white noise errors and allows for the idiosyncratic error \(\epsilon_{it}\) to be arbitrarily heteroskedastic and serially correlated over time, a more general kind of feasible GLS is needed, called the unrestricted or general GLS. This specification can also be augmented with individual-specific error components possibly correlated with the regressors, in which case it is termed fixed effects GLS.

Another way of estimating unobserved effects models through removing time-invariant individual components is by first-differencing the data: lagging the model and subtracting, the time-invariant components (the intercept and the individual error component) are eliminated, and the model

\[\begin{equation*} \Delta y_{it}= \beta^\top \Delta x_{it} + \Delta u_{it} \end{equation*}\]

(where \(\Delta y_{it}=y_{it}-y_{i,t-1}\), \(\Delta x_{it}=x_{it}-x_{i,t-1}\) and, from @ref(eq:errcomp), \(\Delta u_{it}=u_{it}-u_{i,t-1}=\Delta \epsilon_{it}\) for \(t=2,...,T\)) can be consistently estimated by pooled OLS. This is called the first-difference or FD estimator. Its relative efficiency, and so reasons for choosing it against other consistent alternatives, depends on the properties of the error term. The FD estimator is usually preferred if the errors \(u_{it}\) are strongly persistent in time, because then the \(\Delta u_{it}\) will tend to be serially uncorrelated.

Lastly, the between model, which is computed on time (group) averages of the data, discards all the information due to intragroup variability but is consistent in some settings (e.g., non-stationarity) where the others are not, and is often preferred to estimate long-run relationships.

Variable coefficients models relax the assumption that \(\beta_{it}=\beta\) for all \(i,t\). Fixed coefficients models allow the coefficients to vary along one dimension, like \(\beta_{it}=\beta_i\) for all \(t\). Random coefficients models instead assume that coefficients vary randomly around a common average, as \(\beta_{it}=\beta+\eta_{i}\) for all \(t\), where \(\eta_{i}\) is a group– (time–) specific effect with mean zero.

The hypotheses on parameters and error terms (and hence the choice of the most appropriate estimator) are usually tested by means of:

  • pooling tests to check poolability, i.e., the hypothesis that the same coefficients apply across all individuals,
  • if the homogeneity assumption over the coefficients is established, the next step is to establish the presence of unobserved effects, comparing the null of spherical residuals with the alternative of group (time) specific effects in the error term,
  • the choice between fixed and random effects specifications is based on Hausman-type tests, comparing the two estimators under the null of no significant difference: if this is not rejected, the more efficient random effects estimator is chosen,
  • even after this step, departures of the error structure from sphericity can further affect inference, so that either screening tests or robust diagnostics are needed.

Dynamic models and in general lack of strict exogeneity of the regressors, pose further problems to estimation which are usually dealt with in the generalized method of moments (GMM) framework.

These were, in our opinion, the basic requirements of a panel data econometrics package for the R language and environment. Some, as often happens with R, were already fulfilled by packages developed for other branches of computational statistics, while others (like the fixed effects or the between estimators) were straightforward to compute after transforming the data, but in every case there were either language inconsistencies w.r.t. the standard econometric toolbox or subtleties to be dealt with (like, for example, appropriate computation of standard errors for the demeaned model, a common pitfall), so we felt there was need for an “all in one” econometrics-oriented package allowing to make specification searches, estimation and inference in a natural way.

Software approach

Data structure

Panel data have a special structure: each row of the data corresponds to a specific individual and time period. In plm the data argument may be an ordinary data.frame but, in this case, an argument called index has to be added to indicate the structure of the data. This can be:

  • NULL (the default value), it is then assumed that the first two columns contain the individual and the time index and that observations are ordered by individual and by time period,
  • a character string, which should be the name of the individual index,
  • a character vector of length two containing the names of the individual and the time index,
  • an integer which is the number of individuals (only in case of a balanced panel with observations ordered by individual).

The pdata.frame function is then called internally, which returns a pdata.frame which is a data.frame with an attribute called index. This attribute is a data.frame that contains the individual and the time indexes.

It is also possible to use directly the pdata.frame function and then to use the pdata.frame in the estimation functions.

Interface

Estimation interface

Package plm provides various functions for panel data estimation, among them:

  • plm: estimation of the basic panel models and instrumental variable panel models, i.e., between and first-difference models and within and random effect models. Models are estimated internally using the lm function on transformed data,
  • pvcm: estimation of models with variable coefficients,
  • pgmm: estimation of generalized method of moments models,
  • pggls: estimation of general feasible generalized least squares models,
  • pmg: estimators for mean groups (MG), demeaned MG (DMG) and common correlated effects MG (CCEMG) for heterogeneous panel models,
  • pcce: estimators for common correlated effects mean groups (CCEMG) and pooled (CCEP) for panel data with common factors,
  • pldv: panel estimators for limited dependent variables.

The interface of these functions is consistent with the lm() function. Namely, their first two arguments are formula and data (which should be a data.frame and is mandatory). Three additional arguments are common to these functions:

  • index: this argument enables the estimation functions to identify the structure of the data, i.e., the individual and the time period for each observation,
  • effect: the kind of effects to include in the model, i.e., individual effects, time effects or both3,
  • model: the kind of model to be estimated, most of the time a model with fixed effects or a model with random effects.

The results of these four functions are stored in an object which class has the same name of the function. They all inherit from class panelmodel. A panelmodel object contains: coefficients, residuals, fitted.values, vcov, df.residual and call and functions that extract these elements are provided.

Testing interface

The diagnostic testing interface provides both formula and panelmodel methods for most functions, with some exceptions. The user may thus choose whether to employ results stored in a previously estimated panelmodel object or to re-estimate it for the sake of testing.

Although the first strategy is the most efficient one, diagnostic testing on panel models mostly employs OLS residuals from pooling model objects, whose estimation is computationally inexpensive. Therefore most examples in the following are based on formula methods, which are perhaps the cleanest for illustrative purposes.

Computational approach to estimation

The feasible GLS methods needed for efficient estimation of unobserved effects models have a simple closed-form solution: once the variance components have been estimated and hence the covariance matrix of errors \(\hat{V}\), model parameters can be estimated as

\[\begin{equation} (\#eq:naive) \hat{\beta}=(X^\top \hat{V}^{-1} X)^{-1} (X^\top \hat{V}^{-1} y) \end{equation}\]

Nevertheless, in practice plain computation of \(\hat{\beta}\) has long been an intractable problem even for moderate-sized data sets because of the need to invert the \(N\times N\) \(\hat{V}\) matrix. With the advances in computer power, this is no more so, and it is possible to program the “naive” estimator @ref(eq:naive) in R with standard matrix algebra operators and have it working seamlessly for the standard “guinea pigs,” e.g., the Grunfeld data. Estimation with a couple of thousands of data points also becomes feasible on a modern machine, although excruciatingly slow and definitely not suitable for everyday econometric practice. Memory limits would also be very near because of the storage needs related to the huge \(\hat{V}\) matrix. An established solution exists for the random effects model which reduces the problem to an ordinary least squares computation.

The (quasi–)demeaning framework

The estimation methods for the basic models in panel data econometrics, the pooled OLS, random effects and fixed effects (or within) models, can all be described inside the OLS estimation framework. In fact, while pooled OLS simply pools data, the standard way of estimating fixed effects models with, say, group (time) effects entails transforming the data by subtracting the average over time (group) to every variable, which is usually termed time-demeaning. In the random effects case, the various feasible GLS estimators which have been put forth to tackle the issue of serial correlation induced by the group-invariant random effect have been proven to be equivalent (as far as estimation of \(\beta\)s is concerned) to OLS on partially demeaned data, where partial demeaning is defined as:

\[\begin{equation} (\#eq:ldemmodel) y_{it} - \theta \bar{y}_i = ( X_{it} - \theta \bar{X}_{i} ) \beta + ( u_{it} - \theta \bar{u}_i ) \end{equation}\]

where \(\theta=1-[\sigma_u^2 / (\sigma_u^2 + T \sigma_e^2)]^{1/2}\), \(\bar{y}\) and \(\bar{X}\) denote time means of \(y\) and \(X\), and the disturbance \(v_{it} - \theta \bar{v}_i\) is homoskedastic and serially uncorrelated. Thus the feasible RE estimate for \(\beta\) may be obtained estimating \(\hat{\theta}\) and running an OLS regression on the transformed data with lm(). The other estimators can be computed as special cases: for \(\theta=1\) one gets the fixed effects estimator, for \(\theta=0\) the pooled OLS one.

Moreover, instrumental variable estimators of all these models may also be obtained using several calls to lm().

For this reason the three above estimators have been grouped inside the same function.

On the output side, a number of diagnostics and a very general coefficients’ covariance matrix estimator also benefits from this framework, as they can be readily calculated applying the standard OLS formulas to the demeaned data, which are contained inside plm objects. This will be the subject of subsection inference in the panel model.

The object oriented approach to general GLS computations

The covariance matrix of errors in general GLS models is too generic to fit the quasi-demeaning framework, so this method calls for a full-blown application of GLS as in @ref(eq:naive). On the other hand, this estimator relies heavily on \(n\)–asymptotics, making it theoretically most suitable for situations which forbid it computationally: e.g., “short” micropanels with thousands of individuals observed over few time periods.

R has general facilities for fast matrix computation based on object orientation: particular types of matrices (symmetric, sparse, dense etc.) are assigned the relevant class and the additional information on structure is used in the computations, sometimes with dramatic effects on performance (see Bates (2004)) and packages Matrix (see Bates and Maechler (2016)) and SparseM (see Koenker and Ng (2016)). Some optimized linear algebra routines are available in the R package bdsmatrix (see Therneau (2014)) which exploit the particular block-diagonal and symmetric structure of \(\hat{V}\) making it possible to implement a fast and reliable full-matrix solution to problems of any practically relevant size.

The \(\hat{V}\) matrix is constructed as an object of class bdsmatrix. The peculiar properties of this matrix class are used for efficiently storing the object in memory and then by ad-hoc versions of the solve and crossprod methods, dramatically reducing computing times and memory usage. The resulting matrix is then used “the naive way” as in @ref(eq:naive) to compute \(\hat{\beta}\), resulting in speed comparable to that of the demeaning solution.

Inference in the panel model

General frameworks for restrictions and linear hypotheses testing are available in the R environment4. These are based on the Wald test, constructed as \(\hat{\beta}^\top \hat{V}^{-1} \hat{\beta}\), where \(\hat{\beta}\) and \(\hat{V}\) are consistent estimates of \(\beta\) and \(V(\beta)\), The Wald test may be used for zero-restriction (i.e., significance) testing and, more generally, for linear hypotheses in the form \((R \hat{\beta} - r)^\top [R \hat{V} R^\top ]^{-1} (R \hat{\beta} - r)\)5. To be applicable, the test functions require extractor methods for coefficients’ and covariance matrix estimates to be defined for the model object to be tested. Model objects in plm all have coef() and vcov() methods and are therefore compatible with the above functions.

In the same framework, robust inference is accomplished substituting (“plugging in”) a robust estimate of the coefficient covariance matrix into the Wald statistic formula. In the panel context, the estimator of choice is the White system estimator. This called for a flexible method for computing robust coefficient covariance matrices à la White for plm objects.

A general White system estimator for panel data is:

\[\begin{equation*} \hat{V}_R(\beta)=(X^\top X)^{-1} \sum_{i=1}^n{X_i^\top E_i X_i} (X^\top X)^{-1} \end{equation*}\]

where \(E_i\) is a function of the residuals \(\hat{e}_{it}, \; t=1, \dots T\) chosen according to the relevant heteroskedasticity and correlation structure. Moreover, it turns out that the White covariance matrix calculated on the demeaned model’s regressors and residuals (both part of plm objects) is a consistent estimator of the relevant model’s parameters’ covariance matrix, thus the method is readily applicable to models estimated by random or fixed effects, first difference or pooled OLS methods. Different pre-weighting schemes taken from package sandwich (see Zeileis (2004); Lumley and Zeileis (2015)) are also implemented to improve small-sample performance. Robust estimators with any combination of covariance structures and weighting schemes can be passed on to the testing functions.

Managing data and formulae

The package is now illustrated by application to some well-known examples. It is loaded using

library("plm")

The four data sets used are EmplUK which was used by M. Arellano and Bond (1991), the Grunfeld data (Kleiber and Zeileis 2008) which is used in several econometric books, the Produc data used by Munnell (1990) and the Wages used by Cornwell and Rupert (1988).

data("EmplUK", package="plm")
data("Produc", package="plm")
data("Grunfeld", package="plm")
data("Wages", package="plm")

Data structure

As observed above, the current version of plm is capable of working with a regular data.frame without any further transformation, provided that the individual and time indexes are in the first two columns, as in all the example data sets but Wages. If this weren’t the case, an index optional argument would have to be passed on to the estimating and testing functions.

head(Grunfeld)
##   firm year   inv  value capital
## 1    1 1935 317.6 3078.5     2.8
## 2    1 1936 391.8 4661.7    52.6
## 3    1 1937 410.6 5387.1   156.9
## 4    1 1938 257.7 2792.2   209.2
## 5    1 1939 330.8 4313.2   203.4
## 6    1 1940 461.2 4643.9   207.2
E <- pdata.frame(EmplUK, index=c("firm","year"), drop.index=TRUE, row.names=TRUE)
head(E)
##        sector   emp    wage capital   output
## 1-1977      7 5.041 13.1516  0.5894  95.7072
## 1-1978      7 5.600 12.3018  0.6318  97.3569
## 1-1979      7 5.015 12.8395  0.6771  99.6083
## 1-1980      7 4.715 13.8039  0.6171 100.5501
## 1-1981      7 4.093 14.2897  0.5076  99.5581
## 1-1982      7 3.166 14.8681  0.4229  98.6151
head(attr(E, "index"))
##   firm year
## 1    1 1977
## 2    1 1978
## 3    1 1979
## 4    1 1980
## 5    1 1981
## 6    1 1982

Two further arguments are logical: drop.index = TRUE drops the indexes from the data.frame and row.names = TRUE computes “fancy” row names by pasting the individual and the time indexes. While extracting a series from a pdata.frame, a pseries is created, which is the original series with the index attribute. This object has specific methods, like summary and as.matrix. The former indicates the total variation of the variable and the shares of this variation due to the individual and the time dimensions. The latter gives the matrix representation of the series, with, by default, individuals as rows and times as columns.

summary(E$emp)
## total sum of squares: 261539.4 
##          id        time 
## 0.980765381 0.009108488
head(as.matrix(E$emp))
##     1976   1977   1978   1979   1980   1981   1982   1983 1984
## 1     NA  5.041  5.600  5.015  4.715  4.093  3.166  2.936   NA
## 2     NA 71.319 70.643 70.918 72.031 73.689 72.419 68.518   NA
## 3     NA 19.156 19.440 19.900 20.240 19.570 18.125 16.850   NA
## 4     NA 26.160 26.740 27.280 27.830 27.169 24.504 22.562   NA
## 5 86.677 87.100 87.000 90.400 89.200 82.700 73.700     NA   NA
## 6  0.748  0.766  0.762  0.729  0.731  0.779  0.782     NA   NA

Data transformation

Panel data estimation requires to apply different transformations to raw series. If \(x\) is a series of length \(nT\) (where \(n\) is the number of individuals and \(T\) is the number of time periods), the transformed series \(\tilde{x}\) is obtained as \(\tilde{x}=Mx\) where \(M\) is a transformation matrix. Denoting \(j\) a vector of one of length \(T\) and \(I_n\) the identity matrix of dimension \(n\), we get:

  • the between transformation: \(P=\frac{1}{T}I_n\otimes jj'\) returns a vector containing the individual means. The Between and between functions perform this operation, the first one returning a vector of length \(nT\), the second one a vector of length \(n\),
  • the within transformation: \(Q=I_{nT}-P\) returns a vector containing the values in deviation from the individual means. The Within function performs this operation.
  • the first difference transformation \(D=I_n \otimes d\) where

\(d=\left( \begin{array}{ccccccc} 1 & -1 & 0 & 0 & ... & 0 & 0 \\ 0 & 1 & -1 & 0 & ... & 0 & 0 \\ 0 & 0 & 1 & -1 & ... & 0 & 0 \\ \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & 1 & -1 \\ \end{array} \right)\)

is of dimension \((T-1,T)\).

Note that R’s diff() and lag() functions don’t compute correctly these transformations for panel data because they are unable to identify when there is a change in individual in the data. Therefore, specific methods for pseries objects have been written in order to handle correctly panel data. Note that compared to the lag() method for ts objects, the order of lags are indicated by a positive integer. Moreover, 0 is a relevant value and a vector argument may be provided:

head(lag(E$emp, 0:2))
##            0     1     2
## 1-1977 5.041    NA    NA
## 1-1978 5.600 5.041    NA
## 1-1979 5.015 5.600 5.041
## 1-1980 4.715 5.015 5.600
## 1-1981 4.093 4.715 5.015
## 1-1982 3.166 4.093 4.715

Further functions called Between, between and Within are also provided to compute the between and the within transformation. The between returns unique values, whereas Between duplicates the values and returns a vector which length is the number of observations.

head(diff(E$emp), 10)
##     1-1977     1-1978     1-1979     1-1980     1-1981     1-1982     1-1983 
##         NA  0.5590000 -0.5850000 -0.2999997 -0.6220003 -0.9270000 -0.2299998 
##     2-1977     2-1978     2-1979 
##         NA -0.6760020  0.2750010
head(lag(E$emp, 2), 10)
## 1-1977 1-1978 1-1979 1-1980 1-1981 1-1982 1-1983 2-1977 2-1978 2-1979 
##     NA     NA  5.041  5.600  5.015  4.715  4.093     NA     NA 71.319
head(Within(E$emp))
##     1-1977     1-1978     1-1979     1-1980     1-1981     1-1982 
##  0.6744285  1.2334285  0.6484285  0.3484288 -0.2735715 -1.2005715
head(between(E$emp), 4)
##         1         2         3         4 
##  4.366571 71.362428 19.040143 26.035000
head(Between(E$emp), 10)
##         1         1         1         1         1         1         1         2 
##  4.366571  4.366571  4.366571  4.366571  4.366571  4.366571  4.366571 71.362428 
##         2         2 
## 71.362428 71.362428

Formulas

In some circumstances, standard formulas are not very useful to describe a model, notably while using instrumental variable like estimators: to deal with these situations, we use the Formula package.

The Formula package provides a class which enables to construct multi-part formula, each part being separated by a pipe sign (|).

The two formulas below are identical:

emp ~ wage + capital | lag(wage, 1) + capital
emp ~ wage + capital | . -wage + lag(wage, 1)

In the second case, the . means the previous parts which describes the covariates and this part is “updated.” This is particularly interesting when there are a few external instruments.

Model estimation

Estimation of the basic models with plm

Several models can be estimated with plm by filling the model argument:

  • the fixed effects model ("within"), the default,
  • the pooling model ("pooling"),
  • the first-difference model ("fd"),
  • the between model ("between"),
  • the error components model ("random").

The basic use of plm is to indicate the model formula, the data and the model to be estimated. For example, the fixed effects model and the random effects model are estimated using:

grun.fe <- plm(inv~value+capital, data = Grunfeld, model = "within")
grun.re <- plm(inv~value+capital, data = Grunfeld, model = "random")

Methods to display a sumamry of the model estimation are available via summary. For example, for a random model, the summary method gives information about the variance of the components of the errors and some test statistics. Random effects of the estimated model can be extracted via ranef.

summary(grun.re)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = inv ~ value + capital, data = Grunfeld, model = "random")
## 
## Balanced Panel: n = 10, T = 20, N = 200
## 
## Effects:
##                   var std.dev share
## idiosyncratic 2784.46   52.77 0.282
## individual    7089.80   84.20 0.718
## theta: 0.8612
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -177.6063  -19.7350    4.6851   19.5105  252.8743 
## 
## Coefficients:
##               Estimate Std. Error z-value             Pr(>|z|)    
## (Intercept) -57.834415  28.898935 -2.0013              0.04536 *  
## value         0.109781   0.010493 10.4627 < 0.0000000000000002 ***
## capital       0.308113   0.017180 17.9339 < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2381400
## Residual Sum of Squares: 548900
## R-Squared:      0.7695
## Adj. R-Squared: 0.76716
## Chisq: 657.674 on 2 DF, p-value: < 0.000000000000000222
ranef(grun.re)
##            1            2            3            4            5            6 
##   -9.5242955  157.8910235 -172.8958044   29.9119801  -54.6790089   34.3461316 
##            7            8            9           10 
##   -7.8977584    0.6726376  -28.1393497   50.3144442

The fixed effects of a fixed effects model may be extracted easily using fixef. An argument type indicates how fixed effects should be computed: in levels by type = "level" (the default), in deviations from the overall mean by type = "dmean" or in deviations from the first individual by type = "dfirst".

fixef(grun.fe, type = "dmean")
##         1         2         3         4         5         6         7         8 
##  -11.5528  160.6498 -176.8279   30.9346  -55.8729   35.5826   -7.8095    1.1983 
##         9        10 
##  -28.4783   52.1761

The fixef function returns an object of class fixef. A summary method is provided, which prints the effects (in deviation from the overall intercept), their standard errors and the test of equality to the overall intercept.

summary(fixef(grun.fe, type = "dmean"))
##     Estimate Std. Error t-value        Pr(>|t|)    
## 1   -11.5528    49.7080 -0.2324       0.8164700    
## 2   160.6498    24.9383  6.4419 0.0000000009627 ***
## 3  -176.8279    24.4316 -7.2377 0.0000000000113 ***
## 4    30.9346    14.0778  2.1974       0.0292129 *  
## 5   -55.8729    14.1654 -3.9443       0.0001129 ***
## 6    35.5826    12.6687  2.8087       0.0054998 ** 
## 7    -7.8095    12.8430 -0.6081       0.5438694    
## 8     1.1983    13.9931  0.0856       0.9318489    
## 9   -28.4783    12.8919 -2.2090       0.0283821 *  
## 10   52.1761    11.8269  4.4116 0.0000172511647 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

In case of a two-ways fixed effect model, argument effect is relevant in function fixef to extract specific effect fixed effects with possible values "individual" for individual fixed effects (default for two-ways fixed effect models), "time" for time fixed effects, and "twoways" for the sum of individual and time fixed effects. Example to extract the time fixed effects from a two-ways model:

grun.twfe <- plm(inv~value+capital, data=Grunfeld, model="within", effect="twoways")
fixef(grun.twfe, effect = "time")
##    1935    1936    1937    1938    1939    1940    1941    1942    1943    1944 
##  -86.90 -106.10 -127.59 -126.13 -156.37 -131.14 -105.70 -108.04 -129.88 -130.00 
##    1945    1946    1947    1948    1949    1950    1951    1952    1953    1954 
## -142.58 -118.07 -126.29 -130.62 -160.40 -162.80 -149.38 -151.53 -154.62 -180.43

More advanced use of plm

Random effects estimators

As observed above, the random effect model is obtained as a linear estimation on quasi-demeaned data. The parameter of this transformation is obtained using preliminary estimations.

Four estimators of this parameter are available, depending on the value of the argument random.method:

  • "swar": from Swamy and Arora (1972), the default value,
  • "walhus": from Wallace and Hussain (1969),
  • "amemiya": from T. Amemiya (1971),
  • "nerlove": from Nerlove (1971).
  • "ht": for Hausman-Taylor-type instrumental variable (IV) estimation, discussed later, see Section Instrumental variable estimator.

For example, to use the amemiya estimator:

grun.amem <- plm(inv~value+capital, data=Grunfeld,
                 model="random", random.method="amemiya")

The estimation of the variance of the error components are performed using the ercomp function, which has a method and an effect argument, and can be used by itself:

ercomp(inv~value+capital, data=Grunfeld, method = "amemiya", effect = "twoways")
##                   var std.dev share
## idiosyncratic 2644.13   51.42 0.256
## individual    7452.02   86.33 0.721
## time           243.78   15.61 0.024
## theta: 0.868 (id) 0.2787 (time) 0.2776 (total)

Introducing time or two-ways effects

The default behavior of plm is to introduce individual effects. Using the effect argument, one may also introduce:

  • time effects (effect = "time"),
  • individual and time effects (effect = "twoways").

For example, to estimate a two-ways effect model for the Grunfeld data:

grun.tways <- plm(inv~value+capital, data = Grunfeld, effect = "twoways",
                  model = "random", random.method = "amemiya")
summary(grun.tways)
## Twoways effects Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", 
##     model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 10, T = 20, N = 200
## 
## Effects:
##                   var std.dev share
## idiosyncratic 2644.13   51.42 0.256
## individual    7452.02   86.33 0.721
## time           243.78   15.61 0.024
## theta: 0.868 (id) 0.2787 (time) 0.2776 (total)
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -176.9062  -18.0431    3.2697   17.1719  234.1735 
## 
## Coefficients:
##               Estimate Std. Error z-value             Pr(>|z|)    
## (Intercept) -63.767791  29.851537 -2.1362              0.03267 *  
## value         0.111386   0.010909 10.2102 < 0.0000000000000002 ***
## capital       0.323321   0.018772 17.2232 < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2066800
## Residual Sum of Squares: 518200
## R-Squared:      0.74927
## Adj. R-Squared: 0.74673
## Chisq: 588.717 on 2 DF, p-value: < 0.000000000000000222

In the “effects” section of the printed summary of the result, the variance of the three elements of the error term and the three parameters used in the transformation are printed.

Unbalanced panels

Estimations by plm support unbalanced panel models.

The following example is using data used by Harrison and Rubinfeld (1978) to estimate an hedonic housing prices function. It is reproduced in B. H. Baltagi and Chang (1994), table 2 (and in B. H. Baltagi (2005), pp. 172/4; B. H. Baltagi (2013), pp. 195/7 tables 9.1/3).

data("Hedonic", package = "plm")
Hed <- plm(mv~crim+zn+indus+chas+nox+rm+age+dis+rad+tax+ptratio+blacks+lstat,
           data = Hedonic, model = "random", index = "townid")
summary(Hed)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = mv ~ crim + zn + indus + chas + nox + rm + age + 
##     dis + rad + tax + ptratio + blacks + lstat, data = Hedonic, 
##     model = "random", index = "townid")
## 
## Unbalanced Panel: n = 92, T = 1-30, N = 506
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.01696 0.13025 0.562
## individual    0.01324 0.11505 0.438
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.2505  0.5483  0.6284  0.6141  0.7147  0.7976 
## 
## Residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -0.62902 -0.06712 -0.00156 -0.00216  0.06858  0.54973 
## 
## Coefficients:
##                 Estimate   Std. Error  z-value              Pr(>|z|)    
## (Intercept)  9.685866695  0.197510264  49.0398 < 0.00000000000000022 ***
## crim        -0.007411967  0.001047812  -7.0738   0.00000000000150795 ***
## zn           0.000078877  0.000650012   0.1213             0.9034166    
## indus        0.001556340  0.004034911   0.3857             0.6997051    
## chasyes     -0.004424737  0.029211764  -0.1515             0.8796041    
## nox         -0.005842506  0.001245183  -4.6921   0.00000270431168602 ***
## rm           0.009055167  0.001188629   7.6182   0.00000000000002573 ***
## age         -0.000857873  0.000467933  -1.8333             0.0667541 .  
## dis         -0.144418433  0.044093739  -3.2753             0.0010557 ** 
## rad          0.095983935  0.026610945   3.6069             0.0003098 ***
## tax         -0.000377396  0.000176926  -2.1331             0.0329190 *  
## ptratio     -0.029475776  0.009069842  -3.2499             0.0011546 ** 
## blacks       0.562775469  0.101973789   5.5188   0.00000003412743874 ***
## lstat       -0.291074917  0.023927306 -12.1650 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    987.94
## Residual Sum of Squares: 8.9988
## R-Squared:      0.99091
## Adj. R-Squared: 0.99067
## Chisq: 1199.5 on 13 DF, p-value: < 0.000000000000000222

Measures for the unbalancedness of a panel data set or the data used in estimated models are provided by function punbalancedness. It gives the measures \(\gamma\) and \(\nu\) from Ahrens and Pincus (1981) where for both 1 represents balanced data and the more unbalanced the data the lower the value.

punbalancedness(Hed)
##     gamma        nu 
## 0.4715336 0.5188292

Instrumental variable estimators

All of the models presented above may be estimated using instrumental variables. The instruments are specified at the end of the formula after a | sign (pipe).

The instrumental variables estimator used is indicated with the inst.method argument:

  • "bvk", from Balestra and Varadharajan–Krishnakumar (1987), the default value,
  • "baltagi", from B. H. Baltagi (1981),
  • "am", from Takeshi Amemiya and MaCurdy (1986),
  • "bms", from Trevor S. Breusch, Mizon, and Schmidt (1989).

An illustration is in the following example from B. H. Baltagi (2005), p. 120; B. H. Baltagi (2013), p. 137; B. H. Baltagi (2021), p. 165, table 7.3 (“G2SLS”).

data("Crime", package = "plm")
cr <- plm(lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen +
          ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed +
          lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year)
          | . - lprbarr - lpolpc + ltaxpc + lmix,
          data = Crime, model = "random")
summary(cr)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## Instrumental variable estimation
##    (Balestra-Varadharajan-Krishnakumar's transformation)
## 
## Call:
## plm(formula = lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + 
##     lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + 
##     lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + 
##     smsa + factor(year) | . - lprbarr - lpolpc + ltaxpc + lmix, 
##     data = Crime, model = "random")
## 
## Balanced Panel: n = 90, T = 7, N = 630
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.02227 0.14924 0.326
## individual    0.04604 0.21456 0.674
## theta: 0.7457
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -0.7485357 -0.0709883  0.0040648  0.0784455  0.4756273 
## 
## Coefficients:
##                  Estimate Std. Error z-value      Pr(>|z|)    
## (Intercept)    -0.4538501  1.7029831 -0.2665      0.789852    
## lprbarr        -0.4141383  0.2210496 -1.8735      0.060998 .  
## lpolpc          0.5049461  0.2277778  2.2168      0.026634 *  
## lprbconv       -0.3432506  0.1324648 -2.5913      0.009563 ** 
## lprbpris       -0.1900467  0.0733392 -2.5913      0.009560 ** 
## lavgsen        -0.0064389  0.0289407 -0.2225      0.823935    
## ldensity        0.4343449  0.0711496  6.1047 0.00000000103 ***
## lwcon          -0.0042958  0.0414226 -0.1037      0.917403    
## lwtuc           0.0444589  0.0215448  2.0636      0.039060 *  
## lwtrd          -0.0085579  0.0419829 -0.2038      0.838476    
## lwfir          -0.0040305  0.0294569 -0.1368      0.891166    
## lwser           0.0105602  0.0215823  0.4893      0.624630    
## lwmfg          -0.2018020  0.0839373 -2.4042      0.016208 *  
## lwfed          -0.2134579  0.2151046 -0.9923      0.321029    
## lwsta          -0.0601232  0.1203149 -0.4997      0.617275    
## lwloc           0.1835363  0.1396775  1.3140      0.188846    
## lpctymle       -0.1458703  0.2268086 -0.6431      0.520131    
## lpctmin         0.1948763  0.0459385  4.2421 0.00002214292 ***
## regionwest     -0.2281821  0.1010260 -2.2586      0.023905 *  
## regioncentral  -0.1987703  0.0607475 -3.2721      0.001068 ** 
## smsayes        -0.2595451  0.1499718 -1.7306      0.083518 .  
## factor(year)82  0.0132147  0.0299924  0.4406      0.659500    
## factor(year)83 -0.0847693  0.0320010 -2.6490      0.008074 ** 
## factor(year)84 -0.1062027  0.0387893 -2.7379      0.006183 ** 
## factor(year)85 -0.0977457  0.0511681 -1.9103      0.056097 .  
## factor(year)86 -0.0719451  0.0605819 -1.1876      0.235004    
## factor(year)87 -0.0396595  0.0758531 -0.5228      0.601081    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    30.169
## Residual Sum of Squares: 12.419
## R-Squared:      0.5923
## Adj. R-Squared: 0.57472
## Chisq: 542.478 on 26 DF, p-value: < 0.000000000000000222

The Hausman-Taylor model (see Hausman and Taylor (1981)) may be estimated with the plm6 function by setting parameters random.method = "ht" and inst.method = "baltagi" like in the example below. The following replicates B. H. Baltagi (2005), pp. 129/30; B. H. Baltagi (2013), pp. 145/6, tables 7.4/5; B. H. Baltagi (2021), pp. 174/5 tables 7.5/6:

ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + 
              bluecol + ind + union + sex + black + ed |
              bluecol + south + smsa + ind + sex + black |
              wks + married + union + exp + I(exp ^ 2), 
          data = Wages, index = 595,
          model = "random", random.method = "ht", inst.method = "baltagi")
summary(ht)
## Oneway (individual) effect Random Effect Model 
##    (Hausman-Taylor's transformation)
## Instrumental variable estimation
##    (Baltagi's transformation)
## 
## Call:
## plm(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + 
##     bluecol + ind + union + sex + black + ed | bluecol + south + 
##     smsa + ind + sex + black | wks + married + union + exp + 
##     I(exp^2), data = Wages, model = "random", random.method = "ht", 
##     inst.method = "baltagi", index = 595)
## 
## Balanced Panel: n = 595, T = 7, N = 4165
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.02304 0.15180 0.025
## individual    0.88699 0.94180 0.975
## theta: 0.9392
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -12.643736  -0.466002   0.043285   0.524739  13.340263 
## 
## Coefficients:
##                 Estimate   Std. Error z-value              Pr(>|z|)    
## (Intercept)  2.912726279  0.283652215 10.2687 < 0.00000000000000022 ***
## wks          0.000837403  0.000599732  1.3963               0.16263    
## southyes     0.007439837  0.031955005  0.2328               0.81590    
## smsayes     -0.041833367  0.018958129 -2.2066               0.02734 *  
## marriedyes  -0.029850749  0.018979963 -1.5728               0.11578    
## exp          0.113132791  0.002470954 45.7851 < 0.00000000000000022 ***
## I(exp^2)    -0.000418865  0.000054598 -7.6718   0.00000000000001696 ***
## bluecolyes  -0.020704707  0.013780948 -1.5024               0.13299    
## ind          0.013603930  0.015237366  0.8928               0.37196    
## unionyes     0.032771447  0.014908437  2.1982               0.02794 *  
## sexfemale   -0.130923610  0.126658988 -1.0337               0.30129    
## blackyes    -0.285747871  0.155701854 -1.8352               0.06647 .  
## ed           0.137943957  0.021248489  6.4919   0.00000000008473689 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    243.04
## Residual Sum of Squares: 4163.6
## R-Squared:      0.60945
## Adj. R-Squared: 0.60833
## Chisq: 6891.87 on 12 DF, p-value: < 0.000000000000000222

Variable coefficients model

The pvcm function enables the estimation of variable coefficients models. Time or individual effects are introduced if argument effect is fixed to "time" or "individual" (the default value).

Coefficients are assumed to be fixed if model="within" or random if model="random". In the first case, a different model is estimated for each individual (or time period). In the second case, the Swamy model (see Swamy (1970)) model is estimated. It is a generalized least squares model which uses the results of the previous model. Denoting \(\hat{\beta}_i\) the vectors of coefficients obtained for each individual, we get:

\[\begin{equation*} \hat{\beta}=\left(\sum_{i=1}^n \left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\right)\left(\hat{\Delta}+\hat{\sigma}_i^2(X_i^\top X_i)^{-1}\right)^{-1}\hat{\beta}_i \end{equation*}\]

where \(\hat{\sigma}_i^2\) is the unbiased estimator of the variance of the errors for individual \(i\) obtained from the preliminary estimation and:

\[\begin{equation*} \hat{\Delta}=\frac{1}{n-1}\sum_{i=1}^n\left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right) \left(\hat{\beta}_i-\frac{1}{n}\sum_{i=1}^n\hat{\beta}_i\right)^\top -\frac{1}{n}\sum_{i=1}^n\hat{\sigma}_i^2(X_i^\top X_i)^{-1} \end{equation*}\]

If this matrix is not positive-definite, the second term is dropped.

With the Grunfeld data, we get:

grun.varw <- pvcm(inv~value+capital, data=Grunfeld, model="within")
grun.varr <- pvcm(inv~value+capital, data=Grunfeld, model="random")
summary(grun.varr)
## Oneway (individual) effect Random coefficients model
## 
## Call:
## pvcm(formula = inv ~ value + capital, data = Grunfeld, model = "random")
## 
## Balanced Panel: n = 10, T = 20, N = 200
## 
## Residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -211.486  -32.321   -4.283    9.048   12.714  579.216 
## 
## Estimated mean of the coefficients:
##              Estimate Std. Error z-value   Pr(>|z|)    
## (Intercept) -9.629285  17.035040 -0.5653  0.5718946    
## value        0.084587   0.019956  4.2387 0.00002248 ***
## capital      0.199418   0.052653  3.7874  0.0001522 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Estimated variance of the coefficients:
##             (Intercept)      value    capital
## (Intercept)  2344.24402 -0.6852340 -4.0276612
## value          -0.68523  0.0031182 -0.0011847
## capital        -4.02766 -0.0011847  0.0244824
## 
## Total Sum of Squares: 474010000
## Residual Sum of Squares: 2194300
## Multiple R-Squared: 0.99537
## Chisq: 38.8364 on 2 DF, p-value: 0.0000000036878

Generalized method of moments estimator

The generalized method of moments is mainly used in panel data econometrics to estimate dynamic models (M. Arellano and Bond 1991; Holtz–Eakin, Newey, and Rosen 1988).

\[\begin{equation*} y_{it}=\rho y_{it-1}+\beta^\top x_{it}+\mu_i+\epsilon_{it} \end{equation*}\]

The model is first differenced to get rid of the individual effect:

\[\begin{equation*} \Delta y_{it}=\rho \Delta y_{it-1}+\beta^\top \Delta x_{it}+\Delta \epsilon_{it} \end{equation*}\]

Least squares are inconsistent because \(\Delta \epsilon_{it}\) is correlated with \(\Delta y_{it-1}\). \(y_{it-2}\) is a valid, but weak instrument (see Anderson and Hsiao (1981)). The GMM estimator uses the fact that the number of valid instruments is growing with \(t\):

  • \(t=3\): \(y_1\),
  • \(t=4\): \(y_1,y_2\),
  • \(t=5\): \(y_1,y_2,y_3\).

For individual \(i\), the matrix of instruments is then:

\[\begin{equation*} W_i=\left( \begin{array}{ccccccccccccc} y_1 & 0 & 0 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i3} \\ 0 & y_1 & y_2 & 0 & 0 & 0 & ... & 0 & 0 & 0 & 0 & x_{i4} \\ 0 & 0 & 0 & y_1 & y_2 & y_3 & ... & 0 & 0 & 0 & 0 & x_{i5} \\ \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & ... & ... & ... & y_1 & y_2 & ... & y_{t-2} & x_{iT-2} &\\ \end{array} \right) \end{equation*}\]

The moment conditions are: \(\sum_{i=1}^n W_i^\top e_i(\beta)\) where \(e_i(\beta)\) is the vector of residuals for individual \(i\). The GMM estimator minimizes:

\[\begin{equation*} \left(\sum_{i=1}^n e_i(\beta)^\top W_i\right) A \left(\sum_{i=1}^n W_i^\top e_i(\beta)\right) \end{equation*}\]

where \(A\) is the weighting matrix of the moments.

One-step estimators are computed using a known weighting matrix. For the model in first differences, one uses:

\[\begin{equation*} A^{(1)}=\left(\sum_{i=1}^n W_i^\top H^{(1)}W_i\right)^{-1} \end{equation*}\]

with:

\[\begin{equation*} H^{(1)}=d^\top d=\left( \begin{array}{ccccc} 2 & -1 & 0 & ... & 0\\ -1 & 2 & -1 & ... & 0\\ 0 & -1 & 2 & ... & 0\\ \vdots & \vdots & \vdots & \vdots & \vdots \\ 0 & 0 & 0 & -1 & 2\\ \end{array} \right) \end{equation*}\]

Two-steps estimators are obtained using \(H^{(2)}_i=\sum_{i=1}^n e^{(1)}_i e^{(1)\top }_i\) where \(e_i^{(1)}\) are the residuals of the one step estimate.

Blundell and Bond (1998) show that with weak hypothesis on the data generating process, supplementary moment conditions exist for the equation in level:

\[ y_{it} = \gamma y_{it-1}+\mu_i+\eta_{it} \]

More precisely, they show that \(\Delta y_{it-2}=y_{it-2}-y_{it-3}\) is a valid instrument. The estimator is obtained using the residual vector in difference and in level:

\[ e^+_i=(\Delta e_i, e_i) \]

and the matrix of augmented moments:

\[ Z_i^+=\left( \begin{array}{ccccc} Z_i & 0 & 0 & ... & 0 \\ 0 & \Delta y_{i2} & 0 & ... & 0 \\ 0 & 0 & \Delta y_{i3} & ... & 0 \\ 0 & 0 & 0 & ... & \Delta y_{iT-1} \end{array} \right) \]

The moment conditions are then

\[\begin{eqnarray*} \left(\sum_{i=1}^n Z_i^{+\top} \left(\begin{array}{c}\bar{e}_i(\beta)\\ e_i(\beta)\end{array}\right)\right)^\top = \left(\sum_{i=1}^n y_{i1} \bar{e}_{i3},\sum_{i=1}^n y_{i1}\bar{e}_{i4},\sum_{i=1}^n y_{i2}\bar{e}_{i4}, ..., \right.\\ \left. \sum_{i=1}^n y_{i1} \bar{e}_{iT}, \sum_{i=1}^n y_{i2} \bar{e}_{iT}, ...,\sum_{i=1}^n y_{iT-2} \bar{e}_{iT}, \sum_{i=1}^n \sum_{t=3}^T x_{it} \bar{e}_{it}\right.\\ \left.\sum_{i=1}^n e_{i3} \Delta y_{i2}, \sum_{i=1}^n e_{i4} \Delta y_{i3}, ... , \sum_{i=1}^n e_{iT} \Delta y_{iT-1} \right)^\top \end{eqnarray*}\]

The GMM estimator is provided by the pgmm function. By using a multi-part formula, the variables of the model and the lag structure are described.

In a GMM estimation, there are “normal instruments” and “GMM instruments.” GMM instruments are indicated in the second part of the formula. By default, all the variables of the model that are not used as GMM instruments are used as normal instruments, with the same lag structure; “normal” instruments may also be indicated in the third part of the formula.

The effect argument is either NULL, "individual" (the default), or "twoways". In the first case, the model is estimated in levels. In the second case, the model is estimated in first differences to get rid of the individuals effects. In the last case, the model is estimated in first differences and time dummies are included.

The model argument specifies whether a one-step or a two-steps model is requested ("onestep" or "twosteps").

The following example is from M. Arellano and Bond (1991). Employment is explained by past values of employment (two lags), current and first lag of wages and output and current value of capital.

emp.gmm <- pgmm(log(emp)~lag(log(emp), 1:2)+lag(log(wage), 0:1)+log(capital)+
                lag(log(output), 0:1) | lag(log(emp), 2:99),
                data = EmplUK, effect = "twoways", model = "twosteps")
summary(emp.gmm)
## Twoways effects Two-steps model Difference GMM 
## 
## Call:
## pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 
##     0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 
##     2:99), data = EmplUK, effect = "twoways", model = "twosteps")
## 
## Unbalanced Panel: n = 140, T = 7-9, N = 1031
## 
## Number of Observations Used: 611
## Residuals:
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -0.6190677 -0.0255683  0.0000000 -0.0001339  0.0332013  0.6410272 
## 
## Coefficients:
##                         Estimate Std. Error z-value    Pr(>|z|)    
## lag(log(emp), 1:2)1     0.474151   0.185398  2.5575   0.0105437 *  
## lag(log(emp), 1:2)2    -0.052967   0.051749 -1.0235   0.3060506    
## lag(log(wage), 0:1)0   -0.513205   0.145565 -3.5256   0.0004225 ***
## lag(log(wage), 0:1)1    0.224640   0.141950  1.5825   0.1135279    
## log(capital)            0.292723   0.062627  4.6741 0.000002953 ***
## lag(log(output), 0:1)0  0.609775   0.156263  3.9022 0.000095304 ***
## lag(log(output), 0:1)1 -0.446373   0.217302 -2.0542   0.0399605 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Sargan test: chisq(25) = 30.11247 (p-value = 0.22011)
## Autocorrelation test (1): normal = -1.53845 (p-value = 0.12394)
## Autocorrelation test (2): normal = -0.2796829 (p-value = 0.77972)
## Wald test for coefficients: chisq(7) = 142.0353 (p-value = < 0.000000000000000222)
## Wald test for time dummies: chisq(6) = 16.97046 (p-value = 0.0093924)

The following example is from Blundell and Bond (1998). The “sys” estimator is obtained using transformation = "ld" for level and difference. The robust argument of the summary method enables to use the robust covariance matrix proposed by Windmeijer (2005). For all pgmm models, robust = TRUE is the default (but set in this example explicitly).

z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) +
           lag(log(capital), 0:1) | lag(log(emp), 2:99) +
           lag(log(wage), 2:99) + lag(log(capital), 2:99),        
           data = EmplUK, effect = "twoways", model = "onestep", 
           transformation = "ld")
summary(z2, robust = TRUE)
## Twoways effects One-step model System GMM 
## 
## Call:
## pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + 
##     lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 
##     2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", 
##     model = "onestep", transformation = "ld")
## 
## Unbalanced Panel: n = 140, T = 7-9, N = 1031
## 
## Number of Observations Used: 1642
## Residuals:
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -0.7530341 -0.0369030  0.0000000  0.0002882  0.0466069  0.6001503 
## 
## Coefficients:
##                          Estimate Std. Error z-value              Pr(>|z|)    
## lag(log(emp), 1)         0.935605   0.026295 35.5810 < 0.00000000000000022 ***
## lag(log(wage), 0:1)0    -0.630976   0.118054 -5.3448    0.0000000905012861 ***
## lag(log(wage), 0:1)1     0.482620   0.136887  3.5257             0.0004224 ***
## lag(log(capital), 0:1)0  0.483930   0.053867  8.9838 < 0.00000000000000022 ***
## lag(log(capital), 0:1)1 -0.424393   0.058479 -7.2572    0.0000000000003952 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Sargan test: chisq(100) = 118.763 (p-value = 0.097096)
## Autocorrelation test (1): normal = -4.808434 (p-value = 0.0000015212)
## Autocorrelation test (2): normal = -0.2800133 (p-value = 0.77947)
## Wald test for coefficients: chisq(5) = 11174.82 (p-value = < 0.000000000000000222)
## Wald test for time dummies: chisq(7) = 14.71138 (p-value = 0.039882)

General FGLS models

General FGLS estimators are based on a two-step estimation process: first an OLS model is estimated, then its residuals \(\hat{u}_{it}\) are used to estimate an error covariance matrix more general than the random effects one for use in a feasible-GLS analysis. Formally, the estimated error covariance matrix is \(\hat{V}=I_n \otimes \hat{\Omega}\), with \[\hat{\Omega}=\sum_{i=1}^n \frac{\hat{u}_{it} \hat{u}_{it}^\top }{n} \] (see Wooldridge (2002) 10.4.3 and 10.5.5).

This framework allows the error covariance structure inside every group (if effect = "individual") of observations to be fully unrestricted and is therefore robust against any type of intragroup heteroskedasticity and serial correlation. This structure, by converse, is assumed identical across groups and thus general FGLS is inefficient under groupwise heteroskedasticity. Cross-sectional correlation is excluded a priori.

Moreover, the number of variance parameters to be estimated with \(N=n\times T\) data points is \(T(T+1)/2\), which makes these estimators particularly suited for situations where \(n>>T\), as e.g., in labour or household income surveys, while problematic for “long” panels, where \(\hat{V}\) tends to become singular and standard errors therefore become biased downwards.

In a pooled time series context (effect = "time"), symmetrically, this estimator is able to account for arbitrary cross-sectional correlation, provided that the latter is time-invariant (see Greene (2003) 13.9.1–2, pp. 321–2). In this case serial correlation has to be assumed away and the estimator is consistent with respect to the time dimension, keeping \(n\) fixed.

The function pggls estimates general FGLS models, with either fixed or “random” effects7.

The “random effect” general FGLS is estimated by:

zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="pooling")
summary(zz)
## Oneway (individual) effect General FGLS model
## 
## Call:
## pggls(formula = log(emp) ~ log(wage) + log(capital), data = EmplUK, 
##     model = "pooling")
## 
## Unbalanced Panel: n = 140, T = 7-9, N = 1031
## 
## Residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.80696 -0.36552  0.06181  0.03230  0.44279  1.58719 
## 
## Coefficients:
##               Estimate Std. Error z-value              Pr(>|z|)    
## (Intercept)   2.023480   0.158468 12.7690 < 0.00000000000000022 ***
## log(wage)    -0.232329   0.048001 -4.8401           0.000001298 ***
## log(capital)  0.610484   0.017434 35.0174 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Total Sum of Squares: 1853.6
## Residual Sum of Squares: 402.55
## Multiple R-squared: 0.78283

The fixed effects pggls (see Wooldridge (2002), p. 276) is based on the estimation of a within model in the first step; the rest follows as above. It is estimated by:

zz <- pggls(log(emp)~log(wage)+log(capital), data=EmplUK, model="within")

The pggls function is similar to plm in many respects. An exception is that the estimate of the group covariance matrix of errors (zz$sigma, a matrix, not shown) is reported in the model objects instead of the usual estimated variances of the two error components.

Tests

As sketched in Section linear panel model, specification testing in panel models involves essentially testing for poolability, for individual or time unobserved effects and for correlation between these latter and the regressors (Hausman-type tests). As for the other usual diagnostic checks, we provide a suite of serial correlation tests, while not touching on the issue of heteroskedasticity testing. Instead, we provide heteroskedasticity-robust covariance estimators, to be described in subsection robust covariance matrix estimation.

Tests of poolability

pooltest tests the hypothesis that the same coefficients apply to each individual. It is a standard F test, based on the comparison of a model obtained for the full sample and a model based on the estimation of an equation for each individual. The first argument of pooltest is a plm object. The second argument is a pvcm object obtained with model="within". If the first argument is a pooling model, the test applies to all the coefficients (including the intercepts), if it is a within model, different intercepts are assumed.

To test the hypothesis that all the coefficients in the Grunfeld example, excluding the intercepts, are equal, we use :

znp <- pvcm(inv ~ value + capital, data = Grunfeld, model = "within")
zplm <- plm(inv ~ value + capital, data = Grunfeld, model = "within")
pooltest(zplm, znp)
## 
##  F statistic
## 
## data:  inv ~ value + capital
## F = 5.7805, df1 = 18, df2 = 170, p-value = 0.0000000001219
## alternative hypothesis: unstability

The same test can be computed using a formula as first argument of the pooltest function:

pooltest(inv ~ value + capital, data = Grunfeld, model = "within")

Tests for individual and time effects

plmtest implements Lagrange multiplier tests of individual or/and time effects based on the results of the pooling model. Its main argument is a plm object (the result of a pooling model) or a formula.

Two additional arguments can be added to indicate the kind of test to be computed. The argument type is one of:

  • "honda": Honda (1985), the default value,
  • "bp": T. S. Breusch and Pagan (1980),
  • "kw": King and Wu (1997)8,
  • "ghm": Gourieroux, Holly, and Monfort (1982).

The effects tested are indicated with the effect argument (one of "individual", "time", or "twoways"). The test statistics implemented are also suitable for unbalanced panels.9

To test the presence of individual and time effects in the Grunfeld example, using the Gourieroux, Holly, and Monfort (1982) test, we use:

g <- plm(inv ~ value + capital, data=Grunfeld, model="pooling")
plmtest(g, effect="twoways", type="ghm")
## 
##  Lagrange Multiplier Test - two-ways effects (Gourieroux, Holly and
##  Monfort) for balanced panels
## 
## data:  inv ~ value + capital
## chibarsq = 798.16, df0 = 0.00, df1 = 1.00, df2 = 2.00, w0 = 0.25, w1 =
## 0.50, w2 = 0.25, p-value < 0.00000000000000022
## alternative hypothesis: significant effects

or

plmtest(inv~value+capital, data=Grunfeld, effect="twoways", type="ghm")

pFtest computes F tests of effects based on the comparison of the within and the pooling model. Its main arguments are either two plm objects (a pooling and a within model) or a formula.

gw <- plm(inv ~ value + capital, data=Grunfeld, effect="twoways", model="within")
gp <- plm(inv ~ value + capital, data=Grunfeld, model="pooling")
pFtest(gw, gp)
## 
##  F test for twoways effects
## 
## data:  inv ~ value + capital
## F = 17.403, df1 = 28, df2 = 169, p-value < 0.00000000000000022
## alternative hypothesis: significant effects
pFtest(inv~value+capital, data=Grunfeld, effect="twoways")

Hausman test

phtest computes the Hausman test (at times also called Durbin–Wu–Hausman test) which is based on the comparison of two sets of estimates (see Hausman (1978)).

Its main arguments are two panelmodel objects or a formula. A classical application of the Hausman test for panel data is to compare the fixed and the random effects models:

gw <- plm(inv ~ value + capital, data = Grunfeld, model="within")
gr <- plm(inv ~ value + capital, data = Grunfeld, model="random")
phtest(gw, gr)
## 
##  Hausman Test
## 
## data:  inv ~ value + capital
## chisq = 2.3304, df = 2, p-value = 0.3119
## alternative hypothesis: one model is inconsistent

The command also supports the auxiliary-regression-based version as described in, e.g., Wooldridge (2010) Sec.10.7.3 by using the formula interface and setting argument test = "aux". This auxiliary-regression-based version can be robustified by specifying a robust covariance estimator as a function through the argument vcov:

phtest(inv ~ value + capital, data = Grunfeld, method = "aux", vcov = vcovHC)
## 
##  Regression-based Hausman test, vcov: vcovHC
## 
## data:  inv ~ value + capital
## chisq = 8.2998, df = 2, p-value = 0.01577
## alternative hypothesis: one model is inconsistent

Tests of serial correlation

A model with individual effects has composite errors that are serially correlated by definition. The presence of the time-invariant error component10 gives rise to serial correlation which does not die out over time, thus standard tests applied on pooled data always end up rejecting the null of spherical residuals11. There may also be serial correlation of the “usual” kind in the idiosyncratic error terms, e.g., as an AR(1) process. By “testing for serial correlation” we mean testing for this latter kind of dependence.

For these reasons, the subjects of testing for individual error components and for serially correlated idiosyncratic errors are closely related. In particular, simple (marginal) tests for one direction of departure from the hypothesis of spherical errors usually have power against the other one: in case it is present, they are substantially biased towards rejection. Joint tests are correctly sized and have power against both directions, but usually do not give any information about which one actually caused rejection. Conditional tests for serial correlation that take into account the error components are correctly sized under presence of both departures from sphericity and have power only against the alternative of interest. While most powerful if correctly specified, the latter, based on the likelihood framework, are crucially dependent on normality and homoskedasticity of the errors.

In plm we provide a number of joint, marginal and conditional ML-based tests, plus some semiparametric alternatives which are robust vs. heteroskedasticity and free from distributional assumptions.

Unobserved effects test

The unobserved effects test à la Wooldridge (see Wooldridge (2002) 10.4.4), is a semiparametric test for the null hypothesis that \(\sigma^2_{\mu}=0\), i.e. that there are no unobserved effects in the residuals. Given that under the null the covariance matrix of the residuals for each individual is diagonal, the test statistic is based on the average of elements in the upper (or lower) triangle of its estimate, diagonal excluded: \(n^{-1/2} \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is}\) (where \(\hat{u}\) are the pooled OLS residuals), which must be “statistically close” to zero under the null, scaled by its standard deviation: \[W=\frac{ \sum_{i=1}^n \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} }{ [{ \sum_{i=1}^n ( \sum_{t=1}^{T-1} \sum_{s=t+1}^T \hat{u}_{it} \hat{u}_{is} } )^2 ]^{1/2} }\]

This test is (\(n\)-) asymptotically distributed as a standard normal regardless of the distribution of the errors. It does also not rely on homoskedasticity.

It has power both against the standard random effects specification, where the unobserved effects are constant within every group, as well as against any kind of serial correlation. As such, it “nests” both random effects and serial correlation tests, trading some power against more specific alternatives in exchange for robustness.

While not rejecting the null favours the use of pooled OLS, rejection may follow from serial correlation of different kinds, and in particular, quoting Wooldridge (2002), “should not be interpreted as implying that the random effects error structure must be true.”

Below, the test is applied to the data and model in Munnell (1990):

pwtest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc)
## 
##  Wooldridge's test for unobserved individual effects
## 
## data:  formula
## z = 3.9383, p-value = 0.00008207
## alternative hypothesis: unobserved effect

Locally robust tests for serial correlation or random effects

The presence of random effects may affect tests for residual serial correlation, and the opposite. One solution is to use a joint test, which has power against both alternatives. A joint LM test for random effects and serial correlation under normality and homoskedasticity of the idiosyncratic errors has been derived by B. Baltagi and Li (1991) and B. Baltagi and Li (1995) and is implemented as an option in pbsytest:

pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="j")
## 
##  Baltagi and Li AR-RE joint test - balanced panel
## 
## data:  formula
## chisq = 4187.6, df = 2, p-value < 0.00000000000000022
## alternative hypothesis: AR(1) errors or random effects

Rejection of the joint test, though, gives no information on the direction of the departure from the null hypothesis, i.e.: is rejection due to the presence of serial correlation, of random effects or of both?

Bera, Sosa–Escudero, and Yoon (2001) (hereafter BSY) derive locally robust tests both for individual random effects and for first-order serial correlation in residuals as “corrected” versions of the standard LM test (see plmtest). While still dependent on normality and homoskedasticity, these are robust to local departures from the hypotheses of, respectively, no serial correlation or no random effects. The authors observe that, although suboptimal, these tests may help detecting the right direction of the departure from the null, thus complementing the use of joint tests. Moreover, being based on pooled OLS residuals, the BSY tests are computationally far less demanding than likelihood-based conditional tests.

On the other hand, the statistical properties of these “locally corrected” tests are inferior to those of the non-corrected counterparts when the latter are correctly specified. If there is no serial correlation, then the optimal test for random effects is the likelihood-based LM test of Breusch and Godfrey (with refinements by Honda, see plmtest), while if there are no random effects the optimal test for serial correlation is, again, Breusch-Godfrey’s test12. If the presence of a random effect is taken for granted, then the optimal test for serial correlation is the likelihood-based conditional LM test of B. Baltagi and Li (1995) (see pbltest).

The serial correlation version is the default:

pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc)
## 
##  Bera, Sosa-Escudero and Yoon locally robust test - balanced panel
## 
## data:  formula
## chisq = 52.636, df = 1, p-value = 0.0000000000004015
## alternative hypothesis: AR(1) errors sub random effects

The BSY test for random effects is implemented in the one-sided version13, which takes heed that the variance of the random effect must be non-negative:

pbsytest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, test="re")
## 
##  Bera, Sosa-Escudero and Yoon locally robust test (one-sided) -
##  balanced panel
## 
## data:  formula
## z = 57.914, p-value < 0.00000000000000022
## alternative hypothesis: random effects sub AR(1) errors

Conditional LM test for AR(1) or MA(1) errors under random effects

B. Baltagi and Li (1991) and B. Baltagi and Li (1995) derive a Lagrange multiplier test for serial correlation in the idiosyncratic component of the errors under (normal, heteroskedastic) random effects. Under the null of serially uncorrelated errors, the test turns out to be identical for both the alternative of AR(1) and MA(1) processes. One- and two-sided versions are provided, the one-sided having power against positive serial correlation only. The two-sided is the default, while for the other one must specify the alternative option to "onesided":

pbltest(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, 
        data=Produc, alternative="onesided")
## 
##  Baltagi and Li one-sided LM test
## 
## data:  log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp
## z = 21.69, p-value < 0.00000000000000022
## alternative hypothesis: AR(1)/MA(1) errors in RE panel model

As usual, the LM test statistic is based on residuals from the maximum likelihood estimate of the restricted model (random effects with serially uncorrelated errors). In this case, though, the restricted model cannot be estimated by OLS anymore, therefore the testing function depends on lme() in the nlme package for estimation of a random effects model by maximum likelihood. For this reason, the test is applicable only to balanced panels.

No test has been implemented to date for the symmetric hypothesis of no random effects in a model with errors following an AR(1) process, but an asymptotically equivalent likelihood ratio test is available in the nlme package (see Section plm versus nlme and lme4).

General serial correlation tests

A general testing procedure for serial correlation in fixed effects (FE), random effects (RE) and pooled-OLS panel models alike can be based on considerations in Wooldridge (2002), 10.7.2.

Recall that plm model objects are the result of OLS estimation performed on “demeaned” data, where, in the case of individual effects (else symmetric), this means time-demeaning for the FE (within) model, quasi-time-demeaning for the RE (random) model and original data, with no demeaning at all, for the pooled OLS (pooling) model (see Section software approach).

For the random effects model, Wooldridge (2002) observes that under the null of homoskedasticity and no serial correlation in the idiosyncratic errors, the residuals from the quasi-demeaned regression must be spherical as well. Else, as the individual effects are wiped out in the demeaning, any remaining serial correlation must be due to the idiosyncratic component. Hence, a simple way of testing for serial correlation is to apply a standard serial correlation test to the quasi-demeaned model. The same applies in a pooled model, w.r.t. the original data.

The FE case needs some qualification. It is well-known that if the original model’s errors are uncorrelated then FE residuals are negatively serially correlated, with \(cor(\hat{u}_{it}, \hat{u}_{is})=-1/(T-1)\) for each \(t,s\) (see Wooldridge (2002) 10.5.4). This correlation clearly dies out as T increases, so this kind of AR test is applicable to within model objects only for T “sufficiently large”14. On the converse, in short panels the test gets severely biased towards rejection (or, as the induced correlation is negative, towards acceptance in the case of the one-sided DW test with alternative="greater"). See below for a serial correlation test applicable to “short” FE panel models.

plm objects retain the “demeaned” data, so the procedure is straightforward for them. The wrapper functions pbgtest and pdwtest re-estimate the relevant quasi-demeaned model by OLS and apply, respectively, standard Breusch-Godfrey and Durbin-Watson tests from package lmtest:

pbgtest(grun.fe, order = 2)
## 
##  Breusch-Godfrey/Wooldridge test for serial correlation in panel models
## 
## data:  inv ~ value + capital
## chisq = 42.587, df = 2, p-value = 0.0000000005655
## alternative hypothesis: serial correlation in idiosyncratic errors

The tests share the features of their OLS counterparts, in particular the pbgtest allows testing for higher-order serial correlation, which might turn useful, e.g., on quarterly data. Analogously, from the point of view of software, as the functions are simple wrappers towards bgtest and dwtest, all arguments from the latter two apply and may be passed on through the ellipsis (the ... argument).

Wooldridge’s test for serial correlation in “short” FE panels

For the reasons reported above, under the null of no serial correlation in the errors, the residuals of a FE model must be negatively serially correlated, with \(cor(\hat{\epsilon}_{it}, \hat{\epsilon}_{is})=-1/(T-1)\) for each \(t,s\). Wooldridge suggests basing a test for this null hypothesis on a pooled regression of FE residuals on themselves, lagged one period: \[\hat{\epsilon}_{i,t}=\alpha + \delta \hat{\epsilon}_{i,t-1} + \eta_{i,t}\] Rejecting the restriction \(\delta = -1/(T-1)\) makes us conclude against the original null of no serial correlation.

The building blocks available in plm make it easy to construct a function carrying out this procedure: first the FE model is estimated and the residuals retrieved, then they are lagged and a pooling AR(1) model is estimated. The test statistic is obtained by applying the above restriction on \(\delta\) and supplying a heteroskedasticity- and autocorrelation-consistent covariance matrix (vcovHC with the appropriate options, in particular method="arellano")15.

pwartest(log(emp) ~ log(wage) + log(capital), data=EmplUK)
## 
##  Wooldridge's test for serial correlation in FE panels
## 
## data:  plm.model
## F = 312.3, df1 = 1, df2 = 889, p-value < 0.00000000000000022
## alternative hypothesis: serial correlation

The test is applicable to any FE panel model, and in particular to “short” panels with small \(T\) and large \(n\).

Wooldridge’s first-difference-based test

In the context of the first difference model, Wooldridge (2002), 10.6.3 proposes a serial correlation test that can also be seen as a specification test to choose the most efficient estimator between fixed effects (within) and first difference (fd).

The starting point is the observation that if the idiosyncratic errors of the original model \(u_{it}\) are uncorrelated, the errors of the (first) differenced model16 \(e_{it} \equiv u_{it}-u_{i,t-1}\) will be correlated, with \(cor(e_{it}, e_{i,t-1})=-0.5\), while any time-invariant effect, “fixed” or “random,” is wiped out in the differencing. So a serial correlation test for models with individual effects of any kind can be based on estimating the model \[\hat{u}_{i,t}= \delta \hat{u}_{i,t-1} + \eta_{i,t}\] and testing the restriction \(\delta = -0.5\), corresponding to the null of no serial correlation. Drukker (2003) provides Monte Carlo evidence of the good empirical properties of the test.

On the other extreme (see Wooldridge (2002) 10.6.1), if the differenced errors \(e_{it}\) are uncorrelated, as by definition \(u_{it} = u_{i,t-1} + e_{it}\), then \(u_{it}\) is a random walk. In this latter case, the most efficient estimator is the first difference (fd) one; in the former case, it is the fixed effects one (within).

The function pwfdtest allows testing either hypothesis: the default behaviour h0="fd" is to test for serial correlation in first-differenced errors:

pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK)
## 
##  Wooldridge's first-difference test for serial correlation in panels
## 
## data:  plm.model
## F = 1.5251, df1 = 1, df2 = 749, p-value = 0.2172
## alternative hypothesis: serial correlation in differenced errors

while specifying h0="fe" the null hypothesis becomes no serial correlation in original errors, which is similar to the pwartest.

pwfdtest(log(emp) ~ log(wage) + log(capital), data=EmplUK, h0="fe")
## 
##  Wooldridge's first-difference test for serial correlation in panels
## 
## data:  plm.model
## F = 131.55, df1 = 1, df2 = 749, p-value < 0.00000000000000022
## alternative hypothesis: serial correlation in original errors

Not rejecting one of the two is evidence in favour of using the estimator corresponding to h0. Should the truth lie in the middle (both rejected), whichever estimator is chosen will have serially correlated errors: therefore it will be advisable to use the autocorrelation-robust covariance estimators from the subsection robust covariance matrix estimation in inference.

Tests for cross-sectional dependence

Next to the more familiar issue of serial correlation, over the last years a growing body of literature has been dealing with cross-sectional dependence (henceforth: XSD) in panels, which can arise, e.g., if individuals respond to common shocks (as in the literature on factor models) or if spatial diffusion processes are present, relating individuals in a way depending on a measure of distance (spatial models).

The subject is huge, and here we touch only some general aspects of misspecification testing and valid inference. If XSD is present, the consequence is, at a minimum, inefficiency of the usual estimators and invalid inference when using the standard covariance matrix17. The plan is to have in plm both misspecification tests to detect XSD and robust covariance matrices to perform valid inference in its presence, like in the serial dependence case. For now, though, only misspecification tests are included.

CD and LM-type tests for global cross-sectional dependence

The function pcdtest implements a family of XSD tests which can be applied in different settings, ranging from those where \(T\) grows large with \(n\) fixed to “short” panels with a big \(n\) dimension and a few time periods. All are based on (transformations of–) the product-moment correlation coefficient of a model’s residuals, defined as

\[ \hat{\rho}_{ij}=\frac{\sum_{t=1}^T \hat{u}_{it} \hat{u}_{jt}}{(\sum_{t=1}^T \hat{u}^2_{it})^{1/2} (\sum_{t=1}^T \hat{u}^2_{jt})^{1/2} } \]

i.e., as averages over the time dimension of pairwise correlation coefficients for each pair of cross-sectional units.

The Breusch-Pagan (T. S. Breusch and Pagan 1980) LM test, based on the squares of \(\rho_{ij}\), is valid for \(T \rightarrow \infty\) with \(n\) fixed; defined as

\[LM=\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2\]

where in the case of an unbalanced panel only pairwise complete observations are considered, and \(T_{ij}=min(T_i,T_j)\) with \(T_i\) being the number of observations for individual \(i\); else, if the panel is balanced, \(T_{ij}=T\) for each \(i,j\). The test is distributed as \(\chi^2_{n(n-1)/2}\). It is inappropriate whenever the \(n\) dimension is “large.” A scaled version, applicable also if \(T \rightarrow \infty\) and then \(n \rightarrow \infty\) (as in some pooled time series contexts), is defined as

\[SCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1 )\]

and distributed as a standard normal (see M. H. Pesaran (2004)).

A bias-corrected scaled version, \(BCSCLM\), for the fixed effect model with individual effects only is also available which is simply the \(SCLM\) with a term correcting for the bias (Badi H. Baltagi, Feng, and Kao (2012))18. This statistic is also asymptotically distributed as standard normal. \[BCSCLM=\sqrt{\frac{1}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} T_{ij} \hat{\rho}_{ij}^2 -1)-\frac{n}{2(T-1)}\]

Pesaran’s (M. H. Pesaran (2004), M. Hashem Pesaran (2015)) \(CD\) test

\[CD=\sqrt{\frac{2}{n(n-1)}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} \sqrt{T_{ij}} \hat{\rho}_{ij} )\]

based on \(\rho_{ij}\) without squaring (also distributed as a standard normal) is appropriate both in \(n\)– and in \(T\)–asymptotic settings. It has remarkable properties in samples of any practically relevant size and is robust to a variety of settings. The only big drawback is that the test loses power against the alternative of cross-sectional dependence if the latter is due to a factor structure with factor loadings averaging zero, that is, some units react positively to common shocks, others negatively.

The default version of the test is "cd" yielding Pesaran’s \(CD\) test. These tests are originally meant to use the residuals of separate estimation of one time-series regression for each cross-sectional unit, so this is the default behaviour of pcdtest.

pcdtest(inv~value+capital, data=Grunfeld)
## 
##  Pesaran CD test for cross-sectional dependence in panels
## 
## data:  inv ~ value + capital
## z = 5.3401, p-value = 0.00000009292
## alternative hypothesis: cross-sectional dependence

If a different model specification (within, random, …) is assumed consistent, one can resort to its residuals for testing19 by specifying the relevant model type. The main argument of this function may be either a model of class panelmodel or a formula and a data.frame; in the second case, unless model is set to NULL, all usual parameters relative to the estimation of a plm model may be passed on. The test is compatible with any consistent panelmodel for the data at hand, with any specification of effect. E.g., specifying effect = "time" or effect = "twoways" allows to test for residual cross-sectional dependence after the introduction of time fixed effects to account for common shocks.

pcdtest(inv~value+capital, data=Grunfeld, model="within")
## 
##  Pesaran CD test for cross-sectional dependence in panels
## 
## data:  inv ~ value + capital
## z = 4.6612, p-value = 0.000003144
## alternative hypothesis: cross-sectional dependence

If the time dimension is insufficient and model=NULL, the function defaults to estimation of a within model and issues a warning.

CD(p) test for local cross-sectional dependence

A local variant of the \(CD\) test, called \(CD(p)\) test (M. H. Pesaran 2004), takes into account an appropriate subset of neighbouring cross-sectional units to check the null of no XSD against the alternative of local XSD, i.e. dependence between neighbours only. To do so, the pairs of neighbouring units are selected by means of a binary proximity matrix like those used in spatial models. In the original paper, a regular ordering of observations is assumed, so that the \(m\)-th cross-sectional observation is a neighbour to the \((m-1)\)-th and to the \((m+1)\)-th. Extending the \(CD(p)\) test to irregular lattices, we employ the binary proximity matrix as a selector for discarding the correlation coefficients relative to pairs of observations that are not neighbours in computing the \(CD\) statistic. The test is then defined as

\[CD=\sqrt{\frac{1}{\sum_{i=1}^{n-1} \sum_{j=i+1}^{n} w(p)_{ij}}} ( \sum_{i=1}^{n-1} \sum_{j=i+1}^{n} [w(p)]_{ij} \sqrt{T_{ij}}\hat{\rho}_{ij} )\]

where \([w(p)]_{ij}\) is the \((i,j)\)-th element of the \(p\)-th order proximity matrix, so that if \(h,k\) are not neighbours, \([w(p)]_{hk}=0\) and \(\hat{\rho}_{hk}\) gets “killed”; this is easily seen to reduce to formula (14) in Pesaran (M. H. Pesaran 2004) for the special case considered in that paper. The same can be applied to the \(LM\), \(SCLM\), and \(BCSCLM\) tests.

Therefore, the local version of either test can be computed supplying an \(n \times n\) matrix (of any kind coercible to logical), providing information on whether any pair of observations are neighbours or not, to the w argument. If w is supplied, only neighbouring pairs will be used in computing the test; else, w will default to NULL and all observations will be used. The matrix needs not really be binary, so commonly used “row-standardized” matrices can be employed as well: it is enough that neighbouring pairs correspond to nonzero elements in w.20

Panel unit root tests

Overview of functions for panel unit root testing

Below, first an overview is provided which tests are implemented per functions. A theoretical treatment is given for a few of those tests later on. The package plm offers several panel unit root tests contained in three functions:

  • purtest (Levin-Lin-Chu test, IPS test, several Fisher-type tests, Hadri’s test),
  • cipstest (cross-sectionally augmented IPS test), and
  • phansitest (Simes’ test).

While purtest implements various tests which can be selected via its test argument, cipstest and phansitest are functions for a specific test each.

Function purtest offers the following tests by setting argument test to:

  • "levinlin" (default), for the Levin-Lin-Chu test (Levin, Lin, and Chu (2002)), see below for a theoretical exposition (Levin-Lin-Chu test)),
  • "ips", for Im-Pesaran-Shin (IPS) test by Im, Pesaran, and Shin (2003), see below for a theoretical exposition (Im-Pesaran-Shin test)),
  • "madwu", is the inverse \(\chi^2\) test by Maddala and Wu (1999), also called P test by Choi (2001),
  • "Pm", is the modified P test proposed by Choi (2001) for large N,
  • "invnormal", is the inverse normal test (Choi (2001)),
  • "logit", is the logit test (Choi (2001)),
  • "hadri", for Hadri’s test (Hadri (2000)).

The tests in purtest are often called first generation panel unit root tests as they do assume absence of cross-sectional correlation; all these, except Hadri’s test, are based on the estimation of augmented Dickey-Fuller (ADF) regressions for each time series. A statistic is then computed using the t-statistics associated with the lagged variable. I a different manner, the Hadri residual-based LM statistic is the cross-sectional average of individual KPSS statistics (Kwiatkowski et al. (1992)), standardized by their asymptotic mean and standard deviation. Among the tests in purtest, "madwu", "Pm", "invormal", and "logit" are Fisher-type tests.21

purtest returns an object of class "purtest" which contains details about the test performed, among them details about the individual regressions/statistics for the test. Associated summary and print.summary methods can be used to extract/display the additional information.

Function cipstest implements Pesaran’s (M. Hashem Pesaran (2007)) cross-sectionally augmented version of the Im-Pesaran-Shin panel unit root test and is a so-called second-generation panel unit root test.

Function phansitest implements the idea of Hanck (2013) to apply Simes’ testing approach for intersection of individual hypothesis tests to panel unit root testing, see below for a more thorough treatment of Simes’ approach for intersecting hypotheses.

Preliminary results

We consider the following model:

\[ y_{it} = \delta y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} \]

The unit root hypothesis is \(\rho = 1\). The model can be rewritten in difference:

\[ \Delta y_{it} = \rho y_{it-1} + \sum_{L=1}^{p_i} \theta_i \Delta y_{it-L}+\alpha_{mi} d_{mt}+\epsilon_{it} \]

So that the unit-root hypothesis is now \(\rho = 0\).

Some of the unit-root tests for panel data are based on preliminary results obtained by running the above Augmented Dickey-Fuller (ADF) regression.

First, we have to determine the optimal number of lags \(p_i\) for each time-series. Several possibilities are available. They all have in common that the maximum number of lags have to be chosen first. Then, \(p_i\) can be chosen by using:

  • the Schwarz information criterion (SIC) (also known as Bayesian information criterion (BIC)),
  • the Akaike information criterion (AIC),
  • the Hall’s method, which consist in removing the higher lags while they are not significant.

The ADF regression is run on \(T-p_i-1\) observations for each individual, so that the total number of observations is \(n\times \tilde{T}\) where \(\tilde{T}=T-p_i-1\)

\(\bar{p}\) is the average number of lags. Call \(e_{i}\) the vector of residuals.

Estimate the variance of the \(\epsilon_i\) as:

\[ \hat{\sigma}_{\epsilon_i}^2 = \frac{\sum_{t=p_i+1}^{T} e_{it}^2}{df_i} \]

Levin-Lin-Chu model

Then, as per Levin, Lin, and Chu (2002), compute artificial regressions of \(\Delta y_{it}\) and \(y_{it-1}\) on \(\Delta y_{it-L}\) and \(d_{mt}\) and get the two vectors of residuals \(z_{it}\) and \(v_{it}\).

Standardize these two residuals and run the pooled regression of \(z_{it}/\hat{\sigma}_i\) on \(v_{it}/\hat{\sigma}_i\) to get \(\hat{\rho}\), its standard deviation \(\hat{\sigma}({\hat{\rho}})\) and the t-statistic \(t_{\hat{\rho}}=\hat{\rho}/\hat{\sigma}({\hat{\rho}})\).

Compute the long run variance of \(y_i\) :

\[ \hat{\sigma}_{yi}^2 = \frac{1}{T-1}\sum_{t=2}^T \Delta y_{it}^2 + 2 \sum_{L=1}^{\bar{K}}w_{\bar{K}L}\left[\frac{1}{T-1}\sum_{t=2+L}^T \Delta y_{it} \Delta y_{it-L}\right] \]

Define \(\bar{s}_i\) as the ratio of the long and short term variance and \(\bar{s}\) the mean for all the individuals of the sample

\[ s_i = \frac{\hat{\sigma}_{yi}}{\hat{\sigma}_{\epsilon_i}} \]

\[ \bar{s} = \frac{\sum_{i=1}^n s_i}{n} \]

\[ t^*_{\rho}=\frac{t_{\rho}- n \bar{T} \bar{s} \hat{\sigma}_{\tilde{\epsilon}}^{-2} \hat{\sigma}({\hat{\rho}}) \mu^*_{m\tilde{T}}}{\sigma^*_{m\tilde{T}}} \]

follows a normal distribution under the null hypothesis of stationarity. \(\mu^*_{m\tilde{T}}\) and \(\sigma^*_{m\tilde{T}}\) are given in table 2 of the original paper and are also available in the package.

An example how the Levin-Lin-Chu test is performed with purtest using a lag of 2 and intercept and a time trend as exogenous variables in the ADF regressions is:

data("HousePricesUS", package = "pder")
lprice <- log(pdata.frame(HousePricesUS)$price)
(lev <- purtest(lprice, test = "levinlin", lags = 2, exo = "trend"))
## 
##  Levin-Lin-Chu Unit-Root Test (ex. var.: Individual Intercepts and
##  Trend)
## 
## data:  lprice
## z = -1.2573, p-value = 0.1043
## alternative hypothesis: stationarity
summary(lev) ### gives details
## Levin-Lin-Chu Unit-Root Test 
## Exogenous variables: Individual Intercepts and Trend 
## User-provided lags
## statistic: -1.257 
## p-value: 0.104 
## 
##    lags obs          rho        trho      p.trho     sigma2ST     sigma2LT
## 1     2  26 -0.092065357 -1.66309731 0.767613204 0.0003143120 0.0004013788
## 4     2  26 -0.124093984 -1.29563385 0.888755668 0.0010950144 0.0014736172
## 5     2  26 -0.104647566 -1.10814627 0.926357866 0.0007296044 0.0007451534
## 6     2  26 -0.219022744 -2.94312106 0.148774635 0.0007716609 0.0048254402
## 8     2  26 -0.052471794 -0.95375744 0.948405601 0.0006375257 0.0028152736
## 9     2  26 -0.181914333 -2.73331072 0.222919642 0.0021489671 0.0064455696
## 10    2  26 -0.232215125 -3.37321191 0.054989191 0.0005566400 0.0024147067
## 11    2  26 -0.356452679 -4.35943612 0.002479709 0.0008542529 0.0045574510
## 12    2  26  0.279936991  1.83482002 0.999998365 0.0004172617 0.0012951914
## 13    2  26 -0.062610441 -0.84216587 0.960499065 0.0003168316 0.0002981994
## 16    2  26 -0.159254884 -2.29683734 0.435109226 0.0007437190 0.0010203969
## 17    2  26 -0.237065476 -4.05050006 0.007367490 0.0005512405 0.0009463645
## 18    2  26 -0.140788644 -2.08598977 0.553093684 0.0005079423 0.0005697978
## 19    2  26 -0.099218199 -1.83853581 0.686000079 0.0008756343 0.0020399374
## 20    2  26 -0.046049208 -0.85174237 0.959567857 0.0003914722 0.0011128571
## 21    2  26 -0.102633777 -1.81503721 0.697696805 0.0004063481 0.0002345858
## 22    2  26 -0.115700485 -1.72146553 0.741996511 0.0010094113 0.0047169602
## 23    2  26 -0.218251170 -2.90863990 0.159598845 0.0010530905 0.0031254005
## 24    2  26 -0.293126134 -3.65827755 0.025157448 0.0004297907 0.0012860757
## 25    2  26 -0.107476475 -2.33427946 0.414643019 0.0008718077 0.0083545213
## 26    2  26 -0.135655633 -2.06664416 0.563904448 0.0009443422 0.0007705242
## 27    2  26 -0.005168776 -0.06565125 0.995432637 0.0007059964 0.0017093982
## 28    2  26 -0.101736562 -1.02991147 0.938382427 0.0008552994 0.0003212357
## 29    2  26 -0.106917037 -1.44344289 0.848353136 0.0004659842 0.0004528307
## 30    2  26 -0.143955051 -1.60594256 0.791068910 0.0016589513 0.0022706981
## 31    2  26 -0.093688191 -1.92279670 0.642427798 0.0004025885 0.0009260538
## 32    2  26 -0.313691108 -2.30732500 0.429359754 0.0009640889 0.0019245305
## 33    2  26 -0.151599029 -2.54586869 0.305755540 0.0011446680 0.0072973098
## 34    2  26 -0.113830637 -2.06152082 0.566761534 0.0008514932 0.0055913854
## 35    2  26 -0.220363663 -1.72391205 0.740887358 0.0005138068 0.0007015982
## 36    2  26 -0.211779244 -3.98522621 0.009148144 0.0011004960 0.0062947120
## 37    2  26 -0.161851244 -2.19906397 0.489557509 0.0002334460 0.0001298656
## 38    2  26 -0.222507555 -1.45762738 0.843900682 0.0048242337 0.0019584921
## 39    2  26 -0.119405321 -2.41405422 0.372087172 0.0004737829 0.0009459741
## 40    2  26 -0.066956522 -0.94176615 0.949844273 0.0011477969 0.0044950987
## 41    2  26 -0.107420235 -2.09998836 0.545259606 0.0009669881 0.0033414294
## 42    2  26 -0.211640785 -3.51839705 0.037371037 0.0004302930 0.0020971822
## 44    2  26 -0.160491538 -2.32116399 0.421790841 0.0016866384 0.0067053791
## 45    2  26  0.013957358  0.21048073 0.998138553 0.0002474183 0.0001310960
## 46    2  26 -0.125206819 -1.36523187 0.871040437 0.0014782610 0.0005893232
## 47    2  26 -0.146576570 -2.35613125 0.402831448 0.0002851628 0.0001796349
## 48    2  26 -0.106184312 -1.41243370 0.857717409 0.0006722417 0.0029218865
## 49    2  26 -0.110328029 -2.31986075 0.422503260 0.0007413810 0.0032547907
## 50    2  26 -0.336849990 -3.07534065 0.112195130 0.0015064070 0.0017150678
## 51    2  26 -0.219041498 -2.26882562 0.450564573 0.0004175437 0.0010455238
## 53    2  26 -0.249921002 -2.67545341 0.246874228 0.0008780514 0.0016600448
## 54    2  26 -0.092856496 -1.36610183 0.870804641 0.0011141161 0.0011656778
## 55    2  26 -0.119379994 -2.19438511 0.492186948 0.0008204933 0.0007526503
## 56    2  26 -0.094196887 -1.53868461 0.816472629 0.0016308380 0.0062631397

Im-Pesaran-Shin (IPS) test

This test by Im, Pesaran, and Shin (2003) does not require that \(\rho\) is the same for all the individuals. The null hypothesis is still that all the series have an unit root, but the alternative is that some may have a unit root and others have different values of \(\rho_i <0\).

The test is based on the average of the student statistic of the \(\rho\) obtained for each individual:

\[ \bar{t}=\frac{1}{n}\sum_{i=1}^n t_{\rho i} \]

The statistic is then:

\[ z = \frac{\sqrt{n}\left(\bar{t}- E(\bar{t})\right)}{\sqrt{V(\bar{t})}} \]

\(\mu^*_{m\tilde{T}}\) and \(\sigma^*_{m\tilde{T}}\) are given in table 2 of the original paper and are also available in the package.

An example of the IPS test with purtest with the same settings as in the previously performed Levin-Lin-Chu test is:

purtest(lprice, test = "ips", lags = 2, exo = "trend")
## 
##  Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts and
##  Trend)
## 
## data:  lprice
## Wtbar = 0.76622, p-value = 0.7782
## alternative hypothesis: stationarity

Simes’ approach: intersecting hypotheses

A different approach to panel unit root testing can be drawn from the general Simes’ test for intersection of individual hypothesis tests (Simes 1986). Hanck (2013) suggests to apply the approach for panel unit root testing: The tests works by combining p-values from single hypothesis tests (individual unit root tests) with a global (intersected) hypothesis and controls for the multiplicity in testing. Thus, it works “on top” of any panel unit root test which yield a p-value for each individual series. Unlike most other panel unit root tests, this approach allows to discriminate between individuals for which the individual H0 (unit root present for individual series) is rejected/is not rejected and requires a pre-specified significance level. Further, the test is robust versus general patterns of cross-sectional dependence.

The function phansitest for this test takes as main input object either a numeric containing p-values of individual tests or a "purtest" object as produced by function purtest which holds a suitable pre-computed panel unit root test (one that produces p-values per individual series). The significance level is set by argument alpha (default 5 %). The function’s return value is a list with detailed evaluation of the applied Simes test. The associated print method gives a verbal evaluation.

The following examples shows both accepted ways of input, the first example replicates Hanck (2013), table 11 (left side), who applied some panel unit root test for a Purchasing Power Parity analysis per country (individual H0 hypotheses per series) to get the individual p-values and then used Simes’ approach for testing the global (intersecting) hypothesis for the whole panel.

### input is numeric (p-values), replicates Hanck (2013), Table 11 (left side)
pvals <- c(0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0050,0.0050,0.0050,
           0.0050,0.0175,0.0175,0.0200,0.0250,0.0400,0.0500,0.0575,0.2375,0.2475)
countries <- c("Argentina","Sweden","Norway","Mexico","Italy","Finland","France",
              "Germany","Belgium","U.K.","Brazil","Australia","Netherlands",
              "Portugal","Canada", "Spain","Denmark","Switzerland","Japan")
names(pvals) <- countries
h <- phansitest(pvals)
print(h)
## 
##         Simes Test as Panel Unit Root Test (Hanck (2013))
## 
## H0: All individual series have a unit root
## HA: Stationarity for at least some individuals
## 
## Alpha: 0.05
## Number of individuals: 19
## 
## Evaluation:
##  H0 rejected (globally)
## 
##  Individual H0 rejected for 10 individual(s) (integer id(s)):
##   1, 2, 3, 4, 5, 6, 7, 8, 9, 10
h$rejected # logical indicating the individuals with rejected individual H0
##   Argentina      Sweden      Norway      Mexico       Italy     Finland 
##        TRUE        TRUE        TRUE        TRUE        TRUE        TRUE 
##      France     Germany     Belgium        U.K.      Brazil   Australia 
##        TRUE        TRUE        TRUE        TRUE       FALSE       FALSE 
## Netherlands    Portugal      Canada       Spain     Denmark Switzerland 
##       FALSE       FALSE       FALSE       FALSE       FALSE       FALSE 
##       Japan 
##       FALSE
### input is a (suitable) purtest object / different example
y <- data.frame(split(Grunfeld$inv, Grunfeld$firm))
obj <- purtest(y, pmax = 4, exo = "intercept", test = "madwu")
phansitest(obj, alpha = 0.06) # test with significance level set to 6 %

Robust covariance matrix estimation

Robust estimators of the covariance matrix of coefficients are provided, mostly for use in Wald-type tests, and this section provides some basics and examples. A more comprehensive exposition of the theory and the capabilities that come with the plm package is given in Millo (2017).

vcovHC estimates three “flavours” of White’s heteroskedasticity-consistent covariance matrix22 (known as the sandwich estimator). Interestingly, in the context of panel data the most general version also proves consistent vs. serial correlation.

All types assume no correlation between errors of different groups while allowing for heteroskedasticity across groups, so that the full covariance matrix of errors is \(V=I_n \otimes \Omega_i; i=1,..,n\). As for the intragroup error covariance matrix of every single group of observations, "white1" allows for general heteroskedasticity but no serial correlation, i.e.

\[\begin{equation} (\#eq:omegaW1) \Omega_i= \left[ \begin{array}{c c c c} \sigma_{i1}^2 & \dots & \dots & 0 \\ 0 & \sigma_{i2}^2 & & \vdots \\ \vdots & & \ddots & 0 \\ 0 & ... & ... & \sigma_{iT}^2 \\ \end{array} \right] \end{equation}\]

while "white2" is "white1" restricted to a common variance inside every group, estimated as \(\sigma_i^2=\sum_{t=1}^T{\hat{u}_{it}^2}/T\), so that \(\Omega_i=I_T \otimes \sigma_i^2\) (see Greene (2003), 13.7.1–2 and Wooldridge (2002), 10.7.2; "arellano" (see ibid. and the original ref. Manuel Arellano (1987)) allows a fully general structure w.r.t. heteroskedasticity and serial correlation:

\[\begin{equation} (\#eq:omegaArellano) \Omega_i= \left[ \begin{array}{c c c c c} \sigma_{i1}^2 & \sigma_{i1,i2} & \dots & \dots & \sigma_{i1,iT} \\ \sigma_{i2,i1} & \sigma_{i2}^2 & & & \vdots \\ \vdots & & \ddots & & \vdots \\ \vdots & & & \sigma_{iT-1}^2 & \sigma_{iT-1,iT} \\ \sigma_{iT,i1} & \dots & \dots & \sigma_{iT,iT-1} & \sigma_{iT}^2 \\ \end{array} \right] \end{equation}\]

The latter is, as already observed, consistent w.r.t. timewise correlation of the errors, but on the converse, unlike the White 1 and 2 methods, it relies on large \(n\) asymptotics with small \(T\).

The fixed effects case, as already observed in Section tests of serial correlation on serial correlation, is complicated by the fact that the demeaning induces serial correlation in the errors. The original White estimator ("white1") turns out to be inconsistent for fixed \(T\) as \(n\) grows, so in this case it is advisable to use the "arellano" version (see Stock and Watson (2008)).

The errors may be weighted according to the schemes proposed by J. G. MacKinnon and White (1985) and Cribari–Neto (2004) to improve small-sample performance23.

The main use of vcovHC (and the other variance-covariance estimators provided in the package vcovBK, vcovNW, vcovDC, vcovSCC) is to pass it to plm’s own functions like summary, pwaldtest, and phtest or together with testing functions from the lmtest and car packages. All of these typically allow passing the vcov or vcov. parameter either as a matrix or as a function (see also Zeileis (2004)). If one is happy with the defaults, it is easiest to pass the function itself24:

re <- plm(inv~value+capital, data = Grunfeld, model = "random")
summary(re, vcov = vcovHC) # gives usual summary output but with robust test statistics
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Note: Coefficient variance-covariance matrix supplied: vcovHC
## 
## Call:
## plm(formula = inv ~ value + capital, data = Grunfeld, model = "random")
## 
## Balanced Panel: n = 10, T = 20, N = 200
## 
## Effects:
##                   var std.dev share
## idiosyncratic 2784.46   52.77 0.282
## individual    7089.80   84.20 0.718
## theta: 0.8612
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -177.6063  -19.7350    4.6851   19.5105  252.8743 
## 
## Coefficients:
##               Estimate Std. Error z-value              Pr(>|z|)    
## (Intercept) -57.834415  23.449626 -2.4663               0.01365 *  
## value         0.109781   0.012984  8.4551 < 0.00000000000000022 ***
## capital       0.308113   0.051889  5.9379        0.000000002887 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2381400
## Residual Sum of Squares: 548900
## R-Squared:      0.7695
## Adj. R-Squared: 0.76716
## Chisq: 78.7096 on 2 DF, p-value: < 0.000000000000000222
library("lmtest")
coeftest(re, vcovHC, df = Inf)
## 
## z test of coefficients:
## 
##               Estimate Std. Error z value              Pr(>|z|)    
## (Intercept) -57.834415  23.449626 -2.4663               0.01365 *  
## value         0.109781   0.012984  8.4551 < 0.00000000000000022 ***
## capital       0.308113   0.051889  5.9379        0.000000002887 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

else one may do the covariance computation inside the call, thus passing on a matrix:

summary(re, vcov = vcovHC(re, method="white2", type="HC3"))
coeftest(re, vcovHC(re, method="white2", type="HC3"), df = Inf)

For some tests, e.g., for multiple model comparisons by waldtest, one should always provide a function25. In this case, optional parameters are provided as shown below (see also Zeileis (2004), p. 12):

waldtest(re, update(re, . ~ . -capital),
         vcov=function(x) vcovHC(x, method="white2", type="HC3"))
## Wald test
## 
## Model 1: inv ~ value + capital
## Model 2: inv ~ value
##   Res.Df Df  Chisq            Pr(>Chisq)    
## 1    197                                    
## 2    198 -1 87.828 < 0.00000000000000022 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Moreover, linearHypothesis from package car may be used to test for linear restrictions:

library("car")
linearHypothesis(re, "2*value=capital", vcov. = vcovHC)
## Linear hypothesis test
## 
## Hypothesis:
## 2 value - capital = 0
## 
## Model 1: restricted model
## Model 2: inv ~ value + capital
## 
## Note: Coefficient covariance matrix supplied.
## 
##   Res.Df Df  Chisq Pr(>Chisq)  
## 1    198                       
## 2    197  1 3.4783    0.06218 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

A specific methods are also provided for pcce and pgmm objects, for the latter vcovHC provides the robust covariance matrix proposed by Windmeijer (2005) for generalized method of moments estimators.

plm versus nlme and lme4

The models termed panel by the econometricians have counterparts in the statistics literature on mixed models (or hierarchical models, or models for longitudinal data), although there are both differences in jargon and more substantial distinctions. This language inconsistency between the two communities, together with the more complicated general structure of statistical models for longitudinal data and the associated notation in the software, is likely to scare some practicing econometricians away from some potentially useful features of the R environment, so it may be useful to provide here a brief reconciliation between the typical panel data specifications used in econometrics and the general framework used in statistics for mixed models26.

R is particularly strong on mixed models’ estimation, thanks to the long-standing nlme package (see J. Pinheiro et al. (2007)) and the more recent lme4 package, based on S4 classes (see Bates (2007))27. In the following we will refer to the more established nlme to give some examples of “econometric” panel models that can be estimated in a likelihood framework, also including some likelihood ratio tests. Some of them are not feasible in plm and make a useful complement to the econometric “toolbox” available in R.

Fundamental differences between the two approaches

Econometrics deal mostly with non-experimental data. Great emphasis is put on specification procedures and misspecification testing. Model specifications tend therefore to be very simple, while great attention is put on the issues of endogeneity of the regressors, dependence structures in the errors and robustness of the estimators under deviations from normality. The preferred approach is often semi- or non-parametric, and heteroskedasticity-consistent techniques are becoming standard practice both in estimation and testing.

For all these reasons, although the maximum likelihood framework is important in testing28 and sometimes used in estimation as well, panel model estimation in econometrics is mostly accomplished in the generalized least squares framework based on Aitken’s Theorem and, when possible, in its special case OLS, which are free from distributional assumptions (although these kick in at the diagnostic testing stage). On the contrary, longitudinal data models in nlme and lme4 are estimated by (restricted or unrestricted) maximum likelihood. While under normality, homoskedasticity and no serial correlation of the errors OLS are also the maximum likelihood estimator, in all the other cases there are important differences.

The econometric GLS approach has closed-form analytical solutions computable by standard linear algebra and, although the latter can sometimes get computationally heavy on the machine, the expressions for the estimators are usually rather simple. ML estimation of longitudinal models, on the contrary, is based on numerical optimization of nonlinear functions without closed-form solutions and is thus dependent on approximations and convergence criteria. For example, the “GLS” functionality in nlme is rather different from its “econometric” counterpart. “Feasible GLS” estimation in plm is based on a single two-step procedure, in which an inefficient but consistent estimation method (typically OLS) is employed first in order to get a consistent estimate of the errors’ covariance matrix, to be used in GLS at the second step; on the converse, “GLS” estimators in nlme are based on iteration until convergence of two-step optimization of the relevant likelihood.

Some false friends

The fixed/random effects terminology in econometrics is often recognized to be misleading, as both are treated as random variates in modern econometrics (see, e.g., Wooldridge (2002) 10.2.1). It has been recognized since Mundlak’s classic paper (Mundlak (1978)) that the fundamental issue is whether the unobserved effects are correlated with the regressors or not. In this last case, they can safely be left in the error term, and the serial correlation they induce is cared for by means of appropriate GLS transformations. On the contrary, in the case of correlation, “fixed effects” methods such as least squares dummy variables or time-demeaning are needed, which explicitly, although inconsistently29, estimate a group– (or time–) invariant additional parameter for each group (or time period).

Thus, from the point of view of model specification, having fixed effects in an econometric model has the meaning of allowing the intercept to vary with group, or time, or both, while the other parameters are generally still assumed to be homogeneous. Having random effects means having a group– (or time–, or both) specific component in the error term.

In the mixed models literature, on the contrary, fixed effect indicates a parameter that is assumed constant, while random effects are parameters that vary randomly around zero according to a joint multivariate normal distribution.

So, the FE model in econometrics has no counterpart in the mixed models framework, unless reducing it to OLS on a specification with one dummy for each group (often termed least squares dummy variables, or LSDV model) which can trivially be estimated by OLS. The RE model is instead a special case of a mixed model where only the intercept is specified as a random effect, while the “random” type variable coefficients model can be seen as one that has the same regressors in the fixed and random sets. The unrestricted generalized least squares can in turn be seen, in the nlme framework, as a standard linear model with a general error covariance structure within the groups and errors uncorrelated across groups.

A common taxonomy

To reconcile the two terminologies, in the following we report the specification of the panel models in plm according to the general expression of a mixed model in Laird-Ware form (see the web appendix to Fox 2002) and the nlme estimation commands for maximum likelihood estimation of an equivalent specification30.

The Laird-Ware representation for mixed models

A general representation for the linear mixed effects model is given in Laird and Ware (1982).

\[ \begin{array}{rcl} y_{it} & = & \beta_1 x_{1ij} + \dots + \beta_p x_{pij} \\ & & b_1 z_{1ij} + \dots + b_p z_{pij} + \epsilon_{ij} \\ b_{ik} & \sim & N(0,\psi^2_k), \phantom{p} Cov(b_k,b_{k'}) = \psi_{kk'} \\ \epsilon_{ij} & \sim & N(0,\sigma^2 \lambda_{ijj}), \phantom{p} Cov(\epsilon_{ij},\epsilon_{ij'}) = \sigma^2 \lambda_{ijj'} \\ \end{array} \]

where the \(x_1, \dots x_p\) are the fixed effects regressors and the \(z_1, \dots z_p\) are the random effects regressors, assumed to be normally distributed across groups. The covariance of the random effects coefficients \(\psi_{kk'}\) is assumed constant across groups and the covariances between the errors in group \(i\), \(\sigma^2 \lambda_{ijj'}\), are described by the term \(\lambda_{ijj'}\) representing the correlation structure of the errors within each group (e.g., serial correlation over time) scaled by the common error variance \(\sigma^2\).

Pooling and Within

The pooling specification in plm is equivalent to a classical linear model (i.e., no random effects regressor and spherical errors: \(b_{iq}=0 \phantom{p} \forall i,q, \phantom{p} \lambda_{ijj}=\sigma^2\) for \(j=j'\), \(0\) else). The within one is the same with the regressors’ set augmented by \(n-1\) group dummies. There is no point in using nlme as parameters can be estimated by OLS which is also ML.

Random effects

In the Laird and Ware notation, the RE specification is a model with only one random effects regressor: the intercept. Formally, \(z_{1ij}=1 \phantom{p}\forall i,j, \phantom{p} z_{qij}=0 \phantom{p} \forall i, \forall j, \forall q \neq 1\) \(\lambda_{ij}=1\) for \(i=j\), \(0\) else). The composite error is therefore \(u_{ij}=1b_{i1} + \epsilon_{ij}\). Below we report coefficients of Grunfeld’s model estimated by GLS and then by ML:

library(nlme)
reGLS <- plm(inv~value+capital, data=Grunfeld, model="random")

reML <- lme(inv~value+capital, data=Grunfeld, random=~1|firm)

coef(reGLS)
## (Intercept)       value     capital 
## -57.8344149   0.1097812   0.3081130
summary(reML)$coefficients$fixed
## (Intercept)       value     capital 
## -57.8644245   0.1097897   0.3081881

Variable coefficients, “random”

Swamy’s variable coefficients model (Swamy 1970) has coefficients varying randomly (and independently of each other) around a set of fixed values, so the equivalent specification is \(z_{q}=x_{q} \phantom{p} \forall q\), i.e. the fixed effects and the random effects regressors are the same, and \(\psi_{kk'}=\sigma_\mu^2 I_N\), and \(\lambda_{ijj}=1\), \(\lambda_{ijj'}=0\) for \(j \neq j'\), that’s to say they are not correlated.

Estimation of a mixed model with random coefficients on all regressors is rather demanding from the computational side. Some models from our examples fail to converge. The below example is estimated on the Grunfeld data and model with time effects.

vcm <- pvcm(inv~value+capital, data=Grunfeld, model="random", effect="time")

vcmML <- lme(inv~value+capital, data=Grunfeld, random=~value+capital|year)

coef(vcm)
## (Intercept)       value     capital 
## -18.5538638   0.1239595   0.1114579
summary(vcmML)$coefficients$fixed
## (Intercept)       value     capital 
## -26.3558395   0.1241982   0.1381782

Variable coefficients, “within”

This specification actually entails separate estimation of \(T\) different standard linear models, one for each group in the data, so the estimation approach is the same: OLS. In nlme this is done by creating an lmList object, so that the two models below are equivalent (output suppressed):

vcmf <- pvcm(inv~value+capital, data=Grunfeld, model="within", effect="time")

vcmfML <- lmList(inv~value+capital|year, data=Grunfeld)

General FGLS

The general, or unrestricted, feasible GLS (FGLS), pggls in the plm nomenclature, is equivalent to a model with no random effects regressors (\(b_{iq}=0 \phantom{p} \forall i,q\)) and an error covariance structure which is unrestricted within groups apart from the usual requirements. The function for estimating such models with correlation in the errors but no random effects is gls().

This very general serial correlation and heteroskedasticity structure is not estimable for the original Grunfeld data, which have more time periods than firms, therefore we restrict them to firms 4 to 6.

sGrunfeld <- Grunfeld[Grunfeld$firm %in% 4:6, ]

ggls <- pggls(inv~value+capital, data=sGrunfeld, model="pooling")

gglsML <- gls(inv~value+capital, data=sGrunfeld,
              correlation=corSymm(form=~1|year))

coef(ggls)
## (Intercept)       value     capital 
##  1.19679342  0.10555908  0.06600166
summary(gglsML)$coefficients
## (Intercept)       value     capital 
##  -2.4156266   0.1163550   0.0735837

The within case is analogous, with the regressor set augmented by \(n-1\) group dummies.

Some useful “econometric” models in nlme

Finally, amongst the many possible specifications estimable with nlme, we report a couple cases that might be especially interesting to applied econometricians.

AR(1) pooling or random effects panel

Linear models with groupwise structures of time-dependence31 may be fitted by gls(), specifying the correlation structure in the correlation option32:

Grunfeld$year <- as.numeric(as.character(Grunfeld$year))
lmAR1ML <- gls(inv~value+capital,data=Grunfeld,
               correlation=corAR1(0,form=~year|firm))

and analogously the random effects panel with, e.g., AR(1) errors (see B. H. Baltagi (2005); B. H. Baltagi (2013); B. H. Baltagi (2021), ch. 5), which is a very common specification in econometrics, may be fit by lme specifying an additional random intercept:

reAR1ML <- lme(inv~value+capital, data=Grunfeld,random=~1|firm,
               correlation=corAR1(0,form=~year|firm))

The regressors’ coefficients and the error’s serial correlation coefficient may be retrieved this way:

summary(reAR1ML)$coefficients$fixed
##  (Intercept)        value      capital 
## -40.27650822   0.09336672   0.31323330
coef(reAR1ML$modelStruct$corStruct, unconstrained=FALSE)
##      Phi 
## 0.823845

Significance statistics for the regressors’ coefficients are to be found in the usual summary object, while to get the significance test of the serial correlation coefficient one can do a likelihood ratio test as shown in the following.

An LR test for serial correlation and one for random effects

A likelihood ratio test for serial correlation in the idiosyncratic residuals can be done as a nested models test, by anova(), comparing the model with spherical idiosyncratic residuals with the more general alternative featuring AR(1) residuals. The test takes the form of a zero restriction test on the autoregressive parameter.

This can be done on pooled or random effects models alike. First we report the simpler case.

We already estimated the pooling AR(1) model above. The GLS model without correlation in the residuals is the same as OLS, and one could well use lm() for the restricted model. Here we estimate it by gls().

lmML <- gls(inv~value+capital, data=Grunfeld)
anova(lmML, lmAR1ML)
##         Model df      AIC      BIC    logLik   Test  L.Ratio p-value
## lmML        1  4 2400.217 2413.350 -1196.109                        
## lmAR1ML     2  5 2094.936 2111.352 -1042.468 1 vs 2 307.2813  <.0001

The AR(1) test on the random effects model is to be done in much the same way, using the random effects model objects estimated above:

anova(reML, reAR1ML)
##         Model df      AIC      BIC    logLik   Test  L.Ratio p-value
## reML        1  5 2205.851 2222.267 -1097.926                        
## reAR1ML     2  6 2094.802 2114.501 -1041.401 1 vs 2 113.0496  <.0001

A likelihood ratio test for random effects compares the specifications with and without random effects and spherical idiosyncratic errors:

anova(lmML, reML)
##      Model df      AIC      BIC    logLik   Test L.Ratio p-value
## lmML     1  4 2400.217 2413.350 -1196.109                       
## reML     2  5 2205.851 2222.267 -1097.926 1 vs 2 196.366  <.0001

The random effects, AR(1) errors model in turn nests the AR(1) pooling model, therefore a likelihood ratio test for random effects sub AR(1) errors may be carried out, again, by comparing the two autoregressive specifications:

anova(lmAR1ML, reAR1ML)
##         Model df      AIC      BIC    logLik   Test  L.Ratio p-value
## lmAR1ML     1  5 2094.936 2111.352 -1042.468                        
## reAR1ML     2  6 2094.802 2114.501 -1041.401 1 vs 2 2.134349   0.144

whence we see that the Grunfeld model specification doesn’t seem to need any random effects once we control for serial correlation in the data.

Conclusions

With plm we aim at providing a comprehensive package containing the standard functionalities that are needed for the management and the econometric analysis of panel data. In particular, we provide: functions for data transformation; estimators for pooled, random and fixed effects static panel models and variable coefficients models, general GLS for general covariance structures, and generalized method of moments estimators for dynamic panels; specification and diagnostic tests. Instrumental variables estimation is supported. Most estimators allow working with unbalanced panels. While among the different approaches to longitudinal data analysis we take the perspective of the econometrician, the syntax is consistent with the basic linear modeling tools, like the lm function.

On the input side, formula and data arguments are used to specify the model to be estimated. Special functions are provided to make writing formulas easier, and the structure of the data is indicated with an index argument.

On the output side, the model objects (of the new class panelmodel) are compatible with the general restriction testing frameworks of packages lmtest and car. Specialized methods are also provided for the calculation of robust covariance matrices; heteroskedasticity- and correlation-consistent testing is accomplished by passing these on to testing functions, together with a panelmodel object.

The main functionalities of the package have been illustrated here by applying them on some well-known data sets from the econometric literature. The similarities and differences with the maximum likelihood approach to longitudinal data have also been briefly discussed.

Acknowledgments

While retaining responsibility for any error, we thank Jeffrey Wooldridge, Achim Zeileis and three anonymous referees for useful comments. We also acknowledge kind editing assistance by Lisa Benedetti.

Bibliography

Ahrens, H., and R. Pincus. 1981. “On Two Measures of Unbalancedness in a One-Way Model and Their Relation to Efficiency.” Biometrical Journal 23 (3): 227–35. https://doi.org/10.1002/bimj.4710230302.
Amemiya, T. 1971. “The Estimation of the Variances in a Variance–Components Model.” International Economic Review 12: 1–13.
Amemiya, Takeshi, and Thomas E MaCurdy. 1986. “Instrumental-Variable Estimation of an Error-Components Model.” Econometrica 54 (4): 869–80.
Anderson, T. W., and C. Hsiao. 1981. “Estimation of Dynamic Models with Error Components.” Journal of the American Statistical Association 76: 598–606.
Arellano, Manuel. 1987. “Computing Robust Standard Errors for Within-Groups Estimators.” Oxford Bulletin of Economics and Statistics 49 (4): 431–34.
Arellano, M., and S. Bond. 1991. “Some Tests of Specification for Panel Data : Monte Carlo Evidence and an Application to Employment Equations.” Review of Economic Studies 58: 277–97.
Balestra, P., and J. Varadharajan–Krishnakumar. 1987. “Full Information Estimations of a System of Simultaneous Equations with Error Components.” Econometric Theory 3: 223–46.
Baltagi, B. H. 1981. “Simultaneous Equations with Error Components.” Journal of Econometrics 17: 21–49.
Baltagi, B. H. 2005. Econometric Analysis of Panel Data. 3rd ed. John Wiley; Sons ltd.
———. 2013. Econometric Analysis of Panel Data. 5th ed. John Wiley; Sons ltd.
———. 2021. Econometric Analysis of Panel Data. 6th ed. Springer.
Baltagi, B. H., and Y. J. Chang. 1994. “Incomplete Panels: A Comparative Study of Alternative Estimators for the Unbalanced One-Way Error Component Regression Model.” Journal of Econometrics 62: 67–89.
Baltagi, B. H., Y. J. Chang, and Q. Li. 1992. “Monte Carlo Results on Several New and Existing Tests for the Error Components Model.” Journal of Econometrics 54: 95–120.
Baltagi, B. H., and Q. Li. 1990. “A Lagrange Multiplier Test for the Error Components Model with Incomplete Panels.” Econometric Reviews 9: 103–7.
Baltagi, Badi H., Qu Feng, and Chihwa Kao. 2012. “A Lagrange Multiplier Test for Cross-Sectional Dependence in a Fixed Effects Panel Data Model.” Journal of Econometrics 170 (1): 164–77. https://www.sciencedirect.com/science/article/pii/S030440761200098X.
Baltagi, Badi H., and Ping X. Wu. 1999. “Unequally Spaced Panel Data Regressions with AR(1) Disturbances.” Econometric Theory 15 (6): 814–23.
Baltagi, Badi, YA Chang, and Q Li. 1998. “Testing for Random Individual and Time Effects Using Unbalanced Panel Data.” Advances in Econometrics 13 (January): 1–20.
Baltagi, B., and Q. Li. 1991. “A Joint Test for Serial Correlation and Random Individual Effects.” Statistics and Probability Letters 11: 277–80.
———. 1995. “Testing AR(1) Against MA(1) Disturbances in an Error Component Model.” Journal of Econometrics 68: 133–51.
Bates, Douglas. 2004. “Least Squares Calculations in .” –News 4 (1): 17–20.
———. 2007. : Linear Mixed–Effects Models Using Classes. https://CRAN.r-project.org/package=lme4.
Bates, Douglas, and Martin Maechler. 2016. : Sparse and Dense Matrix Classes and Methods. https://CRAN.R-project.org/package=Matrix.
Bera, A. K., W. Sosa–Escudero, and M. Yoon. 2001. “Tests for the Error Component Model in the Presence of Local Misspecification.” Journal of Econometrics 101: 1–23.
Bhargava, A., L. Franzini, and W. Narendranathan. 1982. “Serial Correlation and the Fixed Effects Model.” The Review of Economic Studies 49 (4): 533–49.
Bivand, Roger. 2008. Spdep: Spatial Dependence: Weighting Schemes, Statistics and Models.
Blundell, R., and S. Bond. 1998. “Initital Conditions and Moment Restrictions in Dynamic Panel Data Models.” Journal of Econometrics 87: 115–43.
Breusch, T. S., and A. R. Pagan. 1980. “The Lagrange Multiplier Test and Its Applications to Model Specification in Econometrics.” Review of Economic Studies 47: 239–53.
Breusch, Trevor S, Grayham E Mizon, and Peter Schmidt. 1989. “Efficient Estimation Using Panel Data.” Econometrica 57 (3): 695–700.
Choi, In. 2001. “Unit Root Tests for Panel Data.” Journal of International Money and Finance 20 (2): 249–72. https://www.sciencedirect.com/science/article/pii/S0261560600000486.
Cornwell, C., and P. Rupert. 1988. “Efficient Estimation with Panel Data: An Empirical Comparison of Instrumental Variables Estimators.” Journal of Applied Econometrics 3: 149–55.
Cribari–Neto, F. 2004. “Asymptotic Inference Under Heteroskedasticity of Unknown Form.” Computational Statistics & Data Analysis 45: 215–33.
Croissant, Yves, and Giovanni Millo. 2008. “Panel Data Econometrics in : The Package.” Journal of Statistical Software 27 (2): 1–43. https://www.jstatsoft.org/article/view/v027i02.
De Hoyos, R. E., and V. Sarafidis. 2006. “Testing for Cross–Sectional Dependence in Panel–Data Models.” The Stata Journal 6 (4): 482–96.
Development Core Team. 2008. : A Language and Environment for Statistical Computing. Vienna, Austria: Foundation for Statistical Computing. https://www.r-project.org/.
Drukker, D. M. 2003. “Testing for Serial Correlation in Linear Panel–Data Models.” The Stata Journal 3 (2): 168–77.
Fox, John. 2002. An and Companion to Applied Regression. Sage.
———. 2016. : Companion to Applied Regression. https://CRAN.R-project.org/package=car.
Gourieroux, C., A. Holly, and A. Monfort. 1982. “Likelihood Ratio Test, Wald Test, and Kuhn–Tucker Test in Linear Models with Inequality Constraints on the Regression Parameters.” Econometrica 50: 63–80.
Greene, W. H. 2003. Econometric Analysis. 5th ed. Prentice Hall.
Hadri, Kaddour. 2000. “Testing for Stationarity in Heterogeneous Panel Data.” The Econometrics Journal 3 (2): 148–61.
Hanck, Christoph. 2013. “An Intersection Test for Panel Unit Roots.” Econometric Reviews 32: 183–203.
Harrison, D., and D. L. Rubinfeld. 1978. “Hedonic Housing Prices and the Demand for Clean Air.” Journal of Environmental Economics and Management 5: 81–102.
Hausman, J. A. 1978. “Specification Tests in Econometrics.” Econometrica 46: 1251–71.
Hausman, J. A., and W. E. Taylor. 1981. “Panel Data and Unobservable Individual Effects.” Econometrica 49: 1377–98.
Holtz–Eakin, D., W. Newey, and H. S. Rosen. 1988. “Estimating Vector Autoregressions with Panel Data.” Econometrica 56: 1371–95.
Honda, Y. 1985. “Testing the Error Components Model with Non–Normal Disturbances.” Review of Economic Studies 52: 681–90.
Hothorn, T., A. Zeileis, R. W. Farebrother, C. Cummins, G. Millo, and D. Mitchell. 2015. : Testing Linear Regression Models. https://CRAN.R-project.org/package=lmtest.
Im, K. S., M. H. Pesaran, and Y. Shin. 2003. “Testing for Unit Roots in Heterogenous Panels.” Journal of Econometrics 115(1): 53–74.
King, M. L., and P. X. Wu. 1997. “Locally Optimal One–Sided Tests for Multiparameter Hypothese.” Econometric Reviews 33: 523–29.
Kleiber, Christian, and Achim Zeileis. 2008. Applied Econometrics with R. New York: Springer-Verlag. https://CRAN.R-project.org/package=AER.
Koenker, Roger, and Pin Ng. 2016. : Sparse Linear Algebra. https://CRAN.R-project.org/package=SparseM.
Kwiatkowski, Denis, Peter C. B. Phillips, Peter Schmidt, and Yongcheol Shin. 1992. “Testing the Null Hypothesis of Stationarity Against the Alternative of a Unit Root: How Sure Are We That Economic Time Series Have a Unit Root?” Journal of Econometrics 54 (1): 159–78. https://www.sciencedirect.com/science/article/pii/030440769290104Y.
Laird, N. M., and J. H. Ware. 1982. “Random–Effects Models for Longitudinal Data.” Biometrics 38: 963–74.
Levin, A., C. F. Lin, and C. S. J. Chu. 2002. “Unit Root Tests in Panel Data : Asymptotic and Finite-Sample Properties.” Journal of Econometrics 108: 1–24.
Lumley, T., and A. Zeileis. 2015. : Robust Covariance Matrix Estimators. https://CRAN.R-project.org/package=sandwich.
MacKinnon, J. G., and H. White. 1985. “Some Heteroskedasticity–Consistent Covariance Matrix Estimators with Improved Finite Sample Properties.” Journal of Econometrics 29: 305–25.
MacKinnon, James G. 1994. “Approximate Asymptotic Distribution Functions for Unit-Root and Cointegration Tests.” Journal of Business & Economic Statistics 12 (2): 167–76.
———. 1996. “Numerical Distribution Functions for Unit Root and Cointegration Tests.” Journal of Applied Econometrics 11 (6): 601–18.
Maddala, G. S., and S. Wu. 1999. “A Comparative Study of Unit Root Tests with Panel Data and a New Simple Test.” Oxford Bulletin of Economics and Statistics 61: 631–52.
Millo, G. 2017. “Robust Standard Error Estimators for Panel Models: A Unifying Approach.” Journal of Statistical Software 82 (3): 1–27.
Mundlak, Yair. 1978. “On the Pooling of Time Series and Cross Section Data.” Econometrica 46 (1): 69–85.
Munnell, A. 1990. “Why Has Productivity Growth Declined? Productivity and Public Investment.” New England Economic Review, 3–22.
Nerlove, M. 1971. “Further Evidence on the Estimation of Dynamic Economic Relations from a Time–Series of Cross–Sections.” Econometrica 39: 359–82.
Pesaran, M Hashem. 2007. “A Simple Panel Unit Root Test in the Presence of Cross-Section Dependence.” Journal of Applied Econometrics 22 (2): 265–312.
Pesaran, M. H. 2004. “General Diagnostic Tests for Cross Section Dependence in Panels.”
Pesaran, M. Hashem. 2015. “Testing Weak Cross-Sectional Dependence in Large Panels.” Econometric Reviews 34 (6-10): 1089–1117. https://doi.org/10.1080/07474938.2014.956623.
Pfaff, Bernhard. 2008. Analysis of Integrated and Cointegrated Time Series with r. Second. New York: Springer. https://CRAN.r-project.org/package=urca.
Pinheiro, J. C., and D. Bates. 2000. Mixed–Effects Models in and . Springer-Verlag.
Pinheiro, Jose, Douglas Bates, Saikat DebRoy, and Deepayan Sarkar the Core team. 2007. : Linear and Nonlinear Mixed Effects Models. https://CRAN.r-project.org/package=nlme.
Simes, R. J. 1986. “An Improved Bonferroni Procedure for Multiple Tests of Significance.” Biometrika 73: 751–54.
Stock, James H., and Mark W. Watson. 2008. “Heteroskedasticity–Robust Standard Errors for Fixed Effects Panel Data Regression.” Econometrica 76 (1): 155–74.
Swamy, P. A. V. B. 1970. “Efficient Inference in a Random Coefficient Regression Model.” Econometrica 38: 311–23.
Swamy, P. A. V. B., and S. S Arora. 1972. “The Exact Finite Sample Properties of the Estimators of Coefficients in the Error Components Regression Models.” Econometrica 40: 261–75.
Therneau, Terry. 2014. : Routines for Block Diagonal Symmetric Matrices. https://CRAN.R-project.org/package=bdsmatrix.
Wallace, T. D., and A. Hussain. 1969. “The Use of Error Components Models in Combining Cross Section with Time Series Data.” Econometrica 37 (1): 55–72.
White, H. 1984. Asymptotic Theory for Econometricians. New York: Academic press.
White, Halbert. 1980. “A Heteroskedasticity-Consistent Covariance Matrix Estimator and a Direct Test for Heteroskedasticity.” Econometrica 48 (4): 817–38.
Windmeijer, F. 2005. “A Finite Sample Correction for the Variance of Linear Efficient Two–Steps GMM Estimators.” Journal of Econometrics 126: 25–51.
Wooldridge, J. M. 2002. Econometric Analysis of Cross–Section and Panel Data. MIT Press.
———. 2010. Econometric Analysis of Cross–Section and Panel Data. 2nd ed. MIT Press.
Zeileis, A. 2004. “Econometric Computing with HC and HAC Covariance Matrix Estimators.” Journal of Statistical Software 11 (10): 1–17. https://www.jstatsoft.org/article/view/v011i10.

  1. Comprehensive treatments are to be found in many econometrics textbooks, e.g., B. H. Baltagi (2005), B. H. Baltagi (2013), B. H. Baltagi (2021) or Wooldridge (2002), Wooldridge (2010): the reader is referred to these, especially to the first 9 chapters of B. H. Baltagi (2005), B. H. Baltagi (2013), B. H. Baltagi (2021).↩︎

  2. For the sake of exposition we are considering only the individual effects case here. There may also be time effects, which is a symmetric case, or both of them, so that the error has three components: \(u_{it}=\mu_{i}+\lambda_{t}+\epsilon_{it}\).↩︎

  3. Although in most models the individual and time effects cases are symmetric, there are exceptions: estimating the first-difference model on time effects is meaningless because cross-sections do not generally have a natural ordering, so trying effect = "time" stops with an error message as does effect = "twoways" which is not defined for first-difference models.↩︎

  4. See packages lmtest (Hothorn et al. (2015)) and car (Fox (2016)).↩︎

  5. Moreover, coeftest() provides a compact way of looking at coefficient estimates and significance diagnostics.↩︎

  6. Function pht is a deprecated way to estimate this type of model: ht <- pht(lwage~wks+south+smsa+married+exp+I(exp^2)+ bluecol+ind+union+sex+black+ed | sex+black+bluecol+south+smsa+ind, data=Wages,index=595).↩︎

  7. The “random effect” is better termed “general FGLS” model, as in fact it does not have a proper random effects structure, but we keep this terminology for general language consistency.↩︎

  8. NB: Oneway King-Wu ("kw") statistics ("individual" and "time") coincide with the respective Honda statistics ("honda"); however, the twoway statistics of "kw" and "honda" differ.↩︎

  9. The "bp" test for unbalanced panels was derived in B. H. Baltagi and Li (1990), the "kw" test for unbalanced panels in Badi Baltagi, Chang, and Li (1998). The "ghm" test and the "kw" test were extended to two–way effects in B. H. Baltagi, Chang, and Li (1992). For a concise overview of all these statistics see B. H. Baltagi (2013) Sec. 4.2, pp. 68–76 (for balanced panels) and Sec. 9.5, pp. 200–203 (for unbalanced panels) or B. H. Baltagi (2021), Sec. 4.2, pp. 81-84 (balanced), Sec. 9.6, pp. 243-246 (unbalanced).↩︎

  10. Here we treat fixed and random effects alike, as components of the error term, according with the modern approach in econometrics (see Wooldridge (2002), Wooldridge (2010)).↩︎

  11. Neglecting time effects may also lead to serial correlation in residuals (as observed in Wooldridge (2002) 10.4.1).↩︎

  12. \(LM_3\) in B. Baltagi and Li (1995).↩︎

  13. Corresponding to \(RSO^*_{\mu}\) in the original paper.↩︎

  14. Baltagi and Li derive a basically analogous T-asymptotic test for first-order serial correlation in a FE panel model as a Breusch-Godfrey LM test on within residuals (see B. Baltagi and Li (1995) par. 2.3 and formula 12). They also observe that the test on within residuals can be used for testing on the RE model, as “the within transformation [time-demeaning, in our terminology] wipes out the individual effects, whether fixed or random.” Generalizing the Durbin-Watson test to FE models by applying it to fixed effects residuals is documented in Bhargava, Franzini, and Narendranathan (1982), a (modified) version for unbalanced and/or non-consecutive panels is implemented in pbnftest as is Baltagi-Wu’s LBI statistic (for both see Badi H. Baltagi and Wu (1999)).↩︎

  15. see subsection robust covariance matrix estimation.↩︎

  16. Here, \(e_{it}\) for notational simplicity (and as in Wooldridge): equivalent to \(\Delta \epsilon_{it}\) in the general notation of the paper.↩︎

  17. This is the case, e.g., if in an unobserved effects model when XSD is due to an unobservable factor structure, with factors that are uncorrelated with the regressors. In this case the within or random estimators are still consistent, although inefficient (see De Hoyos and Sarafidis (2006)).↩︎

  18. The unbalanced version of this statistic uses max(Tij) for T in the bias-correction term.↩︎

  19. This is also the only solution when the time dimension’s length is insufficient for estimating the heterogeneous model.↩︎

  20. The very comprehensive package spdep for spatial dependence analysis (see Bivand (2008)) contains features for creating, lagging and manipulating neighbour list objects of class nb, that can be readily converted to and from proximity matrices by means of the nb2mat function. Higher orders of the \(CD(p)\) test can be obtained by lagging the corresponding nbs through nblag.↩︎

  21. The individual p-values for the Fisher-type tests are approximated as described in James G. MacKinnon (1996) if the package urca (Pfaff (2008)) is available, otherwise as described in James G. MacKinnon (1994).↩︎

  22. See Halbert White (1980) and H. White (1984).↩︎

  23. The HC3 and HC4 weighting schemes are computationally expensive and may hit memory limits for \(nT\) in the thousands, where on the other hand it makes little sense to apply small sample corrections.↩︎

  24. For coeftest set df = Inf to have the coefficients’ tests be performed with standard normal distribution instead of t distribution as we deal with a random effects model here. For these types of models, the precise distribution of the coefficients estimates is unknown.↩︎

  25. Joint zero-restriction testing still allows providing the vcov of the unrestricted model as a matrix, see the documentation of package lmtest.↩︎

  26. This discussion does not consider GMM models. One of the basic reasons for econometricians not to choose maximum likelihood methods in estimation is that the strict exogeneity of regressors assumption required for consistency of the ML models reported in the following is often inappropriate in economic settings.↩︎

  27. The standard reference on the subject of mixed models in S/R is J. C. Pinheiro and Bates (2000).↩︎

  28. Lagrange Multiplier tests based on the likelihood principle are suitable for testing against more general alternatives on the basis of a maintained model with spherical residuals and find therefore application in testing for departures from the classical hypotheses on the error term. The seminal reference is T. S. Breusch and Pagan (1980).↩︎

  29. For fixed effects estimation, as the sample grows (on the dimension on which the fixed effects are specified) so does the number of parameters to be estimated. Estimation of individual fixed effects is \(T\)– (but not \(n\)–) consistent, and the opposite.↩︎

  30. In doing so, we stress that “equivalence” concerns only the specification of the model, and neither the appropriateness nor the relative efficiency of the relevant estimation techniques, which will of course be dependent on the context. Unlike their mixed model counterparts, the specifications in plm are, strictly speaking, distribution-free. Nevertheless, for the sake of exposition, in the following we present them in the setting which ensures consistency and efficiency (e.g., we consider the hypothesis of spherical errors part of the specification of pooled OLS and so forth).↩︎

  31. Take heed that here, in contrast to the usual meaning of serial correlation in time series, we always speak of serial correlation between the errors of each group.↩︎

  32. note that the time index is coerced to numeric before the estimation.↩︎

plm/inst/CITATION0000644000176200001440000000363614124132276013166 0ustar liggesusersbibentry(bibtype = "Book", title = "Panel Data Econometrics with {R}", author = c(person(given = "Yves", family = "Croissant", email = "yves.croissant@univ-reunion.fr"), person(given = "Giovanni", family = "Millo", email = "giovanni.millo@deams.units.it")), publisher = "Wiley", year = "2018", header = "To cite plm in publications use:" ) bibentry(bibtype = "Article", title = "Panel Data Econometrics in {R}: The {plm} Package", author = c(person(given = "Yves", family = "Croissant", email = "yves.croissant@univ-reunion.fr"), person(given = "Giovanni", family = "Millo", email = "giovanni.millo@deams.units.it")), journal = "Journal of Statistical Software", year = "2008", volume = "27", number = "2", pages = "1--43", doi = "10.18637/jss.v027.i02", header = "To cite plm in publications use:" ) bibentry(bibtype = "Article", title = "Robust Standard Error Estimators for Panel Models: A Unifying Approach", author = person(given = "Giovanni", family = "Millo", email = "giovanni.millo@deams.units.it"), journal = "Journal of Statistical Software", year = "2017", volume = "82", number = "3", pages = "1--27", doi = "10.18637/jss.v082.i03", header = "For the covariance matrix estimators in plm, please cite:" ) plm/inst/tests/0000755000176200001440000000000014164773671013201 5ustar liggesusersplm/inst/tests/test_pdata.frame_unused_levels.R0000644000176200001440000000461314124132276021470 0ustar liggesusers## Test if pdata.frame() drops the unused levels of factors library(plm) ### test for dropping of unused levels ### data("Grunfeld", package = "plm") Grunfeld$fac_var <- factor(rep(c("a", "b"), 100)) levels(Grunfeld$fac_var) <- c("a", "b", "unused") # is unused level pGrun_unused_level <- pdata.frame(Grunfeld, drop.unused.levels = FALSE) pGrun_unused_level_default <- pdata.frame(Grunfeld) # test default behaviour if (!isTRUE(all.equal(levels(pGrun_unused_level$fac_var), c("a", "b", "unused")))) stop("unused levels dropped but should be kept") if (!isTRUE(all.equal(levels(pGrun_unused_level_default$fac_var), c("a", "b", "unused")))) stop("unused levels dropped but should be kept") # index var with unused levels (rather: variable from which the index var is derived) Grunfeld$firm <- factor(Grunfeld$firm) levels(Grunfeld$firm) <- c(levels(Grunfeld$firm), "unused") pGrunfeld_unused_level_index <- pdata.frame(Grunfeld, drop.unused.levels = FALSE) if (!isTRUE(all.equal(levels(pGrunfeld_unused_level_index$firm), as.character(1:10)))) stop("unused level not dropped from index variable but should by in any case") # make sure the index variable in attribute is withoud unused levels iind <- index(pGrunfeld_unused_level_index)[[1]] if (!isTRUE(all.equal(levels(iind), levels(droplevels(iind))))) stop("unused level in index var (in attributes)!") ######## 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 n = c(1:3)) pdf <- pdata.frame(df, drop.unused.levels = TRUE) levels(df$f2) levels(pdf$f2) if (!isTRUE(all.equal(levels(pdf$f2), c("1", "2", "3")))) stop("used levels in non-index factor not dropped") ### test unused level in index variable 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 n = c(1:3)) pdfindex <- pdata.frame(dfindex, drop.unused.levels = FALSE) levels(dfindex$time) levels(pdfindex$time) if (!isTRUE(all.equal(levels(pdfindex$time), c("1", "2")))) stop("used levels in index not dropped") plm/inst/tests/test_pseries_subsetting.R0000644000176200001440000001332714154734502020277 0ustar liggesusers# Test subsetting for pseries objects # # Note: # currently, we do not have a special subsetting method activated for pseries # in file tool_pdata.frame.R is a commented [.pseries but see the hints there as it interferes with loaded dplyr library(plm) # data.frame with factor df <- data.frame(id = c(1,1,2), time = c(1,2,1), f = factor(c("a", "a", "b")), n = c(1:3)) df$f levels(df$f) <- c("a","b","c") df$f[1] df$f[1, drop = FALSE] df$f[1, drop = TRUE] df$f[drop = TRUE] df$f[0] df$f[integer()] df$f[NA] # pdata.frame with c("pseries", "factor") pdf <- pdata.frame(df) pdf$f levels(pdf$f) <- c("a","b","c") pdf$f[1] pdf$f[1, drop = TRUE] pdf$f[drop = TRUE] pdf$f[0] attr(pdf$f[0], "index") pdf$f[0] pdf$f[integer()] str(pdf$f[integer()]) str( df$f[NA]) str(pdf$f[NA]) df$f[integer()] pdf$f[integer()] pf <- pdf$f if (!all(levels(pdf$f[1, drop = FALSE]) == c("a","b","c"))) stop("subsetting for c(\"pseries\", \"factor\") (with drop = FALSE) not correct") if (!all(class(pdf$f[1]) == c("pseries", "factor"))) stop("classes not correct after subsetting pseries") if (!levels(pdf$f[1, drop = TRUE]) == "a") stop("subsetting for c(\"pseries\", \"factor\") with drop = TRUE not correct - unused levels not dropped") if (!all(levels(pdf$f[drop = TRUE]) == c("a", "b"))) stop("subsetting for c(\"pseries\", \"factor\") with drop = TRUE not correct - unused levels not dropped") ### activate these tests once the subsetting method for pseries is defined. #if (is.null(attr(pdf$f[1], "index"))) stop("no index after subsetting") #if (!nrow(attr(pdf$f[1], "index")) == 1) stop("wrong index after subsetting") lapply(df, attributes) lapply(pdf, attributes) lapply(df, class) lapply(pdf, class) ############### test pseries subsetting ("[.pseries") ################ #### "[.pseries" is in pdata.frame.R data("EmplUK", package = "plm") (plm(log(emp) ~ log(wage) + log(capital), data = EmplUK, model = "fd")) data("Grunfeld", package = "plm") Grunfeld$fac <- factor(c("a", "b", "c", "d")) pGrunfeld <- pdata.frame(Grunfeld) pseries <- pGrunfeld$inv pfac <- pGrunfeld$fac fac <- Grunfeld$fac pseries[1] pseries[c(1,2)] pseries[-c(1,2)] # # this also checks for the both indexes having the same levels after subsetting # # (unused levels in index are dropped): #### if(!isTRUE(all.equal(index(pseries[c(1)]), index(pGrunfeld[c(1), ])))) stop("indexes not the same") #### if(!isTRUE(all.equal(index(pseries[c(1,2)]), index(pGrunfeld[c(1,2), ])))) stop("indexes not the same") #### if(!isTRUE(all.equal(index(pseries[-c(1,2)]), index(pGrunfeld[-c(1,2), ])))) stop("indexes not the same") # subsetting when there are no names (in this case (dummy) names are used in the subsetting code) pseries_nn <- unname(pGrunfeld$inv) pfac_nn <- unname(pGrunfeld$fac) fac_nn <- unname(Grunfeld$fac) pseries_nn[1] pseries_nn[c(1,2)] pseries_nn[-c(1,2)] # # # this also checks for the both indexes having the same levels after subsetting # # # (unused levels in index are dropped): #### if(!isTRUE(all.equal(index(pseries_nn[c(1)]), index(pGrunfeld[c(1), ])))) stop("indexes not the same") #### if(!isTRUE(all.equal(index(pseries_nn[c(1,2)]), index(pGrunfeld[c(1,2), ])))) stop("indexes not the same") #### if(!isTRUE(all.equal(index(pseries_nn[-c(1,2)]), index(pGrunfeld[-c(1,2), ])))) stop("indexes not the same") # subsetting with character pseries["10-1946"] pseries[c("10-1935", "10-1946")] # character subsetting works for plain numeric: series <- Grunfeld$inv names(series) <- names(pseries) names(fac) <- names(pfac) series["10-1946"] #### if(!isTRUE(all.equal(index(pseries["10-1946"]), index(pGrunfeld["10-1946", ])))) stop("indexes not the same") #### if(!isTRUE(all.equal(index(pseries[c("10-1935", "10-1946")]), index(pGrunfeld[c("10-1935", "10-1946"), ])))) stop("indexes not the same") ### For c("pseries", "factor") perform additional tests of 'drop' argument pfac[1, drop = TRUE] # only level "a" should be left pfac[1:3][drop = TRUE] # only level "a", "b", "c" should be left fac[1, drop = TRUE] fac[1:3][drop = TRUE] pfac["nonExist"] # should be NA and levels "a" to "d" fac["nonExist"] pfac["nonExist"][drop = TRUE] # should be NA and no level left fac["nonExist"][drop = TRUE] # check subsetting with NA: #### if(!isTRUE(all.equal(as.numeric(pseries[NA]), series[NA], check.attributes = FALSE))) stop("subsetting with NA not the same for pseries") # assign first operand's attributes: pseries[1:(length(pseries)-1)] + pseries[2:length(pseries)] head(index(pseries[1:(length(pseries)-1)])) head(index(pseries[2:length(pseries)])) # ... just as in base R for names: i1 <- 1:100; i2 <- 1:100 names(i1) <- 1:100; names(i2) <- LETTERS[(0:99 %% 26) + 1] head(i1) head(i2) # names are taken from first operand in base R numerics, # so for pseries it is ok to assign the index of the first operand names(i1 + i2) names(i2 + i1) ## These are ok (give (about) same error msg for plain numeric as for pseries numeric) # pseries[1, ] # Error in x[...] : incorrect number of dimensions # series[1, ] # Error during wrapup: incorrect number of dimensions # subsetting with NA # entries and names are all NA pseries[NA] attr(pseries[NA], "index") # same as in pdata.frame's index when pdata.frame is indexed by NA str(pseries[NA]) series[NA] # subsetting with integer() pseries[integer()] class(pseries[integer()]) # c("pseries", "numeric") class(attr(pseries[integer()], "index")) str(pseries[integer()], "index") series[integer()] str(series[integer()]) # subsetting with 0 pseries[0] class(pseries[0]) # c("pseries", "numeric") class(attr(pseries[0], "index")) str(pseries[0], "index") series[0] str(series[0]) plm/inst/tests/test_model.matrix_pmodel.response.R0000644000176200001440000001141014124132276022142 0ustar liggesusers## Tests for model.matrix[.pFormula|.plm] and pmodel.response.[pFormula|.plm|.data.frame] # commented lines do not run in v1.5-15 # 1) model.matrix[.pFormula|.plm] # 2) pmodel.response.[pFormula|.plm|.data.frame] library(plm) data("Grunfeld", package="plm") form <- formula(inv ~ value + capital) plm_pool <- plm(form, data=Grunfeld, model="pooling") plm_fe <- plm(form, data=Grunfeld, model="within") plm_re <- plm(form, data=Grunfeld, model="random") ########### 1) model.matrix[.pFormula|.plm] ########### # pooling and within models work pdata.frame [albeit one should input a model.frame of class pdata.frame] pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) mf <- model.frame(pGrunfeld, form) #MM modmat_pFormula_pdf_pool <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="pooling") # works #MM modmat_pFormula_pdf_fe <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="within") # works modmat_pFormula_pdf_pool <- plm:::model.matrix.pdata.frame(mf, model="pooling") # works modmat_pFormula_pdf_fe <- plm:::model.matrix.pdata.frame(mf, model="within") # works #modmat_pFormula_re2 <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="random") # still fails in v1.5-15 # Error: # Error in plm:::model.matrix.pFormula(form, data = pGrunfeld, model = "random") : # dims [product 600] do not match the length of object [0] #### some sanity checks if various interfaces yield the same result ### modmat_plm_pool <- model.matrix(plm_pool) modmat_plm_fe <- model.matrix(plm_fe) modmat_plm_re <- model.matrix(plm_re) ##### interfaces: plm vs. pFormula with pdata.frame if(!isTRUE(all.equal(modmat_plm_pool, modmat_pFormula_pdf_pool, check.attributes = FALSE))) stop("model.matrix's are not the same") if(!isTRUE(all.equal(modmat_plm_fe, modmat_pFormula_pdf_fe, check.attributes = FALSE))) stop("model.matrix's are not the same") #if(!isTRUE(all.equal(modmat_plm_re, modmat_pFormula_pdf_re, check.attributes = FALSE))) stop("model.matrix's are not the same") ########### 2) pmodel.response.[pFormula|.plm|.data.frame] ########### # pooling and within models work on a pdata.frame [the plain pdata.frame is coerced to a model.frame # internally in pmodel.response.pFormula] #MM resp_pFormula_pool <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "pooling") #MM resp_pFormula_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within") resp_pFormula_pool <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "pooling") resp_pFormula_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within") # still fails # resp_pFormula_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld, model = "random") # # Error in model.matrix.pFormula(pFormula(formula), data = data, model = model, : # dims [product 200] do not match the length of object [0] ### pmodel.response.data.frame on data.frame/pdata.frame ## the 'data' data.frame for pmodel.response.data.frame must be a model.frame created by plm's model.frame ## it needs to be a model.frame because then it is ensured we find the response variable in the fist column #pGrunfeld_mf <- model.frame(pFormula(form), data = pGrunfeld) pGrunfeld_mf <- model.frame(pGrunfeld, form) resp_pdf_mf_pool <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "pooling") # works resp_pdf_mf_fe <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "within") # works #resp_pdf_mf_re <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "random") # error, likely due to missing arguments ## these errored pre rev. 601 due to missing 'match.arg()' to set default value: #pmodel.response(pFormula(form), data = pGrunfeld) pmodel.response(form, data = pGrunfeld) pmodel.response(pGrunfeld_mf) #### some sanity checks if various interfaces yield the same result ### resp_plm_pool <- pmodel.response(plm_pool) resp_plm_fe <- pmodel.response(plm_fe) resp_plm_re <- pmodel.response(plm_re) # compare interface pFormula with plm if(!isTRUE(all.equal(resp_pFormula_pool, resp_plm_pool, check.attributes = FALSE))) stop("responses not equal") if(!isTRUE(all.equal(resp_pFormula_fe, resp_plm_fe, check.attributes = FALSE))) stop("responses not equal") #if(!isTRUE(all.equal(resp_pFormula_re, resp_plm_re, check.attributes = FALSE))) stop("responses not equal") # compare interface data.frame with model.frame with plm if(!isTRUE(all.equal(resp_pdf_mf_pool, resp_plm_pool, check.attributes = FALSE))) stop("responses not equal") if(!isTRUE(all.equal(resp_pdf_mf_fe, resp_plm_fe, check.attributes = FALSE))) stop("responses not equal") #if(!isTRUE(all.equal(resp_pdf_mf_re, resp_plm_re, check.attributes = FALSE))) stop("responses not equal") plm/inst/tests/test_pgrangertest.Rout.save0000644000176200001440000000743514124132276020550 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Grunfeld", package = "plm") > > pgrangertest(inv ~ value, data = Grunfeld) Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012)) data: inv ~ value Ztilde = 3.2896, p-value = 0.001003 alternative hypothesis: Granger causality for at least one individual > pgrangertest(inv ~ value, data = Grunfeld, order = 2L) Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012)) data: inv ~ value Ztilde = 1.6832, p-value = 0.09234 alternative hypothesis: Granger causality for at least one individual > pgrangertest(inv ~ value, data = Grunfeld, order = 2L, test = "Zbar") Panel Granger (Non-)Causality Test (Dumitrescu/Hurlin (2012)) data: inv ~ value Zbar = 2.9657, p-value = 0.00302 alternative hypothesis: Granger causality for at least one individual > > > # unbalanced > unbal <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = 2L) > unbal$indgranger firm Chisq p-value df lag 1 1 1.8255237 0.401414049 2 2 2 2 4.3694800 0.112506980 2 2 3 3 0.7983334 0.670878856 2 2 4 4 3.3069760 0.191381208 2 2 5 5 11.0631807 0.003959687 2 2 6 6 10.8343468 0.004439678 2 2 7 7 1.3410752 0.511433558 2 2 8 8 0.2900525 0.864999607 2 2 9 9 4.4068769 0.110422824 2 2 10 10 0.2960011 0.862430626 2 2 > > # varying lag order > bal_varorder <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = c(rep(2L, 9), 3L)) > bal_varorder$indgranger firm Chisq p-value df lag 1 1 1.8255237 0.401414049 2 2 2 2 4.3694800 0.112506980 2 2 3 3 0.7983334 0.670878856 2 2 4 4 3.3069760 0.191381208 2 2 5 5 11.0631807 0.003959687 2 2 6 6 10.8343468 0.004439678 2 2 7 7 1.3410752 0.511433558 2 2 8 8 0.2900525 0.864999607 2 2 9 9 4.4068769 0.110422824 2 2 10 10 2.9874921 0.393557671 3 3 > unbal_varorder <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = c(rep(2L, 9), 3L)) > unbal_varorder$indgranger firm Chisq p-value df lag 1 1 1.8255237 0.401414049 2 2 2 2 4.3694800 0.112506980 2 2 3 3 0.7983334 0.670878856 2 2 4 4 3.3069760 0.191381208 2 2 5 5 11.0631807 0.003959687 2 2 6 6 10.8343468 0.004439678 2 2 7 7 1.3410752 0.511433558 2 2 8 8 0.2900525 0.864999607 2 2 9 9 4.4068769 0.110422824 2 2 10 10 2.9874921 0.393557671 3 3 > > > ## Demo data from Dumitrescu/Hurlin (2012) supplement: > ## http://www.runmycode.org/companion/view/42 > ## The data are in the following format: 20 x 20 > ## First 20 columns are the x series for the 10 individual > ## next 20 columns are the y series for the 10 individuals > ## -> need to convert to 'long' format first > > # demodat <- readxl::read_excel("data/Granger_Data_demo_long.xls") > # demodat <- data.frame(demodat) > # pdemodat <- pdata.frame(demodat) > > # pgrangertest(y ~ x, data = pdemodat, order = 1L) > # pgrangertest(y ~ x, data = pdemodat, order = 1L, test = "Zbar") > # > # pgrangertest(y ~ x, data = pdemodat, order = 2L) > # pgrangertest(y ~ x, data = pdemodat, order = 2L, test = "Zbar") > > proc.time() user system elapsed 1.042 0.068 1.108 plm/inst/tests/test_phtest_Hausman_regression.Rout.save0000644000176200001440000002742514154734502023272 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Hausman test (original version and regression-based version) > ## > ## > ## (1) comparison to Baltagi (2013), sec. 4.3.1, example 1 (pp. 81-82) > ## (2) comparison to Baltagi (2013), sec. 4.3.2, example 2 (pp. 82-83) > ## (3) comparison to Stata > > > ################################## (1) ################################## > # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons > # Sec 4.3.1, p. 81 (example 1): > # > #### statistics are: 2.33 for original Hausman (m1) > # 2.131 for m2, m3 (for the Grunfeld data) > # > #### vcov within * 10^-3: > # > # 0.14058 -0.077468 > # 0.3011788 > # > #### vcov between * 10^-3: > # > # 0.82630142 -3.7002477 > # 36.4572431 > > options(digits = 10) > library(plm) > data("Grunfeld", package = "plm") > Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) > fe_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within") > be_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="between") > re_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random") > pool_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="pooling") > > # Hausman test > # m1, m2, m3 are all mathematically identical; however computer computation differs a little bit > > phtest(inv ~ value + capital, Grunfeldpdata) # replicates Baltagi's m1 = 2.33 Hausman Test data: inv ~ value + capital chisq = 2.3303669, df = 2, p-value = 0.3118654 alternative hypothesis: one model is inconsistent > phtest(fe_grun, re_grun) # same as above, replicates Baltagi's m1 = 2.33 Hausman Test data: inv ~ value + capital chisq = 2.3303669, df = 2, p-value = 0.3118654 alternative hypothesis: one model is inconsistent > phtest(re_grun, fe_grun) Hausman Test data: inv ~ value + capital chisq = 2.3303669, df = 2, p-value = 0.3118654 alternative hypothesis: one model is inconsistent > > phtest(be_grun, re_grun) # replicates Baltagi's m2 = 2.131 Hausman Test data: inv ~ value + capital chisq = 2.1313791, df = 2, p-value = 0.3444902 alternative hypothesis: one model is inconsistent > phtest(re_grun, be_grun) Hausman Test data: inv ~ value + capital chisq = 2.1313791, df = 2, p-value = 0.3444902 alternative hypothesis: one model is inconsistent > phtest(be_grun, fe_grun) # replicates Baltagi's m3 = 2.131 [values m2 and m3 coincide in this case] Hausman Test data: inv ~ value + capital chisq = 2.1313662, df = 2, p-value = 0.3444924 alternative hypothesis: one model is inconsistent > phtest(fe_grun, be_grun) Hausman Test data: inv ~ value + capital chisq = 2.1313662, df = 2, p-value = 0.3444924 alternative hypothesis: one model is inconsistent > > phtest(inv ~ value + capital, Grunfeldpdata, method="aux") # replicates m3 from above in regression test Regression-based Hausman test data: inv ~ value + capital chisq = 2.1313662, df = 2, p-value = 0.3444924 alternative hypothesis: one model is inconsistent > phtest(inv ~ value + capital, Grunfeldpdata, method="aux", vcov = vcovHC) # no comparison value given Regression-based Hausman test, vcov: vcovHC data: inv ~ value + capital chisq = 8.2998366, df = 2, p-value = 0.0157657 alternative hypothesis: one model is inconsistent > > # replicates variance-covariance matrices > vcov(fe_grun)*1000 value capital value 0.14058119769 -0.07746798877 capital -0.07746798877 0.30117876659 > vcov(be_grun)*1000 (Intercept) value capital (Intercept) 2257704.4692300 127.5372064329 -6060.336301170 value 127.5372064 0.8263014212 -3.700247744 capital -6060.3363012 -3.7002477442 36.457243151 > > > ################################## (2) ################################## > # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons > # Sec 4.3.2, p. 82-83 (example 2): > ### Baltagi's Gasoline example > data("Gasoline", package = "plm") > form <- lgaspcar ~ lincomep + lrpmg + lcarpcap > fe <- plm(form, data = Gasoline, model = "within") > be <- plm(form, data = Gasoline, model = "between") > re <- plm(form, data = Gasoline, model = "random") > > phtest(fe, re) # replicates Baltagi's m1 = 302.8 Hausman Test data: form chisq = 302.80375, df = 3, p-value < 2.2204e-16 alternative hypothesis: one model is inconsistent > phtest(form, data = Gasoline) # same as above (m1) Hausman Test data: form chisq = 302.80375, df = 3, p-value < 2.2204e-16 alternative hypothesis: one model is inconsistent > > phtest(be, re) # replicates Baltagi's m2 = 27.45 Hausman Test data: form chisq = 27.454835, df = 3, p-value = 4.72651e-06 alternative hypothesis: one model is inconsistent > phtest(be, fe) # replicates Baltagi's m3 = 26.507 almost Hausman Test data: form chisq = 26.495054, df = 3, p-value = 7.511821e-06 alternative hypothesis: one model is inconsistent > > phtest(form, data = Gasoline, method = "aux") # chisq = 26.495054, replicates _almost_ Baltagi's m3 = 26.507 Regression-based Hausman test data: form chisq = 26.495054, df = 3, p-value = 7.511821e-06 alternative hypothesis: one model is inconsistent > > # replicates variance-covariance matrices > # > # vcov in Baltagi within: > # 0.539 0.029 -0.205 > # 0.194 0.009 > # 0.088 > # > # vcov in Baltagi between: > # 2.422 -1.694 -1.056 > # 1.766 0.883 > # 0.680 > vcov(fe)*100 lincomep lrpmg lcarpcap lincomep 0.53855115445 0.02895845376 -0.20490968678 lrpmg 0.02895845376 0.19447441921 0.00886367791 lcarpcap -0.20490968678 0.00886367791 0.08808342018 > vcov(be)*100 (Intercept) lincomep lrpmg lcarpcap (Intercept) 27.7501849361 4.431994498 -1.4951182465 0.1224824001 lincomep 4.4319944982 2.423196927 -1.6955014702 -1.0571031309 lrpmg -1.4951182465 -1.695501470 1.7668108564 0.8836800189 lcarpcap 0.1224824001 -1.057103131 0.8836800189 0.6801996482 > > > ##### twoways case ### > fe2_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within", effect = "twoways") > # be_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="between") > # RE gives warning due to neg. variance estimation > re2_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random", effect = "twoways") > > > phtest(fe2_grun, re2_grun) # 13.460, p = 0.00194496 [also given by EViews 9.5; Hausman Test data: inv ~ value + capital chisq = 13.460061, df = 2, p-value = 0.001194496 alternative hypothesis: one model is inconsistent > # Baltagi (2013), p. 85 has other values due to older/wrong version of EViews?] > > > phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") Hausman Test data: inv ~ value + capital chisq = 13.460061, df = 2, p-value = 0.001194496 alternative hypothesis: one model is inconsistent > phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "time") Hausman Test data: inv ~ value + capital chisq = 0.32309434, df = 2, p-value = 0.8508264 alternative hypothesis: one model is inconsistent > > # test to see of phtest(, method = "aux") respects argument effect > # formal test (statistic is about 13 for twoways case and well below in one-way cases) > testobj <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways", method = "aux") > #YC if (round(testobj$statistic, digits = 0) != 13) stop("argument effect seems to be not respected with method = \"aux\"") > testobj2 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") # just to be sure: test for method="chisq" also... > #YC if (round(testobj2$statistic, digits = 0) != 13) stop("argument effect seems to be not respected with method = \"chisq\"") > > > > # test for class of statistic [was matrix pre rev. 305] > testobj1 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways", method = "aux") > testobj2 <- phtest(fe2_grun, re2_grun) > testobj3 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") > if (class(testobj1$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj1$statistic))) > if (class(testobj2$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj2$statistic))) > if (class(testobj3$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj3$statistic))) > > > > > # Two-ways case with beetween model should result in informative errors. > # phtest(fe2_grun, be_grun) > # phtest(re2_grun, be_grun) > > > > > ################################## (3) ################################## > ### comparison to Stata: > # Hausman test with Stata example 2, pp. 5-6 in http://www.stata.com/manuals/xtxtregpostestimation.pdf > # > # Results of phtest differ, most likely because RE model differs slightly from Stata's RE model as the > # default RE model in Stata uses a slightly different implementation of Swamy-Arora method > # [see http://www.stata.com/manuals/xtxtreg.pdf] > # > # Stata: > # chi2(8) = (b-B)'[(V_b-V_B)^(-1)](b-B) > # = 149.43 > # Prob>chi2 = 0.0000 > > # library(haven) > # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file > # nlswork$race <- factor(nlswork$race) # convert > # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example > # nlswork$grade <- as.numeric(nlswork$grade) > # nlswork$age2 <- (nlswork$age)^2 > # nlswork$tenure2 <- (nlswork$tenure)^2 > # nlswork$ttl_exp2 <- (nlswork$ttl_exp)^2 > # > # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) > # > # form_nls_ex2 <- formula(ln_wage ~ grade + age + age2 + ttl_exp + ttl_exp2 + tenure + tenure2 + race2 + not_smsa + south) > # > # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") > # plm_be_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "between") > # plm_re_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "random") > # > # summary(plm_re_nlswork) > # > # ### Stata: chi2(8) = 149.43 > # phtest(plm_fe_nlswork, plm_re_nlswork) # chisq = 176.39, df = 8, p-value < 2.2e-16 > # phtest(plm_be_nlswork, plm_re_nlswork) # chisq = 141.97, df = 10, p-value < 2.2e-16 > # phtest(form_nls_ex2, data = pnlswork, method="aux") # chisq = 627.46, df = 8, p-value < 2.2e-16 [this resulted in an error for SVN revisions 125 - 141] > # phtest(form_nls_ex2, data = nlswork, method="aux") # same on data.frame > # phtest(form_nls_ex2, data = pnlswork, method="aux", vcov = vcovHC) # chisq = 583.56, df = 8, p-value < 2.2e-16 > # # phtest(form_nls_ex2, data = pnlswork, method="aux", vcov = function(x) vcovHC(x, method="white2", type="HC3")) # computationally too heavy! > > > > proc.time() user system elapsed 3.76 0.35 4.07 plm/inst/tests/test_cipstest.R0000644000176200001440000000243414126005460016202 0ustar liggesusers## run tests for cipstest() library(plm) data("Produc", package = "plm") Produc <- pdata.frame(Produc, index=c("state", "year")) # truncated = FALSE (default) cipstest(Produc$gsp, type = "trend", model = "cmg") cipstest(Produc$gsp, type = "drift", model = "cmg") cipstest(Produc$gsp, type = "none", model = "cmg") cipstest(Produc$gsp, type = "trend", model = "mg") cipstest(Produc$gsp, type = "drift", model = "mg") cipstest(Produc$gsp, type = "none", model = "mg") cipstest(Produc$gsp, type = "trend", model = "dmg") cipstest(Produc$gsp, type = "drift", model = "dmg") cipstest(Produc$gsp, type = "none", model = "dmg") # truncated = TRUE cipstest(Produc$gsp, type = "trend", model = "cmg", truncated = TRUE) cipstest(Produc$gsp, type = "drift", model = "cmg", truncated = TRUE) cipstest(Produc$gsp, type = "none", model = "cmg", truncated = TRUE) cipstest(Produc$gsp, type = "trend", model = "mg", truncated = TRUE) cipstest(Produc$gsp, type = "drift", model = "mg", truncated = TRUE) cipstest(Produc$gsp, type = "none", model = "mg", truncated = TRUE) cipstest(Produc$gsp, type = "trend", model = "dmg", truncated = TRUE) cipstest(Produc$gsp, type = "drift", model = "dmg", truncated = TRUE) cipstest(Produc$gsp, type = "none", model = "dmg", truncated = TRUE) plm/inst/tests/test_pgmm.R0000644000176200001440000001274514154734502015321 0ustar liggesuserslibrary("plm") data("EmplUK", package = "plm") ## Arellano and Bond (1991), table 4 col. b z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(z1, robust = TRUE) # default z1col <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE) summary(z1col, robust = TRUE) # default z1ind <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") summary(z1ind, robust = TRUE) # default z1indcol <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") summary(z1indcol, robust = TRUE) # default ## Blundell and Bond (1998) table 4 (cf DPD for OX p.12 col.4) ## not quite... z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) z2b <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "individual", model = "onestep", transformation = "ld") summary(z2b, robust = TRUE) ### further run tests with various argument values summary(z1, robust = FALSE) summary(z1col, robust = FALSE) summary(z1ind, robust = FALSE) summary(z1indcol, robust = FALSE) summary(z2, robust = FALSE) summary(z2b, robust = FALSE) z3 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", transformation = "ld") summary(z3) z3col <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE, transformation = "ld") summary(z3col) z3ind <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") summary(z3ind) z3indcol <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") summary(z3indcol) # Baltagi (2005, 2013/2021), Table 8.1 # Interesting note: Baltagi (2005, 3rd), table 8.1 has different values compared # to Baltagi (2013/2021, 5th/6th) for the two-step GMM case where the difference # stems from using xtabond2 and collapsed instruments in the newer editions # (as opposed to xtabond and not mentioning of collapsed instruments in older edition). data("Cigar", package = "plm") Cigar$real_c <- Cigar$sales * Cigar$pop/Cigar$pop16 Cigar$real_p <- Cigar$price/Cigar$cpi * 100 Cigar$real_pimin <- Cigar$pimin/Cigar$cpi * 100 Cigar$real_ndi <- Cigar$ndi/Cigar$cpi form_cig <- log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + log(real_ndi) | lag(log(real_c), 2:99) # Baltagi (2005, 3rd edition), table 8.1 # one-step GMM gmm_onestep <- pgmm(form_cig, data = Cigar, effect = "twoways", model = "onestep") # matches table 8.1: 0.84, -0.377, -0.016, 0.14 summary(gmm_onestep) # two-step GMM # # Table 8.1, 8.2 in Baltagi (2021): Coefs (z-stat) 0.70 (10.2) −0.396 (6.0) −0.105 (1.3) 0.13 (3.5) # # Stata xtabond2 lnc L.(lnc) lnrp lnrpn lnrdi dum3 dum8 dum10-dum29, gmm(L.(lnc), collapse) # iv(lnrp lnrpn lndrdi dum3 dum8 dum10-29) noleveleq robust nomata twostep # No of obs 1288, no of groups = 48, balanced, no of instruments = 53 year.d <- contr.treatment(levels(factor(Cigar$year))) year.d <- cbind("63" = c(1, rep(0, nrow(year.d)-1)), year.d) colnames(year.d) <- paste0("year_", colnames(year.d)) year.d <- cbind("year" = rownames(year.d), as.data.frame(year.d)) Cigar <- merge(Cigar, year.d) pCigar <- pdata.frame(Cigar, index = c("state", "year")) # not quite (need to add IV instruments!?): gmm_twostep <- pgmm(log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + log(real_ndi) # + year_63 + year_64 + year_65 + # year_66 + year_67 + year_68 + year_69 + year_70 + # year_71 + year_72 + year_73 + year_74 + year_75 + year_76 + year_77 + year_78 + year_79 + year_80 + year_81 + year_82 + year_83 + year_84 + year_85 + year_86 + year_87 + year_88 + year_89 + year_90 + year_91 # + year_92 | lag(log(real_c), 2:99) , data = pCigar, effect = "individual", model = "twosteps", transformation = "d", collapse = TRUE) summary(gmm_twostep) plm/inst/tests/test_vcovG_lin_dep.R0000644000176200001440000000563414154734502017136 0ustar liggesusers# Currently (in at least rev. 195), plm() and summary() can deal with linear dependent # columns (by silently dropping them), but vcovG framework had a hiccup pre rev. 302 # see the example below library(plm) data("Cigar", package = "plm") Cigar.p <- pdata.frame(Cigar) Cigar.p[ , "fact1"] <- c(0,1) Cigar.p[ , "fact2"] <- c(1,0) # linear dependent columns are silently dropped in these functions, thus they work mod_fe_lin_dep <- plm(price ~ cpi + fact1 + fact2, data = Cigar.p, model = "within") # contains lin dep columns mod_fe_no_lin_dep <- plm(price ~ cpi + fact1, data = Cigar.p, model = "within") # does not contain lin dep columns summary(mod_fe_lin_dep) # works with linear dep columns summary(mod_fe_no_lin_dep) # detect linear dependence detect.lindep(model.matrix(mod_fe_lin_dep)) detect.lindep(model.matrix(mod_fe_no_lin_dep)) mod_fe_lin_dep$aliased mod_fe_no_lin_dep$aliased # failed in vcovG up to rev. 301; # fixed in rev. 302 by taking care of aliased coefficients # the linear dependent column is not dropped leading to failing function due # to the non-invertible matrix vcovHC(mod_fe_lin_dep) vcovHC(mod_fe_no_lin_dep) if (!identical(vcovHC(mod_fe_lin_dep), vcovHC(mod_fe_no_lin_dep))) { stop("vcov w/ linear dependent columns and the corresponding one w/o are not identical") } ## test for vcovBK because code is separate from the vcovG framework vcovBK(mod_fe_lin_dep) vcovBK(mod_fe_no_lin_dep) if (!identical(vcovBK(mod_fe_lin_dep), vcovBK(mod_fe_no_lin_dep))) { stop("vcov w/ linear dependent columns and the corresponding one w/o are not identical") } ## test for IV models with linear dependent columns data("Crime", package = "plm") cr <- plm(log(crmrte) ~ log(prbarr) + log(polpc) + log(prbconv) + I(2*log(prbconv)) | log(prbarr) + log(polpc) + log(taxpc) + log(mix), data = Crime, model = "pooling") head(model.matrix(cr$formula, cr$model, rhs = 1)) head(model.matrix(cr$formula, cr$model, rhs = 2)) detect.lindep(cr) vcovHC(cr) vcovBK(cr) ## linear dependence in instrument part cr2 <- plm(log(crmrte) ~ log(prbarr) + log(polpc) + log(prbconv) | log(prbarr) + log(polpc) + log(taxpc) + log(mix) + I(2*log(mix)), data = Crime, model = "pooling") detect.lindep(cr2) # does not inspect instrument matrix head(model.matrix(cr2$formula, cr2$model, rhs = 2)) detect.lindep(model.matrix(cr2$formula, cr2$model, rhs = 2)) vcovHC(cr2) vcovBK(cr2) # just run test for 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), list(2, 1, 2, 2)), data = EmplUK, effect = "twoways", model = "twosteps", gmm.inst = ~ log(emp), lag.gmm = list(c(2, 99))) vcovHC(ar) plm:::vcovHC.pgmm(ar) plm/inst/tests/test_cipstest.Rout.save0000644000176200001440000001561514126006252017674 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## run tests for cipstest() > library(plm) > data("Produc", package = "plm") > Produc <- pdata.frame(Produc, index=c("state", "year")) > > > # truncated = FALSE (default) > cipstest(Produc$gsp, type = "trend", model = "cmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.58228, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "cmg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "cmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.59924, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "cmg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "cmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.52464, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "cmg") : p-value greater than printed p-value > > cipstest(Produc$gsp, type = "trend", model = "mg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -1.658, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "mg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "mg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.011214, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "mg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "mg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 1.7254, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "mg") : p-value greater than printed p-value > > cipstest(Produc$gsp, type = "trend", model = "dmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 0.032088, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "dmg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "dmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 0.032088, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "dmg") : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "dmg") Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 1.2753, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "dmg") : p-value greater than printed p-value > > # truncated = TRUE > cipstest(Produc$gsp, type = "trend", model = "cmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.61357, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "cmg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "cmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.59924, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "cmg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "cmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.52464, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "cmg", truncated = TRUE) : p-value greater than printed p-value > > cipstest(Produc$gsp, type = "trend", model = "mg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -1.658, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "mg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "mg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.011214, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "mg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "mg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 1.7254, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "mg", truncated = TRUE) : p-value greater than printed p-value > > cipstest(Produc$gsp, type = "trend", model = "dmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = -0.052654, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "trend", model = "dmg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "drift", model = "dmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 0.0054748, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "drift", model = "dmg", truncated = TRUE) : p-value greater than printed p-value > cipstest(Produc$gsp, type = "none", model = "dmg", truncated = TRUE) Pesaran's CIPS test for unit roots data: Produc$gsp CIPS test = 1.2753, lag order = 2, p-value = 0.1 alternative hypothesis: Stationarity Warning message: In cipstest(Produc$gsp, type = "none", model = "dmg", truncated = TRUE) : p-value greater than printed p-value > > proc.time() user system elapsed 2.42 0.17 2.54 plm/inst/tests/test_pdata.frame_pseriesfy.R0000644000176200001440000000404614126025352020622 0ustar liggesusers# test of pseriesfy() (turns all columns of a pdata.frame into pseries) library("plm") data("Grunfeld", package = "plm") Grunfeld$fac <- factor(1:200) pGrun <- pdata.frame(Grunfeld) options("plm.fast" = FALSE) pGrunpser1.1 <- pseriesfy(pGrun) ## Run tests only if package 'collapse' is available ## (as they are 'Suggests' dependencies) collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE if(collapse.avail) { options("plm.fast" = TRUE) pGrunpser2.1 <- pseriesfy(pGrun) options("plm.fast" = FALSE) # Tests for base R vs. collapse version class(pGrunpser1.1) class(pGrunpser2.1) stopifnot(identical(pGrunpser1.1, pGrunpser2.1)) lapply(pGrunpser1.1, class) lapply(pGrunpser2.1, class) lapply(pGrunpser1.1, names) lapply(pGrunpser2.1, names) form <- inv ~ value + capital plm(form, pGrunpser1.1, model = "within") plm(form, pGrunpser2.1, model = "within") # apply again to an already pseriesfy-ed pdata.frame (result should not change) options("plm.fast" = FALSE) pGrunpser1.2 <- pseriesfy(pGrunpser1.1) options("plm.fast" = TRUE) pGrunpser2.2 <- pseriesfy(pGrunpser2.1) options("plm.fast" = FALSE) class(pGrunpser1.2) class(pGrunpser2.2) lapply(pGrunpser1.2, class) lapply(pGrunpser2.2, class) lapply(pGrunpser1.2, names) lapply(pGrunpser2.2, names) stopifnot(identical(pGrunpser1.1, pGrunpser1.2)) stopifnot(identical(pGrunpser2.1, pGrunpser2.2)) stopifnot(identical(pGrunpser1.2, pGrunpser2.2)) with(pGrun, lag(value)) # dispatches to base R's lag with(pGrunpser1.1, lag(value)) # dispatches to plm's lag() respect. panel structure invisible(NULL) } ### benchmark: collapse version about 10x faster # library(collapse) # data("wlddev", package = "collapse") # pwld <- pdata.frame(wlddev, index = c("iso3c", "year")) # options("plm.fast" = FALSE) # microbenchmark::microbenchmark(pseriesfy(pwld), times = 100, unit = "us") # options("plm.fast" = TRUE) # microbenchmark::microbenchmark(pseriesfy(pwld), times = 100, unit = "us") # options("plm.fast" = FALSE) plm/inst/tests/test_make.pconsecutive_pbalanced.Rout.save0000644000176200001440000006545014126043435023460 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ##### Testing of make.pconsecutive.* ##### > ##### and of make.pbalanced.* ##### > ##### > ## in separate file test_is.pconsecutive.R: test of is.pconsecutive.* > > > library(plm) > > > ##################### test of make.pconsecutive.indexes ##################### > # (non-exported function) > > # make.pconsecutive.indexes: for data.frames > data("Grunfeld", package = "plm") > drop_for_unbalanced <- c(2,42,56,78) > unbalanced_Grunfeld <- Grunfeld[-drop_for_unbalanced, ] > gindex <- plm:::make.pconsecutive.indexes(unbalanced_Grunfeld, index = c("firm", "year"))[[1L]] > nrow(gindex) [1] 200 > all.equal(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ]) [1] TRUE > #compare::compare(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ], allowAll = TRUE) > > if (!identical(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ])) stop("failure data.frame") > if (!isTRUE(all.equal(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ]))) stop("failure data.frame") > > > # class(unbalanced_Grunfeld[, 2]) > # class(gindex[-drop_for_unbalanced, 2]) > # > # typeof(unbalanced_Grunfeld[, 2]) > # typeof(gindex[-drop_for_unbalanced, 2]) > # > # attr(unbalanced_Grunfeld, "row.names") > # attr(gindex, "row.names") > > # make.pconsecutive.indexes: for pdata.frames > punbalanced_Grunfeld <- pdata.frame(unbalanced_Grunfeld) > pgindex <- plm:::make.pconsecutive.indexes(punbalanced_Grunfeld, index = c("firm", "year"))[[1L]] > nrow(pgindex) [1] 200 > > if (!identical(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ])) stop("failure index of pdata.frame") > if (!isTRUE(all.equal(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ]))) stop("failure index of pdata.frame") > #compare::compare(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ], allowAll = TRUE) > > > > # class(pgindex[-drop_for_unbalanced, ]) > # mode(attr(unbalanced_Grunfeld[, 1:2], "row.names")) > # mode(attr(gindex[-drop_for_unbalanced, ], "row.names")) > # class(row.names(gindex[-drop_for_unbalanced, ])) > > > > # make.pconsecutive.indexes: pseries interface > pgindex <- plm:::make.pconsecutive.indexes(punbalanced_Grunfeld$inv, index = c("firm", "year"))[[1L]] > if (!identical(attr(punbalanced_Grunfeld$inv, "index")[, 1:2], pgindex[-drop_for_unbalanced, ])) stop("failure index of pdata.frame") > if (!isTRUE(all.equal(attr(punbalanced_Grunfeld$inv, "index")[, 1:2], pgindex[-drop_for_unbalanced, ]))) stop("failure index of pdata.frame") > ##################### END test of make.pconsecutive.indexes ##################### > > > ##################### test of make.pconsecutive methods (various interfaces) ##################### > > ### create some easy test data with some leading and trailing NAs ### > df_consec <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), + time = c(1, 2, 3, 1, 2, 1, 2, 3), + value = c("a", "b", "c", "d", "e", "f", "g", "h")) > > df_first_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), + time = c(NA, 2, 3, 1, 2, 1, 2, 3), + value = c("a", "b", "c", "d", "e", "f", "g", "h")) > > df_first_t_NA2 <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), + time = c(1, 2, 3, NA, 2, 1, 2, 3), + value = c("a", "b", "c", "d", "e", "f", "g", "h")) > > df_last_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), + time = c(1, 2, NA, 1, 2, 1, 2, 3), + value = c("a", "b", "c", "d", "e", "f", "g", "h")) > > df_first_last_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), + time = c(NA, 2, NA, 1, 2, 1, 2, NA), + value = c("a", "b", "c", "d", "e", "f", "g", "h")) > > pdf_consec <- pdata.frame(df_consec) > pdf_first_t_NA <- pdata.frame(df_first_t_NA) Warning message: In pdata.frame(df_first_t_NA) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > pdf_first_t_NA2 <- pdata.frame(df_first_t_NA2) Warning message: In pdata.frame(df_first_t_NA2) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > pdf_last_t_NA <- pdata.frame(df_last_t_NA) Warning message: In pdata.frame(df_last_t_NA) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > pdf_first_last_t_NA <- pdata.frame(df_first_last_t_NA) Warning message: In pdata.frame(df_first_last_t_NA) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > > > if (!identical(make.pconsecutive(pdf_consec$value), pdf_consec$value)) + stop("failure for already consecutive pseries: result is not identical to input") > > if (!all(names(make.pconsecutive(pdf_first_t_NA$value)) == c("1-2", "1-3", "2-1", "2-2", "3-1", "3-2", "3-3"))) + stop("failure for leading NA") > > if (!all(names(make.pconsecutive(pdf_first_t_NA2$value)) == c("1-1", "1-2", "1-3", "2-2", "3-1", "3-2", "3-3"))) + stop("failure for leading NA") > > if (!all(names(make.pconsecutive(pdf_last_t_NA$value)) == c("1-1", "1-2", "2-1", "2-2", "3-1", "3-2", "3-3"))) + stop("failure for last NA") > > if (!all(names(make.pconsecutive(pdf_first_last_t_NA$value)) == c("1-2", "2-1" , "2-2", "3-1", "3-2"))) + stop("failure for first/last NA pattern") > > > ## some missing periods > data("Grunfeld", package = "plm") > > Grunfeld_missing_periods_one_id <- Grunfeld[-c(2,6,7), ] > pGrunfeld_missing_periods_one_id <- pdata.frame(Grunfeld_missing_periods_one_id) > pinv_missing_periods <- pGrunfeld_missing_periods_one_id$inv > > multi_periods <- c(2,6,7,22,23,56) # may not be at the first or last pos for an id, otherwise this line cannot be restored > Grunfeld_missing_periods_multi_id <- Grunfeld[-multi_periods, ] > pGrunfeld_missing_periods_multi_id <- pdata.frame(Grunfeld_missing_periods_multi_id) > pinv_missing_periods_multi_id <- pGrunfeld_missing_periods_multi_id$inv > > #### test of pseries interface #### > if (!all(is.pconsecutive(make.pconsecutive(pinv_missing_periods)))) stop("failure") > if (!nrow(attr(make.pconsecutive(pinv_missing_periods), "index")) == 200) stop("wrong index") > if (!all(class(make.pconsecutive(pinv_missing_periods)) == class(pinv_missing_periods))) stop("wrong class") > > # test for fancy_rownames > names(make.pconsecutive(pinv_missing_periods)) # names should be "fancy" [1] "1-1935" "1-1936" "1-1937" "1-1938" "1-1939" "1-1940" "1-1941" [8] "1-1942" "1-1943" "1-1944" "1-1945" "1-1946" "1-1947" "1-1948" [15] "1-1949" "1-1950" "1-1951" "1-1952" "1-1953" "1-1954" "2-1935" [22] "2-1936" "2-1937" "2-1938" "2-1939" "2-1940" "2-1941" "2-1942" [29] "2-1943" "2-1944" "2-1945" "2-1946" "2-1947" "2-1948" "2-1949" [36] "2-1950" "2-1951" "2-1952" "2-1953" "2-1954" "3-1935" "3-1936" [43] "3-1937" "3-1938" "3-1939" "3-1940" "3-1941" "3-1942" "3-1943" [50] "3-1944" "3-1945" "3-1946" "3-1947" "3-1948" "3-1949" "3-1950" [57] "3-1951" "3-1952" "3-1953" "3-1954" "4-1935" "4-1936" "4-1937" [64] "4-1938" "4-1939" "4-1940" "4-1941" "4-1942" "4-1943" "4-1944" [71] "4-1945" "4-1946" "4-1947" "4-1948" "4-1949" "4-1950" "4-1951" [78] "4-1952" "4-1953" "4-1954" "5-1935" "5-1936" "5-1937" "5-1938" [85] "5-1939" "5-1940" "5-1941" "5-1942" "5-1943" "5-1944" "5-1945" [92] "5-1946" "5-1947" "5-1948" "5-1949" "5-1950" "5-1951" "5-1952" [99] "5-1953" "5-1954" "6-1935" "6-1936" "6-1937" "6-1938" "6-1939" [106] "6-1940" "6-1941" "6-1942" "6-1943" "6-1944" "6-1945" "6-1946" [113] "6-1947" "6-1948" "6-1949" "6-1950" "6-1951" "6-1952" "6-1953" [120] "6-1954" "7-1935" "7-1936" "7-1937" "7-1938" "7-1939" "7-1940" [127] "7-1941" "7-1942" "7-1943" "7-1944" "7-1945" "7-1946" "7-1947" [134] "7-1948" "7-1949" "7-1950" "7-1951" "7-1952" "7-1953" "7-1954" [141] "8-1935" "8-1936" "8-1937" "8-1938" "8-1939" "8-1940" "8-1941" [148] "8-1942" "8-1943" "8-1944" "8-1945" "8-1946" "8-1947" "8-1948" [155] "8-1949" "8-1950" "8-1951" "8-1952" "8-1953" "8-1954" "9-1935" [162] "9-1936" "9-1937" "9-1938" "9-1939" "9-1940" "9-1941" "9-1942" [169] "9-1943" "9-1944" "9-1945" "9-1946" "9-1947" "9-1948" "9-1949" [176] "9-1950" "9-1951" "9-1952" "9-1953" "9-1954" "10-1935" "10-1936" [183] "10-1937" "10-1938" "10-1939" "10-1940" "10-1941" "10-1942" "10-1943" [190] "10-1944" "10-1945" "10-1946" "10-1947" "10-1948" "10-1949" "10-1950" [197] "10-1951" "10-1952" "10-1953" "10-1954" > > pGrunfeld_missing_periods_one_id_wo_fancy_rownames <- pdata.frame(Grunfeld_missing_periods_one_id, row.names = FALSE) > pinv_missing_periods_wo_fancy_rownames <- pGrunfeld_missing_periods_one_id_wo_fancy_rownames$inv > # should not be "fancy" but sequence of numbers > if (!all(as.numeric(names(make.pconsecutive(pinv_missing_periods_wo_fancy_rownames))) == c(1:200))) + stop("fancy rownames test failed") > > > ### test of data.frame interface #### > > # index vars automatically taken from columns 1,2, as no index arg specified > a <- make.pconsecutive(Grunfeld_missing_periods_one_id) > all.equal(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ]) [1] TRUE > identical(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ]) [1] TRUE > if (!identical(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ])) stop("data.frame interface: non identical results") > > b <- make.pconsecutive(Grunfeld_missing_periods_multi_id) > all.equal(b[-multi_periods, ], Grunfeld[-multi_periods, ]) [1] TRUE > identical(b[-multi_periods, ], Grunfeld[-multi_periods, ]) [1] TRUE > if (!identical(b[-multi_periods, ], Grunfeld[-multi_periods, ])) stop("data.frame interface: non identical results") > > # place index vars at other positions, specify index arg > permutate_cols <- c(3, 1, 4, 5, 2) > Grunfeld_missing_periods_multi_id_other_pos_index <- Grunfeld_missing_periods_multi_id[ , permutate_cols] > > d <- make.pconsecutive(Grunfeld_missing_periods_multi_id_other_pos_index, index = c("firm", "year")) > all.equal(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index) [1] TRUE > identical(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index) [1] TRUE > if (!identical(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index)) stop("data.frame interface: non identical results") > > ### test of pdata.frame interface > f <- pdata.frame(Grunfeld_missing_periods_multi_id, index = c("firm", "year"), drop.index = FALSE) > f_without_indexvars <- pdata.frame(Grunfeld_missing_periods_multi_id, index = c("firm", "year"), drop.index = TRUE) > > f_consec <- make.pconsecutive(f) > f_without_indexvars_consec <- make.pconsecutive(f_without_indexvars) > > ## it seems like it is not possible here to check for equality of subsetted pdata.frames because > ## the subsetting functions for pdata.frame alters the pdata.frame > ## (this seems due to the fact that, currently, pdata.frames when created do not have > ## "pseries" in columns and carry no index attribute. Only after extracting a column, that column > ## will be of class c(“pseries”, “original_class”) and carry an index attribute. > ## > # To see this, use lapply (to avoid extraction): > # df <- data.frame(id = c(1,1,2), time = c(1,2,1), f = factor(c("a", "a", "b")), n = c(1:3)) > # pdf <- pdata.frame(df) > # lapply(df, class) > # lapply(pdf, class) > # > # lapply(df, attributes) > # lapply(pdf, attributes) > > > > all.equal(f, f_consec[-multi_periods, ]) [1] TRUE > all.equal(f, f_consec[-multi_periods, ], check.attributes = FALSE) [1] TRUE > identical(f, f_consec[-multi_periods, ]) [1] TRUE > if (!identical(f, f_consec[-multi_periods, ])) stop("make.pconsecutive pdata.frame interface: non identical results") > > all.equal(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ]) [1] TRUE > identical(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ]) [1] TRUE > if (!identical(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ])) stop("pdata.frame interface: non identical results") > > > if (!isTRUE(all.equal(f, f_consec[-multi_periods, ], check.attributes = FALSE))) stop("pdata.frame interface: non all.equal results") > if (!isTRUE(all.equal(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ], check.attributes = FALSE))) stop("pdata.frame interface: non all.equal results") > > > > ##### test for consecutive and at the same time balanced: > unbalanced_Grunfeld2 <- Grunfeld[-c(1, 41, 42, 79), ] # due to missing first time periods for some individuals, > # simply making it consecutive is not possible, because the > # periods cannot be infered > punbalanced_Grunfeld2 <- pdata.frame(unbalanced_Grunfeld2) > if (!nrow(make.pconsecutive(unbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE)) == 200) stop("not balanced") > if (!pdim(make.pconsecutive(unbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE))$balanced) stop("not balanced") > > if (!nrow(make.pconsecutive(punbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE)) == 200) stop("not balanced") > if (!pdim(make.pconsecutive(punbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE))$balanced) stop("not balanced") > > # for pseries > if (length(make.pconsecutive(punbalanced_Grunfeld2$inv, balanced = TRUE)) != 200) stop("not balanced") > # pseries is consecutive but not balanced and balancedness requested > psun <- pdata.frame(Grunfeld[1:199 , ])$inv > if (!length(make.pconsecutive(psun, balanced = TRUE)) == 200) stop("faile make.pconsecutive pseries") > if (!nrow(attr(make.pconsecutive(psun, balanced = TRUE), "index")) == 200) stop("failure make.pconsecutive pseries' index") > > > ######## test make.pbalanced ######### > delte_2nd_period_and_3rd_for_id1 <- c(c(2, 2 + 20*c(1:9)), 3) > Grunfeld_wo_2nd_period_and_3rd_for_id1 <- Grunfeld[-delte_2nd_period_and_3rd_for_id1, ] > pGrunfeld_wo_2nd_period_and_3rd_for_id1 <- pdata.frame(Grunfeld_wo_2nd_period_and_3rd_for_id1) > nrow(Grunfeld_wo_2nd_period_and_3rd_for_id1) [1] 189 > > # data.frame > if (!nrow(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)) == 190) stop("failure make.pbalanced data.frame") > # pdata.frame and its index > if (!nrow(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1)) == 190) stop("failure make.pbalanced pdata.frame") > if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1), "index")) == 190) stop("failure make.pbalanced pdata.frame's index") > # pseries and its index > if (!length(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv)) == 190) stop("failure make.pbalanced pseries") > if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv), "index")) == 190) stop("failure make.pbalanced pseries' index") > > # pseries is consecutive but not balanced and balancedness requested > psun <- pdata.frame(Grunfeld[1:199 , ])$inv > if (!length(make.pbalanced(psun, balance.type = "fill")) == 200) stop("faile make.pbalanced pseries") > if (!nrow(attr(make.pbalanced(psun, balance.type = "fill"), "index")) == 200) stop("failure make.pbalanced pseries' index") > > ## make.pbalanced with balance.type = "shared.times": > # 2 periods deleted -> 180 rows/entries left in (p)data.frame/pseries > > # data.frame > if (!nrow(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times") == 180)) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") > # pdata.frame > if (!nrow(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times") == 180)) stop("failure make.pbalanced, balance.type = \"shared.times\") pdata.frame") > if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times"), "index")) == 180) stop("failure make.pbalanced, balance.type = \"shared.times\") pdata.frame's index") > # pseries > if (!length(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv, balance.type = "shared.times")) == 180) stop("failure make.pbalanced(, balance.type = \"shared.times\") pseries") > if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv, balance.type = "shared.times"), "index")) == 180) stop("failure make.pbalanced pseries' index") > > # delete one (but different) period per id -> upper half of years (1945 to 1953) should be left > delete_1_per_id_half <- c(1, 22, 43, 64, 85, 106, 127, 148, 169, 190) > #split(Grunfeld[-delete_1_per_id_half, ]$year, Grunfeld[-delete_1_per_id_half, ]$firm) # inspect structure > > if (!nrow(make.pbalanced(Grunfeld[-delete_1_per_id_half, ], balance.type = "shared.times") == 100)) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") > if (!all(unique(make.pbalanced(Grunfeld[-delete_1_per_id_half, ], balance.type = "shared.times")$year) == c(1945:1954))) stop("wrong years") > > # delete two (but different) periods per id -> none should be left -> data frame with 0 rows > delete_2_per_id_all <- c(1, 20, 22, 39, 43, 58, 64, 77, 85, 96, 106, 115, 127, 134, 148, 153, 169, 172, 190, 191) > #split(Grunfeld[-delete_2_per_id_all, ]$year, Grunfeld[-delete_2_per_id_all, ]$firm) # inspect structure > if (!nrow(make.pbalanced(Grunfeld[-delete_2_per_id_all, ], balance.type = "shared.times")) == 0) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") > > > > ############## check that no additional individuals or times were introduced > # (because making it balanced does not introduce time periods > # which are not present for at least one individual) > # > > # pdata.frame and pseries: this is checking for new factor levels > # data.frame: check for unique values > > #### pdata.frame > if (!all(levels(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1)$year) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1$year))) + stop("failure pdata.frame: factor levels for time periods do not match") > > # test: no new levels in index: > if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1$year))) + stop("failure pdata.frame: factor levels for time periods in index do not match") > > # for pdata.frame without index vars as columns > pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index <- pdata.frame(Grunfeld_wo_2nd_period_and_3rd_for_id1, drop.index = TRUE) > if (!all(levels(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index)$year) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) + stop("failure pdata.frame: factor levels for time periods do not match") > > # test: no new levels in index: > if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) + stop("failure pdata.frame: factor levels for time periods in index do not match") > > #### pseries > # (only need to test index for pseries): no new levels in index > if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$value), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) + stop("failure for pseries: factor levels for time periods in index do not match") > > #### data.frame > # check that no additional values for individuals were introduced > if (!all(sort(unique(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)$firm)) == sort(unique(Grunfeld_wo_2nd_period_and_3rd_for_id1$firm)))) + stop("failure for data.frame: unique individuals in index do not match") > # check that no additional values for time were introduced > if (!all(sort(unique(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)$year)) == sort(unique(Grunfeld_wo_2nd_period_and_3rd_for_id1$year)))) + stop("failure for data.frame: unique time periods in index do not match") > > ######## END test make.pbalanced ######### > > > > ### messy data with various NA patterns ### > # > ## commented because needs package 'haven' and data need to be loaded from web > # library(haven) > # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") > # # remove attributes added by haven > # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) > # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) > # nlswork_r8$here_before <- TRUE > # > # > # length(unique(pnlswork_r8$year)) # == 15 > # unique(pnlswork_r8$year) # years missing: 74, 76, 79, 81, 84, 86 (# = 6) > # # => 15 + 6 = 21 > # > # ### test of pseries interface > # > # age_consec <- make.pconsecutive(pnlswork_r8$age) > # if (!(all(is.pconsecutive(age_consec)))) stop("failure") > # > # > # length(age_consec) > # length(index(age_consec)[[1L]]) > # length(index(age_consec)[[2L]]) > # > # ### test of data.frame interface > # df_nlswork_r8_consec <- make.pconsecutive(nlswork_r8) > # > # if (!all(is.pconsecutive(df_nlswork_r8_consec))) stop("failure") > # if (!nrow(df_nlswork_r8_consec) == 52365) stop("failure") > # > # # make temp original data with row.names so that identical can return TRUE > # # otherwise it cannot be TRUE because new row.names were introduced and row.names > # # are a consecutive series (rownames == row numbers) in the original data > # # see how the output of all.equal diverges > # rows_there_before <- df_nlswork_r8_consec$here_before & !is.na(df_nlswork_r8_consec$here_before) > # all.equal(df_nlswork_r8_consec[rows_there_before, ], nlswork_r8) > # > # nlswork_r8_comparison <- nlswork_r8 > # attr(nlswork_r8_comparison, "row.names") <- attr(df_nlswork_r8_consec[rows_there_before, ], "row.names") > # > # if (!identical(df_nlswork_r8_consec[rows_there_before, ],nlswork_r8_comparison)) stop("data.frame: not identical") > # > # if (!identical(typeof(attr(nlswork_r8, "row.names")), typeof(attr(df_nlswork_r8_consec, "row.names")))) > # stop("wrong typeof of attribute 'row.names'") > # > # ### test of pdata.frame interface > # pdf_pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) > # > # if (!all(is.pconsecutive(pdf_pnlswork_r8_consec))) stop("failure") > # if (!nrow(pdf_pnlswork_r8_consec) == 52365) stop("failure") > # > # # same row.names adoption necessary as for data.frame > # pnlswork_r8_comparison <- pnlswork_r8 > # pdf_pnlswork_r8_consec_rows_there_before <- pdf_pnlswork_r8_consec[rows_there_before, ] > # attr(attr(pnlswork_r8_comparison, "index"), "row.names") <- attr(attr(pdf_pnlswork_r8_consec_rows_there_before, "index"), "row.names") > # # as the index vars are in the pdata.frame: added levels are not to be dropped; thus: adapt here to enable comparison > # pdf_pnlswork_r8_consec_rows_there_before$idcode <- droplevels(pdf_pnlswork_r8_consec_rows_there_before$idcode) > # pdf_pnlswork_r8_consec_rows_there_before$year <- droplevels(pdf_pnlswork_r8_consec_rows_there_before$year) > # > # length(levels(pdf_pnlswork_r8_consec_rows_there_before$year)) > # > # all.equal(pdf_pnlswork_r8_consec_rows_there_before, pnlswork_r8_comparison) > # if (!identical(pdf_pnlswork_r8_consec_rows_there_before, pnlswork_r8_comparison)) stop("pdata.frame: not identical") > # > # > # > # dims_consec <- pdim(pdf_pnlswork_r8_consec) > # min(dims_consec$Tint$Ti) # 1 > # max(dims_consec$Tint$Ti) # 21 = 15 + 6 > # dims_consec$Tint$nt # => ok! (not all the same years for each individual, because just consecutive, not balanced) > # > # # 15 + 6 == 21 > # if (!length(unique(index(pdf_pnlswork_r8_consec)[[2]])) == 21) stop("failure") > # # years 68 to 88 need to be present (each year needs to be present) > # if (!all(levels(attr(pdf_pnlswork_r8_consec, "index")[[2]]) == factor(68:88))) stop("failure") > # > # > # # test argument balanced on this data set > # pdf_pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) > # dims_consec_bal <- pdim(pdf_pnlswork_r8_consec_bal) > # # need to have same numer of obs per year (because balanced) > # if (!all(dims_consec_bal$Tint$nt[1] == dims_consec_bal$Tint$nt)) stop("failure for argument balanced") > # if (!nrow(pdf_pnlswork_r8_consec_bal) == 98931) stop("failure: nrow not correct") > # if (!dims_consec_bal$balanced) stop("failure: not balanced") > # > # ## test of only making it balanced, but not consecutive > # nlswork_r8_bal <- make.pbalanced(nlswork_r8) # data.frame > # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8) # pdata.frame > # > # if (!all(sort(unique(nlswork_r8$year)) == sort(unique(nlswork_r8_bal$year)))) stop("data.frame: times do not match") > # if (!all(levels(pnlswork_r8$year) == levels(pnlswork_r8_bal$year))) stop("pdata.frame: times do not match") > > > > ########### compare results to statar ######################## > # devtools::install_github("matthieugomez/statar") > # library(tidyr) > # library(dplyr) > > > > ########### compare to tidyr ########## > ## commented because it requires a separate package > # > ## make panel balanced by inserting NAs > ## note: this is a good bit faster than make.psconsective(, balanced = TRUE) > > # nlswork_r8_no_NA <- tidyr::complete(nlswork_r8, idcode, year = as.integer(tidyr::full_seq(year, 1))) > # > # tidyr::full_seq(c(1, 2, 4, 5, 10), 1) > # tidyr::full_seq(c(1, 2, 4, 5, 10), 2) # error: not a regular sequence > # tidyr::full_seq(c( 2, 4, 6, 10), 2) > # pnlswork_r8_no_NA <- pdata.frame(nlswork_r8_no_NA, index=c("idcode", "year"), drop.index=F) > # > # > # all(is.pconsecutive(pnlswork_r8_no_NA)) > # > # pdim_tidyr <- pdim(pnlswork_r8_no_NA) > # > # min(dims$Tint$Ti) > # max(dims$Tint$Ti) > # > # pdim(pnlswork_r8_no_NA) > # anyNA(pnlswork_r8_no_NA$year) > > > proc.time() user system elapsed 4.96 0.70 5.75 plm/inst/tests/test_EstimatorsNested.R0000644000176200001440000000151614125776262017657 0ustar liggesuserslibrary(plm) data("Produc", package = "plm") pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp summary(plm(form, data = pProduc, model = "random", effect = "nested")) summary(plm(form, data = pProduc, model = "random", effect = "nested", random.method = "walhus")) summary(plm(form, data = pProduc, model = "random", effect = "nested", random.method = "amemiya")) pProduc_unbal <- pProduc[-c(2, 20:45, 75, 83:85, 500:510, 632:688, 700, 750), ] summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested")) summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested", random.method = "walhus")) summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested", random.method = "amemiya")) plm/inst/tests/test_EstimatorsIV.R0000644000176200001440000002425414126005660016743 0ustar liggesusers## Replicate some IV regression results ## Replicate Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, ch. 7.2 (p. 133) ## (same as Baltagi (2006), Estimating an econometric model of crime using panel data from North Carolina, ## Journal of Applied Econometrics 21(4), pp. 543-547. ## ## NB: Crime data set: results can diverge slightly form the values printed in Baltagi ## if logarithm computation is performed on the original variable. For the paper, ## a data set with pre-computed logarithms (variables l*) was used and those ## logarithmic values diverge from what R's log() function gives. ## -> see the two FE2SLS example which is computed in both ways library(plm) data("Crime", package = "plm") # replicates Table 7.1, column "Between" form <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa be <- plm(form, data = Crime, model = "between") summary(be) # replicates Table 7.1, column "Fixed Effects" fe <- plm(form, data = Crime, model = "within", effect = "twoways") summary(fe) # replicates Table 7.1, column "FE2SLS" form_iv <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa | . -log(prbarr) - log(polpc) + log(taxpc) + log(mix) form_iv2 <- lcrmrte ~ lprbarr + lprbconv + lprbpris + lavgsen + lpolpc + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa | . -lprbarr - lpolpc + ltaxpc + lmix fe_iv <- plm(form_iv, data = Crime, model = "within", effect = "twoways", inst.method = "baltagi") fe_iv2 <- plm(form_iv2, data = Crime, model = "within", effect = "twoways", inst.method = "baltagi") summary(fe_iv) # logs computed by R summary(fe_iv2) # logs as in data set by Baltagi -> results match exactly # ## felm example # library(lfe) # form_felm <- log(crmrte) ~ log(prbconv) + log(prbpris) + log(avgsen) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) | # county + year | # (log(prbarr) + log(polpc) ~ log(prbpris) + log(avgsen) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(taxpc) + log(mix)) # summary(felm(form_felm, data = Crime)) # replicates Table 7.1, column "BE2SLS" be_iv <- plm(form_iv, data = Crime, model = "between") summary(be_iv) # not in table fd_iv <- plm(form_iv, data = Crime, model = "fd", effect = "individual") summary(fd_iv) # replicates Table 7.1, column "EC2SLS" ## need to include time dummies! form_re_iv <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa + factor(year) | . -log(prbarr) - log(polpc) + log(taxpc) + log(mix) form_re_iv2 <- lcrmrte ~ lprbarr + lprbconv + lprbpris + lavgsen + lpolpc + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . -lprbarr - lpolpc + ltaxpc + lmix re_iv <- plm(form_re_iv, data = Crime, model = "random", inst.method = "baltagi") re_iv2 <- plm(form_re_iv2, data = Crime, model = "random", inst.method = "baltagi") summary(re_iv) summary(re_iv2) # replicates Baltagi (2013), p. 137/Baltagi (2021), p. 165 ("G2SLS"), table 7.3 (not in Table 7.1) re_iv_bvk <- plm(form_re_iv, data = Crime, model = "random", inst.method = "bvk") re_iv_bvk2 <- plm(form_re_iv2, data = Crime, model = "random", inst.method = "bvk") summary(re_iv_bvk) summary(re_iv_bvk2) cor(plm:::fitted_exp.plm(re_iv_bvk2), re_iv_bvk2$model[ , 1])^2 # overall R^2 as per Stata ## Hausman-Taylor estimator: ## replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 # (chisq values in Baltagi (2021) are not those of the models but of Hausman test # between the models! plm's summary replicates chisq values of the models as # given by Stata and printed in Baltagi (2021), tables 7.6, 7.7) # # Table 7.5 claims to replicate Baltagi/Khanti-Akom (1990), table II, but values # for all models but within are largely different (even the GLS case!), making # the book reproducible but not the paper (likely the paper is in error!). data("Wages", package = "plm") pWages <- pdata.frame(Wages, index = 595) form_wage <- lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed form_wage_iv <- lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2) gls <- plm(form_wage, data = pWages, model = "random") summary(gls) within <- plm(form_wage, data = pWages, model = "within") summary(within) ht <- plm(form_wage_iv, data = pWages, random.method = "ht", model = "random", inst.method = "baltagi") summary(ht) am <- plm(form_wage_iv, data = pWages, random.method = "ht", model = "random", inst.method = "am") summary(am) bms <- plm(form_wage_iv, data = pWages, random.method = "ht", model = "random", inst.method = "bms") summary(bms) # texreg::screenreg(list(ht, am, bms)) phtest(within, ht) # 5.2577 -> match Baltagi (2021), p. 175 for statistic but # df are different (9 vs. 3), Baltagi explains why df = 3. phtest(ht, am) # 14.66 -> close to Baltagi's 17.74 (df = 12 vs. 13) ### IV estimators ## form_wage_iv2 <- lwage ~ wks + married + exp + I(exp ^ 2) + bluecol | wks + exp + bluecol | wks + married + exp + I(exp ^ 2) ## balanced one-way individual IVbvk <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "bvk") summary(IVbvk) IVbalt <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "baltagi") summary(IVbalt) IVam <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "am") summary(IVam) IVbms <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "bms") summary(IVbms) # texreg::screenreg(list("BVK" = IVbvk, "Baltagi" = IVbalt, "AM" = IVam, "BMS" = IVbms), # digits = 5) ## unbalanced one-way individual pWages_ubal <- pWages[-c(2:7, 79:82, 500:505), ] pdim(pWages_ubal) IVbvk_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bvk") summary(IVbvk_ubal) IVbalt_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "baltagi") summary(IVbalt_ubal) IVam_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "am") summary(IVam_ubal) IVbms_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bms") summary(IVbms_ubal) # texreg::screenreg(list("BVK ui" = IVbvk_ubal, "Baltagi ui" = IVbalt_ubal, "AM ui" = IVam_ubal, "BMS ui" = IVbms_ubal), # digits = 5) ## balanced one-way time # gives identical results for "am" and "bms" results are identical to "baltagi", # likely because function StarX is not symmetric in effect IVbvk_t <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "bvk", effect = "time") summary(IVbvk_t) IVbalt_t <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "baltagi", effect = "time") summary(IVbalt_t) IVam_t <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "am", effect = "time") summary(IVam_t) IVbms_t <- plm(form_wage_iv2, data = pWages, model = "random", inst.method = "bms", effect = "time") summary(IVbms_t) # texreg::screenreg(list("BVK t" = IVbvk_t, "Baltagi t" = IVbalt_t, "AM t" = IVam_t, "BMS t" = IVbms_t), # digits = 5) ## unbalanced one-way time IVbvk_t_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bvk", effect = "time") summary(IVbvk_t_ubal) IVbalt_t_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "baltagi", effect = "time") summary(IVbalt_t_ubal) IVam_t_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "am", effect = "time") summary(IVam_t_ubal) IVbms_t_ubal <- plm(form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bms", effect = "time") summary(IVbms_t_ubal) # texreg::screenreg(list("BVK tu" = IVbvk_t_ubal, "Baltagi tu" = IVbalt_t_ubal, "AM tu" = IVam_t_ubal, "BMS tu" = IVbms_t_ubal), # digits = 5) ### twoway RE estimation: currently prevented (error informatively) # IVbvktw <- plm(form_wage_iv2, # data = pWages, # model = "random", inst.method = "bvk", effect = "twoways") # summary(IVbvktw) # # IVbalttw <- plm(form_wage_iv2, # data = pWages, # model = "random", inst.method = "baltagi", effect = "twoways") # summary(IVbalttw) # # IVamtw <- plm(form_wage_iv2, # data = pWages, # model = "random", inst.method = "am", effect = "twoways") # summary(IVamtw) # # IVbmstw <- plm(form_wage_iv2, # data = pWages, # model = "random", inst.method = "bms", effect = "twoways") # summary(IVbmstw) # # texreg::screenreg(list("BVK tw" = IVbvktw, "Baltagi tw" = IVbalttw, "AM tw" = IVamtw, "BMS tw" = IVbmstw), # digits = 5) plm/inst/tests/test_clubSandwich_interoperability.R0000644000176200001440000001373414154734502022433 0ustar liggesusers## Test of interoperability of vcov generated by package 'clubSandwich' with pwaldtest ## test of detection of those vcovs and test of translation function plm:::trans_clubSandwich_vcov # library(plm) # # # clubSandwich.avail <- if(!requireNamespace("clubSandwich", quietly = TRUE)) FALSE else TRUE # # if(clubSandwich.avail) { # library(clubSandwich) # data("MortalityRates", package = "clubSandwich") # # # partly from clubSandwich's vignette # # subset for deaths in motor vehicle accidents, 1970-1983 # MV_deaths <- subset(MortalityRates, cause=="Motor Vehicle" & # year <= 1983 & !is.na(beertaxa)) # # plm_unweighted <- plm(mrate ~ legal + beertaxa, data = MV_deaths, # effect = "individual", index = c("state","year")) # # plm_unweighted_re <- plm(mrate ~ legal + beertaxa, data = MV_deaths, model = "random", # effect = "twoways", index = c("state","year"), random.method = "walhus") # # clubSandwich::coef_test(plm_unweighted, vcov = "CR1", cluster = "individual", test = "naive-t") # clubSandwich::coef_test(plm_unweighted, vcov = "CR1", cluster = "individual", test = "Satterthwaite") # # # vcov_club_id <- clubSandwich::vcovCR(plm_unweighted, type = "CR0", cluster = "individual") # vcov_club_time <- clubSandwich::vcovCR(plm_unweighted, type = "CR0", cluster = "time") # vcov_plm_id <- vcovHC(plm_unweighted, method="arellano", type="HC0", cluster = "group") # vcov_plm_time <- vcovHC(plm_unweighted, method="arellano", type="HC0", cluster = "time") # # if(!isTRUE(all.equal(as.matrix(vcov_club_id), vcov_plm_id, check.attributes = FALSE))) stop("vcov_club_id and vcov_plm_id differ") # if(!isTRUE(all.equal(as.matrix(vcov_club_time), vcov_plm_time, check.attributes = FALSE))) stop("vcov_club_time and vcov_plm_time differ") # # # # some features: # is.matrix(vcov_club_id) # TRUE # class(vcov_club_id) # c("vcovCR", "clubSandwich") # str(vcov_club_id) # # ## clubSandwich's vcov holds the actual variable in attribute "cluster", # ## not a character string like plm's vcov # # # Translation of attribute "cluster" # attr(plm:::trans_clubSandwich_vcov(vcov_club_id, attr(model.frame(plm_unweighted), "index")), "cluster") # attr(plm:::trans_clubSandwich_vcov(vcov_club_time, attr(model.frame(plm_unweighted), "index")), "cluster") # # # Test if df adjustment in pwaldtest works (needs plm ver >= 1.5-34) # df2_id <- pwaldtest(plm_unweighted, vcov = vcov_plm_id, test = "F")[["parameter"]][2] # if(!pwaldtest(plm_unweighted, vcov = vcov_club_id, test = "F")[["parameter"]][2] == df2_id) stop("wrong df2") # # df2_time <- pwaldtest(plm_unweighted, vcov = vcov_plm_time, test = "F")[["parameter"]][2] # if(!pwaldtest(plm_unweighted, vcov = vcov_club_time, test = "F")[["parameter"]][2] == df2_time) stop("wrong df2") # # attr(vcov_club_id, "cluster") <- "asdf" # if(!is.null(attr(plm:::trans_clubSandwich_vcov(vcov_club_id, attr(model.frame(plm_unweighted), "index")), "cluster"))) # stop("attr 'cluster' other than known values found but not set to NULL") # # # should give warning # attr(vcov_club_id, "cluster") <- NULL # attr(plm:::trans_clubSandwich_vcov(vcov_club_id, attr(model.frame(plm_unweighted), "index")), "cluster") # # vcov_club_id <- clubSandwich::vcovCR(plm_unweighted, type = "CR0", cluster = "individual") # get "fresh" vcov # # # clubSandwich's Wald tests # # clubSandwich::Wald_test(plm_unweighted, constraints = c("legal","beertaxa"), vcov = "CR1", test = "chi-sq") # # clubSandwich::Wald_test(plm_unweighted, constraints = c("legal","beertaxa"), vcov = "CR0", test = "Naive-F") # # clubSandwich::Wald_test(plm_unweighted, constraints = c("legal","beertaxa"), vcov = "CR0", test = "All") # # # summary(plm_unweighted, vcov = vcov_plm_id) # summary(plm_unweighted, vcov = vcov_club_id) # just a run test # summary(plm_unweighted, vcov = vcov_plm_time) # summary(plm_unweighted, vcov = vcov_club_time) # just a run test # # # run test, gave error pre rev. 637 (in case an intercept is in the model): # pwaldtest(plm_unweighted_re, vcov = clubSandwich::vcovCR(plm_unweighted, type = "CR2"), test = "F") # # clubSandwich::coef_test(plm_unweighted, vcov = "CR0") # clubSandwich::coef_test(plm_unweighted, vcov = "CR0", test = "naive-t") # clubSandwich::coef_test(plm_unweighted, vcov = "CR0", test = "saddlepoint") # # clubSandwich::coef_test(plm_unweighted, vcov = vcov_club_id, test = "naive-t") # clubSandwich::coef_test(plm_unweighted, vcov = "CR0", test = "All") # # # library(lmtest) # # lmtest::coeftest(plm_unweighted, vcov. = vcov_plm_id) # # lmtest::coeftest(plm_unweighted, vcov. = vcov_club_id) # # lmtest::coeftest(plm_unweighted, vcov. = function(x) vcovCR(x, type = "CR0", cluster = "individual")) # # lmtest::coeftest(plm_unweighted, vcov. = vcovCR)# does not work due to missing default values # } ### multiwayvcov # library(multiwayvcov) # lm_mod <- lm(mrate ~ legal + beertaxa + factor(state), data = MV_deaths) # summary(lm_mod) # vcov_multiwayvcov <- cluster.vcov(lm_mod, ~ year) # lmtest::coeftest(lm_mod, vcov_multiwayvcov) # str(vcov_multiwayvcov) # no additional information to infer vcov comes from multiwayvcov or about cluster variable # class(vcov_multiwayvcov) # on plm model # Error in UseMethod("estfun") : # no applicable method for 'estfun' applied to an object of class "c('plm', 'panelmodel')" ##### lfe ## robust # library(lfe) # data("Grunfeld", package = "plm") # mod_felm_firm_robust <- felm(inv ~ value + capital | firm | 0 | firm, data = Grunfeld) # str(mod_felm_firm_robust) # # mod_felm_firm_robust$clustervar # in est. object: clustervar holds the actual variable, not just a character # summary(mod_felm_firm_robust) # gives df adjusted F test for projected model # lfe:::vcov.felm(mod_felm_firm_robust) # attributes(lfe:::vcov.felm(mod_felm_firm_robust)) # no special attributes -> no information about clustering in vcov object # str(lfe:::vcov.felm(mod_felm_firm_robust)) plm/inst/tests/test_misc.Rout.save0000644000176200001440000017141714126044705017001 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Grunfeld", package = "plm") > Grunfeld_unbal <- Grunfeld[1:199, ] > # ercomp(plm(inv ~ value, Grunfeld, model = "random")) > # ercomp(plm(inv ~ value, Grunfeld, model = "random", random.method = "amemiya")) > # ercomp(plm(inv ~ value + capital, Grunfeld_unbal, model = "random")) > > > # these resulted in errors pre rev. 523 due to missing drop = FALSE > plm(inv ~ value, Grunfeld_unbal, model = "random", random.method = "amemiya") Model Formula: inv ~ value Coefficients: (Intercept) value -40.07159 0.17196 > plm(inv ~ value, Grunfeld_unbal, model = "random", random.method = "amemiya", effect = "time") Model Formula: inv ~ value Coefficients: (Intercept) value -6.26072 0.14083 > > > # test case for illegal pseries in pmerge's return value: > # up to rev. 675, pmerge produced a data.frame with a column declared to be a pseries but with lacking index, > # and there should be no 'pseries' in the resulting data.frame in first place > pGrunfeld <- pdata.frame(Grunfeld) > df_after_pmerge <- plm:::pmerge(pGrunfeld$inv, pGrunfeld$value) > if (inherits(df_after_pmerge$ind, "pseries") && is.null(attr(df_after_pmerge$ind, "index"))) stop("illegal pseries (no index) produced by pmerge") > if ("pseries" %in% unlist(lapply(df_after_pmerge, class))) stop("pmerge returned a column with pseries") > if (!"data.frame" == class(df_after_pmerge)) stop("pmerge did not return a pure data.frame according to class()") > > > # pmodel.response: test case for illegal pseries > form <- formula(inv ~ value + capital) > if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "pooling"))) stop("pmodel.response's return value is not a valid pseries") > if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "within"))) stop("pmodel.response's return value is not a valid pseries") > if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "Between"))) stop("pmodel.response's return value is not a valid pseries") > if (!is.pseries(pmodel.response(plm(form, data = pGrunfeld, model = "random")))) stop("pmodel.response's return value is not a valid pseries") > # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression > if (inherits(pmodel.response(form, data = pGrunfeld, model = "fd"), "pseries")) stop("pmodel.response's return value shall not be a pseries for fd models") > if (inherits(pmodel.response(form, data = pGrunfeld, model = "between"), "pseries")) stop("pmodel.response's return value shall not be a pseries for between models") > if (plm:::has.index(pmodel.response(plm(form, data = pGrunfeld, model = "fd")))) stop("pmodel.response's return value shall not have an index for fd models") > if (plm:::has.index(pmodel.response(plm(form, data = pGrunfeld, model = "between")))) stop("pmodel.response's return value shall not have an index for between models") > > > # residuals.plm: test case for illegal pseries > if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "pooling")))) stop("residuals.plm's return value is not a valid pseries") > if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "within")))) stop("residuals.plm's return value is not a valid pseries") > if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "random")))) stop("residuals.plm's return value is not a valid pseries") > # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression > if (inherits(residuals(plm(form, data = pGrunfeld, model = "fd")), "pseries")) stop("residuals.plm's return value shall not be a pseries for fd models") > if (inherits(residuals(plm(form, data = pGrunfeld, model = "between")), "pseries")) stop("residuals.plm's return value shall not be a pseries for between models") > if (plm:::has.index(residuals(plm(form, data = pGrunfeld, model = "fd")))) stop("residuals.plm's return value shall not have an index for fd models") > if (plm:::has.index(residuals(plm(form, data = pGrunfeld, model = "between")))) stop("residuals.plm's return value shall not have an index for between models") > > > # fitted.plm: test case for illegal pseries > if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "pooling")))) stop("fitted.plm's return value is not a valid pseries") > if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "within")))) stop("fitted.plm's return value is not a valid pseries") > if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "random")))) stop("fitted.plm's return value is not a valid pseries") > # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression > if (inherits(fitted(plm(form, data = pGrunfeld, model = "fd")), "pseries")) stop("fitted.plm's return value shall not be a pseries for fd models") > if (inherits(fitted(plm(form, data = pGrunfeld, model = "between")), "pseries")) stop("fitted.plm's return value shall not be a pseries for between models") > if (plm:::has.index(fitted(plm(form, data = pGrunfeld, model = "fd")))) stop("fitted.plm's return value shall not have an index for fd models") > if (plm:::has.index(fitted(plm(form, data = pGrunfeld, model = "between")))) stop("fitted.plm's return value shall not have an index for between models") > > ## WLS > p <- plm(inv ~ value, Grunfeld, model = "pooling") > pwls <- plm(inv ~ value + capital, data = Grunfeld, weights = Grunfeld$capital, model = "pooling") > > if (!is.null(p$weights)) stop("element 'weights' in plm object albeit it should not be there") > if (is.null(pwls$weights)) stop("element 'weights' missing in plm object") > > ## aneweytest > data("RiceFarms", package = "plm") > aneweytest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") Angrist and Newey's test of within model data: log(goutput) ~ log(seed) + log(totlabor) + log(size) chisq = 141.89, df = 87, p-value = 0.0001851 alternative hypothesis: within specification does not apply > > ## piest > pirice <- piest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") > summary(pirice) Estimate Std. Error z-value Pr(>|z|) log(seed) 0.1096449 0.0157087 6.9799 2.954e-12 *** log(totlabor) 0.2261224 0.0168539 13.4166 < 2.2e-16 *** log(size) 0.6575833 0.0226042 29.0912 < 2.2e-16 *** log(seed).1 0.1168747 0.0282226 4.1412 3.455e-05 *** log(totlabor).1 0.0440505 0.0352284 1.2504 0.2111448 log(size).1 -0.2315263 0.0451630 -5.1265 2.952e-07 *** log(seed).2 -0.0190152 0.0119321 -1.5936 0.1110215 log(totlabor).2 -0.0261597 0.0290088 -0.9018 0.3671718 log(size).2 0.0314256 0.0233416 1.3463 0.1781949 log(seed).3 -0.0687868 0.0247259 -2.7820 0.0054030 ** log(totlabor).3 0.1221667 0.0294784 4.1443 3.409e-05 *** log(size).3 0.0487253 0.0238871 2.0398 0.0413683 * log(seed).4 0.0132149 0.0285666 0.4626 0.6436509 log(totlabor).4 0.0526304 0.0272371 1.9323 0.0533221 . log(size).4 -0.0046384 0.0443225 -0.1047 0.9166526 log(seed).5 -0.1105456 0.0291603 -3.7910 0.0001501 *** log(totlabor).5 -0.2277151 0.0390801 -5.8269 5.647e-09 *** log(size).5 0.2376872 0.0437637 5.4311 5.599e-08 *** log(seed).6 0.2556306 0.0364290 7.0172 2.263e-12 *** log(totlabor).6 0.1535560 0.0354287 4.3342 1.463e-05 *** log(size).6 -0.3550436 0.0422203 -8.4093 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Chamberlain's pi test data: log(goutput) ~ log(seed) + log(totlabor) + log(size) chisq = 113.72, df = 87, p-value = 0.02882 alternative hypothesis: within specification does not apply > > ## mtest > data("EmplUK", package = "plm") > ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps") > mtest(ar, order = 1) Arellano-Bond autocorrelation test of degree 1 data: log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + lag(log(capital), ... normal = -2.9998, p-value = 0.002702 alternative hypothesis: autocorrelation present > mtest(ar, order = 2, vcov = vcovHC) Arellano-Bond autocorrelation test of degree 2, vcov: vcovHC data: log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + lag(log(capital), ... normal = -0.36744, p-value = 0.7133 alternative hypothesis: autocorrelation present > > ## pcdtest > pcdtest(inv ~ value + capital, data = Grunfeld, + index = c("firm", "year")) Pesaran CD test for cross-sectional dependence in panels data: inv ~ value + capital z = 5.3401, p-value = 9.292e-08 alternative hypothesis: cross-sectional dependence > > ## test on two-way fixed effects homogeneous model > pcdtest(inv ~ value + capital, data = Grunfeld, model = "within", + effect = "twoways", index = c("firm", "year")) Pesaran CD test for cross-sectional dependence in panels data: inv ~ value + capital z = 0.1162, p-value = 0.9075 alternative hypothesis: cross-sectional dependence > > ## test on panelmodel object > g <- plm(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) > pcdtest(g) Pesaran CD test for cross-sectional dependence in panels data: inv ~ value + capital z = 4.6612, p-value = 3.144e-06 alternative hypothesis: cross-sectional dependence > > ## scaled LM test > pcdtest(g, test = "sclm") Scaled LM test for cross-sectional dependence in panels data: inv ~ value + capital z = 21.222, p-value < 2.2e-16 alternative hypothesis: cross-sectional dependence > > ## test on pseries > pGrunfeld <- pdata.frame(Grunfeld) > pcdtest(pGrunfeld$value) Pesaran CD test for cross-sectional dependence in panels data: pGrunfeld$value z = 13.843, p-value < 2.2e-16 alternative hypothesis: cross-sectional dependence > > ## local test > ## define neighbours for individual 2: 1, 3, 4, 5 in lower triangular matrix > w <- matrix(0, ncol= 10, nrow=10) > w[2,1] <- w[3,2] <- w[4,2] <- w[5,2] <- 1 > pcdtest(g, w = w) Pesaran CD test for local cross-sectional dependence in panels data: inv ~ value + capital z = -0.87759, p-value = 0.3802 alternative hypothesis: cross-sectional dependence > > > ## cortab > pGrunfeld <- pdata.frame(Grunfeld) > grp <- c(rep(1, 100), rep(2, 50), rep(3, 50)) # make 3 groups > cortab(pGrunfeld$value, grouping = grp, groupnames = c("A", "B", "C")) A B C A 0.5562310 NA NA B 0.5431652 0.5406152 NA C 0.3799585 0.2999645 -0.1665637 > > ## ercomp > data("Produc", package = "plm") > ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, + method = "walhus", effect = "time") var std.dev share idiosyncratic 0.0075942 0.0871449 0.985 time 0.0001192 0.0109175 0.015 theta: 0.2448 > z <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, random.method = "walhus", + effect = "time", model = "random") > ercomp(z) var std.dev share idiosyncratic 0.0075942 0.0871449 0.985 time 0.0001192 0.0109175 0.015 theta: 0.2448 > ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, + method = "amemiya", effect = "twoways") var std.dev share idiosyncratic 0.0011695 0.0341975 0.046 individual 0.0238635 0.1544780 0.929 time 0.0006534 0.0255613 0.025 theta: 0.9464 (id) 0.8104 (time) 0.8084 (total) > > ## index > data("Grunfeld", package = "plm") > Gr <- pdata.frame(Grunfeld, index = c("firm", "year")) > m <- plm(inv ~ value + capital, data = Gr) > index(Gr, "firm") [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 [26] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 [51] 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [76] 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [101] 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 7 7 7 7 7 [126] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 8 8 8 8 8 8 8 8 8 8 [151] 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 [176] 9 9 9 9 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > index(Gr, "time") [1] 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [16] 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 [31] 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 [46] 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 [61] 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [76] 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 [91] 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 [106] 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 [121] 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [136] 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 [151] 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1937 1938 1939 [166] 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 [181] 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [196] 1950 1951 1952 1953 1954 20 Levels: 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 ... 1954 > index(Gr$inv, c(2, 1)) year firm 1 1935 1 2 1936 1 3 1937 1 4 1938 1 5 1939 1 6 1940 1 7 1941 1 8 1942 1 9 1943 1 10 1944 1 11 1945 1 12 1946 1 13 1947 1 14 1948 1 15 1949 1 16 1950 1 17 1951 1 18 1952 1 19 1953 1 20 1954 1 21 1935 2 22 1936 2 23 1937 2 24 1938 2 25 1939 2 26 1940 2 27 1941 2 28 1942 2 29 1943 2 30 1944 2 31 1945 2 32 1946 2 33 1947 2 34 1948 2 35 1949 2 36 1950 2 37 1951 2 38 1952 2 39 1953 2 40 1954 2 41 1935 3 42 1936 3 43 1937 3 44 1938 3 45 1939 3 46 1940 3 47 1941 3 48 1942 3 49 1943 3 50 1944 3 51 1945 3 52 1946 3 53 1947 3 54 1948 3 55 1949 3 56 1950 3 57 1951 3 58 1952 3 59 1953 3 60 1954 3 61 1935 4 62 1936 4 63 1937 4 64 1938 4 65 1939 4 66 1940 4 67 1941 4 68 1942 4 69 1943 4 70 1944 4 71 1945 4 72 1946 4 73 1947 4 74 1948 4 75 1949 4 76 1950 4 77 1951 4 78 1952 4 79 1953 4 80 1954 4 81 1935 5 82 1936 5 83 1937 5 84 1938 5 85 1939 5 86 1940 5 87 1941 5 88 1942 5 89 1943 5 90 1944 5 91 1945 5 92 1946 5 93 1947 5 94 1948 5 95 1949 5 96 1950 5 97 1951 5 98 1952 5 99 1953 5 100 1954 5 101 1935 6 102 1936 6 103 1937 6 104 1938 6 105 1939 6 106 1940 6 107 1941 6 108 1942 6 109 1943 6 110 1944 6 111 1945 6 112 1946 6 113 1947 6 114 1948 6 115 1949 6 116 1950 6 117 1951 6 118 1952 6 119 1953 6 120 1954 6 121 1935 7 122 1936 7 123 1937 7 124 1938 7 125 1939 7 126 1940 7 127 1941 7 128 1942 7 129 1943 7 130 1944 7 131 1945 7 132 1946 7 133 1947 7 134 1948 7 135 1949 7 136 1950 7 137 1951 7 138 1952 7 139 1953 7 140 1954 7 141 1935 8 142 1936 8 143 1937 8 144 1938 8 145 1939 8 146 1940 8 147 1941 8 148 1942 8 149 1943 8 150 1944 8 151 1945 8 152 1946 8 153 1947 8 154 1948 8 155 1949 8 156 1950 8 157 1951 8 158 1952 8 159 1953 8 160 1954 8 161 1935 9 162 1936 9 163 1937 9 164 1938 9 165 1939 9 166 1940 9 167 1941 9 168 1942 9 169 1943 9 170 1944 9 171 1945 9 172 1946 9 173 1947 9 174 1948 9 175 1949 9 176 1950 9 177 1951 9 178 1952 9 179 1953 9 180 1954 9 181 1935 10 182 1936 10 183 1937 10 184 1938 10 185 1939 10 186 1940 10 187 1941 10 188 1942 10 189 1943 10 190 1944 10 191 1945 10 192 1946 10 193 1947 10 194 1948 10 195 1949 10 196 1950 10 197 1951 10 198 1952 10 199 1953 10 200 1954 10 > index(m, "id") [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 [26] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 [51] 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [76] 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [101] 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 7 7 7 7 7 [126] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 8 8 8 8 8 8 8 8 8 8 [151] 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 [176] 9 9 9 9 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > > # with additional group index > data("Produc", package = "plm") > pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) > index(pProduc, 3) [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [38] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [75] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 [149] 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [186] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [223] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [260] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [297] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [334] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 [371] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [408] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [445] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [482] 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [519] 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [556] 6 6 6 6 6 6 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [593] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [630] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [667] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [704] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [741] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9 9 9 [778] 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 [815] 9 9 Levels: 1 2 3 4 5 6 7 8 9 > index(pProduc, "region") [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [38] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [75] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 [149] 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [186] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [223] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [260] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [297] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [334] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 [371] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [408] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [445] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [482] 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [519] 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [556] 6 6 6 6 6 6 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [593] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [630] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [667] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [704] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [741] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9 9 9 [778] 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 [815] 9 9 Levels: 1 2 3 4 5 6 7 8 9 > index(pProduc, "group") [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [38] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 [75] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 [149] 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [186] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 [223] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [260] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [297] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 [334] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 [371] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [408] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [445] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 [482] 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [519] 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 [556] 6 6 6 6 6 6 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [593] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 [630] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [667] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [704] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 [741] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9 9 9 [778] 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 [815] 9 9 Levels: 1 2 3 4 5 6 7 8 9 > > ## is.pbalanced > Grunfeld_missing_period <- Grunfeld[-2, ] > is.pbalanced(Grunfeld_missing_period) # check if balanced: FALSE [1] FALSE > pdim(Grunfeld_missing_period)$balanced # same [1] FALSE > pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) > is.pbalanced(Grunfeld_missing_period) [1] FALSE > is.pbalanced(pGrunfeld_missing_period$inv) [1] FALSE > > ## is.pconsecutive > is.pconsecutive(Grunfeld) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld, index=c("firm", "year")) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # delete 2nd row (2nd time period for first individual) > # -> non consecutive > Grunfeld_missing_period <- Grunfeld[-2, ] > is.pconsecutive(Grunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > all(is.pconsecutive(Grunfeld_missing_period)) # FALSE [1] FALSE > > # delete rows 1 and 2 (1st and 2nd time period for first individual) > # -> consecutive > Grunfeld_missing_period_other <- Grunfeld[-c(1,2), ] > is.pconsecutive(Grunfeld_missing_period_other) # all TRUE 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # delete year 1937 (3rd period) for _all_ individuals > Grunfeld_wo_1937 <- Grunfeld[Grunfeld$year != 1937, ] > is.pconsecutive(Grunfeld_wo_1937) # all FALSE 1 2 3 4 5 6 7 8 9 10 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE > > # pdata.frame interface > pGrunfeld <- pdata.frame(Grunfeld) > pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) > is.pconsecutive(pGrunfeld) # all TRUE 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(pGrunfeld_missing_period) # first FALSE, others TRUE 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # panelmodel interface (first, estimate some models) > mod_pGrunfeld <- plm(inv ~ value + capital, data = Grunfeld) > mod_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = Grunfeld_missing_period) > > is.pconsecutive(mod_pGrunfeld) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(mod_pGrunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > nobs(mod_pGrunfeld) # 200 [1] 200 > nobs(mod_pGrunfeld_missing_period) # 199 [1] 199 > > # pseries interface > pinv <- pGrunfeld$inv > pinv_missing_period <- pGrunfeld_missing_period$inv > > is.pconsecutive(pinv) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(pinv_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # default method for arbitrary vectors or NULL > inv <- Grunfeld$inv > inv_missing_period <- Grunfeld_missing_period$inv > is.pconsecutive(inv, id = Grunfeld$firm, time = Grunfeld$year) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(inv_missing_period, id = Grunfeld_missing_period$firm, + time = Grunfeld_missing_period$year) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # only id and time are needed for evaluation > is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > ## is.pseries > Em <- pdata.frame(EmplUK) > z <- Em$output > > class(z) # pseries as indicated by class [1] "pseries" "numeric" > is.pseries(z) # and confirmed by check [1] TRUE > > # destroy index of pseries and re-check > attr(z, "index") <- NA > is.pseries(z) # now FALSE [1] FALSE > > ## model.frame, model.matrix > pGrunfeld <- pdata.frame(Grunfeld) > > # then make a model frame from a formula and a pdata.frame > form <- inv ~ value > mf <- model.frame(pGrunfeld, form) > > # then construct the (transformed) model matrix (design matrix) > # from model frame > modmat <- model.matrix(mf, model = "within") > > ## retrieve model frame and model matrix from an estimated plm object > fe_model <- plm(form, data = pGrunfeld, model = "within") > model.frame(fe_model) inv value 1-1935 317.60 3078.50 1-1936 391.80 4661.70 1-1937 410.60 5387.10 1-1938 257.70 2792.20 1-1939 330.80 4313.20 1-1940 461.20 4643.90 1-1941 512.00 4551.20 1-1942 448.00 3244.10 1-1943 499.60 4053.70 1-1944 547.50 4379.30 1-1945 561.20 4840.90 1-1946 688.10 4900.90 1-1947 568.90 3526.50 1-1948 529.20 3254.70 1-1949 555.10 3700.20 1-1950 642.90 3755.60 1-1951 755.90 4833.00 1-1952 891.20 4924.90 1-1953 1304.40 6241.70 1-1954 1486.70 5593.60 2-1935 209.90 1362.40 2-1936 355.30 1807.10 2-1937 469.90 2676.30 2-1938 262.30 1801.90 2-1939 230.40 1957.30 2-1940 361.60 2202.90 2-1941 472.80 2380.50 2-1942 445.60 2168.60 2-1943 361.60 1985.10 2-1944 288.20 1813.90 2-1945 258.70 1850.20 2-1946 420.30 2067.70 2-1947 420.50 1796.70 2-1948 494.50 1625.80 2-1949 405.10 1667.00 2-1950 418.80 1677.40 2-1951 588.20 2289.50 2-1952 645.50 2159.40 2-1953 641.00 2031.30 2-1954 459.30 2115.50 3-1935 33.10 1170.60 3-1936 45.00 2015.80 3-1937 77.20 2803.30 3-1938 44.60 2039.70 3-1939 48.10 2256.20 3-1940 74.40 2132.20 3-1941 113.00 1834.10 3-1942 91.90 1588.00 3-1943 61.30 1749.40 3-1944 56.80 1687.20 3-1945 93.60 2007.70 3-1946 159.90 2208.30 3-1947 147.20 1656.70 3-1948 146.30 1604.40 3-1949 98.30 1431.80 3-1950 93.50 1610.50 3-1951 135.20 1819.40 3-1952 157.30 2079.70 3-1953 179.50 2371.60 3-1954 189.60 2759.90 4-1935 40.29 417.50 4-1936 72.76 837.80 4-1937 66.26 883.90 4-1938 51.60 437.90 4-1939 52.41 679.70 4-1940 69.41 727.80 4-1941 68.35 643.60 4-1942 46.80 410.90 4-1943 47.40 588.40 4-1944 59.57 698.40 4-1945 88.78 846.40 4-1946 74.12 893.80 4-1947 62.68 579.00 4-1948 89.36 694.60 4-1949 78.98 590.30 4-1950 100.66 693.50 4-1951 160.62 809.00 4-1952 145.00 727.00 4-1953 174.93 1001.50 4-1954 172.49 703.20 5-1935 39.68 157.70 5-1936 50.73 167.90 5-1937 74.24 192.90 5-1938 53.51 156.70 5-1939 42.65 191.40 5-1940 46.48 185.50 5-1941 61.40 199.60 5-1942 39.67 189.50 5-1943 62.24 151.20 5-1944 52.32 187.70 5-1945 63.21 214.70 5-1946 59.37 232.90 5-1947 58.02 249.00 5-1948 70.34 224.50 5-1949 67.42 237.30 5-1950 55.74 240.10 5-1951 80.30 327.30 5-1952 85.40 359.40 5-1953 91.90 398.40 5-1954 81.43 365.70 6-1935 20.36 197.00 6-1936 25.98 210.30 6-1937 25.94 223.10 6-1938 27.53 216.70 6-1939 24.60 286.40 6-1940 28.54 298.00 6-1941 43.41 276.90 6-1942 42.81 272.60 6-1943 27.84 287.40 6-1944 32.60 330.30 6-1945 39.03 324.40 6-1946 50.17 401.90 6-1947 51.85 407.40 6-1948 64.03 409.20 6-1949 68.16 482.20 6-1950 77.34 673.80 6-1951 95.30 676.90 6-1952 99.49 702.00 6-1953 127.52 793.50 6-1954 135.72 927.30 7-1935 24.43 138.00 7-1936 23.21 200.10 7-1937 32.78 210.10 7-1938 32.54 161.20 7-1939 26.65 161.70 7-1940 33.71 145.10 7-1941 43.50 110.60 7-1942 34.46 98.10 7-1943 44.28 108.80 7-1944 70.80 118.20 7-1945 44.12 126.50 7-1946 48.98 156.70 7-1947 48.51 119.40 7-1948 50.00 129.10 7-1949 50.59 134.80 7-1950 42.53 140.80 7-1951 64.77 179.00 7-1952 72.68 178.10 7-1953 73.86 186.80 7-1954 89.51 192.70 8-1935 12.93 191.50 8-1936 25.90 516.00 8-1937 35.05 729.00 8-1938 22.89 560.40 8-1939 18.84 519.90 8-1940 28.57 628.50 8-1941 48.51 537.10 8-1942 43.34 561.20 8-1943 37.02 617.20 8-1944 37.81 626.70 8-1945 39.27 737.20 8-1946 53.46 760.50 8-1947 55.56 581.40 8-1948 49.56 662.30 8-1949 32.04 583.80 8-1950 32.24 635.20 8-1951 54.38 723.80 8-1952 71.78 864.10 8-1953 90.08 1193.50 8-1954 68.60 1188.90 9-1935 26.63 290.60 9-1936 23.39 291.10 9-1937 30.65 335.00 9-1938 20.89 246.00 9-1939 28.78 356.20 9-1940 26.93 289.80 9-1941 32.08 268.20 9-1942 32.21 213.30 9-1943 35.69 348.20 9-1944 62.47 374.20 9-1945 52.32 387.20 9-1946 56.95 347.40 9-1947 54.32 291.90 9-1948 40.53 297.20 9-1949 32.54 276.90 9-1950 43.48 274.60 9-1951 56.49 339.90 9-1952 65.98 474.80 9-1953 66.11 496.00 9-1954 49.34 474.50 10-1935 2.54 70.91 10-1936 2.00 87.94 10-1937 2.19 82.20 10-1938 1.99 58.72 10-1939 2.03 80.54 10-1940 1.81 86.47 10-1941 2.14 77.68 10-1942 1.86 62.16 10-1943 0.93 62.24 10-1944 1.18 61.82 10-1945 1.36 65.85 10-1946 2.24 69.54 10-1947 3.81 64.97 10-1948 5.66 68.00 10-1949 4.21 71.24 10-1950 3.42 69.05 10-1951 4.67 83.04 10-1952 6.00 74.42 10-1953 6.53 63.51 10-1954 5.12 58.12 > model.matrix(fe_model) value 1-1935 -1255.345 1-1936 327.855 1-1937 1053.255 1-1938 -1541.645 1-1939 -20.645 1-1940 310.055 1-1941 217.355 1-1942 -1089.745 1-1943 -280.145 1-1944 45.455 1-1945 507.055 1-1946 567.055 1-1947 -807.345 1-1948 -1079.145 1-1949 -633.645 1-1950 -578.245 1-1951 499.155 1-1952 591.055 1-1953 1907.855 1-1954 1259.755 2-1935 -609.425 2-1936 -164.725 2-1937 704.475 2-1938 -169.925 2-1939 -14.525 2-1940 231.075 2-1941 408.675 2-1942 196.775 2-1943 13.275 2-1944 -157.925 2-1945 -121.625 2-1946 95.875 2-1947 -175.125 2-1948 -346.025 2-1949 -304.825 2-1950 -294.425 2-1951 317.675 2-1952 187.575 2-1953 59.475 2-1954 143.675 3-1935 -770.725 3-1936 74.475 3-1937 861.975 3-1938 98.375 3-1939 314.875 3-1940 190.875 3-1941 -107.225 3-1942 -353.325 3-1943 -191.925 3-1944 -254.125 3-1945 66.375 3-1946 266.975 3-1947 -284.625 3-1948 -336.925 3-1949 -509.525 3-1950 -330.825 3-1951 -121.925 3-1952 138.375 3-1953 430.275 3-1954 818.575 4-1935 -275.710 4-1936 144.590 4-1937 190.690 4-1938 -255.310 4-1939 -13.510 4-1940 34.590 4-1941 -49.610 4-1942 -282.310 4-1943 -104.810 4-1944 5.190 4-1945 153.190 4-1946 200.590 4-1947 -114.210 4-1948 1.390 4-1949 -102.910 4-1950 0.290 4-1951 115.790 4-1952 33.790 4-1953 308.290 4-1954 9.990 5-1935 -73.770 5-1936 -63.570 5-1937 -38.570 5-1938 -74.770 5-1939 -40.070 5-1940 -45.970 5-1941 -31.870 5-1942 -41.970 5-1943 -80.270 5-1944 -43.770 5-1945 -16.770 5-1946 1.430 5-1947 17.530 5-1948 -6.970 5-1949 5.830 5-1950 8.630 5-1951 95.830 5-1952 127.930 5-1953 166.930 5-1954 134.230 6-1935 -222.865 6-1936 -209.565 6-1937 -196.765 6-1938 -203.165 6-1939 -133.465 6-1940 -121.865 6-1941 -142.965 6-1942 -147.265 6-1943 -132.465 6-1944 -89.565 6-1945 -95.465 6-1946 -17.965 6-1947 -12.465 6-1948 -10.665 6-1949 62.335 6-1950 253.935 6-1951 257.035 6-1952 282.135 6-1953 373.635 6-1954 507.435 7-1935 -11.790 7-1936 50.310 7-1937 60.310 7-1938 11.410 7-1939 11.910 7-1940 -4.690 7-1941 -39.190 7-1942 -51.690 7-1943 -40.990 7-1944 -31.590 7-1945 -23.290 7-1946 6.910 7-1947 -30.390 7-1948 -20.690 7-1949 -14.990 7-1950 -8.990 7-1951 29.210 7-1952 28.310 7-1953 37.010 7-1954 42.910 8-1935 -479.410 8-1936 -154.910 8-1937 58.090 8-1938 -110.510 8-1939 -151.010 8-1940 -42.410 8-1941 -133.810 8-1942 -109.710 8-1943 -53.710 8-1944 -44.210 8-1945 66.290 8-1946 89.590 8-1947 -89.510 8-1948 -8.610 8-1949 -87.110 8-1950 -35.710 8-1951 52.890 8-1952 193.190 8-1953 522.590 8-1954 517.990 9-1935 -43.050 9-1936 -42.550 9-1937 1.350 9-1938 -87.650 9-1939 22.550 9-1940 -43.850 9-1941 -65.450 9-1942 -120.350 9-1943 14.550 9-1944 40.550 9-1945 53.550 9-1946 13.750 9-1947 -41.750 9-1948 -36.450 9-1949 -56.750 9-1950 -59.050 9-1951 6.250 9-1952 141.150 9-1953 162.350 9-1954 140.850 10-1935 -0.011 10-1936 17.019 10-1937 11.279 10-1938 -12.201 10-1939 9.619 10-1940 15.549 10-1941 6.759 10-1942 -8.761 10-1943 -8.681 10-1944 -9.101 10-1945 -5.071 10-1946 -1.381 10-1947 -5.951 10-1948 -2.921 10-1949 0.319 10-1950 -1.871 10-1951 12.119 10-1952 3.499 10-1953 -7.411 10-1954 -12.801 attr(,"assign") [1] 0 1 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > > # same as constructed before > all.equal(mf, model.frame(fe_model), check.attributes = FALSE) # TRUE [1] TRUE > all.equal(modmat, model.matrix(fe_model), check.attributes = FALSE) # TRUE [1] TRUE > > > ## pmodel.response > > form <- inv ~ value + capital > mf <- model.frame(pGrunfeld, form) > # construct (transformed) response of the within model > resp <- pmodel.response(form, data = mf, model = "within", effect = "individual") > # retrieve (transformed) response directly from model frame > resp_mf <- pmodel.response(mf, model = "within", effect = "individual") > > # retrieve (transformed) response from a plm object, i.e., an estimated model > fe_model <- plm(form, data = pGrunfeld, model = "within") > pmodel.response(fe_model) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 -290.4200 -216.2200 -197.4200 -350.3200 -277.2200 -146.8200 -96.0200 -160.0200 1-1943 1-1944 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 -108.4200 -60.5200 -46.8200 80.0800 -39.1200 -78.8200 -52.9200 34.8800 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 2-1938 147.8800 283.1800 696.3800 878.6800 -200.5750 -55.1750 59.4250 -148.1750 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 2-1945 2-1946 -180.0750 -48.8750 62.3250 35.1250 -48.8750 -122.2750 -151.7750 9.8250 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 10.0250 84.0250 -5.3750 8.3250 177.7250 235.0250 230.5250 48.8250 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 -69.1900 -57.2900 -25.0900 -57.6900 -54.1900 -27.8900 10.7100 -10.3900 3-1943 3-1944 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 -40.9900 -45.4900 -8.6900 57.6100 44.9100 44.0100 -3.9900 -8.7900 3-1951 3-1952 3-1953 3-1954 4-1935 4-1936 4-1937 4-1938 32.9100 55.0100 77.2100 87.3100 -45.8335 -13.3635 -19.8635 -34.5235 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4-1945 4-1946 -33.7135 -16.7135 -17.7735 -39.3235 -38.7235 -26.5535 2.6565 -12.0035 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 -23.4435 3.2365 -7.1435 14.5365 74.4965 58.8765 88.8065 86.3665 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 -22.1225 -11.0725 12.4375 -8.2925 -19.1525 -15.3225 -0.4025 -22.1325 5-1943 5-1944 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 0.4375 -9.4825 1.4075 -2.4325 -3.7825 8.5375 5.6175 -6.0625 5-1951 5-1952 5-1953 5-1954 6-1935 6-1936 6-1937 6-1938 18.4975 23.5975 30.0975 19.6275 -35.0510 -29.4310 -29.4710 -27.8810 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 6-1945 6-1946 -30.8110 -26.8710 -12.0010 -12.6010 -27.5710 -22.8110 -16.3810 -5.2410 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 -3.5610 8.6190 12.7490 21.9290 39.8890 44.0790 72.1090 80.3090 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 -23.1655 -24.3855 -14.8155 -15.0555 -20.9455 -13.8855 -4.0955 -13.1355 7-1943 7-1944 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 -3.3155 23.2045 -3.4755 1.3845 0.9145 2.4045 2.9945 -5.0655 7-1951 7-1952 7-1953 7-1954 8-1935 8-1936 8-1937 8-1938 17.1745 25.0845 26.2645 41.9145 -29.9615 -16.9915 -7.8415 -20.0015 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 8-1945 8-1946 -24.0515 -14.3215 5.6185 0.4485 -5.8715 -5.0815 -3.6215 10.5685 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 12.6685 6.6685 -10.8515 -10.6515 11.4885 28.8885 47.1885 25.7085 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 -15.2590 -18.4990 -11.2390 -20.9990 -13.1090 -14.9590 -9.8090 -9.6790 9-1943 9-1944 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 -6.1990 20.5810 10.4310 15.0610 12.4310 -1.3590 -9.3490 1.5910 9-1951 9-1952 9-1953 9-1954 10-1935 10-1936 10-1937 10-1938 14.6010 24.0910 24.2210 7.4510 -0.5445 -1.0845 -0.8945 -1.0945 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 10-1945 10-1946 -1.0545 -1.2745 -0.9445 -1.2245 -2.1545 -1.9045 -1.7245 -0.8445 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 0.7255 2.5755 1.1255 0.3355 1.5855 2.9155 3.4455 2.0355 > > # same as constructed before > all.equal(resp, pmodel.response(fe_model), check.attributes = FALSE) # TRUE [1] TRUE > > > > ## nobs > z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, + model="random", subset = gsp > 5000) > > nobs(z) # total observations used in estimation [1] 808 > pdim(z)$nT$N # same information [1] 808 > pdim(z) # more information about the dimensions (no. of individuals and time periods) Unbalanced Panel: n = 48, T = 9-17, N = 808 > > # illustrate difference between nobs and pdim for first-difference model > data("Grunfeld", package = "plm") > fdmod <- plm(inv ~ value + capital, data = Grunfeld, model = "fd") > nobs(fdmod) # 190 [1] 190 > pdim(fdmod)$nT$N # 200 [1] 200 > > ## pgmm > ## Arellano and Bond (1991), table 4 col. b > z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps") > summary(z1, robust = FALSE) Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.6190677 -0.0255683 0.0000000 -0.0001339 0.0332013 0.6410272 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.474151 0.085303 5.5584 2.722e-08 *** lag(log(emp), 1:2)2 -0.052967 0.027284 -1.9413 0.0522200 . lag(log(wage), 0:1)0 -0.513205 0.049345 -10.4003 < 2.2e-16 *** lag(log(wage), 0:1)1 0.224640 0.080063 2.8058 0.0050192 ** log(capital) 0.292723 0.039463 7.4177 1.191e-13 *** lag(log(output), 0:1)0 0.609775 0.108524 5.6188 1.923e-08 *** lag(log(output), 0:1)1 -0.446373 0.124815 -3.5763 0.0003485 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 30.11247 (p-value = 0.22011) Autocorrelation test (1): normal = -2.427829 (p-value = 0.01519) Autocorrelation test (2): normal = -0.3325401 (p-value = 0.73948) Wald test for coefficients: chisq(7) = 371.9877 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 26.9045 (p-value = 0.0001509) > > ## Blundell and Bond (1998) table 4 (cf. DPD for OX p. 12 col. 4) > z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + + lag(log(capital), 0:1) | lag(log(emp), 2:99) + + lag(log(wage), 2:99) + lag(log(capital), 2:99), + data = EmplUK, effect = "twoways", model = "onestep", + transformation = "ld") > summary(z2, robust = TRUE) Twoways effects One-step model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.7530341 -0.0369030 0.0000000 0.0002882 0.0466069 0.6001503 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.935605 0.026295 35.5810 < 2.2e-16 *** lag(log(wage), 0:1)0 -0.630976 0.118054 -5.3448 9.050e-08 *** lag(log(wage), 0:1)1 0.482620 0.136887 3.5257 0.0004224 *** lag(log(capital), 0:1)0 0.483930 0.053867 8.9838 < 2.2e-16 *** lag(log(capital), 0:1)1 -0.424393 0.058479 -7.2572 3.952e-13 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(100) = 118.763 (p-value = 0.097096) Autocorrelation test (1): normal = -4.808434 (p-value = 1.5212e-06) Autocorrelation test (2): normal = -0.2800133 (p-value = 0.77947) Wald test for coefficients: chisq(5) = 11174.82 (p-value = < 2.22e-16) Wald test for time dummies: chisq(7) = 14.71138 (p-value = 0.039882) > > # Same with the old formula or dynformula interface > # Arellano and Bond (1991), table 4, col. b > z1 <- pgmm(log(emp) ~ log(wage) + log(capital) + log(output), + lag.form = list(2,1,0,1), data = EmplUK, + effect = "twoways", model = "twosteps", + gmm.inst = ~log(emp), lag.gmm = list(c(2,99))) Warning messages: 1: use of 'dynformula()' is deprecated, use a multi-part formula instead 2: use of 'dynformula()' is deprecated, use a multi-part formula instead > summary(z1, robust = FALSE) Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ log(wage) + log(capital) + log(output), data = EmplUK, effect = "twoways", model = "twosteps", lag.form = list(2, 1, 0, 1), gmm.inst = ~log(emp), lag.gmm = list(c(2, 99))) Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.6190677 -0.0255683 0.0000000 -0.0001339 0.0332013 0.6410272 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), c(1, 2))1 0.474151 0.085303 5.5584 2.722e-08 *** lag(log(emp), c(1, 2))2 -0.052967 0.027284 -1.9413 0.0522200 . log(wage) -0.513205 0.049345 -10.4003 < 2.2e-16 *** lag(log(wage), 1) 0.224640 0.080063 2.8058 0.0050192 ** log(capital) 0.292723 0.039463 7.4177 1.191e-13 *** log(output) 0.609775 0.108524 5.6188 1.923e-08 *** lag(log(output), 1) -0.446373 0.124815 -3.5763 0.0003485 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 30.11247 (p-value = 0.22011) Autocorrelation test (1): normal = -2.427829 (p-value = 0.01519) Autocorrelation test (2): normal = -0.3325401 (p-value = 0.73948) Wald test for coefficients: chisq(7) = 371.9877 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 26.9045 (p-value = 0.0001509) > > ## Blundell and Bond (1998) table 4 (cf DPD for OX p. 12 col. 4) > z2 <- pgmm(dynformula(log(emp) ~ log(wage) + log(capital), list(1,1,1)), + data = EmplUK, effect = "twoways", model = "onestep", + gmm.inst = ~log(emp) + log(wage) + log(capital), + lag.gmm = c(2,99), transformation = "ld") Warning messages: 1: use of 'dynformula()' is deprecated, use a multi-part formula instead 2: use of 'dynformula()' is deprecated, use a multi-part formula instead > summary(z2, robust = TRUE) Twoways effects One-step model System GMM Call: pgmm(formula = dynformula(log(emp) ~ log(wage) + log(capital), list(1, 1, 1)), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld", gmm.inst = ~log(emp) + log(wage) + log(capital), lag.gmm = c(2, 99)) Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.7530341 -0.0369030 0.0000000 0.0002882 0.0466069 0.6001503 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.935605 0.026295 35.5810 < 2.2e-16 *** log(wage) -0.630976 0.118054 -5.3448 9.050e-08 *** lag(log(wage), 1) 0.482620 0.136887 3.5257 0.0004224 *** log(capital) 0.483930 0.053867 8.9838 < 2.2e-16 *** lag(log(capital), 1) -0.424393 0.058479 -7.2572 3.952e-13 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(100) = 118.763 (p-value = 0.097096) Autocorrelation test (1): normal = -4.808434 (p-value = 1.5212e-06) Autocorrelation test (2): normal = -0.2800133 (p-value = 0.77947) Wald test for coefficients: chisq(5) = 11174.82 (p-value = < 2.22e-16) Wald test for time dummies: chisq(7) = 14.71138 (p-value = 0.039882) > > ## pht (deprecated) > # deprecated way with pht() for HT > data("Wages", package = "plm") > ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, + data = Wages, model = "ht", index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(ht) Oneway (individual) effect Hausman-Taylor Model (Hausman-Taylor estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "ht", index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9193535 -0.0707404 0.0065708 0.0796568 2.0250882 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9127e+00 2.8365e-01 10.2687 < 2.2e-16 *** wks 8.3740e-04 5.9973e-04 1.3963 0.16263 southyes 7.4398e-03 3.1955e-02 0.2328 0.81590 smsayes -4.1833e-02 1.8958e-02 -2.2066 0.02734 * marriedyes -2.9851e-02 1.8980e-02 -1.5728 0.11578 exp 1.1313e-01 2.4710e-03 45.7851 < 2.2e-16 *** I(exp^2) -4.1886e-04 5.4598e-05 -7.6718 1.696e-14 *** bluecolyes -2.0705e-02 1.3781e-02 -1.5024 0.13299 ind 1.3604e-02 1.5237e-02 0.8928 0.37196 unionyes 3.2771e-02 1.4908e-02 2.1982 0.02794 * sexfemale -1.3092e-01 1.2666e-01 -1.0337 0.30129 blackyes -2.8575e-01 1.5570e-01 -1.8352 0.06647 . ed 1.3794e-01 2.1248e-02 6.4919 8.474e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.947 Chisq: 6891.87 on 12 DF, p-value: < 2.22e-16 > > am <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, + data = Wages, model = "am", index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(am) Oneway (individual) effect Hausman-Taylor Model (Amemiya-MaCurdy estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "am", index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9192710 -0.0705595 0.0065602 0.0794836 2.0248644 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9273e+00 2.7513e-01 10.6399 < 2.2e-16 *** wks 8.3806e-04 5.9945e-04 1.3980 0.16210 southyes 7.2818e-03 3.1936e-02 0.2280 0.81964 smsayes -4.1951e-02 1.8947e-02 -2.2141 0.02682 * marriedyes -3.0089e-02 1.8967e-02 -1.5864 0.11266 exp 1.1297e-01 2.4688e-03 45.7584 < 2.2e-16 *** I(exp^2) -4.2140e-04 5.4554e-05 -7.7244 1.124e-14 *** bluecolyes -2.0850e-02 1.3765e-02 -1.5147 0.12986 ind 1.3629e-02 1.5229e-02 0.8949 0.37082 unionyes 3.2475e-02 1.4894e-02 2.1804 0.02922 * sexfemale -1.3201e-01 1.2660e-01 -1.0427 0.29709 blackyes -2.8590e-01 1.5549e-01 -1.8388 0.06595 . ed 1.3720e-01 2.0570e-02 6.6703 2.553e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.871 Chisq: 6879.2 on 12 DF, p-value: < 2.22e-16 > > ## pldv > pder.avail <- if (!requireNamespace("pder", quietly = TRUE)) FALSE else TRUE > if(pder.avail) { + data("Donors", package = "pder") + pDonors <- pdata.frame(Donors, index = "id") + modA <- pldv(donation ~ treatment + prcontr, data = pDonors, + model = "random", method = "bfgs") + summary(modA) + modB <- pldv(donation ~ treatment * prcontr - prcontr, data = pDonors, + model = "random", method = "bfgs") + summary(modB) + invisible(NULL) + } There were 50 or more warnings (use warnings() to see the first 50) > > ## pwartest > pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK) Wooldridge's test for serial correlation in FE panels data: plm.model F = 312.3, df1 = 1, df2 = 889, p-value < 2.2e-16 alternative hypothesis: serial correlation > pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3") Wooldridge's test for serial correlation in FE panels data: plm.model F = 305.17, df1 = 1, df2 = 889, p-value < 2.2e-16 alternative hypothesis: serial correlation > > ## pwfdtest > pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK) Wooldridge's first-difference test for serial correlation in panels data: plm.model F = 1.5251, df1 = 1, df2 = 749, p-value = 0.2172 alternative hypothesis: serial correlation in differenced errors > pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, h0 = "fe") Wooldridge's first-difference test for serial correlation in panels data: plm.model F = 131.55, df1 = 1, df2 = 749, p-value < 2.2e-16 alternative hypothesis: serial correlation in original errors > pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3", h0 = "fe") Wooldridge's first-difference test for serial correlation in panels data: plm.model F = 123.79, df1 = 1, df2 = 749, p-value < 2.2e-16 alternative hypothesis: serial correlation in original errors > > mod <- plm(log(emp) ~ log(wage) + log(capital), data = EmplUK, model = "fd") > pwfdtest(mod) Wooldridge's first-difference test for serial correlation in panels data: mod F = 1.5251, df1 = 1, df2 = 749, p-value = 0.2172 alternative hypothesis: serial correlation in differenced errors > pwfdtest(mod, h0 = "fe") Wooldridge's first-difference test for serial correlation in panels data: mod F = 131.55, df1 = 1, df2 = 749, p-value < 2.2e-16 alternative hypothesis: serial correlation in original errors > pwfdtest(mod, type = "HC3", h0 = "fe") Wooldridge's first-difference test for serial correlation in panels data: mod F = 123.79, df1 = 1, df2 = 749, p-value < 2.2e-16 alternative hypothesis: serial correlation in original errors > > # pwtest > pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) Wooldridge's test for unobserved individual effects data: formula z = 3.9383, p-value = 8.207e-05 alternative hypothesis: unobserved effect > pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time") Wooldridge's test for unobserved time effects data: formula z = 1.3143, p-value = 0.1888 alternative hypothesis: unobserved effect > > ## panelmodel interface > # first, estimate a pooling model, than compute test statistics > form <- formula(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp) > pool_prodc <- plm(form, data = Produc, model = "pooling") > pwtest(pool_prodc) # == effect="individual" Wooldridge's test for unobserved individual effects data: formula z = 3.9383, p-value = 8.207e-05 alternative hypothesis: unobserved effect > pwtest(pool_prodc, effect="time") Wooldridge's test for unobserved time effects data: formula z = 1.3143, p-value = 0.1888 alternative hypothesis: unobserved effect > > proc.time() user system elapsed 19.03 0.54 20.32 plm/inst/tests/test_Chow.R0000644000176200001440000000154114125776247015263 0ustar liggesusers############## Poolability: Chow test # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons # Sec 4.1.3, example 2, p. 68 => results are replicated library(plm) data("Gasoline", package = "plm") form <- lgaspcar ~ lincomep + lrpmg + lcarpcap # poolability across countries pooltest(form, data = Gasoline, effect = "individual", model = "pooling") # matches: F=129.38 [F(68,270)] # poolability across countries [slope coefficients only, allowing for different intercepts] pooltest(form, data = Gasoline, effect = "individual", model = "within") # matches: F= 27.33 [F(51,270)] # poolability across time pooltest(form, data = Gasoline, effect = "time", model = "pooling") # matches: F= 0.276 [F(72,266)] pooltest(form, data = Gasoline, effect = "time", model = "within") # no value stated in Baltagi (2013) for within plm/inst/tests/test_pbsytest_unbalanced.R0000644000176200001440000002025314124132276020400 0ustar liggesusers# test pbsytest() - unbalanced and balanced version ################### Bera, Sosa-Escudero and Yoon (2001) and joint test of Baltagi/Li (1991) ############### # see Baltagi (2005), Econometric Analysis of Panel Data, 3rd edition, pp. 96-97 # or Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, p. 108. # ## only balanced tests described in Bera, Sosa-Escudero and Yoon (2001) and Baltagi (2005, 2013)! # # Baltagi (2013), p. 108: # Grunfeld data, (table 4.2) # LM_mu = 798.162 (with Stata's xttest0 command) [-> plmtest(pool_grunfeld, type = "bp")] # LM_rho = 143.523, LM*_mu = 664.948, LM*_rho = 10.310, joint test (LM1) = 808.471 (all using TSP) # # comments about significance in book: # joint test (LM1): rejects null hypo (no first-order serial correlation and no random effects) # LM_rho, LM*_rho: reject null hypo (no first-order serial correlation) # LM_mu, LM*_mu: reject null hypo (no random effects) library(plm) data("Grunfeld", package = "plm") Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) form_gunfeld <- formula(inv ~ value + capital) pool_grunfeld <- plm(form_gunfeld, data = Grunfeldpdata, model="pooling") pbsytest(pool_grunfeld, test = "ar") # chisq = 10.31 => LM*_rho in Baltagi's book (RS*_lambda from Sosa-Escudero/Bera (2008), p. 73) pbsytest(pool_grunfeld, test = "re", re.normal = FALSE) # chisq = 664.948 => LM*_mu in Baltagi's book (RS*_mu from Sosa-Escudero/Bera (2008), p. 73) pbsytest(pool_grunfeld, test = "re") # [sqrt(chisq) = z = 25.787] => RSO*_mu from Sosa-Escudero/Bera (2008), p. 75 pbsytest(pool_grunfeld, test = "j") # chisq = 808.47 => LM1 in Baltagi's book (RS_lambda_mu in Sosa-Escudero/Bera (2008), p. 74) # formula interface pbsytest(form_gunfeld, data = Grunfeld, test = "ar") pbsytest(form_gunfeld, data = Grunfeld, test = "re") pbsytest(form_gunfeld, data = Grunfeld, test = "re", re.normal = FALSE) pbsytest(form_gunfeld, data = Grunfeld, test = "j") plmtest(pool_grunfeld, type = "bp") # LM_mu in Baltagi's book ############### balanced version ################### ### Results from Bera et al. (2001), p. 13: ## Bera/Sosa-Escudero/Yoon (2001), Tests for the error component model in the presence of local misspecifcation, ## Journal of Econometrics 101 (2001), pp. 1-23. # To replicate, a special version of the Grunfeld data set is needed: only 5 selected firms (total of 100 obs) # from http://pages.stern.nyu.edu/~wgreene/Text/tables/TableF13-1.txt # or http://statmath.wu.ac.at/~zeileis/grunfeld/TableF13-1.txt # # NB: this data set contains 3 errors compared to the original Grunfeld data, see e.g., the # analysis of various different Grundfeld data sets circulating at http://statmath.wu-wien.ac.at/~zeileis/grunfeld/ # or https://eeecon.uibk.ac.at/~zeileis/grunfeld/ # ## commented due to file download # Grunfeld_greene_5firms <- read.csv("http://pages.stern.nyu.edu/~wgreene/Text/tables/TableF13-1.txt", sep="") # # Grunfeld_greene_5firms <- read.csv("http://statmath.wu.ac.at/~zeileis/grunfeld/TableF13-1.txt", sep="") # alternative source # # # Matching to Grunfeld data set in plm # # Grunfeld[c(1:20, 41:60), 3:5] == Grunfeld_greene_5firms[c(1:20, 41:60), 3:5] # # Grunfeld[61:80, 3:5] == Grunfeld_greene_5firms[21:40, 3:5] # # Grunfeld[141:160, 3:5] == Grunfeld_greene_5firms[61:80, 3:5] # # Grunfeld[21:40, 3:5] == Grunfeld_greene_5firms[81:100, 3:5] # almost all equal, 3 values differ (3 errors in the Greene 5 firm version) # # pGrunfeld_greene_5firms <- pdata.frame(Grunfeld_greene_5firms, index = c("Firm", "Year"), drop.index = FALSE, row.names = TRUE) # form_gunfeld_half <- formula(I ~ F + C) # pool_grunfeld_half <- plm(form_gunfeld_half, data=pGrunfeld_greene_5firms, model = "pooling") # re_grunfeld_half <- plm(form_gunfeld_half, data=pGrunfeld_greene_5firms, model = "random") # # pbsytest(pool_grunfeld_half, test = "ar") # chisq = 3.7125 => RS*_rho in Bera et al. (2001), p. 13 # pbsytest(pool_grunfeld_half, test = "re") # normal = 19.601; p = 0 => RSO*_mu # pbsytest(pool_grunfeld_half, test = "re", re.normal = FALSE) # chisq = 384.183 => RS*_mu [sqrt(chisq) = z = 19.601] # pbsytest(pool_grunfeld_half, test = "j") # chisq = 457.53 => RS_mu_rho # # # plmtest's statistic is also mentioned in paper # plmtest(pool_grunfeld_half, type = "bp") # chisq = 453.82 => RS_mu in Bera et al. (2001), p. 13 # plmtest(pool_grunfeld_half, type = "honda") # normal = 21.3031 => RSO_mu # # # ## RS_rho in Bera et al (2001), p. 9 (formula 19) is not implemented # ## it's origin is in Baltagi/Li (1991), but there is is just a side result # ## in terms of n, t, b of pbsystest it is: (n*t^2*(B^2)) / (t-1) # # # formula interface # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "ar") # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "re") # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "re", re.normal = FALSE) # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "j") # # plmtest(form_gunfeld_half, data = pGrunfeld_greene_5firms, type = "bp") ############ Replicate tests from original paper Sosa-Escudero/Bera (2008) #################### ############ unbalanced panel #################### ## ## data set for test from Sosa-Escudero/Bera (2008), pp. 75-77 ## available as Stata .dta file at http://www.stata-journal.com/software/sj8-1/sg164_1/ginipanel5.dta ## ## Sosa-Escudero/Bera (2008), Tests for unbalanced error-components models under local misspecification, ## The Stata Journal (2008), Vol. 8, Number 1, pp. 68-78. ## Commented due to extra package needed # library(haven) # ginipanel5 <- read_dta("http://www.stata-journal.com/software/sj8-1/sg164_1/ginipanel5.dta") # pginipanel5 <- pdata.frame(ginipanel5, index = c("naglo", "ano"), drop.index = FALSE, row.names = TRUE) # # # Stata command for RE model: xtreg gini ie ie2 indus adpubedsal desempleo tactiv invipib apertura pyas4 e64 supc tamfam, re # # use pooling model in R: # formula_gini <- formula(gini ~ ie + ie2 + indus + adpubedsal + desempleo + tactiv + invipib + apertura + pyas4 + e64 + supc + tamfam) # pool_gini <- plm(formula_gini, data = pginipanel5, model = "pooling") # # pdim(pool_gini) # Unbalanced Panel: n=17, T=6-8, N=128 # # # Stata's Output of xttest1, unadjusted (Sosa-Escudero/Bera (2008), p. 77): # # # # Random Effects, Two Sided: # # LM(Var(u)=0) = 13.50 Pr>chi2(1) = 0.0002 # # ALM(Var(u)=0) = 6.03 Pr>chi2(1) = 0.0141 # test="re", re.normal = FALSE # # # # Random Effects, One Sided: # # LM(Var(u)=0) = 3.67 Pr>N(0,1) = 0.0001 # # ALM(Var(u)=0) = 2.46 Pr>N(0,1) = 0.0070 # test="re", re.normal = TRUE # # # # Serial Correlation: # # LM(lambda=0) = 9.32 Pr>chi2(1) = 0.0023 # # ALM(lambda=0) = 1.86 Pr>chi2(1) = 0.1732 # test="ar" # # # # Joint Test: # # LM(Var(u)=0,lambda=0) = 15.35 Pr>chi2(2) = 0.0005 # test="j" # # # pbsytest(pool_gini, test = "re", re.normal = FALSE) # chisq = 6.0288793, df = 1, p-value = 0.01407367 # pbsytest(pool_gini, test = "re") # normal = 2.4553776, n/a p-value = 0.007036833 # pbsytest(pool_gini, test = "ar") # chisq = 1.8550073, df = 1, p-value = 0.1732021 # pbsytest(pool_gini, test = "j") # chisq = 15.352307, df = 2, p-value = 0.0004637552 # # # formula interface # pbsytest(formula_gini, data = pginipanel5, test = "re", re.normal = FALSE) # chisq = 6.0288793, df = 1, p-value = 0.01407367 # pbsytest(formula_gini, data = pginipanel5, test = "re") # normal = 2.4553776, n/a p-value = 0.007036833 # pbsytest(formula_gini, data = pginipanel5, test = "ar") # chisq = 1.8550073, df = 1, p-value = 0.1732021 # pbsytest(formula_gini, data = pginipanel5, test = "j") # chisq = 15.352307, df = 2, p-value = 0.0004637552 # plm/inst/tests/test_pgmm.Rout.save0000644000176200001440000010106314154734502016776 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library("plm") > data("EmplUK", package = "plm") > ## Arellano and Bond (1991), table 4 col. b > z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps") > summary(z1, robust = TRUE) # default Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.6190677 -0.0255683 0.0000000 -0.0001339 0.0332013 0.6410272 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.474151 0.185398 2.5575 0.0105437 * lag(log(emp), 1:2)2 -0.052967 0.051749 -1.0235 0.3060506 lag(log(wage), 0:1)0 -0.513205 0.145565 -3.5256 0.0004225 *** lag(log(wage), 0:1)1 0.224640 0.141950 1.5825 0.1135279 log(capital) 0.292723 0.062627 4.6741 2.953e-06 *** lag(log(output), 0:1)0 0.609775 0.156263 3.9022 9.530e-05 *** lag(log(output), 0:1)1 -0.446373 0.217302 -2.0542 0.0399605 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 30.11247 (p-value = 0.22011) Autocorrelation test (1): normal = -1.53845 (p-value = 0.12394) Autocorrelation test (2): normal = -0.2796829 (p-value = 0.77972) Wald test for coefficients: chisq(7) = 142.0353 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 16.97046 (p-value = 0.0093924) > > > z1col <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE) > summary(z1col, robust = TRUE) # default Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE) Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.8455637 -0.0326605 0.0000000 -0.0003799 0.0312841 0.7010278 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.853895 0.562348 1.5184 0.128902 lag(log(emp), 1:2)2 -0.169886 0.123293 -1.3779 0.168232 lag(log(wage), 0:1)0 -0.533119 0.245948 -2.1676 0.030189 * lag(log(wage), 0:1)1 0.352516 0.432846 0.8144 0.415408 log(capital) 0.271707 0.089921 3.0216 0.002514 ** lag(log(output), 0:1)0 0.612855 0.242289 2.5294 0.011424 * lag(log(output), 0:1)1 -0.682550 0.612311 -1.1147 0.264974 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(5) = 11.62681 (p-value = 0.040275) Autocorrelation test (1): normal = -1.290551 (p-value = 0.19686) Autocorrelation test (2): normal = 0.4482577 (p-value = 0.65397) Wald test for coefficients: chisq(7) = 134.788 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 11.91947 (p-value = 0.06379) > > z1ind <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "individual", model = "twosteps") > summary(z1ind, robust = TRUE) # default Oneway (individual) effect Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.5891371 -0.0258848 0.0000000 -0.0001108 0.0354295 0.6092587 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.448806 0.182638 2.4573 0.0139968 * lag(log(emp), 1:2)2 -0.042209 0.056360 -0.7489 0.4539021 lag(log(wage), 0:1)0 -0.542931 0.150326 -3.6117 0.0003042 *** lag(log(wage), 0:1)1 0.191413 0.154501 1.2389 0.2153787 log(capital) 0.320322 0.057396 5.5809 2.393e-08 *** lag(log(output), 0:1)0 0.636832 0.113729 5.5996 2.149e-08 *** lag(log(output), 0:1)1 -0.246296 0.204975 -1.2016 0.2295240 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 31.87899 (p-value = 0.16154) Autocorrelation test (1): normal = -1.501206 (p-value = 0.1333) Autocorrelation test (2): normal = -0.41767 (p-value = 0.67619) Wald test for coefficients: chisq(7) = 725.4739 (p-value = < 2.22e-16) > > z1indcol <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "individual", model = "twosteps") > summary(z1indcol, robust = TRUE) # default Oneway (individual) effect Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.5891371 -0.0258848 0.0000000 -0.0001108 0.0354295 0.6092587 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.448806 0.182638 2.4573 0.0139968 * lag(log(emp), 1:2)2 -0.042209 0.056360 -0.7489 0.4539021 lag(log(wage), 0:1)0 -0.542931 0.150326 -3.6117 0.0003042 *** lag(log(wage), 0:1)1 0.191413 0.154501 1.2389 0.2153787 log(capital) 0.320322 0.057396 5.5809 2.393e-08 *** lag(log(output), 0:1)0 0.636832 0.113729 5.5996 2.149e-08 *** lag(log(output), 0:1)1 -0.246296 0.204975 -1.2016 0.2295240 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 31.87899 (p-value = 0.16154) Autocorrelation test (1): normal = -1.501206 (p-value = 0.1333) Autocorrelation test (2): normal = -0.41767 (p-value = 0.67619) Wald test for coefficients: chisq(7) = 725.4739 (p-value = < 2.22e-16) > > > ## Blundell and Bond (1998) table 4 (cf DPD for OX p.12 col.4) > ## not quite... > z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + + lag(log(capital), 0:1) | lag(log(emp), 2:99) + + lag(log(wage), 3:99) + lag(log(capital), 2:99), + data = EmplUK, effect = "twoways", model = "onestep", + transformation = "ld") > summary(z2, robust = TRUE) Twoways effects One-step model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.7501512 -0.0389075 0.0000000 0.0001834 0.0459166 0.6149616 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.945068 0.029312 32.2415 < 2.2e-16 *** lag(log(wage), 0:1)0 -0.655654 0.105377 -6.2220 4.909e-10 *** lag(log(wage), 0:1)1 0.499634 0.128513 3.8878 0.0001012 *** lag(log(capital), 0:1)0 0.474032 0.054796 8.6509 < 2.2e-16 *** lag(log(capital), 0:1)1 -0.414113 0.061467 -6.7371 1.616e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(94) = 115.8547 (p-value = 0.062687) Autocorrelation test (1): normal = -4.955307 (p-value = 7.2216e-07) Autocorrelation test (2): normal = -0.2551838 (p-value = 0.79858) Wald test for coefficients: chisq(5) = 7517.379 (p-value = < 2.22e-16) Wald test for time dummies: chisq(7) = 15.88489 (p-value = 0.026189) > > z2b <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + + lag(log(capital), 0:1) | lag(log(emp), 2:99) + + lag(log(wage), 3:99) + lag(log(capital), 2:99), + data = EmplUK, effect = "individual", model = "onestep", + transformation = "ld") > summary(z2b, robust = TRUE) Oneway (individual) effect One-step model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "individual", model = "onestep", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.772126 -0.035115 0.000000 0.004193 0.055023 0.591462 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.903871 0.045345 19.9333 < 2.2e-16 *** lag(log(wage), 0:1)0 -0.513039 0.088364 -5.8059 6.400e-09 *** lag(log(wage), 0:1)1 0.546466 0.089703 6.0919 1.116e-09 *** lag(log(capital), 0:1)0 0.554952 0.048778 11.3771 < 2.2e-16 *** lag(log(capital), 0:1)1 -0.484148 0.050905 -9.5108 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(94) = 104.872 (p-value = 0.20826) Autocorrelation test (1): normal = -5.646905 (p-value = 1.6336e-08) Autocorrelation test (2): normal = -0.5507488 (p-value = 0.58181) Wald test for coefficients: chisq(5) = 20061.48 (p-value = < 2.22e-16) > > > ### further run tests with various argument values > summary(z1, robust = FALSE) Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.6190677 -0.0255683 0.0000000 -0.0001339 0.0332013 0.6410272 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.474151 0.085303 5.5584 2.722e-08 *** lag(log(emp), 1:2)2 -0.052967 0.027284 -1.9413 0.0522200 . lag(log(wage), 0:1)0 -0.513205 0.049345 -10.4003 < 2.2e-16 *** lag(log(wage), 0:1)1 0.224640 0.080063 2.8058 0.0050192 ** log(capital) 0.292723 0.039463 7.4177 1.191e-13 *** lag(log(output), 0:1)0 0.609775 0.108524 5.6188 1.923e-08 *** lag(log(output), 0:1)1 -0.446373 0.124815 -3.5763 0.0003485 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 30.11247 (p-value = 0.22011) Autocorrelation test (1): normal = -2.427829 (p-value = 0.01519) Autocorrelation test (2): normal = -0.3325401 (p-value = 0.73948) Wald test for coefficients: chisq(7) = 371.9877 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 26.9045 (p-value = 0.0001509) > summary(z1col, robust = FALSE) Twoways effects Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE) Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.8455637 -0.0326605 0.0000000 -0.0003799 0.0312841 0.7010278 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.853895 0.263518 3.2404 0.001194 ** lag(log(emp), 1:2)2 -0.169886 0.064766 -2.6231 0.008714 ** lag(log(wage), 0:1)0 -0.533119 0.180123 -2.9597 0.003079 ** lag(log(wage), 0:1)1 0.352516 0.266323 1.3236 0.185622 log(capital) 0.271707 0.055429 4.9019 9.494e-07 *** lag(log(output), 0:1)0 0.612855 0.186648 3.2835 0.001025 ** lag(log(output), 0:1)1 -0.682550 0.370817 -1.8407 0.065670 . --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(5) = 11.62681 (p-value = 0.040275) Autocorrelation test (1): normal = -2.266948 (p-value = 0.023393) Autocorrelation test (2): normal = 0.5875041 (p-value = 0.55687) Wald test for coefficients: chisq(7) = 190.1203 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 17.70124 (p-value = 0.0070238) > summary(z1ind, robust = FALSE) Oneway (individual) effect Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.5891371 -0.0258848 0.0000000 -0.0001108 0.0354295 0.6092587 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.448806 0.097605 4.5982 4.261e-06 *** lag(log(emp), 1:2)2 -0.042209 0.034526 -1.2225 0.22151 lag(log(wage), 0:1)0 -0.542931 0.044565 -12.1828 < 2.2e-16 *** lag(log(wage), 0:1)1 0.191413 0.088443 2.1642 0.03045 * log(capital) 0.320322 0.037208 8.6089 < 2.2e-16 *** lag(log(output), 0:1)0 0.636832 0.077032 8.2671 < 2.2e-16 *** lag(log(output), 0:1)1 -0.246296 0.112826 -2.1830 0.02904 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 31.87899 (p-value = 0.16154) Autocorrelation test (1): normal = -2.269105 (p-value = 0.023262) Autocorrelation test (2): normal = -0.5029366 (p-value = 0.61501) Wald test for coefficients: chisq(7) = 1438.767 (p-value = < 2.22e-16) > summary(z1indcol, robust = FALSE) Oneway (individual) effect Two-steps model Difference GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 611 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.5891371 -0.0258848 0.0000000 -0.0001108 0.0354295 0.6092587 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 0.448806 0.097605 4.5982 4.261e-06 *** lag(log(emp), 1:2)2 -0.042209 0.034526 -1.2225 0.22151 lag(log(wage), 0:1)0 -0.542931 0.044565 -12.1828 < 2.2e-16 *** lag(log(wage), 0:1)1 0.191413 0.088443 2.1642 0.03045 * log(capital) 0.320322 0.037208 8.6089 < 2.2e-16 *** lag(log(output), 0:1)0 0.636832 0.077032 8.2671 < 2.2e-16 *** lag(log(output), 0:1)1 -0.246296 0.112826 -2.1830 0.02904 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(25) = 31.87899 (p-value = 0.16154) Autocorrelation test (1): normal = -2.269105 (p-value = 0.023262) Autocorrelation test (2): normal = -0.5029366 (p-value = 0.61501) Wald test for coefficients: chisq(7) = 1438.767 (p-value = < 2.22e-16) > > summary(z2, robust = FALSE) Twoways effects One-step model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.7501512 -0.0389075 0.0000000 0.0001834 0.0459166 0.6149616 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.945068 0.019033 49.6533 < 2.2e-16 *** lag(log(wage), 0:1)0 -0.655654 0.070755 -9.2666 < 2.2e-16 *** lag(log(wage), 0:1)1 0.499634 0.065372 7.6429 2.124e-14 *** lag(log(capital), 0:1)0 0.474032 0.045731 10.3657 < 2.2e-16 *** lag(log(capital), 0:1)1 -0.414113 0.049202 -8.4165 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(94) = 115.8547 (p-value = 0.062687) Autocorrelation test (1): normal = -5.029015 (p-value = 4.9301e-07) Autocorrelation test (2): normal = -0.2562654 (p-value = 0.79775) Wald test for coefficients: chisq(5) = 16102.85 (p-value = < 2.22e-16) Wald test for time dummies: chisq(7) = 25.92564 (p-value = 0.00051931) > summary(z2b, robust = FALSE) Oneway (individual) effect One-step model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1) + lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 3:99) + lag(log(capital), 2:99), data = EmplUK, effect = "individual", model = "onestep", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1642 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.772126 -0.035115 0.000000 0.004193 0.055023 0.591462 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1) 0.903871 0.025343 35.6656 < 2.2e-16 *** lag(log(wage), 0:1)0 -0.513039 0.056721 -9.0449 < 2.2e-16 *** lag(log(wage), 0:1)1 0.546466 0.056239 9.7169 < 2.2e-16 *** lag(log(capital), 0:1)0 0.554952 0.036886 15.0449 < 2.2e-16 *** lag(log(capital), 0:1)1 -0.484148 0.036522 -13.2563 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(94) = 104.872 (p-value = 0.20826) Autocorrelation test (1): normal = -5.831331 (p-value = 5.4987e-09) Autocorrelation test (2): normal = -0.5530494 (p-value = 0.58023) Wald test for coefficients: chisq(5) = 63160.34 (p-value = < 2.22e-16) > > z3 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps", transformation = "ld") > summary(z3) Twoways effects Two-steps model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1362 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -1.2783232 -0.0312663 0.0000000 -0.0008859 0.0305511 0.9968286 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 1.159729 0.065914 17.5945 < 2.2e-16 *** lag(log(emp), 1:2)2 -0.208429 0.052465 -3.9727 7.105e-05 *** lag(log(wage), 0:1)0 -0.384443 0.200473 -1.9177 0.055152 . lag(log(wage), 0:1)1 0.345628 0.207797 1.6633 0.096254 . log(capital) 0.043447 0.024748 1.7555 0.079166 . lag(log(output), 0:1)0 0.551373 0.212272 2.5975 0.009391 ** lag(log(output), 0:1)1 -0.549793 0.214530 -2.5628 0.010384 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(37) = 57.1014 (p-value = 0.018479) Autocorrelation test (1): normal = -2.035183 (p-value = 0.041832) Autocorrelation test (2): normal = 0.06457302 (p-value = 0.94851) Wald test for coefficients: chisq(7) = 50169.13 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 20.07568 (p-value = 0.0026848) > > z3col <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE, transformation = "ld") > summary(z3col) Twoways effects Two-steps model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps", collapse = TRUE, transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1362 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -1.607481 -0.026549 0.000000 0.001298 0.032377 1.235349 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 1.229634 0.079161 15.5334 < 2.2e-16 *** lag(log(emp), 1:2)2 -0.263162 0.061139 -4.3043 1.675e-05 *** lag(log(wage), 0:1)0 -0.219949 0.133473 -1.6479 0.09938 . lag(log(wage), 0:1)1 0.179443 0.136161 1.3179 0.18755 log(capital) 0.032176 0.026294 1.2237 0.22107 lag(log(output), 0:1)0 0.438920 0.199552 2.1995 0.02784 * lag(log(output), 0:1)1 -0.463668 0.203810 -2.2750 0.02291 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(11) = 19.53659 (p-value = 0.052116) Autocorrelation test (1): normal = -1.590997 (p-value = 0.11161) Autocorrelation test (2): normal = 0.3393808 (p-value = 0.73432) Wald test for coefficients: chisq(7) = 73202.37 (p-value = < 2.22e-16) Wald test for time dummies: chisq(6) = 28.81019 (p-value = 6.608e-05) > > > z3ind <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") > summary(z3ind) Oneway (individual) effect Two-steps model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1362 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -1.11438 -0.03413 0.00000 -0.00239 0.03146 0.91822 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 1.169008 0.082802 14.1180 < 2.2e-16 *** lag(log(emp), 1:2)2 -0.226597 0.062002 -3.6546 0.0002575 *** lag(log(wage), 0:1)0 -0.483095 0.180535 -2.6759 0.0074528 ** lag(log(wage), 0:1)1 0.429235 0.198680 2.1604 0.0307393 * log(capital) 0.054308 0.032483 1.6719 0.0945465 . lag(log(output), 0:1)0 0.647134 0.124038 5.2172 1.816e-07 *** lag(log(output), 0:1)1 -0.595851 0.138535 -4.3011 1.700e-05 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(37) = 66.41158 (p-value = 0.0021142) Autocorrelation test (1): normal = -2.431116 (p-value = 0.015052) Autocorrelation test (2): normal = -0.02784006 (p-value = 0.97779) Wald test for coefficients: chisq(7) = 77862.01 (p-value = < 2.22e-16) > > z3indcol <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), + data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") > summary(z3indcol) Oneway (individual) effect Two-steps model System GMM Call: pgmm(formula = log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "individual", model = "twosteps", transformation = "ld") Unbalanced Panel: n = 140, T = 7-9, N = 1031 Number of Observations Used: 1362 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -1.11438 -0.03413 0.00000 -0.00239 0.03146 0.91822 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(emp), 1:2)1 1.169008 0.082802 14.1180 < 2.2e-16 *** lag(log(emp), 1:2)2 -0.226597 0.062002 -3.6546 0.0002575 *** lag(log(wage), 0:1)0 -0.483095 0.180535 -2.6759 0.0074528 ** lag(log(wage), 0:1)1 0.429235 0.198680 2.1604 0.0307393 * log(capital) 0.054308 0.032483 1.6719 0.0945465 . lag(log(output), 0:1)0 0.647134 0.124038 5.2172 1.816e-07 *** lag(log(output), 0:1)1 -0.595851 0.138535 -4.3011 1.700e-05 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(37) = 66.41158 (p-value = 0.0021142) Autocorrelation test (1): normal = -2.431116 (p-value = 0.015052) Autocorrelation test (2): normal = -0.02784006 (p-value = 0.97779) Wald test for coefficients: chisq(7) = 77862.01 (p-value = < 2.22e-16) > > > > # Baltagi (2005, 2013/2021), Table 8.1 > # Interesting note: Baltagi (2005, 3rd), table 8.1 has different values compared > # to Baltagi (2013/2021, 5th/6th) for the two-step GMM case where the difference > # stems from using xtabond2 and collapsed instruments in the newer editions > # (as opposed to xtabond and not mentioning of collapsed instruments in older edition). > > data("Cigar", package = "plm") > Cigar$real_c <- Cigar$sales * Cigar$pop/Cigar$pop16 > Cigar$real_p <- Cigar$price/Cigar$cpi * 100 > Cigar$real_pimin <- Cigar$pimin/Cigar$cpi * 100 > Cigar$real_ndi <- Cigar$ndi/Cigar$cpi > > form_cig <- log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + log(real_ndi) | lag(log(real_c), 2:99) > > # Baltagi (2005, 3rd edition), table 8.1 > # one-step GMM > gmm_onestep <- pgmm(form_cig, data = Cigar, effect = "twoways", model = "onestep") Warning message: In pgmm(form_cig, data = Cigar, effect = "twoways", model = "onestep") : the second-step matrix is singular, a general inverse is used > # matches table 8.1: 0.84, -0.377, -0.016, 0.14 > summary(gmm_onestep) Twoways effects One-step model Difference GMM Call: pgmm(formula = form_cig, data = Cigar, effect = "twoways", model = "onestep") Balanced Panel: n = 46, T = 30, N = 1380 Number of Observations Used: 1288 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.309407 -0.022219 -0.001561 0.000000 0.022143 0.293543 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(real_c)) 0.842867 0.031279 26.9466 < 2e-16 *** log(real_p) -0.377229 0.045527 -8.2859 < 2e-16 *** log(real_pimin) -0.016150 0.059643 -0.2708 0.78657 log(real_ndi) 0.139449 0.064857 2.1501 0.03155 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(405) = 46 (p-value = 1) Autocorrelation test (1): normal = -5.071433 (p-value = 3.9483e-07) Autocorrelation test (2): normal = 2.281198 (p-value = 0.022537) Wald test for coefficients: chisq(4) = 1440.769 (p-value = < 2.22e-16) Wald test for time dummies: chisq(28) = 1252.564 (p-value = < 2.22e-16) Warning message: In vcovHC.pgmm(object) : a general inverse is used > > # two-step GMM > # > # Table 8.1, 8.2 in Baltagi (2021): Coefs (z-stat) 0.70 (10.2) −0.396 (6.0) −0.105 (1.3) 0.13 (3.5) > # > # Stata xtabond2 lnc L.(lnc) lnrp lnrpn lnrdi dum3 dum8 dum10-dum29, gmm(L.(lnc), collapse) > # iv(lnrp lnrpn lndrdi dum3 dum8 dum10-29) noleveleq robust nomata twostep > # No of obs 1288, no of groups = 48, balanced, no of instruments = 53 > > year.d <- contr.treatment(levels(factor(Cigar$year))) > year.d <- cbind("63" = c(1, rep(0, nrow(year.d)-1)), year.d) > colnames(year.d) <- paste0("year_", colnames(year.d)) > year.d <- cbind("year" = rownames(year.d), as.data.frame(year.d)) > > Cigar <- merge(Cigar, year.d) > pCigar <- pdata.frame(Cigar, index = c("state", "year")) > > # not quite (need to add IV instruments!?): > gmm_twostep <- pgmm(log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + log(real_ndi) + # + year_63 + year_64 + + year_65 + + # year_66 + year_67 + year_68 + year_69 + + year_70 + + # year_71 + + year_72 + year_73 + year_74 + year_75 + year_76 + year_77 + + year_78 + year_79 + year_80 + year_81 + year_82 + year_83 + + year_84 + year_85 + year_86 + year_87 + year_88 + year_89 + + year_90 + year_91 + # + year_92 + | lag(log(real_c), 2:99) + , data = pCigar, effect = "individual", model = "twosteps", transformation = "d", collapse = TRUE) Warning message: In pgmm(log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + : the second-step matrix is singular, a general inverse is used > summary(gmm_twostep) Oneway (individual) effect Two-steps model Difference GMM Call: pgmm(formula = log(real_c) ~ lag(log(real_c)) + log(real_p) + log(real_pimin) + log(real_ndi) + year_65 + year_70 + year_72 + year_73 + year_74 + year_75 + year_76 + year_77 + year_78 + year_79 + year_80 + year_81 + year_82 + year_83 + year_84 + year_85 + year_86 + year_87 + year_88 + year_89 + year_90 + year_91 | lag(log(real_c), 2:99), data = pCigar, effect = "individual", model = "twosteps", collapse = TRUE, transformation = "d") Balanced Panel: n = 46, T = 30, N = 1380 Number of Observations Used: 1288 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -2.786e-01 -2.218e-02 -1.459e-03 -6.592e-05 2.111e-02 2.752e-01 Coefficients: Estimate Std. Error z-value Pr(>|z|) lag(log(real_c)) 0.7127422 0.0671003 10.6220 < 2.2e-16 *** log(real_p) -0.3867883 0.0685552 -5.6420 1.681e-08 *** log(real_pimin) -0.1067969 0.0792667 -1.3473 0.1778803 log(real_ndi) 0.1392827 0.0372024 3.7439 0.0001812 *** year_65 0.0181928 0.0069297 2.6253 0.0086560 ** year_70 -0.0320790 0.0099423 -3.2265 0.0012530 ** year_72 0.0177397 0.0082126 2.1601 0.0307686 * year_73 -0.0284079 0.0106662 -2.6633 0.0077367 ** year_74 -0.0449170 0.0118539 -3.7892 0.0001511 *** year_75 -0.0653649 0.0145267 -4.4996 6.807e-06 *** year_76 -0.0490544 0.0129143 -3.7985 0.0001456 *** year_77 -0.0832712 0.0152030 -5.4773 4.319e-08 *** year_78 -0.0690354 0.0149865 -4.6065 4.095e-06 *** year_79 -0.1192233 0.0157143 -7.5869 3.276e-14 *** year_80 -0.1376209 0.0206042 -6.6793 2.401e-11 *** year_81 -0.1537759 0.0235528 -6.5290 6.621e-11 *** year_82 -0.1501573 0.0192424 -7.8034 6.024e-15 *** year_83 -0.1214331 0.0143877 -8.4401 < 2.2e-16 *** year_84 -0.1058821 0.0107484 -9.8510 < 2.2e-16 *** year_85 -0.0760759 0.0100939 -7.5368 4.817e-14 *** year_86 -0.0673082 0.0101933 -6.6032 4.024e-11 *** year_87 -0.0733055 0.0083516 -8.7774 < 2.2e-16 *** year_88 -0.0736761 0.0118634 -6.2104 5.285e-10 *** year_89 -0.0739029 0.0077779 -9.5016 < 2.2e-16 *** year_90 -0.0665771 0.0096429 -6.9043 5.047e-12 *** year_91 -0.0538857 0.0093046 -5.7913 6.985e-09 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Sargan test: chisq(27) = 28.86345 (p-value = 0.36755) Autocorrelation test (1): normal = -4.750024 (p-value = 2.0339e-06) Autocorrelation test (2): normal = 1.857129 (p-value = 0.063293) Wald test for coefficients: chisq(26) = 6139.499 (p-value = < 2.22e-16) Warning message: In vcovHC.pgmm(object) : a general inverse is used > > proc.time() user system elapsed 8.14 0.64 8.84 plm/inst/tests/test_pwaldtest.Rout.save0000644000176200001440000005225214126007106020042 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Testfile for pwaldtest() > # > # see also tests/test_pwaldtest_vcovG_attr_cluster.R for the attribute 'cluster' of the furnished vcovs > options(scipen = 999) > options(digits = 8) > library(plm) > data("Grunfeld", package="plm") > gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") > gi <- plm(inv ~ value + capital, data = Grunfeld, + effect = "individual", model = "within") > gt <- plm(inv ~ value + capital, data = Grunfeld, + effect = "time", model = "within") > gd <- plm(inv ~ value + capital, data = Grunfeld, + effect = "twoways", model = "within") > gre<- plm(inv ~ value + capital, data = Grunfeld, + effect = "individual", model = "random") > > # Chisq > plm::pwaldtest(gp, test = "Chisq") Wald test for joint significance data: inv ~ value + capital Chisq = 853.151, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq") Wald test for joint significance data: inv ~ value + capital Chisq = 618.028, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq") Wald test for joint significance data: inv ~ value + capital Chisq = 729.289, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq") Wald test for joint significance data: inv ~ value + capital Chisq = 434.885, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "Chisq") Wald test for joint significance data: inv ~ value + capital Chisq = 657.674, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # F > plm::pwaldtest(gp, test = "F") F test for joint significance data: inv ~ value + capital F = 426.576, df1 = 2, df2 = 197, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F") F test for joint significance data: inv ~ value + capital F = 309.014, df1 = 2, df2 = 188, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F") F test for joint significance data: inv ~ value + capital F = 364.645, df1 = 2, df2 = 178, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F") F test for joint significance data: inv ~ value + capital F = 217.442, df1 = 2, df2 = 169, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "F") F test for joint significance data: inv ~ value + capital F = 328.837, df1 = 2, df2 = 197, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > > # Gretl uses Stata's small sample adjustment > g <- pdim(gi)$nT$n # no of individuals > n <- pdim(gi)$nT$N # no of total obs > k <- length(coefficients(gi)) > adj_k1 <- (g/(g-1) * (n-1)/(n-k-1)) # k <- k + 1 because Stata and Gretl have the intercept in the FE model > adj <- (g/(g-1) * (n-1)/(n-k)) > adj_gd <- (g/(g-1) * (n-1)/(n-k-1-19)) # Gretl has time dummies, not demeaning by time (20 periods for Grunfeld data) > # vcov with adjustment factors > vcov_mat_adj_gp <- adj_k1 * plm::vcovHC(gp) > vcov_mat_adj_gi <- adj_k1 * plm::vcovHC(gi) > vcov_mat_adj_gd <- adj_gd * plm::vcovHC(gd) # NB: adj_gd to be used here > vcov_mat_adj_gre <- adj_k1 * plm::vcovHC(gre) > vcov_mat_adj_gt <- adj_k1 * plm::vcovHC(gt) > > # Chisq - robust - formula > plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 115.81, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 63.5489, df = 2, p-value = 0.000000000000015869 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 124.216, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 149.268, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 78.7096, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # Chisq - robust - matrix > plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC(gp)) Wald test for joint significance (robust), vcov: vcovHC(gp) data: inv ~ value + capital Chisq = 115.81, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC(gi)) Wald test for joint significance (robust), vcov: vcovHC(gi) data: inv ~ value + capital Chisq = 63.5489, df = 2, p-value = 0.000000000000015869 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC(gt)) Wald test for joint significance (robust), vcov: vcovHC(gt) data: inv ~ value + capital Chisq = 124.216, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC(gd)) Wald test for joint significance (robust), vcov: vcovHC(gd) data: inv ~ value + capital Chisq = 149.268, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "Chisq", vcov = vcov_mat_adj_gre) # replicates Gretl: Chi-square(2) = 70.1267 Wald test for joint significance (robust), vcov: vcov_mat_adj_gre data: inv ~ value + capital Chisq = 70.1267, df = 2, p-value = 0.00000000000000059181 alternative hypothesis: at least one coefficient is not null > > # F - robust > plm::pwaldtest(gp, test = "F", vcov = vcov_mat_adj_gp) # replicates Gretl: F(2, 9) = 51.59060 F test for joint significance (robust), vcov: vcov_mat_adj_gp data: inv ~ value + capital F = 51.5906, df1 = 2, df2 = 9, p-value = 0.000011734 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcov_mat_adj_gi) # replicates Gretl: F(2, 9) = 28.3096 F test for joint significance (robust), vcov: vcov_mat_adj_gi data: inv ~ value + capital F = 28.3096, df1 = 2, df2 = 9, p-value = 0.00013105 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = function(x) vcovHC(x, cluster = "time")) # cluster on time, df2 = 19 F test for joint significance (robust), vcov: function(x) vcovHC(x, cluster = "time") data: inv ~ value + capital F = 109.317, df1 = 2, df2 = 19, p-value = 0.00000000003776 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcov_mat_adj_gt) F test for joint significance (robust), vcov: vcov_mat_adj_gt data: inv ~ value + capital F = 55.3352, df1 = 2, df2 = 9, p-value = 0.000008773 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcov_mat_adj_gd) # replicates Gretl: F(2, 9) = 60.0821 F test for joint significance (robust), vcov: vcov_mat_adj_gd data: inv ~ value + capital F = 60.0821, df1 = 2, df2 = 9, p-value = 0.0000062223 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "F", vcov = vcov_mat_adj_gre) F test for joint significance (robust), vcov: vcov_mat_adj_gre data: inv ~ value + capital F = 35.0633, df1 = 2, df2 = 9, p-value = 0.000056447 alternative hypothesis: at least one coefficient is not null > > > # F - robust - matrix > plm::pwaldtest(gp, test = "F", vcov = vcovHC(gp)) F test for joint significance (robust), vcov: vcovHC(gp) data: inv ~ value + capital F = 57.9049, df1 = 2, df2 = 9, p-value = 0.0000072606 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcovHC(gi)) F test for joint significance (robust), vcov: vcovHC(gi) data: inv ~ value + capital F = 31.7744, df1 = 2, df2 = 9, p-value = 0.000083417 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = function(x) vcovHC(x, cluster = "time")) # cluster on time, df2 = 19 F test for joint significance (robust), vcov: function(x) vcovHC(x, cluster = "time") data: inv ~ value + capital F = 109.317, df1 = 2, df2 = 19, p-value = 0.00000000003776 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcovHC(gt)) F test for joint significance (robust), vcov: vcovHC(gt) data: inv ~ value + capital F = 62.1078, df1 = 2, df2 = 9, p-value = 0.0000054149 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcovHC(gd)) F test for joint significance (robust), vcov: vcovHC(gd) data: inv ~ value + capital F = 74.6338, df1 = 2, df2 = 9, p-value = 0.0000024936 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gre, test = "F", vcov = vcovHC(gre)) F test for joint significance (robust), vcov: vcovHC(gre) data: inv ~ value + capital F = 39.3548, df1 = 2, df2 = 9, p-value = 0.000035512 alternative hypothesis: at least one coefficient is not null > > > ############### compare to other statistics packages: > > ## package 'lfe' > # library(lfe) > # data("Grunfeld", package = "plm") > # gi_lfe <- felm(inv ~ value + capital | firm, data = Grunfeld) > # gi_lfe_cluster <- felm(inv ~ value + capital | firm, data = Grunfeld, clustervar="firm") > # summary(gi_lfe) > # summary(gi_lfe_cluster) > # lfe::waldtest(gi_lfe, R = names(coef(gi_lfe))) # df1 = 2, df2 = 188 > # lfe::waldtest(gi_lfe_cluster, R = names(coef(gi_lfe_cluster))) # chi2: 54.03250, F. 27.01625, df1 = 2, df2 = 9 > # gi_lfe_cluster$clustervcv # # this vcov is not identical to vcovHC, so results do not match > > > ### Stata #### > # See http://www.stata.com/manuals14/xtxtreg.pdf > # example 2 vs. example 3 (p 14 and 16): > # F(8, 23386) = 610.12 - normal > # F(8, 4696) = 273.86 - robust > > # commented because it needs extra library 'foreign' > # library(plm) > # library(haven) > # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file > # nlswork$race <- factor(nlswork$race) # convert > # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example > # nlswork$grade <- as.numeric(nlswork$grade) > # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) > # > # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) > # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") > # > # plm:::pwaldtest(plm_fe_nlswork, test = "F") # replicates Stata: F(8, 23386) = 610.12 - normal > # plm:::pwaldtest(plm_fe_nlswork, test = "F", vcov = vcovHC) # replicates Stata: F(8, 4696) = 273.86 - robust > > > > ### replicate Gretl #### > # library(foreign);library(plm) > # wagepan<-read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/wagepan.dta") > # pwagepan <- pdata.frame(wagepan, index = c("nr", "year")) > # pdim(pwagepan) > # > # mod_fe_ind <- plm(lwage ~ exper + hours + married + expersq, data = pwagepan, model = "within", effect = "individual") > # > # plm:::pwaldtest(mod_fe_ind, test="F") > # plm:::pwaldtest(mod_fe_ind, test="F", vcov = function(x) vcovHC(x)) # 121.4972 > # > # # Gretl uses Stata's small sample adjustment > # g <- pdim(mod_fe_ind)$nT$n # no of individuals > # n <- pdim(mod_fe_ind)$nT$N # no of total obs > # k <- length(coefficients(mod_fe_ind)) > # k <- k+1 # + 1 because Stata and Gretl have the intercept in the FE model > # adj <- (g/(g-1) * (n-1)/(n-k)) > # vcov_mat_adj <- adj * plm::vcovHC(mod_fe_ind) > # print(plm:::pwaldtest(mod_fe_ind, test="F", vcov = vcov_mat_adj), digits = 12) # replicate Gretl: F(4, 544) = 121.163 > > > # Reference: Gretl (2016b) > # > # Gretl, wagepan data, fixed effects (oneway, HAC SEs) > # Model 1: Fixed-effects, using 4360 observations > # Included 545 cross-sectional units > # Time-series length = 8 > # Dependent variable: lwage > # Robust (HAC) standard errors > # > # coefficient std. error t-ratio p-value > # ----------------------------------------------------------- > # const 1.30069 0.0550817 23.61 2.15e-085 *** > # exper 0.137331 0.0108430 12.67 2.12e-032 *** > # hours −0.000136467 2.13715e-05 −6.385 3.67e-010 *** > # married 0.0481248 0.0213232 2.257 0.0244 ** > # expersq −0.00532076 0.000692182 −7.687 7.09e-014 *** > # > # Mean dependent var 1.649147 S.D. dependent var 0.532609 > # Sum squared resid 459.8591 S.E. of regression 0.347371 > # LSDV R-squared 0.628105 Within R-squared 0.196125 > # Log-likelihood −1283.082 Akaike criterion 3664.165 > # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 > # rho 0.065436 Durbin-Watson 1.546260 > # > # Joint test on named regressors - > # Test statistic: F(4, 544) = 121.163 > # with p-value = P(F(4, 544) > 121.163) = 7.19472e-074 > # > # Robust test for differing group intercepts - > # Null hypothesis: The groups have a common intercept > # Test statistic: Welch F(544, 1276.3) = 26.9623 > # with p-value = P(F(544, 1276.3) > 26.9623) = 0 > > > > # Model 1: Fixed-effects, using 200 observations > # Included 10 cross-sectional units > # Time-series length = 20 > # Dependent variable: inv > # Robust (HAC) standard errors > # > # coefficient std. error t-ratio p-value > # -------------------------------------------------------- > # const −58.7439 27.6029 −2.128 0.0622 * > # value 0.110124 0.0151945 7.248 4.83e-05 *** > # capital 0.310065 0.0527518 5.878 0.0002 *** > # > # Mean dependent var 145.9582 S.D. dependent var 216.8753 > # Sum squared resid 523478.1 S.E. of regression 52.76797 > # LSDV R-squared 0.944073 Within R-squared 0.766758 > # Log-likelihood −1070.781 Akaike criterion 2165.562 > # Schwarz criterion 2205.142 Hannan-Quinn 2181.579 > # rho 0.663920 Durbin-Watson 0.684480 > # > # Joint test on named regressors - > # Test statistic: F(2, 9) = 28.3096 > # with p-value = P(F(2, 9) > 28.3096) = 0.000131055 > # > # Robust test for differing group intercepts - > # Null hypothesis: The groups have a common intercept > # Test statistic: Welch F(9, 70.6) = 85.9578 > # with p-value = P(F(9, 70.6) > 85.9578) = 1.90087e-034 > > > # Model 6: Fixed-effects, using 200 observations > # Included 10 cross-sectional units > # Time-series length = 20 > # Dependent variable: inv > # Robust (HAC) standard errors > # > # coefficient std. error t-ratio p-value > # -------------------------------------------------------- > # const −32.8363 19.7826 −1.660 0.1313 > # value 0.117716 0.0108244 10.88 1.77e-06 *** > # capital 0.357916 0.0478484 7.480 3.77e-05 *** > # dt_2 −19.1974 20.6986 −0.9275 0.3779 > # dt_3 −40.6900 33.2832 −1.223 0.2526 > # dt_4 −39.2264 15.7365 −2.493 0.0343 ** > # dt_5 −69.4703 26.9988 −2.573 0.0300 ** > # dt_6 −44.2351 17.3723 −2.546 0.0314 ** > # dt_7 −18.8045 17.8475 −1.054 0.3195 > # dt_8 −21.1398 14.1648 −1.492 0.1698 > # dt_9 −42.9776 12.5441 −3.426 0.0076 *** > # dt_10 −43.0988 10.9959 −3.920 0.0035 *** > # dt_11 −55.6830 15.2019 −3.663 0.0052 *** > # dt_12 −31.1693 20.9169 −1.490 0.1704 > # dt_13 −39.3922 26.4371 −1.490 0.1704 > # dt_14 −43.7165 38.8786 −1.124 0.2899 > # dt_15 −73.4951 38.2545 −1.921 0.0869 * > # dt_16 −75.8961 36.7985 −2.062 0.0692 * > # dt_17 −62.4809 49.4181 −1.264 0.2379 > # dt_18 −64.6323 51.5621 −1.253 0.2416 > # dt_19 −67.7180 43.7447 −1.548 0.1560 > # dt_20 −93.5262 31.7263 −2.948 0.0163 ** > # > # Mean dependent var 145.9582 S.D. dependent var 216.8753 > # Sum squared resid 452147.1 S.E. of regression 51.72452 > # LSDV R-squared 0.951693 Within R-squared 0.798540 > # Log-likelihood −1056.132 Akaike criterion 2174.264 > # Schwarz criterion 2276.512 Hannan-Quinn 2215.643 > # rho 0.658860 Durbin-Watson 0.686728 > # > # Joint test on named regressors - > # Test statistic: F(2, 9) = 60.0821 > # with p-value = P(F(2, 9) > 60.0821) = 6.22231e-006 > # > # Robust test for differing group intercepts - > # Null hypothesis: The groups have a common intercept > # Test statistic: Welch F(9, 76.7) = 53.1255 > # with p-value = P(F(9, 76.7) > 53.1255) = 2.45306e-029 > > > > # Model 5: Pooled OLS, using 200 observations > # Included 10 cross-sectional units > # Time-series length = 20 > # Dependent variable: inv > # Robust (HAC) standard errors > # > # coefficient std. error t-ratio p-value > # -------------------------------------------------------- > # const −42.7144 20.4252 −2.091 0.0660 * > # value 0.115562 0.0158943 7.271 4.71e-05 *** > # capital 0.230678 0.0849671 2.715 0.0238 ** > # > # Mean dependent var 145.9582 S.D. dependent var 216.8753 > # Sum squared resid 1755850 S.E. of regression 94.40840 > # R-squared 0.812408 Adjusted R-squared 0.810504 > # F(2, 9) 51.59060 P-value(F) 0.000012 > # Log-likelihood −1191.802 Akaike criterion 2389.605 > # Schwarz criterion 2399.500 Hannan-Quinn 2393.609 > # rho 0.956242 Durbin-Watson 0.209717 > > > # Model 2: Random-effects (GLS), using 200 observations > # Included 10 cross-sectional units > # Time-series length = 20 > # Dependent variable: inv > # Robust (HAC) standard errors > # > # coefficient std. error z p-value > # -------------------------------------------------------- > # const −57.8344 24.8432 −2.328 0.0199 ** > # value 0.109781 0.0137557 7.981 1.45e-015 *** > # capital 0.308113 0.0549728 5.605 2.08e-08 *** > # > # Mean dependent var 145.9582 S.D. dependent var 216.8753 > # Sum squared resid 1841062 S.E. of regression 96.42765 > # Log-likelihood −1196.541 Akaike criterion 2399.083 > # Schwarz criterion 2408.978 Hannan-Quinn 2403.087 > # > # 'Between' variance = 7089.8 > # 'Within' variance = 2784.46 > # theta used for quasi-demeaning = 0.861224 > # corr(y,yhat)^2 = 0.806104 > # > # Joint test on named regressors - > # Asymptotic test statistic: Chi-square(2) = 70.1267 > # with p-value = 5.91814e-016 > # > # Breusch-Pagan test - > # Null hypothesis: Variance of the unit-specific error = 0 > # Asymptotic test statistic: Chi-square(1) = 798.162 > # with p-value = 1.35448e-175 > # > # Hausman test - > # Null hypothesis: GLS estimates are consistent > # Asymptotic test statistic: Chi-square(2) = 7.31971 > # with p-value = 0.0257363 > > > > proc.time() user system elapsed 0.79 0.18 0.96 plm/inst/tests/test_within_intercept.Rout.save0000644000176200001440000004012614124132276021414 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### Test of within_intercept in connection with fixef() and comparison to Stata and Gretl > # > # results for within_intercept matches EViews, also in the two-way unbalanced case > # > # (1) balanced > # (2) unbalanced > > # test in connection with fixef: > library(plm) > data("Grunfeld", package = "plm") > > ############# (1) balanced ############## > # oneway individual balanced > gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "individual") > f_level_gi <- fixef(gi, type = "level") > f_dmean_gi <- fixef(gi, type = "dmean") > int_gi <- within_intercept(gi) > mod_int_gi <- within_intercept(gi, return.model = TRUE) > int_manual_gi <- mean(fixef(gi)) > individual_intercepts_gi <- int_gi + f_dmean_gi > > # check consistency of functions fixef and within_intercept > # works > if (!isTRUE(all.equal(individual_intercepts_gi, f_level_gi, check.attributes = FALSE))) stop("within_intercept: something is wrong") > if (!isTRUE(all.equal(int_gi, int_manual_gi, check.attributes = FALSE))) stop("within_intercept: something is wrong") > > # oneway time balanced > gt <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") > f_level_gt <- fixef(gt, type = "level") > f_dmean_gt <- fixef(gt, type = "dmean") > int_gt <- within_intercept(gt) > mod_int_gt <- within_intercept(gt, return.model = TRUE) > > int_manual_gt <- mean(fixef(gt)) > individual_intercepts_gt <- int_gt + f_dmean_gt > > # check consistency of functions fixef and within_intercept > # works > if(!isTRUE(all.equal(individual_intercepts_gt, f_level_gt, check.attributes = FALSE))) stop("within_intercept: something is wrong") > if(!isTRUE(all.equal(int_gt, int_manual_gt, check.attributes = FALSE))) stop("within_intercept: something is wrong") > > # two-way individual, time balanced > gtw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") > f_level_tw_i <- fixef(gtw, type = "level", effect = "individual") > f_dmean_tw_i <- fixef(gtw, type = "dmean", effect = "individual") > f_level_tw_t <- fixef(gtw, type = "level", effect = "time") > f_dmean_tw_t <- fixef(gtw, type = "dmean", effect = "time") > > int_tw <- within_intercept(gtw) > mod_int_tw <- within_intercept(gtw, return.model = TRUE) > > int_manual_tw_i <- mean(f_level_tw_i) > int_manual_tw_t <- mean(f_level_tw_t) > > individual_intercepts_tw_i <- int_tw + f_dmean_tw_i > individual_intercepts_tw_t <- int_tw + f_dmean_tw_t > > # check consistency of functions fixef and within_intercept > # if(!isTRUE(all.equal(individual_intercepts_tw_i, f_level_tw_i, check.attributes = FALSE))) stop("within_intercept twoways, individual: something is wrong") > # if(!isTRUE(all.equal(individual_intercepts_tw_t, f_level_tw_t, check.attributes = FALSE))) stop("within_intercept twoways, time: something is wrong") > > > > > > ############# (2) unbalanced tests ################ > Grunfeld_unbalanced <- Grunfeld[-c(200), ] > > # oneway individual unbalanced > gi_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "individual") > f_level_gi_u <- fixef(gi_u, type = "level") > f_dmean_gi_u <- fixef(gi_u, type = "dmean") > > > # in the one-way unbalanced case: is the overall intercept is the _weighted_ mean of the effects > # (with the current fixef implementation) - this check also depends on how type = "dmean" is calculated in fixef > int_gi_u <- within_intercept(gi_u) > mod_int_gi_u <- within_intercept(gi_u, return.model = TRUE) > individual_intercepts_gi_u <- int_gi_u + f_dmean_gi_u > > int_manual_gi_u <- weighted.mean(fixef(gi_u), as.numeric(table(index(gi_u)[[1]]))) > mean(f_level_gi_u) [1] -58.74892 > > # check consistency of functions in themselves > if(!isTRUE(all.equal(individual_intercepts_gi_u, f_level_gi_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") > if(!isTRUE(all.equal(int_gi_u, int_manual_gi_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") > > > # oneway time unbalanced > gt_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "time") > f_level_gt_u <- fixef(gt_u, type = "level") > f_dmean_gt_u <- fixef(gt_u, type = "dmean") > int_gt_u <- within_intercept(gt_u) > mod_int_gt_u <- within_intercept(gt_u, return.model = TRUE) > individual_intercepts_gt_u <- int_gt_u + f_dmean_gt_u > > int_manual_gt_u <- weighted.mean(fixef(gt_u), as.numeric(table(index(gt_u)[[2]]))) > mean(f_level_gt_u) # mean is not correct for unbalanced case! [1] -41.66663 > int_gt_u <- within_intercept(gt_u) > > > # check consistency of functions in themselves > if(!isTRUE(all.equal(individual_intercepts_gt_u, f_level_gt_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") > if(!isTRUE(all.equal(int_gt_u, int_manual_gt_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") > > > ## twoways unbalanced > gtw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "twoways") > f_level_tw_i_u <- fixef(gtw_u, type = "level", effect = "individual") > f_level_tw_t_u <- fixef(gtw_u, type = "level", effect = "time") > f_dmean_tw_i_u <- fixef(gtw_u, type = "dmean", effect = "individual") > f_dmean_tw_t_u <- fixef(gtw_u, type = "dmean", effect = "time") > > int_tw_u <- within_intercept(gtw_u) > > ## mean() is not correct in unbalanced case > # int_manual_tw_i_u <- mean(f_level_tw_i_u) > # int_manual_tw_t_u <- mean(f_level_tw_t_u) > # int_manual_tw_i_u + int_manual_tw_t_u > # all.equal(int_manual_tw_i_u, int_manual_tw_t_u) # not equal > > int_manual_tw_i_u <- weighted.mean(f_level_tw_i_u, w = pdim(gtw_u)$Tint$Ti) > int_manual_tw_t_u <- weighted.mean(f_level_tw_t_u, w = pdim(gtw_u)$Tint$nt) > int_manual_tw_i_u + int_manual_tw_t_u [1] -173.4236 > all.equal(int_manual_tw_i_u, int_manual_tw_t_u) # not equal [1] "Mean relative difference: 3.107285" > > individual_intercepts_tw_i_u <- int_manual_tw_i_u + f_dmean_tw_i_u > individual_intercepts_tw_t_u <- int_manual_tw_t_u + f_dmean_tw_t_u > > mod_lm <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) > > # check consistency of functions fixef and within_intercept > if(!isTRUE(all.equal(individual_intercepts_tw_i_u, f_level_tw_i_u, check.attributes = FALSE))) stop("within_intercept twoways, individual: something is wrong") > if(!isTRUE(all.equal(individual_intercepts_tw_t_u, f_level_tw_t_u, check.attributes = FALSE))) stop("within_intercept twoways, time: something is wrong") > f_level_tw_u <- as.numeric(fixef(gtw_u, "twoways", "level")) > f_level_tw_u_test <- int_tw_u + f_dmean_tw_i_u[index(gtw_u)[[1L]]] + f_dmean_tw_t_u[index(gtw_u)[[2L]]] > if(!isTRUE(all.equal(f_level_tw_u, f_level_tw_u_test, check.attributes = FALSE))) stop("within_intercept twoways, individual, time: something is wrong") > > > ### print all within intercepts (to have them compared to the reference output test_within_intercept.Rout.save) > print(within_intercept(gi)) (overall_intercept) -58.74394 attr(,"se") [1] 12.45369 > print(within_intercept(gi_u)) (overall_intercept) -59.01091 attr(,"se") [1] 12.54384 > print(within_intercept(gt)) (overall_intercept) -41.0225 attr(,"se") [1] 10.44985 > print(within_intercept(gt_u)) (overall_intercept) -41.67194 attr(,"se") [1] 10.60547 > print(within_intercept(gtw)) (overall_intercept) -80.1638 attr(,"se") [1] 14.84402 > print(within_intercept(gtw_u)) (overall_intercept) -82.28287 attr(,"se") [1] 15.01727 > > > ######### Test with reference case: balanced panel > ## commented because it needs extra library 'foreign' > # library(foreign) > # library(plm) > # wagepan <- read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/wagepan.dta") > # pwagepan <- pdata.frame(wagepan, index = c("nr", "year")) > # pdim(pwagepan) > # > # mod_fe_ind <- plm(lwage ~ exper + hours + married + expersq, data = pwagepan, model = "within", effect = "individual") > # summary(mod_fe_ind) > # # matches gretl, balanced panel, individual effect (see below) > # inter_mod_fe_ind <- within_intercept(mod_fe_ind) > # print(inter_mod_fe_ind) > # mean(fixef(mod_fe_ind)) > # print(inter_mod_fe_ind) > # > # # matches Gretl robust SE > # inter_mod_fe_ind_robust <- within_intercept(mod_fe_ind, vcov = function(x) vcovHC(x, method="arellano", type="HC0")) > # print(inter_mod_fe_ind_robust) > # print(summary(within_intercept(mod_fe_ind, return.model = TRUE), vcov = function(x) vcovHC(x, method="arellano", type="HC0"))) > > # Some data to compare to: > # gretl: Data wagepan, individual effects, "normal" standard errors > # > # Model 1: Fixed-effects, using 4360 observations > # Included 545 cross-sectional units > # Time-series length = 8 > # Dependent variable: lwage > # > # coefficient std. error t-ratio p-value > # ----------------------------------------------------------- > # const 1.30069 0.0334564 38.88 8.95e-279 *** > # exper 0.137331 0.00856279 16.04 4.56e-056 *** > # hours −0.000136467 1.33668e-05 −10.21 3.67e-024 *** > # married 0.0481248 0.0181012 2.659 0.0079 *** > # expersq −0.00532076 0.000606304 −8.776 2.52e-018 *** > # > # Mean dependent var 1.649147 S.D. dependent var 0.532609 > # Sum squared resid 459.8591 S.E. of regression 0.347371 > # LSDV R-squared 0.628105 Within R-squared 0.196125 > # LSDV F(548, 3811) 11.74547 P-value(F) 0.000000 > # Log-likelihood −1283.082 Akaike criterion 3664.165 > # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 > # rho 0.065436 Durbin-Watson 1.546260 > # > # Joint test on named regressors - > # Test statistic: F(4, 3811) = 232.447 > # with p-value = P(F(4, 3811) > 232.447) = 8.13484e-179 > # > # Test for differing group intercepts - > # Null hypothesis: The groups have a common intercept > # Test statistic: F(544, 3811) = 10.3148 > # with p-value = P(F(544, 3811) > 10.3148) = 0 > > > # gretl: Data wagepan, individual effects, HAC standard errors > # > # Model 1: Fixed-effects, using 4360 observations > # Included 545 cross-sectional units > # Time-series length = 8 > # Dependent variable: lwage > # Robust (HAC) standard errors > # Omitted due to exact collinearity: black hisp > # > # coefficient std. error t-ratio p-value > # ----------------------------------------------------------- > # const 1.30069 0.0550059 23.65 1.82e-115 *** > # exper 0.137331 0.0108281 12.68 3.92e-036 *** > # hours −0.000136467 2.13420e-05 −6.394 1.81e-010 *** > # married 0.0481248 0.0212938 2.260 0.0239 ** > # expersq −0.00532076 0.000691230 −7.698 1.76e-014 *** > # > # Mean dependent var 1.649147 S.D. dependent var 0.532609 > # Sum squared resid 459.8591 S.E. of regression 0.347371 > # LSDV R-squared 0.628105 Within R-squared 0.196125 > # Log-likelihood −1283.082 Akaike criterion 3664.165 > # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 > # rho 0.065436 Durbin-Watson 1.546260 > # > # Joint test on named regressors - > # Test statistic: F(4, 3811) = 121.497 > # with p-value = P(F(4, 3811) > 121.497) = 1.02521e-097 > # > # Robust test for differing group intercepts - > # Null hypothesis: The groups have a common intercept > # Test statistic: Welch F(544, 1276.3) = 27.3958 > # with p-value = P(F(544, 1276.3) > 27.3958) = 0 > > > #### > # Gretl, twoways, Grunfeld, balanced panel, normal SEs > # -- Gretl does only time dummies, no sweeping out of time effect in the data > # -> not comparable because constant becomes the reference year > # Model 2: Fixed-effects, using 200 observations > # Included 10 cross-sectional units > # Time-series length = 20 > # Dependent variable: inv > # > # coefficient std. error t-ratio p-value > # --------------------------------------------------------- > # const −32.8363 18.8753 −1.740 0.0837 * > # value 0.117716 0.0137513 8.560 6.65e-015 *** > # capital 0.357916 0.0227190 15.75 5.45e-035 *** > # dt_2 −19.1974 23.6759 −0.8108 0.4186 > # dt_3 −40.6900 24.6954 −1.648 0.1013 > # dt_4 −39.2264 23.2359 −1.688 0.0932 * > # dt_5 −69.4703 23.6561 −2.937 0.0038 *** > # dt_6 −44.2351 23.8098 −1.858 0.0649 * > # dt_7 −18.8045 23.6940 −0.7936 0.4285 > # dt_8 −21.1398 23.3816 −0.9041 0.3672 > # dt_9 −42.9776 23.5529 −1.825 0.0698 * > # dt_10 −43.0988 23.6102 −1.825 0.0697 * > # dt_11 −55.6830 23.8956 −2.330 0.0210 ** > # dt_12 −31.1693 24.1160 −1.292 0.1980 > # dt_13 −39.3922 23.7837 −1.656 0.0995 * > # dt_14 −43.7165 23.9697 −1.824 0.0699 * > # dt_15 −73.4951 24.1829 −3.039 0.0028 *** > # dt_16 −75.8961 24.3455 −3.117 0.0021 *** > # dt_17 −62.4809 24.8643 −2.513 0.0129 ** > # dt_18 −64.6323 25.3495 −2.550 0.0117 ** > # dt_19 −67.7180 26.6111 −2.545 0.0118 ** > # dt_20 −93.5262 27.1079 −3.450 0.0007 *** > > > > > > ## Test unbalanced panel > ####### replicate Stata's fixed effects estimator, R-squared, F statistic ### > ## http://www.stata.com/manuals14/xtxtreg.pdf [example 2 on p. 14, ex. 3 on p. 16] > # > # commented because it needs extra library 'foreign' > # > # normal SE (ex. 2, p. 14) > # Stata's intercept (coefficient, Standard error) > # _cons 1.03732 , .0485546 > # > # robust SE (ex. 3, p. 16) > # _cons 1.03732 , .0739644 > > # library(plm) > # library(haven) > # nlswork <- haven::read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file > # nlswork$race <- factor(nlswork$race) # convert > # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example > # nlswork$grade <- as.numeric(nlswork$grade) > # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) > # > # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) > # > # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within", effect = "individual") > # > # int_fe_nls_work <- within_intercept(plm_fe_nlswork) # matches Stata "normal" SE > # print(int_fe_nls_work) > # weighted.mean(fixef(plm_fe_nlswork), w = as.numeric(table(index(plm_fe_nlswork)[[1]]))) > # summary(plm_fe_nlswork) > # summary(plm_fe_nlswork, vcov = vcovHC(plm_fe_nlswork, type="sss")) > # int_fe_nls_work_robust <- within_intercept(plm_fe_nlswork, vcov = function(x) vcovHC(x, type="sss")) # matches Stata robust SE > # print(int_fe_nls_work_robust) > > > proc.time() user system elapsed 1.03 0.14 1.14 plm/inst/tests/test_summary.pseries_character_logical_factor.R0000644000176200001440000000115214124132276024556 0ustar liggesusers### some of summary.pseries error'ed or gave warnings pre rev. 445 library("plm") data("Grunfeld", package = "plm") Grunfeld$char <- rep("ab", 200) Grunfeld$logi <- rep(c(T, F), 100) Grunfeld$fac <- factor(rep(c("a", "b"), 100)) pGrund <- pdata.frame(Grunfeld, stringsAsFactors = FALSE) # summary on original data summary(Grunfeld$inv) # numeric summary(Grunfeld$char) # character summary(Grunfeld$logi) # logical summary(Grunfeld$fac) # factor # summary.pseries summary(pGrund$inv) summary(pGrund$char) summary(pGrund$logi) summary(pGrund$fac) summary(Grunfeld) summary(pGrund) plm/inst/tests/test_fixef.Rout.save0000644000176200001440000006207114124132276017141 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### Test of fixef > ### > ### (1): general tests > ### (2): consistency with summary.plm > ### > ### see also: > ### * test file test_within_intercept.R for consistency checks > ### between functions fixef and within_intercept > ### * test file test_fixef_comp_lm_plm.R for a comparison of the fixed effects to LSDV models via lm() > > ############# (1): general run tests ############# > library(plm) > data("Grunfeld", package = "plm") > > # balanced models > gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") > gt <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") > gtw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") > > > f_level <- fixef(gi, type = "level") > f_level_robust_mat <- fixef(gi, type = "level", vcov = vcovHC(gi)) # vcov is matrix > f_level_robust_func <- fixef(gi, type = "level", vcov = vcovHC) # vcov is function > > print(attr(f_level, "se")) 1 2 3 4 5 6 7 8 49.70796 24.93832 24.43162 14.07775 14.16543 12.66874 12.84297 13.99315 9 10 12.89189 11.82689 > print(attr(f_level_robust_func, "se")) 1 2 3 4 5 6 7 8 85.97346 40.49648 44.27241 18.56579 28.84028 15.45980 20.71591 17.26171 9 10 21.56692 11.86157 > > print(summary(f_level), digits = 8) Estimate Std. Error t-value Pr(>|t|) 1 -70.2967175 49.7079588 -1.41419 0.158959 2 101.9058137 24.9383232 4.08631 6.4852e-05 *** 3 -235.5718410 24.4316165 -9.64209 < 2.22e-16 *** 4 -27.8092946 14.0777538 -1.97541 0.049685 * 5 -114.6168128 14.1654333 -8.09130 7.1411e-14 *** 6 -23.1612951 12.6687393 -1.82822 0.069101 . 7 -66.5534735 12.8429734 -5.18209 5.6290e-07 *** 8 -57.5456573 13.9931464 -4.11242 5.8477e-05 *** 9 -87.2222724 12.8918932 -6.76567 1.6345e-10 *** 10 -6.5678435 11.8268910 -0.55533 0.579328 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > print(summary(f_level_robust_func), digits = 8) Estimate Std. Error t-value Pr(>|t|) 1 -70.2967175 85.9734634 -0.81766 0.41458870 2 101.9058137 40.4964809 2.51641 0.01269214 * 3 -235.5718410 44.2724091 -5.32096 2.9169e-07 *** 4 -27.8092946 18.5657912 -1.49788 0.13584202 5 -114.6168128 28.8402827 -3.97419 0.00010058 *** 6 -23.1612951 15.4597951 -1.49816 0.13576805 7 -66.5534735 20.7159098 -3.21267 0.00154736 ** 8 -57.5456573 17.2617119 -3.33372 0.00103213 ** 9 -87.2222724 21.5669197 -4.04426 7.6538e-05 *** 10 -6.5678435 11.8615708 -0.55371 0.58043682 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > f_level_t <- fixef(gt, type = "level") > f_level_t_robust_func <- fixef(gt, type = "level", vcov = vcovHC) # vcov is function > > print(attr(f_level_t, "se")) 1935 1936 1937 1938 1939 1940 1941 1942 31.25408 31.57989 31.87894 31.39361 31.58505 31.63576 31.62813 31.58354 1943 1944 1945 1946 1947 1948 1949 1950 31.67263 31.68469 31.77937 31.87299 32.14450 32.45284 32.75761 32.93717 1951 1952 1953 1954 33.13580 33.73808 34.64354 35.72691 > print(attr(f_level_t_robust_func, "se")) 1935 1936 1937 1938 1939 1940 1941 1942 32.34680 34.18345 35.75038 33.20545 34.20602 34.46783 34.51459 34.60309 1943 1944 1945 1946 1947 1948 1949 1950 35.04938 35.07138 35.52617 36.06382 38.57547 40.71600 42.66511 43.70350 1951 1952 1953 1954 44.51379 48.04058 52.69984 58.48207 > > print(summary(f_level_t), digits = 8) Estimate Std. Error t-value Pr(>|t|) 1935 -23.574968 31.254082 -0.75430 0.451666 1936 -40.787307 31.579889 -1.29156 0.198184 1937 -58.066240 31.878940 -1.82146 0.070216 . 1938 -52.017730 31.393606 -1.65695 0.099291 . 1939 -79.818004 31.585049 -2.52708 0.012372 * 1940 -54.079700 31.635759 -1.70945 0.089111 . 1941 -26.202078 31.628133 -0.82844 0.408530 1942 -24.997122 31.583540 -0.79146 0.429729 1943 -45.376238 31.672627 -1.43266 0.153708 1944 -45.692318 31.684692 -1.44209 0.151033 1945 -57.171437 31.779365 -1.79901 0.073711 . 1946 -30.603029 31.872994 -0.96016 0.338279 1947 -28.821095 32.144500 -0.89661 0.371138 1948 -27.494440 32.452843 -0.84721 0.398015 1949 -52.368285 32.757614 -1.59866 0.111670 1950 -51.929057 32.937171 -1.57661 0.116661 1951 -35.246908 33.135802 -1.06371 0.288901 1952 -29.188192 33.738078 -0.86514 0.388126 1953 -21.125971 34.643537 -0.60981 0.542765 1954 -35.889838 35.726906 -1.00456 0.316472 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > print(summary(f_level_t_robust_func), digits = 8) Estimate Std. Error t-value Pr(>|t|) 1935 -23.574968 32.346803 -0.72882 0.467070 1936 -40.787307 34.183451 -1.19319 0.234383 1937 -58.066240 35.750385 -1.62421 0.106100 1938 -52.017730 33.205451 -1.56654 0.118998 1939 -79.818004 34.206017 -2.33345 0.020742 * 1940 -54.079700 34.467834 -1.56899 0.118426 1941 -26.202078 34.514590 -0.75916 0.448761 1942 -24.997122 34.603094 -0.72240 0.470999 1943 -45.376238 35.049382 -1.29464 0.197122 1944 -45.692318 35.071383 -1.30284 0.194313 1945 -57.171437 35.526170 -1.60928 0.109328 1946 -30.603029 36.063821 -0.84858 0.397255 1947 -28.821095 38.575472 -0.74714 0.455968 1948 -27.494440 40.716004 -0.67527 0.500378 1949 -52.368285 42.665111 -1.22743 0.221283 1950 -51.929057 43.703498 -1.18821 0.236333 1951 -35.246908 44.513794 -0.79182 0.429520 1952 -29.188192 48.040583 -0.60757 0.544245 1953 -21.125971 52.699844 -0.40087 0.688994 1954 -35.889838 58.482071 -0.61369 0.540204 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > f_level_d <- fixef(gtw, type = "level") > f_level_d_robust_func <- fixef(gtw, type = "level", vcov = vcovHC) # vcov is function > > print(attr(f_level_d, "se")) NULL > print(attr(f_level_d_robust_func, "se")) NULL > > print(summary(f_level_d), digits = 8) Estimate 1 -86.9002299 2 120.1540099 3 -222.1310296 4 8.4536121 5 -92.3388251 6 15.9884125 7 -35.4336200 8 -19.4097154 9 -56.6826742 10 39.9368929 > print(summary(f_level_d_robust_func), digits = 8) Estimate 1 -86.9002299 2 120.1540099 3 -222.1310296 4 8.4536121 5 -92.3388251 6 15.9884125 7 -35.4336200 8 -19.4097154 9 -56.6826742 10 39.9368929 > > # just run tests for type = "dmean" and type = "dfirst" > fixef(gi, type = "dmean") 1 2 3 4 5 6 7 8 -11.5528 160.6498 -176.8279 30.9346 -55.8729 35.5826 -7.8095 1.1983 9 10 -28.4783 52.1761 > fixef(gt, type = "dmean") 1935 1936 1937 1938 1939 1940 1941 1942 17.44753 0.23519 -17.04374 -10.99523 -38.79551 -13.05720 14.82042 16.02538 1943 1944 1945 1946 1947 1948 1949 1950 -4.35374 -4.66982 -16.14894 10.41947 12.20140 13.52806 -11.34579 -10.90656 1951 1952 1953 1954 5.77559 11.83431 19.89653 5.13266 > fixef(gtw, effect = "individual", type = "dmean") 1 2 3 4 5 6 7 8 -54.0639 152.9903 -189.2947 41.2899 -59.5025 48.8247 -2.5973 13.4266 9 10 -23.8464 72.7732 > fixef(gtw, effect = "time", type = "dmean") 1935 1936 1937 1938 1939 1940 1941 1942 47.3275 28.1301 6.6375 8.1011 -22.1428 3.0924 28.5230 26.1877 1943 1944 1945 1946 1947 1948 1949 1950 4.3499 4.2287 -8.3556 16.1582 7.9352 3.6110 -26.1676 -28.5686 1951 1952 1953 1954 -15.1534 -17.3049 -20.3905 -46.1987 > fixef(gtw, effect = "twoways", type = "dmean") 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 -6.73643 -25.93384 -47.42644 -45.96284 -76.20672 -50.97152 -25.54090 1-1942 1-1943 1-1944 1-1945 1-1946 1-1947 1-1948 -27.87623 -49.71406 -49.83521 -62.41947 -37.90572 -46.12868 -50.45295 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 -80.23153 -82.63255 -69.21735 -71.36878 -74.45440 -100.26266 200.31781 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 181.12040 159.62780 161.09140 130.84752 156.08272 181.51334 179.17801 2-1943 2-1944 2-1945 2-1946 2-1947 2-1948 2-1949 157.34018 157.21903 144.63477 169.14852 160.92556 156.60129 126.82271 2-1950 2-1951 2-1952 2-1953 2-1954 3-1935 3-1936 124.42169 137.83689 135.68546 132.59984 106.79158 -141.96723 -161.16464 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 -182.65724 -181.19364 -211.43752 -186.20232 -160.77170 -163.10703 -184.94486 3-1944 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 -185.06601 -197.65027 -173.13652 -181.35948 -185.68375 -215.46233 -217.86335 3-1951 3-1952 3-1953 3-1954 4-1935 4-1936 4-1937 -204.44815 -206.59958 -209.68520 -235.49346 88.61741 69.42000 47.92740 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 49.39100 19.14712 44.38232 69.81294 67.47762 45.63978 45.51864 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 32.93437 57.44812 49.22517 44.90089 15.12231 12.72130 26.13650 4-1952 4-1953 4-1954 5-1935 5-1936 5-1937 5-1938 23.98507 20.89944 -4.90881 -12.17503 -31.37244 -52.86504 -51.40143 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5-1945 -81.64532 -56.41011 -30.97949 -33.31482 -55.15265 -55.27380 -67.85807 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 -43.34431 -51.56727 -55.89154 -85.67013 -88.07114 -74.65594 -76.80737 5-1953 5-1954 6-1935 6-1936 6-1937 6-1938 6-1939 -79.89300 -105.70125 96.15221 76.95480 55.46220 56.92580 26.68192 6-1940 6-1941 6-1942 6-1943 6-1944 6-1945 6-1946 51.91712 77.34774 75.01242 53.17458 53.05344 40.46917 64.98292 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 56.75997 52.43569 22.65711 20.25610 33.67130 31.51987 28.43424 6-1954 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 2.62599 44.73018 25.53277 4.04017 5.50377 -24.74011 0.49509 7-1941 7-1942 7-1943 7-1944 7-1945 7-1946 7-1947 25.92571 23.59038 1.75255 1.63140 -10.95286 13.56089 5.33793 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 1.01366 -28.76492 -31.16594 -17.75074 -19.90217 -22.98779 -48.79605 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 60.75408 41.55667 20.06407 21.52768 -8.71621 16.51900 41.94962 8-1942 8-1943 8-1944 8-1945 8-1946 8-1947 8-1948 39.61429 17.77646 17.65531 5.07104 29.58480 21.36184 17.03757 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 9-1935 -12.74102 -15.14203 -1.72683 -3.87826 -6.96389 -32.77214 23.48112 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 4.28372 -17.20889 -15.74528 -45.98917 -20.75396 4.67666 2.34133 9-1943 9-1944 9-1945 9-1946 9-1947 9-1948 9-1949 -19.49650 -19.61765 -32.20192 -7.68816 -15.91112 -20.23539 -50.01398 9-1950 9-1951 9-1952 9-1953 9-1954 10-1935 10-1936 -52.41499 -38.99979 -41.15122 -44.23684 -70.04510 120.10069 100.90328 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 79.41068 80.87428 50.63040 75.86560 101.29623 98.96090 77.12307 10-1944 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 77.00192 64.41765 88.93140 80.70845 76.38417 46.60559 44.20458 10-1951 10-1952 10-1953 10-1954 57.61978 55.46835 52.38272 26.57447 > > > fixef(gi, type = "dfirst") 2 3 4 5 6 7 8 9 172.2025 -165.2751 42.4874 -44.3201 47.1354 3.7432 12.7511 -16.9256 10 63.7289 > fixef(gt, type = "dfirst") 1936 1937 1938 1939 1940 1941 1942 1943 -17.2123 -34.4913 -28.4428 -56.2430 -30.5047 -2.6271 -1.4222 -21.8013 1944 1945 1946 1947 1948 1949 1950 1951 -22.1173 -33.5965 -7.0281 -5.2461 -3.9195 -28.7933 -28.3541 -11.6719 1952 1953 1954 -5.6132 2.4490 -12.3149 > fixef(gtw, effect = "individual", type = "dfirst") 2 3 4 5 6 7 8 9 207.0542 -135.2308 95.3538 -5.4386 102.8886 51.4666 67.4905 30.2176 10 126.8371 > fixef(gtw, effect = "time", type = "dfirst") 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 -19.197 -40.690 -39.226 -69.470 -44.235 -18.804 -21.140 -42.978 -43.099 -55.683 1946 1947 1948 1949 1950 1951 1952 1953 1954 -31.169 -39.392 -43.717 -73.495 -75.896 -62.481 -64.632 -67.718 -93.526 > fixef(gtw, effect = "twoways", type = "dfirst") 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 -19.19741 -40.69001 -39.22640 -69.47029 -44.23508 -18.80446 -21.13979 1-1943 1-1944 1-1945 1-1946 1-1947 1-1948 1-1949 -42.97762 -43.09877 -55.68304 -31.16928 -39.39224 -43.71651 -73.49510 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 -75.89611 -62.48091 -64.63234 -67.71797 -93.52622 207.05424 187.85683 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 166.36423 167.82784 137.58395 162.81916 188.24978 185.91445 164.07662 2-1944 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 163.95547 151.37120 175.88496 167.66200 163.33773 133.55914 131.15813 2-1951 2-1952 2-1953 2-1954 3-1935 3-1936 3-1937 144.57333 142.42190 139.33627 113.52802 -135.23080 -154.42820 -175.92081 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 -174.45720 -204.70109 -179.46588 -154.03526 -156.37059 -178.20842 -178.32957 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 -190.91384 -166.40008 -174.62304 -178.94731 -208.72590 -211.12691 -197.71171 3-1952 3-1953 3-1954 4-1935 4-1936 4-1937 4-1938 -199.86314 -202.94877 -228.75702 95.35384 76.15644 54.66383 56.12744 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4-1945 25.88355 51.11876 76.54938 74.21405 52.37622 52.25507 39.67080 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 64.18456 55.96160 51.63733 21.85874 19.45773 32.87293 30.72150 4-1953 4-1954 5-1935 5-1936 5-1937 5-1938 5-1939 27.63588 1.82762 -5.43860 -24.63600 -46.12860 -44.66500 -74.90888 5-1940 5-1941 5-1942 5-1943 5-1944 5-1945 5-1946 -49.67368 -24.24306 -26.57839 -48.41622 -48.53737 -61.12164 -36.60788 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 -44.83084 -49.15511 -78.93369 -81.33471 -67.91951 -70.07094 -73.15656 5-1954 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 -98.96482 102.88864 83.69124 62.19863 63.66224 33.41835 58.65356 6-1941 6-1942 6-1943 6-1944 6-1945 6-1946 6-1947 84.08418 81.74885 59.91102 59.78987 47.20560 71.71936 63.49640 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 59.17213 29.39354 26.99253 40.40773 38.25630 35.17068 9.36242 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 51.46661 32.26920 10.77660 12.24021 -18.00368 7.23153 32.66215 7-1942 7-1943 7-1944 7-1945 7-1946 7-1947 7-1948 30.32682 8.48899 8.36784 -4.21643 20.29733 12.07437 7.75010 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 8-1935 -22.02849 -24.42950 -11.01430 -13.16573 -16.25136 -42.05961 67.49051 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 48.29311 26.80051 28.26411 -1.97977 23.25543 48.68605 46.35072 8-1943 8-1944 8-1945 8-1946 8-1947 8-1948 8-1949 24.51289 24.39174 11.80747 36.32123 28.09827 23.77400 -6.00458 8-1950 8-1951 8-1952 8-1953 8-1954 9-1935 9-1936 -8.40560 5.00960 2.85817 -0.22745 -26.03571 30.21756 11.02015 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 -10.47245 -9.00885 -39.25273 -14.01753 11.41309 9.07776 -12.76007 9-1944 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 -12.88122 -25.46548 -0.95173 -9.17469 -13.49896 -43.27754 -45.67856 9-1951 9-1952 9-1953 9-1954 10-1935 10-1936 10-1937 -32.26336 -34.41478 -37.50041 -63.30867 126.83712 107.63972 86.14711 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 87.61072 57.36683 82.60204 108.03266 105.69733 83.85950 83.73835 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 71.15408 95.66784 87.44488 83.12061 53.34202 50.94101 64.35621 10-1952 10-1953 10-1954 62.20478 59.11916 33.31090 > > fixef(gtw, effect = "twoways", type = "level") 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 -86.90023 -106.09764 -127.59024 -126.12663 -156.37052 -131.13531 -105.70469 1-1942 1-1943 1-1944 1-1945 1-1946 1-1947 1-1948 -108.04002 -129.87785 -129.99900 -142.58327 -118.06951 -126.29247 -130.61674 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 -160.39533 -162.79634 -149.38114 -151.53257 -154.61820 -180.42645 120.15401 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 100.95660 79.46400 80.92761 50.68372 75.91893 101.34955 99.01422 2-1943 2-1944 2-1945 2-1946 2-1947 2-1948 2-1949 77.17639 77.05524 64.47097 88.98473 80.76177 76.43750 46.65891 2-1950 2-1951 2-1952 2-1953 2-1954 3-1935 3-1936 44.25790 57.67310 55.52167 52.43604 26.62779 -222.13103 -241.32843 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 -262.82104 -261.35743 -291.60132 -266.36611 -240.93549 -243.27082 -265.10865 3-1944 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 -265.22980 -277.81407 -253.30031 -261.52327 -265.84754 -295.62613 -298.02714 3-1951 3-1952 3-1953 3-1954 4-1935 4-1936 4-1937 -284.61194 -286.76337 -289.84900 -315.65725 8.45361 -10.74379 -32.23640 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 -30.77279 -61.01668 -35.78147 -10.35085 -12.68618 -34.52401 -34.64516 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 -47.22943 -22.71567 -30.93863 -35.26290 -65.04149 -67.44250 -54.02730 4-1952 4-1953 4-1954 5-1935 5-1936 5-1937 5-1938 -56.17873 -59.26435 -85.07261 -92.33883 -111.53623 -133.02883 -131.56523 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5-1945 -161.80911 -136.57391 -111.14329 -113.47862 -135.31645 -135.43760 -148.02186 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 -123.50811 -131.73107 -136.05534 -165.83392 -168.23494 -154.81974 -156.97117 5-1953 5-1954 6-1935 6-1936 6-1937 6-1938 6-1939 -160.05679 -185.86505 15.98841 -3.20899 -24.70160 -23.23799 -53.48188 6-1940 6-1941 6-1942 6-1943 6-1944 6-1945 6-1946 -28.24667 -2.81605 -5.15138 -26.98921 -27.11036 -39.69463 -15.18087 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 -23.40383 -27.72810 -57.50669 -59.90770 -46.49250 -48.64393 -51.72955 6-1954 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 -77.53781 -35.43362 -54.63103 -76.12363 -74.66002 -104.90391 -79.66870 7-1941 7-1942 7-1943 7-1944 7-1945 7-1946 7-1947 -54.23808 -56.57341 -78.41124 -78.53239 -91.11666 -66.60290 -74.82586 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 -79.15013 -108.92872 -111.32973 -97.91453 -100.06596 -103.15159 -128.95984 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 -19.40972 -38.60712 -60.09972 -58.63612 -88.88000 -63.64480 -38.21418 8-1942 8-1943 8-1944 8-1945 8-1946 8-1947 8-1948 -40.54951 -62.38734 -62.50849 -75.09276 -50.57900 -58.80196 -63.12623 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 9-1935 -92.90481 -95.30583 -81.89063 -84.04206 -87.12768 -112.93594 -56.68267 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 -75.88008 -97.37268 -95.90908 -126.15296 -100.91776 -75.48714 -77.82247 9-1943 9-1944 9-1945 9-1946 9-1947 9-1948 9-1949 -99.66030 -99.78145 -112.36571 -87.85196 -96.07492 -100.39919 -130.17777 9-1950 9-1951 9-1952 9-1953 9-1954 10-1935 10-1936 -132.57879 -119.16359 -121.31501 -124.40064 -150.20890 39.93689 20.73949 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 -0.75312 0.71049 -29.53340 -4.29819 21.13243 18.79710 -3.04073 10-1944 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 -3.16188 -15.74615 8.76761 0.54465 -3.77962 -33.55821 -35.95922 10-1951 10-1952 10-1953 10-1954 -22.54402 -24.69545 -27.78107 -53.58933 > > ############# (2): consistency with summary.plm ############# > # compare summary.plm to summary.fixef( , type = "dfirst") > mod_pool <- plm(inv ~ value + capital + factor(firm), data = Grunfeld, model = "pooling") > sum_mod_pool <- summary(mod_pool) > f_dfirst <- fixef(gi, type = "dfirst") > sum_f_dfirst <- summary(f_dfirst) > > if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Estimate"], sum_f_dfirst[ , "Estimate"], check.attributes = FALSE))) + stop("estimates diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Std. Error"], sum_f_dfirst[ , "Std. Error"], check.attributes = FALSE))) + stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "t-value"], sum_f_dfirst[ , "t-value"], check.attributes = FALSE))) + stop("t-values diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Pr(>|t|)"], sum_f_dfirst[ , "Pr(>|t|)"], check.attributes = FALSE))) + stop("p-values diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > > ###### compare to package lfe: > ## Standard errors are bootstrapped in lfe > ## -> different SE results compared to plm > ## -> different SE results for every new call > # > # library(lfe) > # data("Grunfeld", package = "plm") > # mod_felm <- felm(inv ~ value + capital | firm, data = Grunfeld) > # summary(mod_felm) > # > # fe_lfe <- getfe(mod_felm, se = TRUE, bN = 50) > # print(fe_lfe) > > # sum_f_level <- summary(f_level) > # print(sum_f_level) > > proc.time() user system elapsed 1.06 0.15 1.18 plm/inst/tests/test_pwaldtest_vcovG_attr_cluster.R0000644000176200001440000001117614124132276022321 0ustar liggesusers#### Testfile to see the attr(vcov, which="cluster") for various vcovXX methods # # see also testfile tests/test_pwaldtest.R for general tests of the F test and Chisq test options(scipen = 999) options(digits = 8) library(plm) data("Grunfeld", package="plm") gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") gi <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual", model = "within") gt <- plm(inv ~ value + capital, data = Grunfeld, effect = "time", model = "within") gd <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "within") # vcovHC print(attr(vcovHC(gi), which="cluster")) # group - default print(attr(vcovHC(gi, cluster="group"), which="cluster")) # group print(attr(vcovHC(gi, cluster="time"), which="cluster")) # time # vcovBK print(attr(vcovBK(gi), which="cluster")) # group - default print(attr(vcovBK(gi, cluster="group"), which="cluster")) # group print(attr(vcovBK(gi, cluster="time"), which="cluster")) # time # vcovSCC print(attr(vcovSCC(gi), which="cluster")) # time - default and should be the only option for SCC print(attr(vcovSCC(gi, cluster="group"), which="cluster")) # group print(attr(vcovSCC(gi, cluster="time"), which="cluster")) # time # vcovNW print(attr(vcovNW(gi), which="cluster")) # time - default and should be the only option for NW print(attr(vcovNW(gi, cluster="group"), which="cluster")) # group print(attr(vcovNW(gi, cluster="time"), which="cluster")) # time # vcovDC print(attr(vcovDC(gi), which="cluster")) # group-time - nothing else possible # pooling model F test - robust - function plm::pwaldtest(gp, test = "F", vcov = vcovHC) plm::pwaldtest(gp, test = "F", vcov = vcovBK) plm::pwaldtest(gp, test = "F", vcov = vcovSCC) plm::pwaldtest(gp, test = "F", vcov = vcovNW) plm::pwaldtest(gp, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering # within model individual F test - robust - function plm::pwaldtest(gi, test = "F", vcov = vcovHC) plm::pwaldtest(gi, test = "F", vcov = vcovBK) plm::pwaldtest(gi, test = "F", vcov = vcovSCC) plm::pwaldtest(gi, test = "F", vcov = vcovNW) plm::pwaldtest(gi, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering # within model time F test - robust - function plm::pwaldtest(gt, test = "F", vcov = vcovHC) plm::pwaldtest(gt, test = "F", vcov = vcovBK) plm::pwaldtest(gt, test = "F", vcov = vcovSCC) plm::pwaldtest(gt, test = "F", vcov = vcovNW) plm::pwaldtest(gt, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering # within model twoways F test - robust - function plm::pwaldtest(gd, test = "F", vcov = vcovHC) plm::pwaldtest(gd, test = "F", vcov = vcovBK) plm::pwaldtest(gd, test = "F", vcov = vcovSCC) plm::pwaldtest(gd, test = "F", vcov = vcovNW) plm::pwaldtest(gd, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering # pooling model Chisq - robust - function plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gp, test = "Chisq", vcov = vcovBK) plm::pwaldtest(gp, test = "Chisq", vcov = vcovSCC) plm::pwaldtest(gp, test = "Chisq", vcov = vcovNW) plm::pwaldtest(gp, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test # within model individual Chisq - robust - function plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gi, test = "Chisq", vcov = vcovBK) plm::pwaldtest(gi, test = "Chisq", vcov = vcovSCC) plm::pwaldtest(gi, test = "Chisq", vcov = vcovNW) plm::pwaldtest(gi, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test # within model time Chisq - robust - function plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gt, test = "Chisq", vcov = vcovBK) plm::pwaldtest(gt, test = "Chisq", vcov = vcovSCC) plm::pwaldtest(gt, test = "Chisq", vcov = vcovNW) plm::pwaldtest(gt, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test # within model twoways Chisq - robust - function plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gd, test = "Chisq", vcov = vcovBK) plm::pwaldtest(gd, test = "Chisq", vcov = vcovSCC) plm::pwaldtest(gd, test = "Chisq", vcov = vcovNW) plm::pwaldtest(gd, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test plm/inst/tests/test_pdata.frame_id_index_more.Rout.save0000644000176200001440000035267114124132276023117 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Test of conversion to pdata.frame if only an individual index in supplied > # bug fixed in rev. 204 > > > library(plm) > data("Hedonic", package = "plm") > > # insert test columns > Hedonic$str <- c(rep(c(letters), nrow(Hedonic)%/%length(letters)), letters[1:(nrow(Hedonic)%%length(letters))]) > Hedonic$str_const <- rep("const", nrow(Hedonic)) > temp <- pdata.frame(Hedonic, index = "townid") > Hedonic$fac <- factor(Hedonic$str) > Hedonic$fac_const <- rep(factor("fac_const"), nrow(Hedonic)) > Hedonic$na <- rep(NA, nrow(Hedonic)) > temp <- pdata.frame(Hedonic, index = "townid") > Hedonic$na2 <- rep(NA, nrow(Hedonic)) > > rm(temp) > > Hedonic2 <- Hedonic[order(Hedonic$mv), ] # sorted a different way > Hedonic3 <- Hedonic[order(Hedonic$townid, decreasing = TRUE), ] # in descending order > > Hed1 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = FALSE) # works > pdim(Hed1) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed1) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-2 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 3-3 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-2 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA 3-3 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > > Hed1_2.1 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = TRUE) # works > pdim(Hed1_2.1) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed1_2.1) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-2 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 3-3 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-2 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA 3-3 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > #str(Hed1_2.1) > sapply(Hed1_2.1, function(x) class(x)) mv crim zn indus chas nox rm age "numeric" "numeric" "numeric" "numeric" "factor" "numeric" "numeric" "numeric" dis rad tax ptratio blacks lstat townid str "numeric" "numeric" "integer" "numeric" "numeric" "numeric" "factor" "factor" str_const fac fac_const na na2 time "factor" "factor" "factor" "logical" "logical" "factor" > > Hed1_2.2 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = FALSE) # works > pdim(Hed1_2.2) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed1_2.2) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-2 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 3-3 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-2 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA 3-3 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > #str(Hed1_2.2) > sapply(Hed1_2.2, function(x) class(x)) mv crim zn indus chas nox "numeric" "numeric" "numeric" "numeric" "factor" "numeric" rm age dis rad tax ptratio "numeric" "numeric" "numeric" "numeric" "integer" "numeric" blacks lstat townid str str_const fac "numeric" "numeric" "factor" "character" "character" "factor" fac_const na na2 time "factor" "logical" "logical" "factor" > > > > Hed2 <- pdata.frame(Hedonic2, index = "townid") > pdim(Hed2) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed2) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 3-2 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-3 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA 3-2 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-3 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > > Hed2_2 <- pdata.frame(Hedonic2, index = "townid") > pdim(Hed2_2) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed2_2) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 3-2 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-3 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA 3-2 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-3 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > head(Hedonic2) mv crim zn indus chas nox rm age dis rad 399 8.51719 38.35180 0 18.09999 no 48.0248 29.7352 100.00000 0.39851 3.17805 406 8.51719 67.92080 0 18.09999 no 48.0248 32.2965 100.00000 0.35445 3.17805 401 8.63052 25.04610 0 18.09999 no 48.0248 35.8442 100.00000 0.46298 3.17805 400 8.74831 9.91655 0 18.09999 no 48.0248 34.2459 77.79999 0.40573 3.17805 415 8.85367 45.74610 0 18.09999 no 48.0248 20.4213 100.00000 0.50573 3.17805 490 8.85367 0.18337 0 27.73999 no 37.0881 29.3114 98.29999 0.56270 1.38629 tax ptratio blacks lstat townid str str_const fac fac_const na na2 399 666 20.20000 0.39690 -1.18453 81 i const i fac_const NA NA 406 666 20.20000 0.38497 -1.47072 81 p const p fac_const NA NA 401 666 20.20000 0.39690 -1.31793 81 k const k fac_const NA NA 400 666 20.20000 0.33817 -1.20481 81 j const j fac_const NA NA 415 666 20.20000 0.08827 -0.99474 83 y const y fac_const NA NA 490 711 20.09999 0.34405 -1.42828 90 v const v fac_const NA NA > > > Hed3 <- pdata.frame(Hedonic3, index = "townid") > pdim(Hed3) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed3) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-2 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 3-3 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-2 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA 3-3 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > > Hed3_2 <- pdata.frame(Hedonic3, index = "townid") > pdim(Hed3_2) Unbalanced Panel: n = 92, T = 1-30, N = 506 > head(Hed3_2) mv crim zn indus chas nox rm age dis rad 1-1 10.08580 0.00632 18 2.309999 no 28.9444 43.2306 65.19995 1.40854 0.00000 2-1 9.98045 0.02731 0 7.070000 no 21.9961 41.2292 78.89996 1.60283 0.69315 2-2 10.45450 0.02730 0 7.070000 no 21.9961 51.6242 61.09998 1.60283 0.69315 3-1 10.41630 0.03237 0 2.179998 no 20.9764 48.9720 45.79999 1.80207 1.09861 3-2 10.49680 0.06905 0 2.179998 no 20.9764 51.0796 54.19998 1.80207 1.09861 3-3 10.26470 0.02985 0 2.179998 no 20.9764 41.3449 58.69998 1.80207 1.09861 tax ptratio blacks lstat townid str str_const fac fac_const na na2 1-1 296 15.29999 0.39690 -3.00074 1 a const a fac_const NA NA 2-1 242 17.79999 0.39690 -2.39251 2 b const b fac_const NA NA 2-2 242 17.79999 0.39283 -3.21165 2 c const c fac_const NA NA 3-1 222 18.70000 0.39464 -3.52744 3 d const d fac_const NA NA 3-2 222 18.70000 0.39690 -2.93163 3 e const e fac_const NA NA 3-3 222 18.70000 0.39412 -2.95555 3 f const f fac_const NA NA time 1-1 1 2-1 1 2-2 2 3-1 1 3-2 2 3-3 3 > head(Hedonic3) mv crim zn indus chas nox rm age dis rad 502 10.01680 0.06263 0 11.929993 no 32.8329 43.4677 69.09998 0.90769 0.00000 503 9.93305 0.04527 0 11.929993 no 32.8329 37.4544 76.69995 0.82746 0.00000 504 10.08160 0.06076 0 11.929993 no 32.8329 48.6646 91.00000 0.77357 0.00000 505 9.99880 0.10959 0 11.929993 no 32.8329 46.1584 89.29999 0.87083 0.00000 506 9.38429 0.04741 0 11.929993 no 32.8329 36.3609 80.79999 0.91829 0.00000 494 9.98967 0.17331 0 9.689995 no 34.2225 32.5698 54.00000 0.86781 1.79176 tax ptratio blacks lstat townid str str_const fac fac_const na na2 502 273 21.0 0.39199 -2.33604 92 h const h fac_const NA NA 503 273 21.0 0.39690 -2.39910 92 i const i fac_const NA NA 504 273 21.0 0.39690 -2.87582 92 j const j fac_const NA NA 505 273 21.0 0.39346 -2.73630 92 k const k fac_const NA NA 506 273 21.0 0.39690 -2.54033 92 l const l fac_const NA NA 494 391 19.2 0.39690 -2.11943 91 z const z fac_const NA NA > > # test for warning of duplicated couples > data("Grunfeld", package = "plm") > Grunfeld_dup <- rbind(Grunfeld, Grunfeld[200, ]) > ttC <- tryCatch(pdata.frame(Grunfeld_dup), error=function(e) e, warning=function(w) w) > if(!is(ttC,"warning") | ttC$message != "duplicate couples (id-time) in resulting pdata.frame\n to find out which, use, e.g., table(index(your_pdataframe), useNA = \"ifany\")") + stop("warning of duplicated couples not successful") > > > # test: character as individual index > Grunfeld.p <- pdata.frame(Grunfeld) > Grunfeld_charac <- Grunfeld > Grunfeld_charac$firm <- as.character(Grunfeld_charac$firm) > Grunfeld_charac.p <- pdata.frame(Grunfeld_charac) > Grunfeld_charac.p2 <- pdata.frame(Grunfeld_charac, stringsAsFactors = FALSE) > if(!identical(Grunfeld_charac.p, Grunfeld_charac.p2)) stop("pdata.frames not identical)") > pdim(Grunfeld_charac.p) Balanced Panel: n = 10, T = 20, N = 200 > pdim(Grunfeld_charac.p2) Balanced Panel: n = 10, T = 20, N = 200 > > > # test: character as individual index > Grunfeld_charac2 <- Grunfeld > Grunfeld_charac2$firm <- as.character(Grunfeld_charac2$firm) > Grunfeld_charac2$year <- as.character(Grunfeld_charac2$year) > Grunfeld_charac2.p <- pdata.frame(Grunfeld_charac2) > Grunfeld_charac2.p2 <- pdata.frame(Grunfeld_charac2, stringsAsFactors = FALSE) > if(!identical(Grunfeld_charac2.p, Grunfeld_charac2.p2)) stop("pdata.frames not identical)") > pdim(Grunfeld_charac2.p) Balanced Panel: n = 10, T = 20, N = 200 > pdim(Grunfeld_charac2.p2) Balanced Panel: n = 10, T = 20, N = 200 > > # index with two variables > Grunfeld.p3 <- pdata.frame(Grunfeld, index = c("firm", "year")) > pdim(Grunfeld.p3) Balanced Panel: n = 10, T = 20, N = 200 > > # index is numeric > data("Wages", package = "plm") > Wag <- pdata.frame(Wages, 595) > pdim(Wag) Balanced Panel: n = 595, T = 7, N = 4165 > > # test for warning about time index > ttC2 <- tryCatch(pdata.frame(Wages, index=c(595, 3)), error=function(e) e, warning = function(w) w) > if(!is(ttC2,"warning") | ttC2$message != "The time index (second element of 'index' argument) will be ignored\n") stop("warning about unused time index not sent") > > # test of index() when individual index is called "group" (fixed in revision 904) > data("Produc", package = "plm") > Produc$group <- Produc$region > pProduc <- pdata.frame(Produc, index = "group") > index(pProduc) group time 86 1 1 87 1 2 88 1 3 89 1 4 90 1 5 91 1 6 92 1 7 93 1 8 94 1 9 95 1 10 96 1 11 97 1 12 98 1 13 99 1 14 100 1 15 101 1 16 102 1 17 273 1 18 274 1 19 275 1 20 276 1 21 277 1 22 278 1 23 279 1 24 280 1 25 281 1 26 282 1 27 283 1 28 284 1 29 285 1 30 286 1 31 287 1 32 288 1 33 289 1 34 307 1 35 308 1 36 309 1 37 310 1 38 311 1 39 312 1 40 313 1 41 314 1 42 315 1 43 316 1 44 317 1 45 318 1 46 319 1 47 320 1 48 321 1 49 322 1 50 323 1 51 443 1 52 444 1 53 445 1 54 446 1 55 447 1 56 448 1 57 449 1 58 450 1 59 451 1 60 452 1 61 453 1 62 454 1 63 455 1 64 456 1 65 457 1 66 458 1 67 459 1 68 613 1 69 614 1 70 615 1 71 616 1 72 617 1 73 618 1 74 619 1 75 620 1 76 621 1 77 622 1 78 623 1 79 624 1 80 625 1 81 626 1 82 627 1 83 628 1 84 629 1 85 715 1 86 716 1 87 717 1 88 718 1 89 719 1 90 720 1 91 721 1 92 722 1 93 723 1 94 724 1 95 725 1 96 726 1 97 727 1 98 728 1 99 729 1 100 730 1 101 731 1 102 460 2 1 461 2 2 462 2 3 463 2 4 464 2 5 465 2 6 466 2 7 467 2 8 468 2 9 469 2 10 470 2 11 471 2 12 472 2 13 473 2 14 474 2 15 475 2 16 476 2 17 494 2 18 495 2 19 496 2 20 497 2 21 498 2 22 499 2 23 500 2 24 501 2 25 502 2 26 503 2 27 504 2 28 505 2 29 506 2 30 507 2 31 508 2 32 509 2 33 510 2 34 596 2 35 597 2 36 598 2 37 599 2 38 600 2 39 601 2 40 602 2 41 603 2 42 604 2 43 605 2 44 606 2 45 607 2 46 608 2 47 609 2 48 610 2 49 611 2 50 612 2 51 171 3 1 172 3 2 173 3 3 174 3 4 175 3 5 176 3 6 177 3 7 178 3 8 179 3 9 180 3 10 181 3 11 182 3 12 183 3 13 184 3 14 185 3 15 186 3 16 187 3 17 188 3 18 189 3 19 190 3 20 191 3 21 192 3 22 193 3 23 194 3 24 195 3 25 196 3 26 197 3 27 198 3 28 199 3 29 200 3 30 201 3 31 202 3 32 203 3 33 204 3 34 324 3 35 325 3 36 326 3 37 327 3 38 328 3 39 329 3 40 330 3 41 331 3 42 332 3 43 333 3 44 334 3 45 335 3 46 336 3 47 337 3 48 338 3 49 339 3 50 340 3 51 545 3 52 546 3 53 547 3 54 548 3 55 549 3 56 550 3 57 551 3 58 552 3 59 553 3 60 554 3 61 555 3 62 556 3 63 557 3 64 558 3 65 559 3 66 560 3 67 561 3 68 783 3 69 784 3 70 785 3 71 786 3 72 787 3 73 788 3 74 789 3 75 790 3 76 791 3 77 792 3 78 793 3 79 794 3 80 795 3 81 796 3 82 797 3 83 798 3 84 799 3 85 205 4 1 206 4 2 207 4 3 208 4 4 209 4 5 210 4 6 211 4 7 212 4 8 213 4 9 214 4 10 215 4 11 216 4 12 217 4 13 218 4 14 219 4 15 220 4 16 221 4 17 222 4 18 223 4 19 224 4 20 225 4 21 226 4 22 227 4 23 228 4 24 229 4 25 230 4 26 231 4 27 232 4 28 233 4 29 234 4 30 235 4 31 236 4 32 237 4 33 238 4 34 341 4 35 342 4 36 343 4 37 344 4 38 345 4 39 346 4 40 347 4 41 348 4 42 349 4 43 350 4 44 351 4 45 352 4 46 353 4 47 354 4 48 355 4 49 356 4 50 357 4 51 375 4 52 376 4 53 377 4 54 378 4 55 379 4 56 380 4 57 381 4 58 382 4 59 383 4 60 384 4 61 385 4 62 386 4 63 387 4 64 388 4 65 389 4 66 390 4 67 391 4 68 409 4 69 410 4 70 411 4 71 412 4 72 413 4 73 414 4 74 415 4 75 416 4 76 417 4 77 418 4 78 419 4 79 420 4 80 421 4 81 422 4 82 423 4 83 424 4 84 425 4 85 528 4 86 529 4 87 530 4 88 531 4 89 532 4 90 533 4 91 534 4 92 535 4 93 536 4 94 537 4 95 538 4 96 539 4 97 540 4 98 541 4 99 542 4 100 543 4 101 544 4 102 647 4 103 648 4 104 649 4 105 650 4 106 651 4 107 652 4 108 653 4 109 654 4 110 655 4 111 656 4 112 657 4 113 658 4 114 659 4 115 660 4 116 661 4 117 662 4 118 663 4 119 103 5 1 104 5 2 105 5 3 106 5 4 107 5 5 108 5 6 109 5 7 110 5 8 111 5 9 112 5 10 113 5 11 114 5 12 115 5 13 116 5 14 117 5 15 118 5 16 119 5 17 120 5 18 121 5 19 122 5 20 123 5 21 124 5 22 125 5 23 126 5 24 127 5 25 128 5 26 129 5 27 130 5 28 131 5 29 132 5 30 133 5 31 134 5 32 135 5 33 136 5 34 137 5 35 138 5 36 139 5 37 140 5 38 141 5 39 142 5 40 143 5 41 144 5 42 145 5 43 146 5 44 147 5 45 148 5 46 149 5 47 150 5 48 151 5 49 152 5 50 153 5 51 290 5 52 291 5 53 292 5 54 293 5 55 294 5 56 295 5 57 296 5 58 297 5 59 298 5 60 299 5 61 300 5 62 301 5 63 302 5 64 303 5 65 304 5 66 305 5 67 306 5 68 511 5 69 512 5 70 513 5 71 514 5 72 515 5 73 516 5 74 517 5 75 518 5 76 519 5 77 520 5 78 521 5 79 522 5 80 523 5 81 524 5 82 525 5 83 526 5 84 527 5 85 630 5 86 631 5 87 632 5 88 633 5 89 634 5 90 635 5 91 636 5 92 637 5 93 638 5 94 639 5 95 640 5 96 641 5 97 642 5 98 643 5 99 644 5 100 645 5 101 646 5 102 732 5 103 733 5 104 734 5 105 735 5 106 736 5 107 737 5 108 738 5 109 739 5 110 740 5 111 741 5 112 742 5 113 743 5 114 744 5 115 745 5 116 746 5 117 747 5 118 748 5 119 766 5 120 767 5 121 768 5 122 769 5 123 770 5 124 771 5 125 772 5 126 773 5 127 774 5 128 775 5 129 776 5 130 777 5 131 778 5 132 779 5 133 780 5 134 781 5 135 782 5 136 1 6 1 2 6 2 3 6 3 4 6 4 5 6 5 6 6 6 7 6 7 8 6 8 9 6 9 10 6 10 11 6 11 12 6 12 13 6 13 14 6 14 15 6 15 16 6 16 17 6 17 239 6 18 240 6 19 241 6 20 242 6 21 243 6 22 244 6 23 245 6 24 246 6 25 247 6 26 248 6 27 249 6 28 250 6 29 251 6 30 252 6 31 253 6 32 254 6 33 255 6 34 358 6 35 359 6 36 360 6 37 361 6 38 362 6 39 363 6 40 364 6 41 365 6 42 366 6 43 367 6 44 368 6 45 369 6 46 370 6 47 371 6 48 372 6 49 373 6 50 374 6 51 664 6 52 665 6 53 666 6 54 667 6 55 668 6 56 669 6 57 670 6 58 671 6 59 672 6 60 673 6 61 674 6 62 675 6 63 676 6 64 677 6 65 678 6 66 679 6 67 680 6 68 35 7 1 36 7 2 37 7 3 38 7 4 39 7 5 40 7 6 41 7 7 42 7 8 43 7 9 44 7 10 45 7 11 46 7 12 47 7 13 48 7 14 49 7 15 50 7 16 51 7 17 256 7 18 257 7 19 258 7 20 259 7 21 260 7 22 261 7 23 262 7 24 263 7 25 264 7 26 265 7 27 266 7 28 267 7 29 268 7 30 269 7 31 270 7 32 271 7 33 272 7 34 562 7 35 563 7 36 564 7 37 565 7 38 566 7 39 567 7 40 568 7 41 569 7 42 570 7 43 571 7 44 572 7 45 573 7 46 574 7 47 575 7 48 576 7 49 577 7 50 578 7 51 681 7 52 682 7 53 683 7 54 684 7 55 685 7 56 686 7 57 687 7 58 688 7 59 689 7 60 690 7 61 691 7 62 692 7 63 693 7 64 694 7 65 695 7 66 696 7 67 697 7 68 18 8 1 19 8 2 20 8 3 21 8 4 22 8 5 23 8 6 24 8 7 25 8 8 26 8 9 27 8 10 28 8 11 29 8 12 30 8 13 31 8 14 32 8 15 33 8 16 34 8 17 69 8 18 70 8 19 71 8 20 72 8 21 73 8 22 74 8 23 75 8 24 76 8 25 77 8 26 78 8 27 79 8 28 80 8 29 81 8 30 82 8 31 83 8 32 84 8 33 85 8 34 154 8 35 155 8 36 156 8 37 157 8 38 158 8 39 159 8 40 160 8 41 161 8 42 162 8 43 163 8 44 164 8 45 165 8 46 166 8 47 167 8 48 168 8 49 169 8 50 170 8 51 392 8 52 393 8 53 394 8 54 395 8 55 396 8 56 397 8 57 398 8 58 399 8 59 400 8 60 401 8 61 402 8 62 403 8 63 404 8 64 405 8 65 406 8 66 407 8 67 408 8 68 426 8 69 427 8 70 428 8 71 429 8 72 430 8 73 431 8 74 432 8 75 433 8 76 434 8 77 435 8 78 436 8 79 437 8 80 438 8 81 439 8 82 440 8 83 441 8 84 442 8 85 477 8 86 478 8 87 479 8 88 480 8 89 481 8 90 482 8 91 483 8 92 484 8 93 485 8 94 486 8 95 487 8 96 488 8 97 489 8 98 490 8 99 491 8 100 492 8 101 493 8 102 698 8 103 699 8 104 700 8 105 701 8 106 702 8 107 703 8 108 704 8 109 705 8 110 706 8 111 707 8 112 708 8 113 709 8 114 710 8 115 711 8 116 712 8 117 713 8 118 714 8 119 800 8 120 801 8 121 802 8 122 803 8 123 804 8 124 805 8 125 806 8 126 807 8 127 808 8 128 809 8 129 810 8 130 811 8 131 812 8 132 813 8 133 814 8 134 815 8 135 816 8 136 52 9 1 53 9 2 54 9 3 55 9 4 56 9 5 57 9 6 58 9 7 59 9 8 60 9 9 61 9 10 62 9 11 63 9 12 64 9 13 65 9 14 66 9 15 67 9 16 68 9 17 579 9 18 580 9 19 581 9 20 582 9 21 583 9 22 584 9 23 585 9 24 586 9 25 587 9 26 588 9 27 589 9 28 590 9 29 591 9 30 592 9 31 593 9 32 594 9 33 595 9 34 749 9 35 750 9 36 751 9 37 752 9 38 753 9 39 754 9 40 755 9 41 756 9 42 757 9 43 758 9 44 759 9 45 760 9 46 761 9 47 762 9 48 763 9 49 764 9 50 765 9 51 > > > # test of 'appropriate' (="non-confusing") index names -> should issue warning > data("Produc", package = "plm") > Produc_confuse <- transform(Produc, id = year) > Produc_confuse <- transform(Produc_confuse, time = state) > > p2 <- pdata.frame(Produc_confuse, index=c("state", "id")) > p3 <- pdata.frame(Produc_confuse, index=c("time", "id")) > > index(p2) # gives wrong index (2x individual variable) with warning state state.1 1 ALABAMA ALABAMA 2 ALABAMA ALABAMA 3 ALABAMA ALABAMA 4 ALABAMA ALABAMA 5 ALABAMA ALABAMA 6 ALABAMA ALABAMA 7 ALABAMA ALABAMA 8 ALABAMA ALABAMA 9 ALABAMA ALABAMA 10 ALABAMA ALABAMA 11 ALABAMA ALABAMA 12 ALABAMA ALABAMA 13 ALABAMA ALABAMA 14 ALABAMA ALABAMA 15 ALABAMA ALABAMA 16 ALABAMA ALABAMA 17 ALABAMA ALABAMA 18 ARIZONA ARIZONA 19 ARIZONA ARIZONA 20 ARIZONA ARIZONA 21 ARIZONA ARIZONA 22 ARIZONA ARIZONA 23 ARIZONA ARIZONA 24 ARIZONA ARIZONA 25 ARIZONA ARIZONA 26 ARIZONA ARIZONA 27 ARIZONA ARIZONA 28 ARIZONA ARIZONA 29 ARIZONA ARIZONA 30 ARIZONA ARIZONA 31 ARIZONA ARIZONA 32 ARIZONA ARIZONA 33 ARIZONA ARIZONA 34 ARIZONA ARIZONA 35 ARKANSAS ARKANSAS 36 ARKANSAS ARKANSAS 37 ARKANSAS ARKANSAS 38 ARKANSAS ARKANSAS 39 ARKANSAS ARKANSAS 40 ARKANSAS ARKANSAS 41 ARKANSAS ARKANSAS 42 ARKANSAS ARKANSAS 43 ARKANSAS ARKANSAS 44 ARKANSAS ARKANSAS 45 ARKANSAS ARKANSAS 46 ARKANSAS ARKANSAS 47 ARKANSAS ARKANSAS 48 ARKANSAS ARKANSAS 49 ARKANSAS ARKANSAS 50 ARKANSAS ARKANSAS 51 ARKANSAS ARKANSAS 52 CALIFORNIA CALIFORNIA 53 CALIFORNIA CALIFORNIA 54 CALIFORNIA CALIFORNIA 55 CALIFORNIA CALIFORNIA 56 CALIFORNIA CALIFORNIA 57 CALIFORNIA CALIFORNIA 58 CALIFORNIA CALIFORNIA 59 CALIFORNIA CALIFORNIA 60 CALIFORNIA CALIFORNIA 61 CALIFORNIA CALIFORNIA 62 CALIFORNIA CALIFORNIA 63 CALIFORNIA CALIFORNIA 64 CALIFORNIA CALIFORNIA 65 CALIFORNIA CALIFORNIA 66 CALIFORNIA CALIFORNIA 67 CALIFORNIA CALIFORNIA 68 CALIFORNIA CALIFORNIA 69 COLORADO COLORADO 70 COLORADO COLORADO 71 COLORADO COLORADO 72 COLORADO COLORADO 73 COLORADO COLORADO 74 COLORADO COLORADO 75 COLORADO COLORADO 76 COLORADO COLORADO 77 COLORADO COLORADO 78 COLORADO COLORADO 79 COLORADO COLORADO 80 COLORADO COLORADO 81 COLORADO COLORADO 82 COLORADO COLORADO 83 COLORADO COLORADO 84 COLORADO COLORADO 85 COLORADO COLORADO 86 CONNECTICUT CONNECTICUT 87 CONNECTICUT CONNECTICUT 88 CONNECTICUT CONNECTICUT 89 CONNECTICUT CONNECTICUT 90 CONNECTICUT CONNECTICUT 91 CONNECTICUT CONNECTICUT 92 CONNECTICUT CONNECTICUT 93 CONNECTICUT CONNECTICUT 94 CONNECTICUT CONNECTICUT 95 CONNECTICUT CONNECTICUT 96 CONNECTICUT CONNECTICUT 97 CONNECTICUT CONNECTICUT 98 CONNECTICUT CONNECTICUT 99 CONNECTICUT CONNECTICUT 100 CONNECTICUT CONNECTICUT 101 CONNECTICUT CONNECTICUT 102 CONNECTICUT CONNECTICUT 103 DELAWARE DELAWARE 104 DELAWARE DELAWARE 105 DELAWARE DELAWARE 106 DELAWARE DELAWARE 107 DELAWARE DELAWARE 108 DELAWARE DELAWARE 109 DELAWARE DELAWARE 110 DELAWARE DELAWARE 111 DELAWARE DELAWARE 112 DELAWARE DELAWARE 113 DELAWARE DELAWARE 114 DELAWARE DELAWARE 115 DELAWARE DELAWARE 116 DELAWARE DELAWARE 117 DELAWARE DELAWARE 118 DELAWARE DELAWARE 119 DELAWARE DELAWARE 120 FLORIDA FLORIDA 121 FLORIDA FLORIDA 122 FLORIDA FLORIDA 123 FLORIDA FLORIDA 124 FLORIDA FLORIDA 125 FLORIDA FLORIDA 126 FLORIDA FLORIDA 127 FLORIDA FLORIDA 128 FLORIDA FLORIDA 129 FLORIDA FLORIDA 130 FLORIDA FLORIDA 131 FLORIDA FLORIDA 132 FLORIDA FLORIDA 133 FLORIDA FLORIDA 134 FLORIDA FLORIDA 135 FLORIDA FLORIDA 136 FLORIDA FLORIDA 137 GEORGIA GEORGIA 138 GEORGIA GEORGIA 139 GEORGIA GEORGIA 140 GEORGIA GEORGIA 141 GEORGIA GEORGIA 142 GEORGIA GEORGIA 143 GEORGIA GEORGIA 144 GEORGIA GEORGIA 145 GEORGIA GEORGIA 146 GEORGIA GEORGIA 147 GEORGIA GEORGIA 148 GEORGIA GEORGIA 149 GEORGIA GEORGIA 150 GEORGIA GEORGIA 151 GEORGIA GEORGIA 152 GEORGIA GEORGIA 153 GEORGIA GEORGIA 154 IDAHO IDAHO 155 IDAHO IDAHO 156 IDAHO IDAHO 157 IDAHO IDAHO 158 IDAHO IDAHO 159 IDAHO IDAHO 160 IDAHO IDAHO 161 IDAHO IDAHO 162 IDAHO IDAHO 163 IDAHO IDAHO 164 IDAHO IDAHO 165 IDAHO IDAHO 166 IDAHO IDAHO 167 IDAHO IDAHO 168 IDAHO IDAHO 169 IDAHO IDAHO 170 IDAHO IDAHO 171 ILLINOIS ILLINOIS 172 ILLINOIS ILLINOIS 173 ILLINOIS ILLINOIS 174 ILLINOIS ILLINOIS 175 ILLINOIS ILLINOIS 176 ILLINOIS ILLINOIS 177 ILLINOIS ILLINOIS 178 ILLINOIS ILLINOIS 179 ILLINOIS ILLINOIS 180 ILLINOIS ILLINOIS 181 ILLINOIS ILLINOIS 182 ILLINOIS ILLINOIS 183 ILLINOIS ILLINOIS 184 ILLINOIS ILLINOIS 185 ILLINOIS ILLINOIS 186 ILLINOIS ILLINOIS 187 ILLINOIS ILLINOIS 188 INDIANA INDIANA 189 INDIANA INDIANA 190 INDIANA INDIANA 191 INDIANA INDIANA 192 INDIANA INDIANA 193 INDIANA INDIANA 194 INDIANA INDIANA 195 INDIANA INDIANA 196 INDIANA INDIANA 197 INDIANA INDIANA 198 INDIANA INDIANA 199 INDIANA INDIANA 200 INDIANA INDIANA 201 INDIANA INDIANA 202 INDIANA INDIANA 203 INDIANA INDIANA 204 INDIANA INDIANA 205 IOWA IOWA 206 IOWA IOWA 207 IOWA IOWA 208 IOWA IOWA 209 IOWA IOWA 210 IOWA IOWA 211 IOWA IOWA 212 IOWA IOWA 213 IOWA IOWA 214 IOWA IOWA 215 IOWA IOWA 216 IOWA IOWA 217 IOWA IOWA 218 IOWA IOWA 219 IOWA IOWA 220 IOWA IOWA 221 IOWA IOWA 222 KANSAS KANSAS 223 KANSAS KANSAS 224 KANSAS KANSAS 225 KANSAS KANSAS 226 KANSAS KANSAS 227 KANSAS KANSAS 228 KANSAS KANSAS 229 KANSAS KANSAS 230 KANSAS KANSAS 231 KANSAS KANSAS 232 KANSAS KANSAS 233 KANSAS KANSAS 234 KANSAS KANSAS 235 KANSAS KANSAS 236 KANSAS KANSAS 237 KANSAS KANSAS 238 KANSAS KANSAS 239 KENTUCKY KENTUCKY 240 KENTUCKY KENTUCKY 241 KENTUCKY KENTUCKY 242 KENTUCKY KENTUCKY 243 KENTUCKY KENTUCKY 244 KENTUCKY KENTUCKY 245 KENTUCKY KENTUCKY 246 KENTUCKY KENTUCKY 247 KENTUCKY KENTUCKY 248 KENTUCKY KENTUCKY 249 KENTUCKY KENTUCKY 250 KENTUCKY KENTUCKY 251 KENTUCKY KENTUCKY 252 KENTUCKY KENTUCKY 253 KENTUCKY KENTUCKY 254 KENTUCKY KENTUCKY 255 KENTUCKY KENTUCKY 256 LOUISIANA LOUISIANA 257 LOUISIANA LOUISIANA 258 LOUISIANA LOUISIANA 259 LOUISIANA LOUISIANA 260 LOUISIANA LOUISIANA 261 LOUISIANA LOUISIANA 262 LOUISIANA LOUISIANA 263 LOUISIANA LOUISIANA 264 LOUISIANA LOUISIANA 265 LOUISIANA LOUISIANA 266 LOUISIANA LOUISIANA 267 LOUISIANA LOUISIANA 268 LOUISIANA LOUISIANA 269 LOUISIANA LOUISIANA 270 LOUISIANA LOUISIANA 271 LOUISIANA LOUISIANA 272 LOUISIANA LOUISIANA 273 MAINE MAINE 274 MAINE MAINE 275 MAINE MAINE 276 MAINE MAINE 277 MAINE MAINE 278 MAINE MAINE 279 MAINE MAINE 280 MAINE MAINE 281 MAINE MAINE 282 MAINE MAINE 283 MAINE MAINE 284 MAINE MAINE 285 MAINE MAINE 286 MAINE MAINE 287 MAINE MAINE 288 MAINE MAINE 289 MAINE MAINE 290 MARYLAND MARYLAND 291 MARYLAND MARYLAND 292 MARYLAND MARYLAND 293 MARYLAND MARYLAND 294 MARYLAND MARYLAND 295 MARYLAND MARYLAND 296 MARYLAND MARYLAND 297 MARYLAND MARYLAND 298 MARYLAND MARYLAND 299 MARYLAND MARYLAND 300 MARYLAND MARYLAND 301 MARYLAND MARYLAND 302 MARYLAND MARYLAND 303 MARYLAND MARYLAND 304 MARYLAND MARYLAND 305 MARYLAND MARYLAND 306 MARYLAND MARYLAND 307 MASSACHUSETTS MASSACHUSETTS 308 MASSACHUSETTS MASSACHUSETTS 309 MASSACHUSETTS MASSACHUSETTS 310 MASSACHUSETTS MASSACHUSETTS 311 MASSACHUSETTS MASSACHUSETTS 312 MASSACHUSETTS MASSACHUSETTS 313 MASSACHUSETTS MASSACHUSETTS 314 MASSACHUSETTS MASSACHUSETTS 315 MASSACHUSETTS MASSACHUSETTS 316 MASSACHUSETTS MASSACHUSETTS 317 MASSACHUSETTS MASSACHUSETTS 318 MASSACHUSETTS MASSACHUSETTS 319 MASSACHUSETTS MASSACHUSETTS 320 MASSACHUSETTS MASSACHUSETTS 321 MASSACHUSETTS MASSACHUSETTS 322 MASSACHUSETTS MASSACHUSETTS 323 MASSACHUSETTS MASSACHUSETTS 324 MICHIGAN MICHIGAN 325 MICHIGAN MICHIGAN 326 MICHIGAN MICHIGAN 327 MICHIGAN MICHIGAN 328 MICHIGAN MICHIGAN 329 MICHIGAN MICHIGAN 330 MICHIGAN MICHIGAN 331 MICHIGAN MICHIGAN 332 MICHIGAN MICHIGAN 333 MICHIGAN MICHIGAN 334 MICHIGAN MICHIGAN 335 MICHIGAN MICHIGAN 336 MICHIGAN MICHIGAN 337 MICHIGAN MICHIGAN 338 MICHIGAN MICHIGAN 339 MICHIGAN MICHIGAN 340 MICHIGAN MICHIGAN 341 MINNESOTA MINNESOTA 342 MINNESOTA MINNESOTA 343 MINNESOTA MINNESOTA 344 MINNESOTA MINNESOTA 345 MINNESOTA MINNESOTA 346 MINNESOTA MINNESOTA 347 MINNESOTA MINNESOTA 348 MINNESOTA MINNESOTA 349 MINNESOTA MINNESOTA 350 MINNESOTA MINNESOTA 351 MINNESOTA MINNESOTA 352 MINNESOTA MINNESOTA 353 MINNESOTA MINNESOTA 354 MINNESOTA MINNESOTA 355 MINNESOTA MINNESOTA 356 MINNESOTA MINNESOTA 357 MINNESOTA MINNESOTA 358 MISSISSIPPI MISSISSIPPI 359 MISSISSIPPI MISSISSIPPI 360 MISSISSIPPI MISSISSIPPI 361 MISSISSIPPI MISSISSIPPI 362 MISSISSIPPI MISSISSIPPI 363 MISSISSIPPI MISSISSIPPI 364 MISSISSIPPI MISSISSIPPI 365 MISSISSIPPI MISSISSIPPI 366 MISSISSIPPI MISSISSIPPI 367 MISSISSIPPI MISSISSIPPI 368 MISSISSIPPI MISSISSIPPI 369 MISSISSIPPI MISSISSIPPI 370 MISSISSIPPI MISSISSIPPI 371 MISSISSIPPI MISSISSIPPI 372 MISSISSIPPI MISSISSIPPI 373 MISSISSIPPI MISSISSIPPI 374 MISSISSIPPI MISSISSIPPI 375 MISSOURI MISSOURI 376 MISSOURI MISSOURI 377 MISSOURI MISSOURI 378 MISSOURI MISSOURI 379 MISSOURI MISSOURI 380 MISSOURI MISSOURI 381 MISSOURI MISSOURI 382 MISSOURI MISSOURI 383 MISSOURI MISSOURI 384 MISSOURI MISSOURI 385 MISSOURI MISSOURI 386 MISSOURI MISSOURI 387 MISSOURI MISSOURI 388 MISSOURI MISSOURI 389 MISSOURI MISSOURI 390 MISSOURI MISSOURI 391 MISSOURI MISSOURI 392 MONTANA MONTANA 393 MONTANA MONTANA 394 MONTANA MONTANA 395 MONTANA MONTANA 396 MONTANA MONTANA 397 MONTANA MONTANA 398 MONTANA MONTANA 399 MONTANA MONTANA 400 MONTANA MONTANA 401 MONTANA MONTANA 402 MONTANA MONTANA 403 MONTANA MONTANA 404 MONTANA MONTANA 405 MONTANA MONTANA 406 MONTANA MONTANA 407 MONTANA MONTANA 408 MONTANA MONTANA 409 NEBRASKA NEBRASKA 410 NEBRASKA NEBRASKA 411 NEBRASKA NEBRASKA 412 NEBRASKA NEBRASKA 413 NEBRASKA NEBRASKA 414 NEBRASKA NEBRASKA 415 NEBRASKA NEBRASKA 416 NEBRASKA NEBRASKA 417 NEBRASKA NEBRASKA 418 NEBRASKA NEBRASKA 419 NEBRASKA NEBRASKA 420 NEBRASKA NEBRASKA 421 NEBRASKA NEBRASKA 422 NEBRASKA NEBRASKA 423 NEBRASKA NEBRASKA 424 NEBRASKA NEBRASKA 425 NEBRASKA NEBRASKA 426 NEVADA NEVADA 427 NEVADA NEVADA 428 NEVADA NEVADA 429 NEVADA NEVADA 430 NEVADA NEVADA 431 NEVADA NEVADA 432 NEVADA NEVADA 433 NEVADA NEVADA 434 NEVADA NEVADA 435 NEVADA NEVADA 436 NEVADA NEVADA 437 NEVADA NEVADA 438 NEVADA NEVADA 439 NEVADA NEVADA 440 NEVADA NEVADA 441 NEVADA NEVADA 442 NEVADA NEVADA 443 NEW_HAMPSHIRE NEW_HAMPSHIRE 444 NEW_HAMPSHIRE NEW_HAMPSHIRE 445 NEW_HAMPSHIRE NEW_HAMPSHIRE 446 NEW_HAMPSHIRE NEW_HAMPSHIRE 447 NEW_HAMPSHIRE NEW_HAMPSHIRE 448 NEW_HAMPSHIRE NEW_HAMPSHIRE 449 NEW_HAMPSHIRE NEW_HAMPSHIRE 450 NEW_HAMPSHIRE NEW_HAMPSHIRE 451 NEW_HAMPSHIRE NEW_HAMPSHIRE 452 NEW_HAMPSHIRE NEW_HAMPSHIRE 453 NEW_HAMPSHIRE NEW_HAMPSHIRE 454 NEW_HAMPSHIRE NEW_HAMPSHIRE 455 NEW_HAMPSHIRE NEW_HAMPSHIRE 456 NEW_HAMPSHIRE NEW_HAMPSHIRE 457 NEW_HAMPSHIRE NEW_HAMPSHIRE 458 NEW_HAMPSHIRE NEW_HAMPSHIRE 459 NEW_HAMPSHIRE NEW_HAMPSHIRE 460 NEW_JERSEY NEW_JERSEY 461 NEW_JERSEY NEW_JERSEY 462 NEW_JERSEY NEW_JERSEY 463 NEW_JERSEY NEW_JERSEY 464 NEW_JERSEY NEW_JERSEY 465 NEW_JERSEY NEW_JERSEY 466 NEW_JERSEY NEW_JERSEY 467 NEW_JERSEY NEW_JERSEY 468 NEW_JERSEY NEW_JERSEY 469 NEW_JERSEY NEW_JERSEY 470 NEW_JERSEY NEW_JERSEY 471 NEW_JERSEY NEW_JERSEY 472 NEW_JERSEY NEW_JERSEY 473 NEW_JERSEY NEW_JERSEY 474 NEW_JERSEY NEW_JERSEY 475 NEW_JERSEY NEW_JERSEY 476 NEW_JERSEY NEW_JERSEY 477 NEW_MEXICO NEW_MEXICO 478 NEW_MEXICO NEW_MEXICO 479 NEW_MEXICO NEW_MEXICO 480 NEW_MEXICO NEW_MEXICO 481 NEW_MEXICO NEW_MEXICO 482 NEW_MEXICO NEW_MEXICO 483 NEW_MEXICO NEW_MEXICO 484 NEW_MEXICO NEW_MEXICO 485 NEW_MEXICO NEW_MEXICO 486 NEW_MEXICO NEW_MEXICO 487 NEW_MEXICO NEW_MEXICO 488 NEW_MEXICO NEW_MEXICO 489 NEW_MEXICO NEW_MEXICO 490 NEW_MEXICO NEW_MEXICO 491 NEW_MEXICO NEW_MEXICO 492 NEW_MEXICO NEW_MEXICO 493 NEW_MEXICO NEW_MEXICO 494 NEW_YORK NEW_YORK 495 NEW_YORK NEW_YORK 496 NEW_YORK NEW_YORK 497 NEW_YORK NEW_YORK 498 NEW_YORK NEW_YORK 499 NEW_YORK NEW_YORK 500 NEW_YORK NEW_YORK 501 NEW_YORK NEW_YORK 502 NEW_YORK NEW_YORK 503 NEW_YORK NEW_YORK 504 NEW_YORK NEW_YORK 505 NEW_YORK NEW_YORK 506 NEW_YORK NEW_YORK 507 NEW_YORK NEW_YORK 508 NEW_YORK NEW_YORK 509 NEW_YORK NEW_YORK 510 NEW_YORK NEW_YORK 511 NORTH_CAROLINA NORTH_CAROLINA 512 NORTH_CAROLINA NORTH_CAROLINA 513 NORTH_CAROLINA NORTH_CAROLINA 514 NORTH_CAROLINA NORTH_CAROLINA 515 NORTH_CAROLINA NORTH_CAROLINA 516 NORTH_CAROLINA NORTH_CAROLINA 517 NORTH_CAROLINA NORTH_CAROLINA 518 NORTH_CAROLINA NORTH_CAROLINA 519 NORTH_CAROLINA NORTH_CAROLINA 520 NORTH_CAROLINA NORTH_CAROLINA 521 NORTH_CAROLINA NORTH_CAROLINA 522 NORTH_CAROLINA NORTH_CAROLINA 523 NORTH_CAROLINA NORTH_CAROLINA 524 NORTH_CAROLINA NORTH_CAROLINA 525 NORTH_CAROLINA NORTH_CAROLINA 526 NORTH_CAROLINA NORTH_CAROLINA 527 NORTH_CAROLINA NORTH_CAROLINA 528 NORTH_DAKOTA NORTH_DAKOTA 529 NORTH_DAKOTA NORTH_DAKOTA 530 NORTH_DAKOTA NORTH_DAKOTA 531 NORTH_DAKOTA NORTH_DAKOTA 532 NORTH_DAKOTA NORTH_DAKOTA 533 NORTH_DAKOTA NORTH_DAKOTA 534 NORTH_DAKOTA NORTH_DAKOTA 535 NORTH_DAKOTA NORTH_DAKOTA 536 NORTH_DAKOTA NORTH_DAKOTA 537 NORTH_DAKOTA NORTH_DAKOTA 538 NORTH_DAKOTA NORTH_DAKOTA 539 NORTH_DAKOTA NORTH_DAKOTA 540 NORTH_DAKOTA NORTH_DAKOTA 541 NORTH_DAKOTA NORTH_DAKOTA 542 NORTH_DAKOTA NORTH_DAKOTA 543 NORTH_DAKOTA NORTH_DAKOTA 544 NORTH_DAKOTA NORTH_DAKOTA 545 OHIO OHIO 546 OHIO OHIO 547 OHIO OHIO 548 OHIO OHIO 549 OHIO OHIO 550 OHIO OHIO 551 OHIO OHIO 552 OHIO OHIO 553 OHIO OHIO 554 OHIO OHIO 555 OHIO OHIO 556 OHIO OHIO 557 OHIO OHIO 558 OHIO OHIO 559 OHIO OHIO 560 OHIO OHIO 561 OHIO OHIO 562 OKLAHOMA OKLAHOMA 563 OKLAHOMA OKLAHOMA 564 OKLAHOMA OKLAHOMA 565 OKLAHOMA OKLAHOMA 566 OKLAHOMA OKLAHOMA 567 OKLAHOMA OKLAHOMA 568 OKLAHOMA OKLAHOMA 569 OKLAHOMA OKLAHOMA 570 OKLAHOMA OKLAHOMA 571 OKLAHOMA OKLAHOMA 572 OKLAHOMA OKLAHOMA 573 OKLAHOMA OKLAHOMA 574 OKLAHOMA OKLAHOMA 575 OKLAHOMA OKLAHOMA 576 OKLAHOMA OKLAHOMA 577 OKLAHOMA OKLAHOMA 578 OKLAHOMA OKLAHOMA 579 OREGON OREGON 580 OREGON OREGON 581 OREGON OREGON 582 OREGON OREGON 583 OREGON OREGON 584 OREGON OREGON 585 OREGON OREGON 586 OREGON OREGON 587 OREGON OREGON 588 OREGON OREGON 589 OREGON OREGON 590 OREGON OREGON 591 OREGON OREGON 592 OREGON OREGON 593 OREGON OREGON 594 OREGON OREGON 595 OREGON OREGON 596 PENNSYLVANIA PENNSYLVANIA 597 PENNSYLVANIA PENNSYLVANIA 598 PENNSYLVANIA PENNSYLVANIA 599 PENNSYLVANIA PENNSYLVANIA 600 PENNSYLVANIA PENNSYLVANIA 601 PENNSYLVANIA PENNSYLVANIA 602 PENNSYLVANIA PENNSYLVANIA 603 PENNSYLVANIA PENNSYLVANIA 604 PENNSYLVANIA PENNSYLVANIA 605 PENNSYLVANIA PENNSYLVANIA 606 PENNSYLVANIA PENNSYLVANIA 607 PENNSYLVANIA PENNSYLVANIA 608 PENNSYLVANIA PENNSYLVANIA 609 PENNSYLVANIA PENNSYLVANIA 610 PENNSYLVANIA PENNSYLVANIA 611 PENNSYLVANIA PENNSYLVANIA 612 PENNSYLVANIA PENNSYLVANIA 613 RHODE_ISLAND RHODE_ISLAND 614 RHODE_ISLAND RHODE_ISLAND 615 RHODE_ISLAND RHODE_ISLAND 616 RHODE_ISLAND RHODE_ISLAND 617 RHODE_ISLAND RHODE_ISLAND 618 RHODE_ISLAND RHODE_ISLAND 619 RHODE_ISLAND RHODE_ISLAND 620 RHODE_ISLAND RHODE_ISLAND 621 RHODE_ISLAND RHODE_ISLAND 622 RHODE_ISLAND RHODE_ISLAND 623 RHODE_ISLAND RHODE_ISLAND 624 RHODE_ISLAND RHODE_ISLAND 625 RHODE_ISLAND RHODE_ISLAND 626 RHODE_ISLAND RHODE_ISLAND 627 RHODE_ISLAND RHODE_ISLAND 628 RHODE_ISLAND RHODE_ISLAND 629 RHODE_ISLAND RHODE_ISLAND 630 SOUTH_CAROLINA SOUTH_CAROLINA 631 SOUTH_CAROLINA SOUTH_CAROLINA 632 SOUTH_CAROLINA SOUTH_CAROLINA 633 SOUTH_CAROLINA SOUTH_CAROLINA 634 SOUTH_CAROLINA SOUTH_CAROLINA 635 SOUTH_CAROLINA SOUTH_CAROLINA 636 SOUTH_CAROLINA SOUTH_CAROLINA 637 SOUTH_CAROLINA SOUTH_CAROLINA 638 SOUTH_CAROLINA SOUTH_CAROLINA 639 SOUTH_CAROLINA SOUTH_CAROLINA 640 SOUTH_CAROLINA SOUTH_CAROLINA 641 SOUTH_CAROLINA SOUTH_CAROLINA 642 SOUTH_CAROLINA SOUTH_CAROLINA 643 SOUTH_CAROLINA SOUTH_CAROLINA 644 SOUTH_CAROLINA SOUTH_CAROLINA 645 SOUTH_CAROLINA SOUTH_CAROLINA 646 SOUTH_CAROLINA SOUTH_CAROLINA 647 SOUTH_DAKOTA SOUTH_DAKOTA 648 SOUTH_DAKOTA SOUTH_DAKOTA 649 SOUTH_DAKOTA SOUTH_DAKOTA 650 SOUTH_DAKOTA SOUTH_DAKOTA 651 SOUTH_DAKOTA SOUTH_DAKOTA 652 SOUTH_DAKOTA SOUTH_DAKOTA 653 SOUTH_DAKOTA SOUTH_DAKOTA 654 SOUTH_DAKOTA SOUTH_DAKOTA 655 SOUTH_DAKOTA SOUTH_DAKOTA 656 SOUTH_DAKOTA SOUTH_DAKOTA 657 SOUTH_DAKOTA SOUTH_DAKOTA 658 SOUTH_DAKOTA SOUTH_DAKOTA 659 SOUTH_DAKOTA SOUTH_DAKOTA 660 SOUTH_DAKOTA SOUTH_DAKOTA 661 SOUTH_DAKOTA SOUTH_DAKOTA 662 SOUTH_DAKOTA SOUTH_DAKOTA 663 SOUTH_DAKOTA SOUTH_DAKOTA 664 TENNESSE TENNESSE 665 TENNESSE TENNESSE 666 TENNESSE TENNESSE 667 TENNESSE TENNESSE 668 TENNESSE TENNESSE 669 TENNESSE TENNESSE 670 TENNESSE TENNESSE 671 TENNESSE TENNESSE 672 TENNESSE TENNESSE 673 TENNESSE TENNESSE 674 TENNESSE TENNESSE 675 TENNESSE TENNESSE 676 TENNESSE TENNESSE 677 TENNESSE TENNESSE 678 TENNESSE TENNESSE 679 TENNESSE TENNESSE 680 TENNESSE TENNESSE 681 TEXAS TEXAS 682 TEXAS TEXAS 683 TEXAS TEXAS 684 TEXAS TEXAS 685 TEXAS TEXAS 686 TEXAS TEXAS 687 TEXAS TEXAS 688 TEXAS TEXAS 689 TEXAS TEXAS 690 TEXAS TEXAS 691 TEXAS TEXAS 692 TEXAS TEXAS 693 TEXAS TEXAS 694 TEXAS TEXAS 695 TEXAS TEXAS 696 TEXAS TEXAS 697 TEXAS TEXAS 698 UTAH UTAH 699 UTAH UTAH 700 UTAH UTAH 701 UTAH UTAH 702 UTAH UTAH 703 UTAH UTAH 704 UTAH UTAH 705 UTAH UTAH 706 UTAH UTAH 707 UTAH UTAH 708 UTAH UTAH 709 UTAH UTAH 710 UTAH UTAH 711 UTAH UTAH 712 UTAH UTAH 713 UTAH UTAH 714 UTAH UTAH 715 VERMONT VERMONT 716 VERMONT VERMONT 717 VERMONT VERMONT 718 VERMONT VERMONT 719 VERMONT VERMONT 720 VERMONT VERMONT 721 VERMONT VERMONT 722 VERMONT VERMONT 723 VERMONT VERMONT 724 VERMONT VERMONT 725 VERMONT VERMONT 726 VERMONT VERMONT 727 VERMONT VERMONT 728 VERMONT VERMONT 729 VERMONT VERMONT 730 VERMONT VERMONT 731 VERMONT VERMONT 732 VIRGINIA VIRGINIA 733 VIRGINIA VIRGINIA 734 VIRGINIA VIRGINIA 735 VIRGINIA VIRGINIA 736 VIRGINIA VIRGINIA 737 VIRGINIA VIRGINIA 738 VIRGINIA VIRGINIA 739 VIRGINIA VIRGINIA 740 VIRGINIA VIRGINIA 741 VIRGINIA VIRGINIA 742 VIRGINIA VIRGINIA 743 VIRGINIA VIRGINIA 744 VIRGINIA VIRGINIA 745 VIRGINIA VIRGINIA 746 VIRGINIA VIRGINIA 747 VIRGINIA VIRGINIA 748 VIRGINIA VIRGINIA 749 WASHINGTON WASHINGTON 750 WASHINGTON WASHINGTON 751 WASHINGTON WASHINGTON 752 WASHINGTON WASHINGTON 753 WASHINGTON WASHINGTON 754 WASHINGTON WASHINGTON 755 WASHINGTON WASHINGTON 756 WASHINGTON WASHINGTON 757 WASHINGTON WASHINGTON 758 WASHINGTON WASHINGTON 759 WASHINGTON WASHINGTON 760 WASHINGTON WASHINGTON 761 WASHINGTON WASHINGTON 762 WASHINGTON WASHINGTON 763 WASHINGTON WASHINGTON 764 WASHINGTON WASHINGTON 765 WASHINGTON WASHINGTON 766 WEST_VIRGINIA WEST_VIRGINIA 767 WEST_VIRGINIA WEST_VIRGINIA 768 WEST_VIRGINIA WEST_VIRGINIA 769 WEST_VIRGINIA WEST_VIRGINIA 770 WEST_VIRGINIA WEST_VIRGINIA 771 WEST_VIRGINIA WEST_VIRGINIA 772 WEST_VIRGINIA WEST_VIRGINIA 773 WEST_VIRGINIA WEST_VIRGINIA 774 WEST_VIRGINIA WEST_VIRGINIA 775 WEST_VIRGINIA WEST_VIRGINIA 776 WEST_VIRGINIA WEST_VIRGINIA 777 WEST_VIRGINIA WEST_VIRGINIA 778 WEST_VIRGINIA WEST_VIRGINIA 779 WEST_VIRGINIA WEST_VIRGINIA 780 WEST_VIRGINIA WEST_VIRGINIA 781 WEST_VIRGINIA WEST_VIRGINIA 782 WEST_VIRGINIA WEST_VIRGINIA 783 WISCONSIN WISCONSIN 784 WISCONSIN WISCONSIN 785 WISCONSIN WISCONSIN 786 WISCONSIN WISCONSIN 787 WISCONSIN WISCONSIN 788 WISCONSIN WISCONSIN 789 WISCONSIN WISCONSIN 790 WISCONSIN WISCONSIN 791 WISCONSIN WISCONSIN 792 WISCONSIN WISCONSIN 793 WISCONSIN WISCONSIN 794 WISCONSIN WISCONSIN 795 WISCONSIN WISCONSIN 796 WISCONSIN WISCONSIN 797 WISCONSIN WISCONSIN 798 WISCONSIN WISCONSIN 799 WISCONSIN WISCONSIN 800 WYOMING WYOMING 801 WYOMING WYOMING 802 WYOMING WYOMING 803 WYOMING WYOMING 804 WYOMING WYOMING 805 WYOMING WYOMING 806 WYOMING WYOMING 807 WYOMING WYOMING 808 WYOMING WYOMING 809 WYOMING WYOMING 810 WYOMING WYOMING 811 WYOMING WYOMING 812 WYOMING WYOMING 813 WYOMING WYOMING 814 WYOMING WYOMING 815 WYOMING WYOMING 816 WYOMING WYOMING Warning message: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. > index(p2, which = "individual") # with warning [1] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [6] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [11] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [16] ALABAMA ALABAMA ARIZONA ARIZONA ARIZONA [21] ARIZONA ARIZONA ARIZONA ARIZONA ARIZONA [26] ARIZONA ARIZONA ARIZONA ARIZONA ARIZONA [31] ARIZONA ARIZONA ARIZONA ARIZONA ARKANSAS [36] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [41] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [46] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [51] ARKANSAS CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [56] CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [61] CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [66] CALIFORNIA CALIFORNIA CALIFORNIA COLORADO COLORADO [71] COLORADO COLORADO COLORADO COLORADO COLORADO [76] COLORADO COLORADO COLORADO COLORADO COLORADO [81] COLORADO COLORADO COLORADO COLORADO COLORADO [86] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [91] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [96] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [101] CONNECTICUT CONNECTICUT DELAWARE DELAWARE DELAWARE [106] DELAWARE DELAWARE DELAWARE DELAWARE DELAWARE [111] DELAWARE DELAWARE DELAWARE DELAWARE DELAWARE [116] DELAWARE DELAWARE DELAWARE DELAWARE FLORIDA [121] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [126] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [131] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [136] FLORIDA GEORGIA GEORGIA GEORGIA GEORGIA [141] GEORGIA GEORGIA GEORGIA GEORGIA GEORGIA [146] GEORGIA GEORGIA GEORGIA GEORGIA GEORGIA [151] GEORGIA GEORGIA GEORGIA IDAHO IDAHO [156] IDAHO IDAHO IDAHO IDAHO IDAHO [161] IDAHO IDAHO IDAHO IDAHO IDAHO [166] IDAHO IDAHO IDAHO IDAHO IDAHO [171] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [176] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [181] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [186] ILLINOIS ILLINOIS INDIANA INDIANA INDIANA [191] INDIANA INDIANA INDIANA INDIANA INDIANA [196] INDIANA INDIANA INDIANA INDIANA INDIANA [201] INDIANA INDIANA INDIANA INDIANA IOWA [206] IOWA IOWA IOWA IOWA IOWA [211] IOWA IOWA IOWA IOWA IOWA [216] IOWA IOWA IOWA IOWA IOWA [221] IOWA KANSAS KANSAS KANSAS KANSAS [226] KANSAS KANSAS KANSAS KANSAS KANSAS [231] KANSAS KANSAS KANSAS KANSAS KANSAS [236] KANSAS KANSAS KANSAS KENTUCKY KENTUCKY [241] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [246] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [251] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [256] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [261] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [266] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [271] LOUISIANA LOUISIANA MAINE MAINE MAINE [276] MAINE MAINE MAINE MAINE MAINE [281] MAINE MAINE MAINE MAINE MAINE [286] MAINE MAINE MAINE MAINE MARYLAND [291] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [296] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [301] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [306] MARYLAND MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [311] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [316] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [321] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MICHIGAN MICHIGAN [326] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [331] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [336] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [341] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [346] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [351] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [356] MINNESOTA MINNESOTA MISSISSIPPI MISSISSIPPI MISSISSIPPI [361] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI [366] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI [371] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSOURI [376] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [381] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [386] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [391] MISSOURI MONTANA MONTANA MONTANA MONTANA [396] MONTANA MONTANA MONTANA MONTANA MONTANA [401] MONTANA MONTANA MONTANA MONTANA MONTANA [406] MONTANA MONTANA MONTANA NEBRASKA NEBRASKA [411] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [416] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [421] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [426] NEVADA NEVADA NEVADA NEVADA NEVADA [431] NEVADA NEVADA NEVADA NEVADA NEVADA [436] NEVADA NEVADA NEVADA NEVADA NEVADA [441] NEVADA NEVADA NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [446] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [451] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [456] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_JERSEY [461] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [466] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [471] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [476] NEW_JERSEY NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [481] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [486] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [491] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_YORK NEW_YORK [496] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [501] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [506] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [511] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [516] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [521] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [526] NORTH_CAROLINA NORTH_CAROLINA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [531] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [536] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [541] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA OHIO [546] OHIO OHIO OHIO OHIO OHIO [551] OHIO OHIO OHIO OHIO OHIO [556] OHIO OHIO OHIO OHIO OHIO [561] OHIO OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [566] OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [571] OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [576] OKLAHOMA OKLAHOMA OKLAHOMA OREGON OREGON [581] OREGON OREGON OREGON OREGON OREGON [586] OREGON OREGON OREGON OREGON OREGON [591] OREGON OREGON OREGON OREGON OREGON [596] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [601] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [606] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [611] PENNSYLVANIA PENNSYLVANIA RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [616] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [621] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [626] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND SOUTH_CAROLINA [631] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [636] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [641] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [646] SOUTH_CAROLINA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [651] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [656] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [661] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA TENNESSE TENNESSE [666] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [671] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [676] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [681] TEXAS TEXAS TEXAS TEXAS TEXAS [686] TEXAS TEXAS TEXAS TEXAS TEXAS [691] TEXAS TEXAS TEXAS TEXAS TEXAS [696] TEXAS TEXAS UTAH UTAH UTAH [701] UTAH UTAH UTAH UTAH UTAH [706] UTAH UTAH UTAH UTAH UTAH [711] UTAH UTAH UTAH UTAH VERMONT [716] VERMONT VERMONT VERMONT VERMONT VERMONT [721] VERMONT VERMONT VERMONT VERMONT VERMONT [726] VERMONT VERMONT VERMONT VERMONT VERMONT [731] VERMONT VIRGINIA VIRGINIA VIRGINIA VIRGINIA [736] VIRGINIA VIRGINIA VIRGINIA VIRGINIA VIRGINIA [741] VIRGINIA VIRGINIA VIRGINIA VIRGINIA VIRGINIA [746] VIRGINIA VIRGINIA VIRGINIA WASHINGTON WASHINGTON [751] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [756] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [761] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [766] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [771] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [776] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [781] WEST_VIRGINIA WEST_VIRGINIA WISCONSIN WISCONSIN WISCONSIN [786] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WISCONSIN [791] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WISCONSIN [796] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WYOMING [801] WYOMING WYOMING WYOMING WYOMING WYOMING [806] WYOMING WYOMING WYOMING WYOMING WYOMING [811] WYOMING WYOMING WYOMING WYOMING WYOMING [816] WYOMING 48 Levels: ALABAMA ARIZONA ARKANSAS CALIFORNIA COLORADO ... WYOMING Warning message: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. > index(p2, which = "id") # with warning [1] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [6] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [11] ALABAMA ALABAMA ALABAMA ALABAMA ALABAMA [16] ALABAMA ALABAMA ARIZONA ARIZONA ARIZONA [21] ARIZONA ARIZONA ARIZONA ARIZONA ARIZONA [26] ARIZONA ARIZONA ARIZONA ARIZONA ARIZONA [31] ARIZONA ARIZONA ARIZONA ARIZONA ARKANSAS [36] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [41] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [46] ARKANSAS ARKANSAS ARKANSAS ARKANSAS ARKANSAS [51] ARKANSAS CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [56] CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [61] CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA CALIFORNIA [66] CALIFORNIA CALIFORNIA CALIFORNIA COLORADO COLORADO [71] COLORADO COLORADO COLORADO COLORADO COLORADO [76] COLORADO COLORADO COLORADO COLORADO COLORADO [81] COLORADO COLORADO COLORADO COLORADO COLORADO [86] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [91] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [96] CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT CONNECTICUT [101] CONNECTICUT CONNECTICUT DELAWARE DELAWARE DELAWARE [106] DELAWARE DELAWARE DELAWARE DELAWARE DELAWARE [111] DELAWARE DELAWARE DELAWARE DELAWARE DELAWARE [116] DELAWARE DELAWARE DELAWARE DELAWARE FLORIDA [121] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [126] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [131] FLORIDA FLORIDA FLORIDA FLORIDA FLORIDA [136] FLORIDA GEORGIA GEORGIA GEORGIA GEORGIA [141] GEORGIA GEORGIA GEORGIA GEORGIA GEORGIA [146] GEORGIA GEORGIA GEORGIA GEORGIA GEORGIA [151] GEORGIA GEORGIA GEORGIA IDAHO IDAHO [156] IDAHO IDAHO IDAHO IDAHO IDAHO [161] IDAHO IDAHO IDAHO IDAHO IDAHO [166] IDAHO IDAHO IDAHO IDAHO IDAHO [171] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [176] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [181] ILLINOIS ILLINOIS ILLINOIS ILLINOIS ILLINOIS [186] ILLINOIS ILLINOIS INDIANA INDIANA INDIANA [191] INDIANA INDIANA INDIANA INDIANA INDIANA [196] INDIANA INDIANA INDIANA INDIANA INDIANA [201] INDIANA INDIANA INDIANA INDIANA IOWA [206] IOWA IOWA IOWA IOWA IOWA [211] IOWA IOWA IOWA IOWA IOWA [216] IOWA IOWA IOWA IOWA IOWA [221] IOWA KANSAS KANSAS KANSAS KANSAS [226] KANSAS KANSAS KANSAS KANSAS KANSAS [231] KANSAS KANSAS KANSAS KANSAS KANSAS [236] KANSAS KANSAS KANSAS KENTUCKY KENTUCKY [241] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [246] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [251] KENTUCKY KENTUCKY KENTUCKY KENTUCKY KENTUCKY [256] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [261] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [266] LOUISIANA LOUISIANA LOUISIANA LOUISIANA LOUISIANA [271] LOUISIANA LOUISIANA MAINE MAINE MAINE [276] MAINE MAINE MAINE MAINE MAINE [281] MAINE MAINE MAINE MAINE MAINE [286] MAINE MAINE MAINE MAINE MARYLAND [291] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [296] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [301] MARYLAND MARYLAND MARYLAND MARYLAND MARYLAND [306] MARYLAND MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [311] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [316] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS [321] MASSACHUSETTS MASSACHUSETTS MASSACHUSETTS MICHIGAN MICHIGAN [326] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [331] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [336] MICHIGAN MICHIGAN MICHIGAN MICHIGAN MICHIGAN [341] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [346] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [351] MINNESOTA MINNESOTA MINNESOTA MINNESOTA MINNESOTA [356] MINNESOTA MINNESOTA MISSISSIPPI MISSISSIPPI MISSISSIPPI [361] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI [366] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI [371] MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSISSIPPI MISSOURI [376] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [381] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [386] MISSOURI MISSOURI MISSOURI MISSOURI MISSOURI [391] MISSOURI MONTANA MONTANA MONTANA MONTANA [396] MONTANA MONTANA MONTANA MONTANA MONTANA [401] MONTANA MONTANA MONTANA MONTANA MONTANA [406] MONTANA MONTANA MONTANA NEBRASKA NEBRASKA [411] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [416] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [421] NEBRASKA NEBRASKA NEBRASKA NEBRASKA NEBRASKA [426] NEVADA NEVADA NEVADA NEVADA NEVADA [431] NEVADA NEVADA NEVADA NEVADA NEVADA [436] NEVADA NEVADA NEVADA NEVADA NEVADA [441] NEVADA NEVADA NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [446] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [451] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE [456] NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_HAMPSHIRE NEW_JERSEY [461] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [466] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [471] NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY NEW_JERSEY [476] NEW_JERSEY NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [481] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [486] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_MEXICO [491] NEW_MEXICO NEW_MEXICO NEW_MEXICO NEW_YORK NEW_YORK [496] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [501] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [506] NEW_YORK NEW_YORK NEW_YORK NEW_YORK NEW_YORK [511] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [516] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [521] NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA NORTH_CAROLINA [526] NORTH_CAROLINA NORTH_CAROLINA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [531] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [536] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA [541] NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA NORTH_DAKOTA OHIO [546] OHIO OHIO OHIO OHIO OHIO [551] OHIO OHIO OHIO OHIO OHIO [556] OHIO OHIO OHIO OHIO OHIO [561] OHIO OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [566] OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [571] OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA OKLAHOMA [576] OKLAHOMA OKLAHOMA OKLAHOMA OREGON OREGON [581] OREGON OREGON OREGON OREGON OREGON [586] OREGON OREGON OREGON OREGON OREGON [591] OREGON OREGON OREGON OREGON OREGON [596] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [601] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [606] PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA PENNSYLVANIA [611] PENNSYLVANIA PENNSYLVANIA RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [616] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [621] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND [626] RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND RHODE_ISLAND SOUTH_CAROLINA [631] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [636] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [641] SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA SOUTH_CAROLINA [646] SOUTH_CAROLINA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [651] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [656] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA [661] SOUTH_DAKOTA SOUTH_DAKOTA SOUTH_DAKOTA TENNESSE TENNESSE [666] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [671] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [676] TENNESSE TENNESSE TENNESSE TENNESSE TENNESSE [681] TEXAS TEXAS TEXAS TEXAS TEXAS [686] TEXAS TEXAS TEXAS TEXAS TEXAS [691] TEXAS TEXAS TEXAS TEXAS TEXAS [696] TEXAS TEXAS UTAH UTAH UTAH [701] UTAH UTAH UTAH UTAH UTAH [706] UTAH UTAH UTAH UTAH UTAH [711] UTAH UTAH UTAH UTAH VERMONT [716] VERMONT VERMONT VERMONT VERMONT VERMONT [721] VERMONT VERMONT VERMONT VERMONT VERMONT [726] VERMONT VERMONT VERMONT VERMONT VERMONT [731] VERMONT VIRGINIA VIRGINIA VIRGINIA VIRGINIA [736] VIRGINIA VIRGINIA VIRGINIA VIRGINIA VIRGINIA [741] VIRGINIA VIRGINIA VIRGINIA VIRGINIA VIRGINIA [746] VIRGINIA VIRGINIA VIRGINIA WASHINGTON WASHINGTON [751] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [756] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [761] WASHINGTON WASHINGTON WASHINGTON WASHINGTON WASHINGTON [766] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [771] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [776] WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA WEST_VIRGINIA [781] WEST_VIRGINIA WEST_VIRGINIA WISCONSIN WISCONSIN WISCONSIN [786] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WISCONSIN [791] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WISCONSIN [796] WISCONSIN WISCONSIN WISCONSIN WISCONSIN WYOMING [801] WYOMING WYOMING WYOMING WYOMING WYOMING [806] WYOMING WYOMING WYOMING WYOMING WYOMING [811] WYOMING WYOMING WYOMING WYOMING WYOMING [816] WYOMING 48 Levels: ALABAMA ARIZONA ARKANSAS CALIFORNIA COLORADO ... WYOMING Warning message: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. > index(p2, which = "time") # with warning [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [16] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [31] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [46] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [61] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [76] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [91] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [106] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [121] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [136] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [151] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [166] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [181] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [196] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [211] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [226] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [241] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [256] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [271] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [286] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [301] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [316] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [331] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [346] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [361] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [376] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [391] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [406] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [421] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [436] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [451] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [466] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [481] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [496] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [511] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [526] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [541] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [556] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [571] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [586] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [601] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [616] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [631] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [646] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [661] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [676] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [691] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [706] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [721] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [736] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [751] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [766] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [781] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [796] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [811] 1981 1982 1983 1984 1985 1986 17 Levels: 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 ... 1986 > > index(p3) # gives wrong index (2x individual variable) id id.1 1 1970 1970 2 1971 1971 3 1972 1972 4 1973 1973 5 1974 1974 6 1975 1975 7 1976 1976 8 1977 1977 9 1978 1978 10 1979 1979 11 1980 1980 12 1981 1981 13 1982 1982 14 1983 1983 15 1984 1984 16 1985 1985 17 1986 1986 18 1970 1970 19 1971 1971 20 1972 1972 21 1973 1973 22 1974 1974 23 1975 1975 24 1976 1976 25 1977 1977 26 1978 1978 27 1979 1979 28 1980 1980 29 1981 1981 30 1982 1982 31 1983 1983 32 1984 1984 33 1985 1985 34 1986 1986 35 1970 1970 36 1971 1971 37 1972 1972 38 1973 1973 39 1974 1974 40 1975 1975 41 1976 1976 42 1977 1977 43 1978 1978 44 1979 1979 45 1980 1980 46 1981 1981 47 1982 1982 48 1983 1983 49 1984 1984 50 1985 1985 51 1986 1986 52 1970 1970 53 1971 1971 54 1972 1972 55 1973 1973 56 1974 1974 57 1975 1975 58 1976 1976 59 1977 1977 60 1978 1978 61 1979 1979 62 1980 1980 63 1981 1981 64 1982 1982 65 1983 1983 66 1984 1984 67 1985 1985 68 1986 1986 69 1970 1970 70 1971 1971 71 1972 1972 72 1973 1973 73 1974 1974 74 1975 1975 75 1976 1976 76 1977 1977 77 1978 1978 78 1979 1979 79 1980 1980 80 1981 1981 81 1982 1982 82 1983 1983 83 1984 1984 84 1985 1985 85 1986 1986 86 1970 1970 87 1971 1971 88 1972 1972 89 1973 1973 90 1974 1974 91 1975 1975 92 1976 1976 93 1977 1977 94 1978 1978 95 1979 1979 96 1980 1980 97 1981 1981 98 1982 1982 99 1983 1983 100 1984 1984 101 1985 1985 102 1986 1986 103 1970 1970 104 1971 1971 105 1972 1972 106 1973 1973 107 1974 1974 108 1975 1975 109 1976 1976 110 1977 1977 111 1978 1978 112 1979 1979 113 1980 1980 114 1981 1981 115 1982 1982 116 1983 1983 117 1984 1984 118 1985 1985 119 1986 1986 120 1970 1970 121 1971 1971 122 1972 1972 123 1973 1973 124 1974 1974 125 1975 1975 126 1976 1976 127 1977 1977 128 1978 1978 129 1979 1979 130 1980 1980 131 1981 1981 132 1982 1982 133 1983 1983 134 1984 1984 135 1985 1985 136 1986 1986 137 1970 1970 138 1971 1971 139 1972 1972 140 1973 1973 141 1974 1974 142 1975 1975 143 1976 1976 144 1977 1977 145 1978 1978 146 1979 1979 147 1980 1980 148 1981 1981 149 1982 1982 150 1983 1983 151 1984 1984 152 1985 1985 153 1986 1986 154 1970 1970 155 1971 1971 156 1972 1972 157 1973 1973 158 1974 1974 159 1975 1975 160 1976 1976 161 1977 1977 162 1978 1978 163 1979 1979 164 1980 1980 165 1981 1981 166 1982 1982 167 1983 1983 168 1984 1984 169 1985 1985 170 1986 1986 171 1970 1970 172 1971 1971 173 1972 1972 174 1973 1973 175 1974 1974 176 1975 1975 177 1976 1976 178 1977 1977 179 1978 1978 180 1979 1979 181 1980 1980 182 1981 1981 183 1982 1982 184 1983 1983 185 1984 1984 186 1985 1985 187 1986 1986 188 1970 1970 189 1971 1971 190 1972 1972 191 1973 1973 192 1974 1974 193 1975 1975 194 1976 1976 195 1977 1977 196 1978 1978 197 1979 1979 198 1980 1980 199 1981 1981 200 1982 1982 201 1983 1983 202 1984 1984 203 1985 1985 204 1986 1986 205 1970 1970 206 1971 1971 207 1972 1972 208 1973 1973 209 1974 1974 210 1975 1975 211 1976 1976 212 1977 1977 213 1978 1978 214 1979 1979 215 1980 1980 216 1981 1981 217 1982 1982 218 1983 1983 219 1984 1984 220 1985 1985 221 1986 1986 222 1970 1970 223 1971 1971 224 1972 1972 225 1973 1973 226 1974 1974 227 1975 1975 228 1976 1976 229 1977 1977 230 1978 1978 231 1979 1979 232 1980 1980 233 1981 1981 234 1982 1982 235 1983 1983 236 1984 1984 237 1985 1985 238 1986 1986 239 1970 1970 240 1971 1971 241 1972 1972 242 1973 1973 243 1974 1974 244 1975 1975 245 1976 1976 246 1977 1977 247 1978 1978 248 1979 1979 249 1980 1980 250 1981 1981 251 1982 1982 252 1983 1983 253 1984 1984 254 1985 1985 255 1986 1986 256 1970 1970 257 1971 1971 258 1972 1972 259 1973 1973 260 1974 1974 261 1975 1975 262 1976 1976 263 1977 1977 264 1978 1978 265 1979 1979 266 1980 1980 267 1981 1981 268 1982 1982 269 1983 1983 270 1984 1984 271 1985 1985 272 1986 1986 273 1970 1970 274 1971 1971 275 1972 1972 276 1973 1973 277 1974 1974 278 1975 1975 279 1976 1976 280 1977 1977 281 1978 1978 282 1979 1979 283 1980 1980 284 1981 1981 285 1982 1982 286 1983 1983 287 1984 1984 288 1985 1985 289 1986 1986 290 1970 1970 291 1971 1971 292 1972 1972 293 1973 1973 294 1974 1974 295 1975 1975 296 1976 1976 297 1977 1977 298 1978 1978 299 1979 1979 300 1980 1980 301 1981 1981 302 1982 1982 303 1983 1983 304 1984 1984 305 1985 1985 306 1986 1986 307 1970 1970 308 1971 1971 309 1972 1972 310 1973 1973 311 1974 1974 312 1975 1975 313 1976 1976 314 1977 1977 315 1978 1978 316 1979 1979 317 1980 1980 318 1981 1981 319 1982 1982 320 1983 1983 321 1984 1984 322 1985 1985 323 1986 1986 324 1970 1970 325 1971 1971 326 1972 1972 327 1973 1973 328 1974 1974 329 1975 1975 330 1976 1976 331 1977 1977 332 1978 1978 333 1979 1979 334 1980 1980 335 1981 1981 336 1982 1982 337 1983 1983 338 1984 1984 339 1985 1985 340 1986 1986 341 1970 1970 342 1971 1971 343 1972 1972 344 1973 1973 345 1974 1974 346 1975 1975 347 1976 1976 348 1977 1977 349 1978 1978 350 1979 1979 351 1980 1980 352 1981 1981 353 1982 1982 354 1983 1983 355 1984 1984 356 1985 1985 357 1986 1986 358 1970 1970 359 1971 1971 360 1972 1972 361 1973 1973 362 1974 1974 363 1975 1975 364 1976 1976 365 1977 1977 366 1978 1978 367 1979 1979 368 1980 1980 369 1981 1981 370 1982 1982 371 1983 1983 372 1984 1984 373 1985 1985 374 1986 1986 375 1970 1970 376 1971 1971 377 1972 1972 378 1973 1973 379 1974 1974 380 1975 1975 381 1976 1976 382 1977 1977 383 1978 1978 384 1979 1979 385 1980 1980 386 1981 1981 387 1982 1982 388 1983 1983 389 1984 1984 390 1985 1985 391 1986 1986 392 1970 1970 393 1971 1971 394 1972 1972 395 1973 1973 396 1974 1974 397 1975 1975 398 1976 1976 399 1977 1977 400 1978 1978 401 1979 1979 402 1980 1980 403 1981 1981 404 1982 1982 405 1983 1983 406 1984 1984 407 1985 1985 408 1986 1986 409 1970 1970 410 1971 1971 411 1972 1972 412 1973 1973 413 1974 1974 414 1975 1975 415 1976 1976 416 1977 1977 417 1978 1978 418 1979 1979 419 1980 1980 420 1981 1981 421 1982 1982 422 1983 1983 423 1984 1984 424 1985 1985 425 1986 1986 426 1970 1970 427 1971 1971 428 1972 1972 429 1973 1973 430 1974 1974 431 1975 1975 432 1976 1976 433 1977 1977 434 1978 1978 435 1979 1979 436 1980 1980 437 1981 1981 438 1982 1982 439 1983 1983 440 1984 1984 441 1985 1985 442 1986 1986 443 1970 1970 444 1971 1971 445 1972 1972 446 1973 1973 447 1974 1974 448 1975 1975 449 1976 1976 450 1977 1977 451 1978 1978 452 1979 1979 453 1980 1980 454 1981 1981 455 1982 1982 456 1983 1983 457 1984 1984 458 1985 1985 459 1986 1986 460 1970 1970 461 1971 1971 462 1972 1972 463 1973 1973 464 1974 1974 465 1975 1975 466 1976 1976 467 1977 1977 468 1978 1978 469 1979 1979 470 1980 1980 471 1981 1981 472 1982 1982 473 1983 1983 474 1984 1984 475 1985 1985 476 1986 1986 477 1970 1970 478 1971 1971 479 1972 1972 480 1973 1973 481 1974 1974 482 1975 1975 483 1976 1976 484 1977 1977 485 1978 1978 486 1979 1979 487 1980 1980 488 1981 1981 489 1982 1982 490 1983 1983 491 1984 1984 492 1985 1985 493 1986 1986 494 1970 1970 495 1971 1971 496 1972 1972 497 1973 1973 498 1974 1974 499 1975 1975 500 1976 1976 501 1977 1977 502 1978 1978 503 1979 1979 504 1980 1980 505 1981 1981 506 1982 1982 507 1983 1983 508 1984 1984 509 1985 1985 510 1986 1986 511 1970 1970 512 1971 1971 513 1972 1972 514 1973 1973 515 1974 1974 516 1975 1975 517 1976 1976 518 1977 1977 519 1978 1978 520 1979 1979 521 1980 1980 522 1981 1981 523 1982 1982 524 1983 1983 525 1984 1984 526 1985 1985 527 1986 1986 528 1970 1970 529 1971 1971 530 1972 1972 531 1973 1973 532 1974 1974 533 1975 1975 534 1976 1976 535 1977 1977 536 1978 1978 537 1979 1979 538 1980 1980 539 1981 1981 540 1982 1982 541 1983 1983 542 1984 1984 543 1985 1985 544 1986 1986 545 1970 1970 546 1971 1971 547 1972 1972 548 1973 1973 549 1974 1974 550 1975 1975 551 1976 1976 552 1977 1977 553 1978 1978 554 1979 1979 555 1980 1980 556 1981 1981 557 1982 1982 558 1983 1983 559 1984 1984 560 1985 1985 561 1986 1986 562 1970 1970 563 1971 1971 564 1972 1972 565 1973 1973 566 1974 1974 567 1975 1975 568 1976 1976 569 1977 1977 570 1978 1978 571 1979 1979 572 1980 1980 573 1981 1981 574 1982 1982 575 1983 1983 576 1984 1984 577 1985 1985 578 1986 1986 579 1970 1970 580 1971 1971 581 1972 1972 582 1973 1973 583 1974 1974 584 1975 1975 585 1976 1976 586 1977 1977 587 1978 1978 588 1979 1979 589 1980 1980 590 1981 1981 591 1982 1982 592 1983 1983 593 1984 1984 594 1985 1985 595 1986 1986 596 1970 1970 597 1971 1971 598 1972 1972 599 1973 1973 600 1974 1974 601 1975 1975 602 1976 1976 603 1977 1977 604 1978 1978 605 1979 1979 606 1980 1980 607 1981 1981 608 1982 1982 609 1983 1983 610 1984 1984 611 1985 1985 612 1986 1986 613 1970 1970 614 1971 1971 615 1972 1972 616 1973 1973 617 1974 1974 618 1975 1975 619 1976 1976 620 1977 1977 621 1978 1978 622 1979 1979 623 1980 1980 624 1981 1981 625 1982 1982 626 1983 1983 627 1984 1984 628 1985 1985 629 1986 1986 630 1970 1970 631 1971 1971 632 1972 1972 633 1973 1973 634 1974 1974 635 1975 1975 636 1976 1976 637 1977 1977 638 1978 1978 639 1979 1979 640 1980 1980 641 1981 1981 642 1982 1982 643 1983 1983 644 1984 1984 645 1985 1985 646 1986 1986 647 1970 1970 648 1971 1971 649 1972 1972 650 1973 1973 651 1974 1974 652 1975 1975 653 1976 1976 654 1977 1977 655 1978 1978 656 1979 1979 657 1980 1980 658 1981 1981 659 1982 1982 660 1983 1983 661 1984 1984 662 1985 1985 663 1986 1986 664 1970 1970 665 1971 1971 666 1972 1972 667 1973 1973 668 1974 1974 669 1975 1975 670 1976 1976 671 1977 1977 672 1978 1978 673 1979 1979 674 1980 1980 675 1981 1981 676 1982 1982 677 1983 1983 678 1984 1984 679 1985 1985 680 1986 1986 681 1970 1970 682 1971 1971 683 1972 1972 684 1973 1973 685 1974 1974 686 1975 1975 687 1976 1976 688 1977 1977 689 1978 1978 690 1979 1979 691 1980 1980 692 1981 1981 693 1982 1982 694 1983 1983 695 1984 1984 696 1985 1985 697 1986 1986 698 1970 1970 699 1971 1971 700 1972 1972 701 1973 1973 702 1974 1974 703 1975 1975 704 1976 1976 705 1977 1977 706 1978 1978 707 1979 1979 708 1980 1980 709 1981 1981 710 1982 1982 711 1983 1983 712 1984 1984 713 1985 1985 714 1986 1986 715 1970 1970 716 1971 1971 717 1972 1972 718 1973 1973 719 1974 1974 720 1975 1975 721 1976 1976 722 1977 1977 723 1978 1978 724 1979 1979 725 1980 1980 726 1981 1981 727 1982 1982 728 1983 1983 729 1984 1984 730 1985 1985 731 1986 1986 732 1970 1970 733 1971 1971 734 1972 1972 735 1973 1973 736 1974 1974 737 1975 1975 738 1976 1976 739 1977 1977 740 1978 1978 741 1979 1979 742 1980 1980 743 1981 1981 744 1982 1982 745 1983 1983 746 1984 1984 747 1985 1985 748 1986 1986 749 1970 1970 750 1971 1971 751 1972 1972 752 1973 1973 753 1974 1974 754 1975 1975 755 1976 1976 756 1977 1977 757 1978 1978 758 1979 1979 759 1980 1980 760 1981 1981 761 1982 1982 762 1983 1983 763 1984 1984 764 1985 1985 765 1986 1986 766 1970 1970 767 1971 1971 768 1972 1972 769 1973 1973 770 1974 1974 771 1975 1975 772 1976 1976 773 1977 1977 774 1978 1978 775 1979 1979 776 1980 1980 777 1981 1981 778 1982 1982 779 1983 1983 780 1984 1984 781 1985 1985 782 1986 1986 783 1970 1970 784 1971 1971 785 1972 1972 786 1973 1973 787 1974 1974 788 1975 1975 789 1976 1976 790 1977 1977 791 1978 1978 792 1979 1979 793 1980 1980 794 1981 1981 795 1982 1982 796 1983 1983 797 1984 1984 798 1985 1985 799 1986 1986 800 1970 1970 801 1971 1971 802 1972 1972 803 1973 1973 804 1974 1974 805 1975 1975 806 1976 1976 807 1977 1977 808 1978 1978 809 1979 1979 810 1980 1980 811 1981 1981 812 1982 1982 813 1983 1983 814 1984 1984 815 1985 1985 816 1986 1986 Warning messages: 1: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. 2: In index.pindex(x = anindex, which = which) : an index variable not being the time index is called 'time'. Likely, any results are distorted. > index(p3, which = "individual") # with warning [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [16] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [31] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [46] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [61] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [76] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [91] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [106] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [121] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [136] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [151] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [166] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [181] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [196] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [211] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [226] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [241] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [256] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [271] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [286] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [301] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [316] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [331] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [346] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [361] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [376] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [391] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [406] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [421] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [436] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [451] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [466] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [481] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [496] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [511] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [526] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [541] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [556] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [571] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [586] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [601] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [616] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [631] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [646] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [661] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [676] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [691] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [706] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [721] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [736] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [751] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [766] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [781] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [796] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [811] 1981 1982 1983 1984 1985 1986 17 Levels: 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 ... 1986 Warning messages: 1: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. 2: In index.pindex(x = anindex, which = which) : an index variable not being the time index is called 'time'. Likely, any results are distorted. > index(p3, which = "id") # with warning [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [16] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [31] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [46] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [61] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [76] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [91] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [106] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [121] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [136] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [151] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [166] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [181] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [196] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [211] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [226] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [241] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [256] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [271] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [286] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [301] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [316] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [331] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [346] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [361] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [376] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [391] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [406] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [421] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [436] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [451] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [466] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [481] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [496] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [511] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [526] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [541] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [556] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [571] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [586] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [601] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [616] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [631] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [646] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [661] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [676] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [691] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [706] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [721] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [736] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [751] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [766] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [781] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [796] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [811] 1981 1982 1983 1984 1985 1986 17 Levels: 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 ... 1986 Warning messages: 1: In index.pindex(x = anindex, which = which) : an index variable not being the invidiual index is called 'id'. Likely, any results are distorted. 2: In index.pindex(x = anindex, which = which) : an index variable not being the time index is called 'time'. Likely, any results are distorted. > index(p3, which = "time") # with warning [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [16] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [31] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [46] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [61] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [76] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [91] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [106] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [121] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [136] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [151] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [166] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [181] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [196] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [211] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [226] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [241] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [256] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [271] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [286] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [301] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [316] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [331] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [346] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [361] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [376] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [391] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [406] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [421] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [436] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [451] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [466] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [481] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [496] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [511] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [526] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [541] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [556] 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 [571] 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 [586] 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 [601] 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 [616] 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 [631] 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 [646] 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 [661] 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 [676] 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 [691] 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 [706] 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 [721] 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 1972 1973 [736] 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1970 1971 [751] 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 [766] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 [781] 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 [796] 1983 1984 1985 1986 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 [811] 1981 1982 1983 1984 1985 1986 17 Levels: 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 ... 1986 Warning message: In index.pindex(x = anindex, which = which) : an index variable not being the time index is called 'time'. Likely, any results are distorted. > > > > # test for error about length(index)>2 > # Should result in error with informative message > #ttC3 <- tryCatch(pdata.frame(Wages, index=c(595, 3, 5)), error=function(e) e, warning = function(w) w) > #if(!is(ttC3,"error") | ttC3$message != "'index' can be of length 2 at the most (one individual and one time index)") stop("error about length(index)>2 not sent") > #YC deprecated, the index can be now of length 3 > > #### larger data set ### > ## commented because needs other package > # require(plm) > # library(ggplot2) > # data("diamonds", package = "ggplot2") > # > # class(diamonds$cut) # ordered factor > # > # diamonds.p <- pdata.frame(diamonds, index = "cut") # wrong indexes created > # pdim(diamonds.p) > # > # # order data set > # diamonds3_asc <- diamonds[order(diamonds$cut), ] > # diamonds3_asc.p <- pdata.frame(diamonds3_asc, index = "cut") > # pdim(diamonds3_asc.p) # works > # > # diamonds3_desc <- diamonds[order(diamonds$cut, decreasing = T), ] > # diamonds3_desc.p <- pdata.frame(diamonds3_desc, index = "cut") > # pdim(diamonds3_desc.p) > # > # > # # try numeric index > # diamonds2 <- diamonds > # diamonds2$cut_num <- as.numeric(diamonds2$cut) # make index numeric > # > # diamonds2_asc <- diamonds2[order(diamonds2$cut_num), ] # ascending order of index > # diamonds2_desc <- diamonds2[order(diamonds2$cut_num, decreasing = T), ] # descending order of index > # > # head(diamonds2_asc) > # head(diamonds2_desc) > # > # diamonds2_asc.p <- pdata.frame(diamonds2_asc, index = "cut_num") > # pdim(diamonds2_asc.p) > # > # diamonds2_desc.p <- pdata.frame(diamonds2_desc, index = "cut_num") # wrong index created > # pdim(diamonds2_desc.p) > # > # > # # Some further tests about the blocks of individuals > # # - does it depend on asc. block length? > # # -> no, works fine > # diamonds2_asc_short <- diamonds2_asc[-c(33940:nrow(diamonds2_asc)), ] > # diamonds2_asc_short.p <- pdata.frame(diamonds2_asc_short, index = "cut_num") > # pdim(diamonds2_asc_short.p) > # > # diamonds2_asc_short2 <- diamonds2_asc[-c(6517:18517), ] > # diamonds2_asc_short2.p <- pdata.frame(diamonds2_asc_short2, index = "cut_num") > # pdim(diamonds2_asc_short2.p) > > proc.time() user system elapsed 1.62 0.40 2.00 plm/inst/tests/test_lagt_leadt.Rout.save0000644000176200001440000021124614124132276020140 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests of lagt and leadt (note the "t") respecting time periods (not just shifting of rows) > # -> there is also a test file (test_lag_lead_factor_levels.R) for plm::lagr which does not > # treat the time variable as a numeric value (merely shifts rows) > # > # The lagging with respect to the time dimension is the default for lag since > # plm version 1.7-0, i.e., lag(..., shift = "time") is a wrapper for plm::lagt > # > # > # (1) test of lagging of index variable > # (2) some dropped factor levels / whole period missing > # (3) general tests > # (4) tests with non-consecutive time periods > # (5) lagt and lag should yield same results on data with consecutive time periods > # (6) NA in time index > > > library(plm) > data("Grunfeld", package = "plm") > > Grunfeld$fac <- factor(c(200:2, 1)) > Grunfeld <- pdata.frame(Grunfeld) > > > ############## (1) test of lagging of index variable ########## > ## test of lagging of index variable > lag(Grunfeld$firm) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1 1 1 1 1 1 1 1 1 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 1 1 1 1 1 1 1 1 1 1 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 2 2 2 2 2 2 2 2 2 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 2 2 2 2 2 2 2 2 2 2 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 3 3 3 3 3 3 3 3 3 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 3 3 3 3 3 3 3 3 3 3 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4 4 4 4 4 4 4 4 4 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 4 4 4 4 4 4 4 4 4 4 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5 5 5 5 5 5 5 5 5 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 5 5 5 5 5 5 5 5 5 5 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 6 6 6 6 6 6 6 6 6 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 6 6 6 6 6 6 6 6 6 6 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 7 7 7 7 7 7 7 7 7 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 7 7 7 7 7 7 7 7 7 7 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 8 8 8 8 8 8 8 8 8 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 8 8 8 8 8 8 8 8 8 8 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 9 9 9 9 9 9 9 9 9 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 9 9 9 9 9 9 9 9 9 9 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 10 10 10 10 10 10 10 10 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > > # variable identical to an index "on character level" > Grunfeld$firm2 <- Grunfeld$firm > lag(Grunfeld$firm2) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1 1 1 1 1 1 1 1 1 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 1 1 1 1 1 1 1 1 1 1 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 2 2 2 2 2 2 2 2 2 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 2 2 2 2 2 2 2 2 2 2 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 3 3 3 3 3 3 3 3 3 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 3 3 3 3 3 3 3 3 3 3 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4 4 4 4 4 4 4 4 4 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 4 4 4 4 4 4 4 4 4 4 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5 5 5 5 5 5 5 5 5 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 5 5 5 5 5 5 5 5 5 5 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 6 6 6 6 6 6 6 6 6 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 6 6 6 6 6 6 6 6 6 6 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 7 7 7 7 7 7 7 7 7 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 7 7 7 7 7 7 7 7 7 7 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 8 8 8 8 8 8 8 8 8 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 8 8 8 8 8 8 8 8 8 8 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 9 9 9 9 9 9 9 9 9 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 9 9 9 9 9 9 9 9 9 9 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 10 10 10 10 10 10 10 10 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > > > ############## (2.1) tests with eliminated factor levels ########## > > # lag by 1 eliminates some factor levels (e.g., "1" in the last observations) > # from the sample's unique factor levels, but it should stay in the levels > lag(Grunfeld$fac) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 200 199 198 197 196 195 194 193 192 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 191 190 189 188 187 186 185 184 183 182 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 180 179 178 177 176 175 174 173 172 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 171 170 169 168 167 166 165 164 163 162 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 160 159 158 157 156 155 154 153 152 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 151 150 149 148 147 146 145 144 143 142 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 140 139 138 137 136 135 134 133 132 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 131 130 129 128 127 126 125 124 123 122 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 120 119 118 117 116 115 114 113 112 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 111 110 109 108 107 106 105 104 103 102 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 100 99 98 97 96 95 94 93 92 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 91 90 89 88 87 86 85 84 83 82 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 80 79 78 77 76 75 74 73 72 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 71 70 69 68 67 66 65 64 63 62 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 60 59 58 57 56 55 54 53 52 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 51 50 49 48 47 46 45 44 43 42 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 40 39 38 37 36 35 34 33 32 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 31 30 29 28 27 26 25 24 23 22 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 20 19 18 17 16 15 14 13 12 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 11 10 9 8 7 6 5 4 3 2 200 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ... 200 > 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(levels(lag(Grunfeld$fac))) == 200)) stop("wrong factor levels") # 200 > > # lead eliminates e.g., level "200" > lead(Grunfeld$fac) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 199 198 197 196 195 194 193 192 191 190 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 189 188 187 186 185 184 183 182 181 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 179 178 177 176 175 174 173 172 171 170 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 169 168 167 166 165 164 163 162 161 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 159 158 157 156 155 154 153 152 151 150 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 149 148 147 146 145 144 143 142 141 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 139 138 137 136 135 134 133 132 131 130 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 129 128 127 126 125 124 123 122 121 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 119 118 117 116 115 114 113 112 111 110 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 109 108 107 106 105 104 103 102 101 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 99 98 97 96 95 94 93 92 91 90 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 89 88 87 86 85 84 83 82 81 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 79 78 77 76 75 74 73 72 71 70 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 69 68 67 66 65 64 63 62 61 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 59 58 57 56 55 54 53 52 51 50 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 49 48 47 46 45 44 43 42 41 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 39 38 37 36 35 34 33 32 31 30 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 29 28 27 26 25 24 23 22 21 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 19 18 17 16 15 14 13 12 11 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 9 8 7 6 5 4 3 2 1 200 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ... 200 > if (!(length(unique(Grunfeld$fac)) == 200)) stop("wrong factor levels") # 200 > if (!(length(unique(lead(Grunfeld$fac))) == 191)) stop("wrong factor levels") # 191 > if (!(length(levels(lead(Grunfeld$fac))) == 200)) stop("wrong factor levels") # 200 > > > ############### (2.2) test for case with a time period missing from whole data set > data("Grunfeld", package = "plm") > obs_3rd <- 3 + 20*c(0:9) > Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) > > # illustration: > levels(Grunfeld_wo_1937$year) # no year 1937 anymore and no level for 1937 anymore [1] "1935" "1936" "1938" "1939" "1940" "1941" "1942" "1943" "1944" "1945" [11] "1946" "1947" "1948" "1949" "1950" "1951" "1952" "1953" "1954" > as.numeric(Grunfeld_wo_1937$year) # as.numeric produces a consecutive series! [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 [26] 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 [51] 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [76] 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 [101] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 [126] 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 [151] 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 [176] 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 > any(diff(as.numeric(Grunfeld_wo_1937$year)) > 1) # -> no gap detected [1] FALSE > > as.numeric(as.character(Grunfeld_wo_1937$year)) # use as.character before as.numeric! [1] 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 [16] 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 [31] 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 [46] 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 [61] 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 [76] 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [91] 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 [106] 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 [121] 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 [136] 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 [151] 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 [166] 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 [181] 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 > any(diff(as.numeric(as.character(Grunfeld_wo_1937$year))) > 1) # -> gap now detected [1] TRUE > > # formal test: > if (!is.na(lag( Grunfeld_wo_1937$inv)["1-1938"])) stop("missing time period not detected (year 1937 is missing from whole data set)") > if (!is.na(lead(Grunfeld_wo_1937$inv)["1-1936"])) stop("missing time period not detected (year 1937 is missing from whole data set)") > > > > ############## (3) some general tests ########## > data("Grunfeld", package = "plm") > > Grunfeld$fac <- factor(c(200:2, 1)) > Grunfeld <- pdata.frame(Grunfeld) > ## some more general testing of lag and lead > # do nothing > if (!isTRUE(all.equal(lag(Grunfeld$fac, 0), Grunfeld$fac))) stop("'lag( , 0)' not equal to 'do nothing'") > if (!isTRUE(all.equal(lead(Grunfeld$fac, 0), Grunfeld$fac))) stop("'lead( , 0)' not equal to 'do nothing'") > # identical is even stricter than all.equal > if (!identical(lag(Grunfeld$fac, 0), Grunfeld$fac)) stop("'lag( , 0)' not identical to 'do nothing'") > if (!identical(lead(Grunfeld$fac, 0), Grunfeld$fac)) stop("'lead( , 0)' not identical to 'do nothing'") > > > # lag( , -k) == lead( , k) > if (!isTRUE(all.equal(lag(Grunfeld$fac, -1), lead(Grunfeld$fac, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") > if (!isTRUE(all.equal(lag(Grunfeld$fac, 1), lead(Grunfeld$fac, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > # identical is even stricter than all.equal > if (!identical(lag(Grunfeld$fac, -1), lead(Grunfeld$fac, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") > if (!identical(lag(Grunfeld$fac, 1), lead(Grunfeld$fac, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") > > # with numeric > if (!isTRUE(all.equal(lag(Grunfeld$inv, -1), lead(Grunfeld$inv, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") > if (!isTRUE(all.equal(lag(Grunfeld$inv, 1), lead(Grunfeld$inv, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > > if (!identical(lag(Grunfeld$inv, -1), lead(Grunfeld$inv, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") > if (!identical(lag(Grunfeld$inv, 1), lead(Grunfeld$inv, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") > > > > # with logical > Grunfeld$log <- rep(c(T, T, F, T), 50) > if (!isTRUE(all.equal(lag(Grunfeld$log, -1), lead(Grunfeld$log, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") > if (!isTRUE(all.equal(lag(Grunfeld$log, 1), lead(Grunfeld$log, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > > if (!identical(lag(Grunfeld$log, -1), lead(Grunfeld$log, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") > if (!identical(lag(Grunfeld$log, 1), lead(Grunfeld$log, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") > > > ## other k's > if (!isTRUE(all.equal(lag(Grunfeld$inv, -5), lead(Grunfeld$inv, 5)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") > if (!isTRUE(all.equal(lag(Grunfeld$inv, 5), lead(Grunfeld$inv, -5)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > > if (!isTRUE(all.equal(lag(Grunfeld$inv, -3), lead(Grunfeld$inv, 3)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") > if (!isTRUE(all.equal(lag(Grunfeld$inv, 3), lead(Grunfeld$inv, -3)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > > if (!identical(lag(Grunfeld$inv, -3), lead(Grunfeld$inv, 3))) stop("'lag( , -1)' not identical to 'lead( , 1)'") > if (!identical(lag(Grunfeld$inv, 3), lead(Grunfeld$inv, -3))) stop("'lag( , 1)' not identical to 'lead( , -1)'") > > > > # should be all NA > if(!isTRUE(all(is.na(lag(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id > if(!isTRUE(all(is.na(lag(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available > if(!isTRUE(all(is.na(lead(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id > if(!isTRUE(all(is.na(lead(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available > > ## length(k) > 1 > lag(Grunfeld$inv, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 410.60 391.80 317.60 NA NA 1-1936 257.70 410.60 391.80 317.60 NA 1-1937 330.80 257.70 410.60 391.80 317.60 1-1938 461.20 330.80 257.70 410.60 391.80 1-1939 512.00 461.20 330.80 257.70 410.60 1-1940 448.00 512.00 461.20 330.80 257.70 1-1941 499.60 448.00 512.00 461.20 330.80 1-1942 547.50 499.60 448.00 512.00 461.20 1-1943 561.20 547.50 499.60 448.00 512.00 1-1944 688.10 561.20 547.50 499.60 448.00 1-1945 568.90 688.10 561.20 547.50 499.60 1-1946 529.20 568.90 688.10 561.20 547.50 1-1947 555.10 529.20 568.90 688.10 561.20 1-1948 642.90 555.10 529.20 568.90 688.10 1-1949 755.90 642.90 555.10 529.20 568.90 1-1950 891.20 755.90 642.90 555.10 529.20 1-1951 1304.40 891.20 755.90 642.90 555.10 1-1952 1486.70 1304.40 891.20 755.90 642.90 1-1953 NA 1486.70 1304.40 891.20 755.90 1-1954 NA NA 1486.70 1304.40 891.20 2-1935 469.90 355.30 209.90 NA NA 2-1936 262.30 469.90 355.30 209.90 NA 2-1937 230.40 262.30 469.90 355.30 209.90 2-1938 361.60 230.40 262.30 469.90 355.30 2-1939 472.80 361.60 230.40 262.30 469.90 2-1940 445.60 472.80 361.60 230.40 262.30 2-1941 361.60 445.60 472.80 361.60 230.40 2-1942 288.20 361.60 445.60 472.80 361.60 2-1943 258.70 288.20 361.60 445.60 472.80 2-1944 420.30 258.70 288.20 361.60 445.60 2-1945 420.50 420.30 258.70 288.20 361.60 2-1946 494.50 420.50 420.30 258.70 288.20 2-1947 405.10 494.50 420.50 420.30 258.70 2-1948 418.80 405.10 494.50 420.50 420.30 2-1949 588.20 418.80 405.10 494.50 420.50 2-1950 645.50 588.20 418.80 405.10 494.50 2-1951 641.00 645.50 588.20 418.80 405.10 2-1952 459.30 641.00 645.50 588.20 418.80 2-1953 NA 459.30 641.00 645.50 588.20 2-1954 NA NA 459.30 641.00 645.50 3-1935 77.20 45.00 33.10 NA NA 3-1936 44.60 77.20 45.00 33.10 NA 3-1937 48.10 44.60 77.20 45.00 33.10 3-1938 74.40 48.10 44.60 77.20 45.00 3-1939 113.00 74.40 48.10 44.60 77.20 3-1940 91.90 113.00 74.40 48.10 44.60 3-1941 61.30 91.90 113.00 74.40 48.10 3-1942 56.80 61.30 91.90 113.00 74.40 3-1943 93.60 56.80 61.30 91.90 113.00 3-1944 159.90 93.60 56.80 61.30 91.90 3-1945 147.20 159.90 93.60 56.80 61.30 3-1946 146.30 147.20 159.90 93.60 56.80 3-1947 98.30 146.30 147.20 159.90 93.60 3-1948 93.50 98.30 146.30 147.20 159.90 3-1949 135.20 93.50 98.30 146.30 147.20 3-1950 157.30 135.20 93.50 98.30 146.30 3-1951 179.50 157.30 135.20 93.50 98.30 3-1952 189.60 179.50 157.30 135.20 93.50 3-1953 NA 189.60 179.50 157.30 135.20 3-1954 NA NA 189.60 179.50 157.30 4-1935 66.26 72.76 40.29 NA NA 4-1936 51.60 66.26 72.76 40.29 NA 4-1937 52.41 51.60 66.26 72.76 40.29 4-1938 69.41 52.41 51.60 66.26 72.76 4-1939 68.35 69.41 52.41 51.60 66.26 4-1940 46.80 68.35 69.41 52.41 51.60 4-1941 47.40 46.80 68.35 69.41 52.41 4-1942 59.57 47.40 46.80 68.35 69.41 4-1943 88.78 59.57 47.40 46.80 68.35 4-1944 74.12 88.78 59.57 47.40 46.80 4-1945 62.68 74.12 88.78 59.57 47.40 4-1946 89.36 62.68 74.12 88.78 59.57 4-1947 78.98 89.36 62.68 74.12 88.78 4-1948 100.66 78.98 89.36 62.68 74.12 4-1949 160.62 100.66 78.98 89.36 62.68 4-1950 145.00 160.62 100.66 78.98 89.36 4-1951 174.93 145.00 160.62 100.66 78.98 4-1952 172.49 174.93 145.00 160.62 100.66 4-1953 NA 172.49 174.93 145.00 160.62 4-1954 NA NA 172.49 174.93 145.00 5-1935 74.24 50.73 39.68 NA NA 5-1936 53.51 74.24 50.73 39.68 NA 5-1937 42.65 53.51 74.24 50.73 39.68 5-1938 46.48 42.65 53.51 74.24 50.73 5-1939 61.40 46.48 42.65 53.51 74.24 5-1940 39.67 61.40 46.48 42.65 53.51 5-1941 62.24 39.67 61.40 46.48 42.65 5-1942 52.32 62.24 39.67 61.40 46.48 5-1943 63.21 52.32 62.24 39.67 61.40 5-1944 59.37 63.21 52.32 62.24 39.67 5-1945 58.02 59.37 63.21 52.32 62.24 5-1946 70.34 58.02 59.37 63.21 52.32 5-1947 67.42 70.34 58.02 59.37 63.21 5-1948 55.74 67.42 70.34 58.02 59.37 5-1949 80.30 55.74 67.42 70.34 58.02 5-1950 85.40 80.30 55.74 67.42 70.34 5-1951 91.90 85.40 80.30 55.74 67.42 5-1952 81.43 91.90 85.40 80.30 55.74 5-1953 NA 81.43 91.90 85.40 80.30 5-1954 NA NA 81.43 91.90 85.40 6-1935 25.94 25.98 20.36 NA NA 6-1936 27.53 25.94 25.98 20.36 NA 6-1937 24.60 27.53 25.94 25.98 20.36 6-1938 28.54 24.60 27.53 25.94 25.98 6-1939 43.41 28.54 24.60 27.53 25.94 6-1940 42.81 43.41 28.54 24.60 27.53 6-1941 27.84 42.81 43.41 28.54 24.60 6-1942 32.60 27.84 42.81 43.41 28.54 6-1943 39.03 32.60 27.84 42.81 43.41 6-1944 50.17 39.03 32.60 27.84 42.81 6-1945 51.85 50.17 39.03 32.60 27.84 6-1946 64.03 51.85 50.17 39.03 32.60 6-1947 68.16 64.03 51.85 50.17 39.03 6-1948 77.34 68.16 64.03 51.85 50.17 6-1949 95.30 77.34 68.16 64.03 51.85 6-1950 99.49 95.30 77.34 68.16 64.03 6-1951 127.52 99.49 95.30 77.34 68.16 6-1952 135.72 127.52 99.49 95.30 77.34 6-1953 NA 135.72 127.52 99.49 95.30 6-1954 NA NA 135.72 127.52 99.49 7-1935 32.78 23.21 24.43 NA NA 7-1936 32.54 32.78 23.21 24.43 NA 7-1937 26.65 32.54 32.78 23.21 24.43 7-1938 33.71 26.65 32.54 32.78 23.21 7-1939 43.50 33.71 26.65 32.54 32.78 7-1940 34.46 43.50 33.71 26.65 32.54 7-1941 44.28 34.46 43.50 33.71 26.65 7-1942 70.80 44.28 34.46 43.50 33.71 7-1943 44.12 70.80 44.28 34.46 43.50 7-1944 48.98 44.12 70.80 44.28 34.46 7-1945 48.51 48.98 44.12 70.80 44.28 7-1946 50.00 48.51 48.98 44.12 70.80 7-1947 50.59 50.00 48.51 48.98 44.12 7-1948 42.53 50.59 50.00 48.51 48.98 7-1949 64.77 42.53 50.59 50.00 48.51 7-1950 72.68 64.77 42.53 50.59 50.00 7-1951 73.86 72.68 64.77 42.53 50.59 7-1952 89.51 73.86 72.68 64.77 42.53 7-1953 NA 89.51 73.86 72.68 64.77 7-1954 NA NA 89.51 73.86 72.68 8-1935 35.05 25.90 12.93 NA NA 8-1936 22.89 35.05 25.90 12.93 NA 8-1937 18.84 22.89 35.05 25.90 12.93 8-1938 28.57 18.84 22.89 35.05 25.90 8-1939 48.51 28.57 18.84 22.89 35.05 8-1940 43.34 48.51 28.57 18.84 22.89 8-1941 37.02 43.34 48.51 28.57 18.84 8-1942 37.81 37.02 43.34 48.51 28.57 8-1943 39.27 37.81 37.02 43.34 48.51 8-1944 53.46 39.27 37.81 37.02 43.34 8-1945 55.56 53.46 39.27 37.81 37.02 8-1946 49.56 55.56 53.46 39.27 37.81 8-1947 32.04 49.56 55.56 53.46 39.27 8-1948 32.24 32.04 49.56 55.56 53.46 8-1949 54.38 32.24 32.04 49.56 55.56 8-1950 71.78 54.38 32.24 32.04 49.56 8-1951 90.08 71.78 54.38 32.24 32.04 8-1952 68.60 90.08 71.78 54.38 32.24 8-1953 NA 68.60 90.08 71.78 54.38 8-1954 NA NA 68.60 90.08 71.78 9-1935 30.65 23.39 26.63 NA NA 9-1936 20.89 30.65 23.39 26.63 NA 9-1937 28.78 20.89 30.65 23.39 26.63 9-1938 26.93 28.78 20.89 30.65 23.39 9-1939 32.08 26.93 28.78 20.89 30.65 9-1940 32.21 32.08 26.93 28.78 20.89 9-1941 35.69 32.21 32.08 26.93 28.78 9-1942 62.47 35.69 32.21 32.08 26.93 9-1943 52.32 62.47 35.69 32.21 32.08 9-1944 56.95 52.32 62.47 35.69 32.21 9-1945 54.32 56.95 52.32 62.47 35.69 9-1946 40.53 54.32 56.95 52.32 62.47 9-1947 32.54 40.53 54.32 56.95 52.32 9-1948 43.48 32.54 40.53 54.32 56.95 9-1949 56.49 43.48 32.54 40.53 54.32 9-1950 65.98 56.49 43.48 32.54 40.53 9-1951 66.11 65.98 56.49 43.48 32.54 9-1952 49.34 66.11 65.98 56.49 43.48 9-1953 NA 49.34 66.11 65.98 56.49 9-1954 NA NA 49.34 66.11 65.98 10-1935 2.19 2.00 2.54 NA NA 10-1936 1.99 2.19 2.00 2.54 NA 10-1937 2.03 1.99 2.19 2.00 2.54 10-1938 1.81 2.03 1.99 2.19 2.00 10-1939 2.14 1.81 2.03 1.99 2.19 10-1940 1.86 2.14 1.81 2.03 1.99 10-1941 0.93 1.86 2.14 1.81 2.03 10-1942 1.18 0.93 1.86 2.14 1.81 10-1943 1.36 1.18 0.93 1.86 2.14 10-1944 2.24 1.36 1.18 0.93 1.86 10-1945 3.81 2.24 1.36 1.18 0.93 10-1946 5.66 3.81 2.24 1.36 1.18 10-1947 4.21 5.66 3.81 2.24 1.36 10-1948 3.42 4.21 5.66 3.81 2.24 10-1949 4.67 3.42 4.21 5.66 3.81 10-1950 6.00 4.67 3.42 4.21 5.66 10-1951 6.53 6.00 4.67 3.42 4.21 10-1952 5.12 6.53 6.00 4.67 3.42 10-1953 NA 5.12 6.53 6.00 4.67 10-1954 NA NA 5.12 6.53 6.00 > lead(Grunfeld$inv, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 NA NA 317.60 391.80 410.60 1-1936 NA 317.60 391.80 410.60 257.70 1-1937 317.60 391.80 410.60 257.70 330.80 1-1938 391.80 410.60 257.70 330.80 461.20 1-1939 410.60 257.70 330.80 461.20 512.00 1-1940 257.70 330.80 461.20 512.00 448.00 1-1941 330.80 461.20 512.00 448.00 499.60 1-1942 461.20 512.00 448.00 499.60 547.50 1-1943 512.00 448.00 499.60 547.50 561.20 1-1944 448.00 499.60 547.50 561.20 688.10 1-1945 499.60 547.50 561.20 688.10 568.90 1-1946 547.50 561.20 688.10 568.90 529.20 1-1947 561.20 688.10 568.90 529.20 555.10 1-1948 688.10 568.90 529.20 555.10 642.90 1-1949 568.90 529.20 555.10 642.90 755.90 1-1950 529.20 555.10 642.90 755.90 891.20 1-1951 555.10 642.90 755.90 891.20 1304.40 1-1952 642.90 755.90 891.20 1304.40 1486.70 1-1953 755.90 891.20 1304.40 1486.70 NA 1-1954 891.20 1304.40 1486.70 NA NA 2-1935 NA NA 209.90 355.30 469.90 2-1936 NA 209.90 355.30 469.90 262.30 2-1937 209.90 355.30 469.90 262.30 230.40 2-1938 355.30 469.90 262.30 230.40 361.60 2-1939 469.90 262.30 230.40 361.60 472.80 2-1940 262.30 230.40 361.60 472.80 445.60 2-1941 230.40 361.60 472.80 445.60 361.60 2-1942 361.60 472.80 445.60 361.60 288.20 2-1943 472.80 445.60 361.60 288.20 258.70 2-1944 445.60 361.60 288.20 258.70 420.30 2-1945 361.60 288.20 258.70 420.30 420.50 2-1946 288.20 258.70 420.30 420.50 494.50 2-1947 258.70 420.30 420.50 494.50 405.10 2-1948 420.30 420.50 494.50 405.10 418.80 2-1949 420.50 494.50 405.10 418.80 588.20 2-1950 494.50 405.10 418.80 588.20 645.50 2-1951 405.10 418.80 588.20 645.50 641.00 2-1952 418.80 588.20 645.50 641.00 459.30 2-1953 588.20 645.50 641.00 459.30 NA 2-1954 645.50 641.00 459.30 NA NA 3-1935 NA NA 33.10 45.00 77.20 3-1936 NA 33.10 45.00 77.20 44.60 3-1937 33.10 45.00 77.20 44.60 48.10 3-1938 45.00 77.20 44.60 48.10 74.40 3-1939 77.20 44.60 48.10 74.40 113.00 3-1940 44.60 48.10 74.40 113.00 91.90 3-1941 48.10 74.40 113.00 91.90 61.30 3-1942 74.40 113.00 91.90 61.30 56.80 3-1943 113.00 91.90 61.30 56.80 93.60 3-1944 91.90 61.30 56.80 93.60 159.90 3-1945 61.30 56.80 93.60 159.90 147.20 3-1946 56.80 93.60 159.90 147.20 146.30 3-1947 93.60 159.90 147.20 146.30 98.30 3-1948 159.90 147.20 146.30 98.30 93.50 3-1949 147.20 146.30 98.30 93.50 135.20 3-1950 146.30 98.30 93.50 135.20 157.30 3-1951 98.30 93.50 135.20 157.30 179.50 3-1952 93.50 135.20 157.30 179.50 189.60 3-1953 135.20 157.30 179.50 189.60 NA 3-1954 157.30 179.50 189.60 NA NA 4-1935 NA NA 40.29 72.76 66.26 4-1936 NA 40.29 72.76 66.26 51.60 4-1937 40.29 72.76 66.26 51.60 52.41 4-1938 72.76 66.26 51.60 52.41 69.41 4-1939 66.26 51.60 52.41 69.41 68.35 4-1940 51.60 52.41 69.41 68.35 46.80 4-1941 52.41 69.41 68.35 46.80 47.40 4-1942 69.41 68.35 46.80 47.40 59.57 4-1943 68.35 46.80 47.40 59.57 88.78 4-1944 46.80 47.40 59.57 88.78 74.12 4-1945 47.40 59.57 88.78 74.12 62.68 4-1946 59.57 88.78 74.12 62.68 89.36 4-1947 88.78 74.12 62.68 89.36 78.98 4-1948 74.12 62.68 89.36 78.98 100.66 4-1949 62.68 89.36 78.98 100.66 160.62 4-1950 89.36 78.98 100.66 160.62 145.00 4-1951 78.98 100.66 160.62 145.00 174.93 4-1952 100.66 160.62 145.00 174.93 172.49 4-1953 160.62 145.00 174.93 172.49 NA 4-1954 145.00 174.93 172.49 NA NA 5-1935 NA NA 39.68 50.73 74.24 5-1936 NA 39.68 50.73 74.24 53.51 5-1937 39.68 50.73 74.24 53.51 42.65 5-1938 50.73 74.24 53.51 42.65 46.48 5-1939 74.24 53.51 42.65 46.48 61.40 5-1940 53.51 42.65 46.48 61.40 39.67 5-1941 42.65 46.48 61.40 39.67 62.24 5-1942 46.48 61.40 39.67 62.24 52.32 5-1943 61.40 39.67 62.24 52.32 63.21 5-1944 39.67 62.24 52.32 63.21 59.37 5-1945 62.24 52.32 63.21 59.37 58.02 5-1946 52.32 63.21 59.37 58.02 70.34 5-1947 63.21 59.37 58.02 70.34 67.42 5-1948 59.37 58.02 70.34 67.42 55.74 5-1949 58.02 70.34 67.42 55.74 80.30 5-1950 70.34 67.42 55.74 80.30 85.40 5-1951 67.42 55.74 80.30 85.40 91.90 5-1952 55.74 80.30 85.40 91.90 81.43 5-1953 80.30 85.40 91.90 81.43 NA 5-1954 85.40 91.90 81.43 NA NA 6-1935 NA NA 20.36 25.98 25.94 6-1936 NA 20.36 25.98 25.94 27.53 6-1937 20.36 25.98 25.94 27.53 24.60 6-1938 25.98 25.94 27.53 24.60 28.54 6-1939 25.94 27.53 24.60 28.54 43.41 6-1940 27.53 24.60 28.54 43.41 42.81 6-1941 24.60 28.54 43.41 42.81 27.84 6-1942 28.54 43.41 42.81 27.84 32.60 6-1943 43.41 42.81 27.84 32.60 39.03 6-1944 42.81 27.84 32.60 39.03 50.17 6-1945 27.84 32.60 39.03 50.17 51.85 6-1946 32.60 39.03 50.17 51.85 64.03 6-1947 39.03 50.17 51.85 64.03 68.16 6-1948 50.17 51.85 64.03 68.16 77.34 6-1949 51.85 64.03 68.16 77.34 95.30 6-1950 64.03 68.16 77.34 95.30 99.49 6-1951 68.16 77.34 95.30 99.49 127.52 6-1952 77.34 95.30 99.49 127.52 135.72 6-1953 95.30 99.49 127.52 135.72 NA 6-1954 99.49 127.52 135.72 NA NA 7-1935 NA NA 24.43 23.21 32.78 7-1936 NA 24.43 23.21 32.78 32.54 7-1937 24.43 23.21 32.78 32.54 26.65 7-1938 23.21 32.78 32.54 26.65 33.71 7-1939 32.78 32.54 26.65 33.71 43.50 7-1940 32.54 26.65 33.71 43.50 34.46 7-1941 26.65 33.71 43.50 34.46 44.28 7-1942 33.71 43.50 34.46 44.28 70.80 7-1943 43.50 34.46 44.28 70.80 44.12 7-1944 34.46 44.28 70.80 44.12 48.98 7-1945 44.28 70.80 44.12 48.98 48.51 7-1946 70.80 44.12 48.98 48.51 50.00 7-1947 44.12 48.98 48.51 50.00 50.59 7-1948 48.98 48.51 50.00 50.59 42.53 7-1949 48.51 50.00 50.59 42.53 64.77 7-1950 50.00 50.59 42.53 64.77 72.68 7-1951 50.59 42.53 64.77 72.68 73.86 7-1952 42.53 64.77 72.68 73.86 89.51 7-1953 64.77 72.68 73.86 89.51 NA 7-1954 72.68 73.86 89.51 NA NA 8-1935 NA NA 12.93 25.90 35.05 8-1936 NA 12.93 25.90 35.05 22.89 8-1937 12.93 25.90 35.05 22.89 18.84 8-1938 25.90 35.05 22.89 18.84 28.57 8-1939 35.05 22.89 18.84 28.57 48.51 8-1940 22.89 18.84 28.57 48.51 43.34 8-1941 18.84 28.57 48.51 43.34 37.02 8-1942 28.57 48.51 43.34 37.02 37.81 8-1943 48.51 43.34 37.02 37.81 39.27 8-1944 43.34 37.02 37.81 39.27 53.46 8-1945 37.02 37.81 39.27 53.46 55.56 8-1946 37.81 39.27 53.46 55.56 49.56 8-1947 39.27 53.46 55.56 49.56 32.04 8-1948 53.46 55.56 49.56 32.04 32.24 8-1949 55.56 49.56 32.04 32.24 54.38 8-1950 49.56 32.04 32.24 54.38 71.78 8-1951 32.04 32.24 54.38 71.78 90.08 8-1952 32.24 54.38 71.78 90.08 68.60 8-1953 54.38 71.78 90.08 68.60 NA 8-1954 71.78 90.08 68.60 NA NA 9-1935 NA NA 26.63 23.39 30.65 9-1936 NA 26.63 23.39 30.65 20.89 9-1937 26.63 23.39 30.65 20.89 28.78 9-1938 23.39 30.65 20.89 28.78 26.93 9-1939 30.65 20.89 28.78 26.93 32.08 9-1940 20.89 28.78 26.93 32.08 32.21 9-1941 28.78 26.93 32.08 32.21 35.69 9-1942 26.93 32.08 32.21 35.69 62.47 9-1943 32.08 32.21 35.69 62.47 52.32 9-1944 32.21 35.69 62.47 52.32 56.95 9-1945 35.69 62.47 52.32 56.95 54.32 9-1946 62.47 52.32 56.95 54.32 40.53 9-1947 52.32 56.95 54.32 40.53 32.54 9-1948 56.95 54.32 40.53 32.54 43.48 9-1949 54.32 40.53 32.54 43.48 56.49 9-1950 40.53 32.54 43.48 56.49 65.98 9-1951 32.54 43.48 56.49 65.98 66.11 9-1952 43.48 56.49 65.98 66.11 49.34 9-1953 56.49 65.98 66.11 49.34 NA 9-1954 65.98 66.11 49.34 NA NA 10-1935 NA NA 2.54 2.00 2.19 10-1936 NA 2.54 2.00 2.19 1.99 10-1937 2.54 2.00 2.19 1.99 2.03 10-1938 2.00 2.19 1.99 2.03 1.81 10-1939 2.19 1.99 2.03 1.81 2.14 10-1940 1.99 2.03 1.81 2.14 1.86 10-1941 2.03 1.81 2.14 1.86 0.93 10-1942 1.81 2.14 1.86 0.93 1.18 10-1943 2.14 1.86 0.93 1.18 1.36 10-1944 1.86 0.93 1.18 1.36 2.24 10-1945 0.93 1.18 1.36 2.24 3.81 10-1946 1.18 1.36 2.24 3.81 5.66 10-1947 1.36 2.24 3.81 5.66 4.21 10-1948 2.24 3.81 5.66 4.21 3.42 10-1949 3.81 5.66 4.21 3.42 4.67 10-1950 5.66 4.21 3.42 4.67 6.00 10-1951 4.21 3.42 4.67 6.00 6.53 10-1952 3.42 4.67 6.00 6.53 5.12 10-1953 4.67 6.00 6.53 5.12 NA 10-1954 6.00 6.53 5.12 NA NA > if(!isTRUE(all.equal(lag(Grunfeld$inv, c(-2, -1, 0, 1, 2)), + lead(Grunfeld$inv, -1*c(-2, -1, 0, 1, 2)), check.attributes = FALSE))) stop("'lag( , c())' not equal to 'lead( , -1*c())'") > # produces a matrix of characters: > # standard R behaviour for factor input to matrix - not beautiful but "correct" > lag(Grunfeld$fac, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 "198" "199" "200" NA NA 1-1936 "197" "198" "199" "200" NA 1-1937 "196" "197" "198" "199" "200" 1-1938 "195" "196" "197" "198" "199" 1-1939 "194" "195" "196" "197" "198" 1-1940 "193" "194" "195" "196" "197" 1-1941 "192" "193" "194" "195" "196" 1-1942 "191" "192" "193" "194" "195" 1-1943 "190" "191" "192" "193" "194" 1-1944 "189" "190" "191" "192" "193" 1-1945 "188" "189" "190" "191" "192" 1-1946 "187" "188" "189" "190" "191" 1-1947 "186" "187" "188" "189" "190" 1-1948 "185" "186" "187" "188" "189" 1-1949 "184" "185" "186" "187" "188" 1-1950 "183" "184" "185" "186" "187" 1-1951 "182" "183" "184" "185" "186" 1-1952 "181" "182" "183" "184" "185" 1-1953 NA "181" "182" "183" "184" 1-1954 NA NA "181" "182" "183" 2-1935 "178" "179" "180" NA NA 2-1936 "177" "178" "179" "180" NA 2-1937 "176" "177" "178" "179" "180" 2-1938 "175" "176" "177" "178" "179" 2-1939 "174" "175" "176" "177" "178" 2-1940 "173" "174" "175" "176" "177" 2-1941 "172" "173" "174" "175" "176" 2-1942 "171" "172" "173" "174" "175" 2-1943 "170" "171" "172" "173" "174" 2-1944 "169" "170" "171" "172" "173" 2-1945 "168" "169" "170" "171" "172" 2-1946 "167" "168" "169" "170" "171" 2-1947 "166" "167" "168" "169" "170" 2-1948 "165" "166" "167" "168" "169" 2-1949 "164" "165" "166" "167" "168" 2-1950 "163" "164" "165" "166" "167" 2-1951 "162" "163" "164" "165" "166" 2-1952 "161" "162" "163" "164" "165" 2-1953 NA "161" "162" "163" "164" 2-1954 NA NA "161" "162" "163" 3-1935 "158" "159" "160" NA NA 3-1936 "157" "158" "159" "160" NA 3-1937 "156" "157" "158" "159" "160" 3-1938 "155" "156" "157" "158" "159" 3-1939 "154" "155" "156" "157" "158" 3-1940 "153" "154" "155" "156" "157" 3-1941 "152" "153" "154" "155" "156" 3-1942 "151" "152" "153" "154" "155" 3-1943 "150" "151" "152" "153" "154" 3-1944 "149" "150" "151" "152" "153" 3-1945 "148" "149" "150" "151" "152" 3-1946 "147" "148" "149" "150" "151" 3-1947 "146" "147" "148" "149" "150" 3-1948 "145" "146" "147" "148" "149" 3-1949 "144" "145" "146" "147" "148" 3-1950 "143" "144" "145" "146" "147" 3-1951 "142" "143" "144" "145" "146" 3-1952 "141" "142" "143" "144" "145" 3-1953 NA "141" "142" "143" "144" 3-1954 NA NA "141" "142" "143" 4-1935 "138" "139" "140" NA NA 4-1936 "137" "138" "139" "140" NA 4-1937 "136" "137" "138" "139" "140" 4-1938 "135" "136" "137" "138" "139" 4-1939 "134" "135" "136" "137" "138" 4-1940 "133" "134" "135" "136" "137" 4-1941 "132" "133" "134" "135" "136" 4-1942 "131" "132" "133" "134" "135" 4-1943 "130" "131" "132" "133" "134" 4-1944 "129" "130" "131" "132" "133" 4-1945 "128" "129" "130" "131" "132" 4-1946 "127" "128" "129" "130" "131" 4-1947 "126" "127" "128" "129" "130" 4-1948 "125" "126" "127" "128" "129" 4-1949 "124" "125" "126" "127" "128" 4-1950 "123" "124" "125" "126" "127" 4-1951 "122" "123" "124" "125" "126" 4-1952 "121" "122" "123" "124" "125" 4-1953 NA "121" "122" "123" "124" 4-1954 NA NA "121" "122" "123" 5-1935 "118" "119" "120" NA NA 5-1936 "117" "118" "119" "120" NA 5-1937 "116" "117" "118" "119" "120" 5-1938 "115" "116" "117" "118" "119" 5-1939 "114" "115" "116" "117" "118" 5-1940 "113" "114" "115" "116" "117" 5-1941 "112" "113" "114" "115" "116" 5-1942 "111" "112" "113" "114" "115" 5-1943 "110" "111" "112" "113" "114" 5-1944 "109" "110" "111" "112" "113" 5-1945 "108" "109" "110" "111" "112" 5-1946 "107" "108" "109" "110" "111" 5-1947 "106" "107" "108" "109" "110" 5-1948 "105" "106" "107" "108" "109" 5-1949 "104" "105" "106" "107" "108" 5-1950 "103" "104" "105" "106" "107" 5-1951 "102" "103" "104" "105" "106" 5-1952 "101" "102" "103" "104" "105" 5-1953 NA "101" "102" "103" "104" 5-1954 NA NA "101" "102" "103" 6-1935 "98" "99" "100" NA NA 6-1936 "97" "98" "99" "100" NA 6-1937 "96" "97" "98" "99" "100" 6-1938 "95" "96" "97" "98" "99" 6-1939 "94" "95" "96" "97" "98" 6-1940 "93" "94" "95" "96" "97" 6-1941 "92" "93" "94" "95" "96" 6-1942 "91" "92" "93" "94" "95" 6-1943 "90" "91" "92" "93" "94" 6-1944 "89" "90" "91" "92" "93" 6-1945 "88" "89" "90" "91" "92" 6-1946 "87" "88" "89" "90" "91" 6-1947 "86" "87" "88" "89" "90" 6-1948 "85" "86" "87" "88" "89" 6-1949 "84" "85" "86" "87" "88" 6-1950 "83" "84" "85" "86" "87" 6-1951 "82" "83" "84" "85" "86" 6-1952 "81" "82" "83" "84" "85" 6-1953 NA "81" "82" "83" "84" 6-1954 NA NA "81" "82" "83" 7-1935 "78" "79" "80" NA NA 7-1936 "77" "78" "79" "80" NA 7-1937 "76" "77" "78" "79" "80" 7-1938 "75" "76" "77" "78" "79" 7-1939 "74" "75" "76" "77" "78" 7-1940 "73" "74" "75" "76" "77" 7-1941 "72" "73" "74" "75" "76" 7-1942 "71" "72" "73" "74" "75" 7-1943 "70" "71" "72" "73" "74" 7-1944 "69" "70" "71" "72" "73" 7-1945 "68" "69" "70" "71" "72" 7-1946 "67" "68" "69" "70" "71" 7-1947 "66" "67" "68" "69" "70" 7-1948 "65" "66" "67" "68" "69" 7-1949 "64" "65" "66" "67" "68" 7-1950 "63" "64" "65" "66" "67" 7-1951 "62" "63" "64" "65" "66" 7-1952 "61" "62" "63" "64" "65" 7-1953 NA "61" "62" "63" "64" 7-1954 NA NA "61" "62" "63" 8-1935 "58" "59" "60" NA NA 8-1936 "57" "58" "59" "60" NA 8-1937 "56" "57" "58" "59" "60" 8-1938 "55" "56" "57" "58" "59" 8-1939 "54" "55" "56" "57" "58" 8-1940 "53" "54" "55" "56" "57" 8-1941 "52" "53" "54" "55" "56" 8-1942 "51" "52" "53" "54" "55" 8-1943 "50" "51" "52" "53" "54" 8-1944 "49" "50" "51" "52" "53" 8-1945 "48" "49" "50" "51" "52" 8-1946 "47" "48" "49" "50" "51" 8-1947 "46" "47" "48" "49" "50" 8-1948 "45" "46" "47" "48" "49" 8-1949 "44" "45" "46" "47" "48" 8-1950 "43" "44" "45" "46" "47" 8-1951 "42" "43" "44" "45" "46" 8-1952 "41" "42" "43" "44" "45" 8-1953 NA "41" "42" "43" "44" 8-1954 NA NA "41" "42" "43" 9-1935 "38" "39" "40" NA NA 9-1936 "37" "38" "39" "40" NA 9-1937 "36" "37" "38" "39" "40" 9-1938 "35" "36" "37" "38" "39" 9-1939 "34" "35" "36" "37" "38" 9-1940 "33" "34" "35" "36" "37" 9-1941 "32" "33" "34" "35" "36" 9-1942 "31" "32" "33" "34" "35" 9-1943 "30" "31" "32" "33" "34" 9-1944 "29" "30" "31" "32" "33" 9-1945 "28" "29" "30" "31" "32" 9-1946 "27" "28" "29" "30" "31" 9-1947 "26" "27" "28" "29" "30" 9-1948 "25" "26" "27" "28" "29" 9-1949 "24" "25" "26" "27" "28" 9-1950 "23" "24" "25" "26" "27" 9-1951 "22" "23" "24" "25" "26" 9-1952 "21" "22" "23" "24" "25" 9-1953 NA "21" "22" "23" "24" 9-1954 NA NA "21" "22" "23" 10-1935 "18" "19" "20" NA NA 10-1936 "17" "18" "19" "20" NA 10-1937 "16" "17" "18" "19" "20" 10-1938 "15" "16" "17" "18" "19" 10-1939 "14" "15" "16" "17" "18" 10-1940 "13" "14" "15" "16" "17" 10-1941 "12" "13" "14" "15" "16" 10-1942 "11" "12" "13" "14" "15" 10-1943 "10" "11" "12" "13" "14" 10-1944 "9" "10" "11" "12" "13" 10-1945 "8" "9" "10" "11" "12" 10-1946 "7" "8" "9" "10" "11" 10-1947 "6" "7" "8" "9" "10" 10-1948 "5" "6" "7" "8" "9" 10-1949 "4" "5" "6" "7" "8" 10-1950 "3" "4" "5" "6" "7" 10-1951 "2" "3" "4" "5" "6" 10-1952 "1" "2" "3" "4" "5" 10-1953 NA "1" "2" "3" "4" 10-1954 NA NA "1" "2" "3" > > # other data set (different time periods) > # Hedonic is an unbalanced panel, townid is the individual index > data("Hedonic", package = "plm") > Hed <- pdata.frame(Hedonic, index = "townid") > head(Hed$age, 20) 1-1 2-1 2-2 3-1 3-2 3-3 4-1 4-2 65.19995 78.89996 61.09998 45.79999 54.19998 58.69998 66.59998 96.09998 4-3 4-4 4-5 4-6 4-7 5-1 5-2 5-3 100.00000 85.89996 94.29999 82.89996 39.00000 61.79999 84.50000 56.50000 5-4 5-5 5-6 5-7 29.29999 81.69995 36.59998 69.50000 > head(lag(Hed$age), 20) 1-1 2-1 2-2 3-1 3-2 3-3 4-1 4-2 NA NA 78.89996 NA 45.79999 54.19998 NA 66.59998 4-3 4-4 4-5 4-6 4-7 5-1 5-2 5-3 96.09998 100.00000 85.89996 94.29999 82.89996 NA 61.79999 84.50000 5-4 5-5 5-6 5-7 56.50000 29.29999 81.69995 36.59998 > head(lag(Hed$age, c(0,1,2)), 20) 0 1 2 1-1 65.19995 NA NA 2-1 78.89996 NA NA 2-2 61.09998 78.89996 NA 3-1 45.79999 NA NA 3-2 54.19998 45.79999 NA 3-3 58.69998 54.19998 45.79999 4-1 66.59998 NA NA 4-2 96.09998 66.59998 NA 4-3 100.00000 96.09998 66.59998 4-4 85.89996 100.00000 96.09998 4-5 94.29999 85.89996 100.00000 4-6 82.89996 94.29999 85.89996 4-7 39.00000 82.89996 94.29999 5-1 61.79999 NA NA 5-2 84.50000 61.79999 NA 5-3 56.50000 84.50000 61.79999 5-4 29.29999 56.50000 84.50000 5-5 81.69995 29.29999 56.50000 5-6 36.59998 81.69995 29.29999 5-7 69.50000 36.59998 81.69995 > if (!isTRUE(all.equal(lag(Hed$age, c(0,1,2,3,4,5)), lead(Hed$age, -1*c(0,1,2,3,4,5)), check.attributes = FALSE))) stop("'lag( , 1)' not equal to 'lead( , -1)'") > > > > # diff > if (!isTRUE(all.equal(diff(Grunfeld$inv), Grunfeld$inv - lag(Grunfeld$inv)))) stop("'diff()' not corresponding to differences with 'lag()'") > if (!isTRUE(all.equal(diff(Grunfeld$inv, 2), Grunfeld$inv - lag(Grunfeld$inv, 2)))) stop("'diff( , 2)' not corresponding to differences with 'lag( , 2)'") > > > > ############## (4) test with non-consecutive time periods #### > data("Grunfeld", package = "plm") > > pGrunfeld_missing_period <- pdata.frame(Grunfeld[-2, ]) # delete one time period of first individual (1-1936 is missing (not NA)) > > is.pconsecutive(pGrunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > head(pGrunfeld_missing_period$inv, 25) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 317.6 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 561.2 688.1 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 568.9 529.2 555.1 642.9 755.9 891.2 1304.4 1486.7 209.9 355.3 469.9 2-1938 2-1939 2-1940 262.3 230.4 361.6 > head(test_Grun_miss_p_lag1 <- lag(pGrunfeld_missing_period$inv), 25) # correct: additional NA for the missing time period is introduced at 1-1937 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 561.2 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 688.1 568.9 529.2 555.1 642.9 755.9 891.2 1304.4 NA 209.9 355.3 2-1938 2-1939 2-1940 469.9 262.3 230.4 > head(lag(pGrunfeld_missing_period$inv, 2), 25) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA 317.6 NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 561.2 688.1 568.9 529.2 555.1 642.9 755.9 891.2 NA NA 209.9 2-1938 2-1939 2-1940 355.3 469.9 262.3 > head(test_Grun_miss_p_lag3 <- lag(pGrunfeld_missing_period$inv, 3), 25) # correct: 1-1938 should be non-NA (former 1-1935: 317.6) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA NA 317.6 NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 547.5 561.2 688.1 568.9 529.2 555.1 642.9 755.9 NA NA NA 2-1938 2-1939 2-1940 209.9 355.3 469.9 > > ### formal test for correct value > if (!is.na(test_Grun_miss_p_lag1["1-1937"])) stop("lag(pGrunfeld_missing_period$inv, 1)' for '1-1937' contains a value but should be 'NA'") > > > if (!is.na(test_Grun_miss_p_lag3["1-1938"])) { + if(!isTRUE(all.equal(test_Grun_miss_p_lag3["1-1938"], pGrunfeld_missing_period$inv["1-1935"], check.attributes = FALSE))) + stop("'lag(pGrunfeld_missing_period$inv, 3)' for '1-1938' is not the expected value of '1-1935' of original data 'pGrunfeld_missing_period$inv'") + } else stop("'lag(pGrunfeld_missing_period$inv, 3)' is NA for '1-1938' but should be the value of '1-1935' from original data 'pGrunfeld_missing_period$inv'") > > > length(pGrunfeld_missing_period$inv) == length(lag(pGrunfeld_missing_period$inv)) [1] TRUE > > # with different data set > data("Hedonic", package = "plm") > Hed_missing_period <- pdata.frame(Hedonic, index = "townid") > Hed_missing_period <- as.data.frame(Hed_missing_period) > Hed_missing_period <- Hed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 > Hed_missing_period <- pdata.frame(Hed_missing_period, index = c("townid", "time")) > > is.pconsecutive(Hed_missing_period) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > head(Hed_missing_period$age, 20) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 65.19995 78.89996 61.09998 45.79999 58.69998 66.59998 96.09998 100.00000 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 85.89996 82.89996 39.00000 61.79999 84.50000 56.50000 29.29999 81.69995 5-6 5-7 5-8 5-9 36.59998 69.50000 98.09998 89.19995 > head(test_Hed_miss_p_lag1 <- lag(Hed_missing_period$age), 20) # correct: lag(, 1): additional NAs introduced at (among others) 3-3 and 4-6 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA 78.89996 NA NA NA 66.59998 96.09998 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 100.00000 NA 82.89996 NA 61.79999 84.50000 56.50000 29.29999 5-6 5-7 5-8 5-9 81.69995 36.59998 69.50000 98.09998 > head(test_Hed_miss_p_lag2 <- lag(Hed_missing_period$age, 2), 20) # correct: lag(, 2): 4-6 should be former 4-4: 85.89996 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA 45.79999 NA NA 66.59998 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 96.09998 85.89996 NA NA NA 61.79999 84.50000 56.50000 5-6 5-7 5-8 5-9 29.29999 81.69995 36.59998 69.50000 > # 3-3 should be former 3-1: 45.79999 > > head(lag(Hed_missing_period$age, c(0,1,2)), 20) # view all at once 0 1 2 1-1 65.19995 NA NA 2-1 78.89996 NA NA 2-2 61.09998 78.89996 NA 3-1 45.79999 NA NA 3-3 58.69998 NA 45.79999 4-1 66.59998 NA NA 4-2 96.09998 66.59998 NA 4-3 100.00000 96.09998 66.59998 4-4 85.89996 100.00000 96.09998 4-6 82.89996 NA 85.89996 4-7 39.00000 82.89996 NA 5-1 61.79999 NA NA 5-2 84.50000 61.79999 NA 5-3 56.50000 84.50000 61.79999 5-4 29.29999 56.50000 84.50000 5-5 81.69995 29.29999 56.50000 5-6 36.59998 81.69995 29.29999 5-7 69.50000 36.59998 81.69995 5-8 98.09998 69.50000 36.59998 5-9 89.19995 98.09998 69.50000 > > ### formal tests for correct values > # lag(, 1) > if(!is.na(test_Hed_miss_p_lag1["3-3"])) stop("lag(Hed_missing_period$age, 1)' for '3-3' contains a value but should be 'NA'") > if(!is.na(test_Hed_miss_p_lag1["4-6"])) stop("lag(Hed_missing_period$age, 1)' for '4-6' contains a value but should be 'NA'") > > # lag(, 2) > if (!is.na(test_Hed_miss_p_lag2["3-3"])) { + if(!isTRUE(all.equal(test_Hed_miss_p_lag2["3-3"], Hed_missing_period$age["3-1"], check.attributes = FALSE))) + stop("'lag(Hed_missing_period$age, 2)' for '3-3' is not the expected value of '3-1' of original data 'Hed_missing_period$age'") + } else stop("'lag(Hed_missing_period$age, 2)' is NA for '3-3' but should be the value of '3-1' from original data 'Hed_missing_period$age'") > > if (!is.na(test_Hed_miss_p_lag2["4-6"])) { + if(!isTRUE(all.equal(test_Hed_miss_p_lag2["4-6"], Hed_missing_period$age["4-4"], check.attributes = FALSE))) + stop("'lag(Hed_missing_period$age, 2)' for '4-6' is not the expected value of '4-4' of original data 'Hed_missing_period$age'") + } else stop("'lag(Hed_missing_period$age, 2)' is NA for '4-6' but should be the value of '4-4' from original data 'Hed_missing_period$age'") > > ##### delete two consecutive time periods > data("Hedonic", package = "plm") > Hed_missing_period2 <- pdata.frame(Hedonic, index = "townid") > Hed_missing_period2 <- as.data.frame(Hed_missing_period2) > Hed_missing_period2 <- Hed_missing_period2[-c(5,11,12), ] # delete 3-2, 4-5, 4-6 > Hed_missing_period2 <- pdata.frame(Hed_missing_period2, index = c("townid", "time")) > > is.pconsecutive(Hed_missing_period2) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > head(Hed_missing_period2$age, 20) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 65.19995 78.89996 61.09998 45.79999 58.69998 66.59998 96.09998 100.00000 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 85.89996 39.00000 61.79999 84.50000 56.50000 29.29999 81.69995 36.59998 5-7 5-8 5-9 5-10 69.50000 98.09998 89.19995 91.69995 > head(test_Hed_miss2_p_lag1 <- lag(Hed_missing_period2$age), 20) # correct: lag(, 1): additional NAs introduced at 3-3 and 4-6 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA 78.89996 NA NA NA 66.59998 96.09998 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 100.00000 NA NA 61.79999 84.50000 56.50000 29.29999 81.69995 5-7 5-8 5-9 5-10 36.59998 69.50000 98.09998 89.19995 > head(test_Hed_miss2_p_lag2 <- lag(Hed_missing_period2$age, 2), 20) # correct: 3-3 should be former 3-1 (45.79999) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA 45.79999 NA NA 66.59998 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 96.09998 NA NA NA 61.79999 84.50000 56.50000 29.29999 5-7 5-8 5-9 5-10 81.69995 36.59998 69.50000 98.09998 > head(test_Hed_miss2_p_lag3 <- lag(Hed_missing_period2$age, 3), 20) # correct: 4-7 should be former 4-4 (85.89996) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA NA NA NA NA 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 66.59998 85.89996 NA NA NA 61.79999 84.50000 56.50000 5-7 5-8 5-9 5-10 29.29999 81.69995 36.59998 69.50000 > head(lag(Hed_missing_period2$age, c(0,1,2,3)), 20) # view all at once 0 1 2 3 1-1 65.19995 NA NA NA 2-1 78.89996 NA NA NA 2-2 61.09998 78.89996 NA NA 3-1 45.79999 NA NA NA 3-3 58.69998 NA 45.79999 NA 4-1 66.59998 NA NA NA 4-2 96.09998 66.59998 NA NA 4-3 100.00000 96.09998 66.59998 NA 4-4 85.89996 100.00000 96.09998 66.59998 4-7 39.00000 NA NA 85.89996 5-1 61.79999 NA NA NA 5-2 84.50000 61.79999 NA NA 5-3 56.50000 84.50000 61.79999 NA 5-4 29.29999 56.50000 84.50000 61.79999 5-5 81.69995 29.29999 56.50000 84.50000 5-6 36.59998 81.69995 29.29999 56.50000 5-7 69.50000 36.59998 81.69995 29.29999 5-8 98.09998 69.50000 36.59998 81.69995 5-9 89.19995 98.09998 69.50000 36.59998 5-10 91.69995 89.19995 98.09998 69.50000 > > ### formal tests for correct values > > ## lag(, 2) > if (!is.na(test_Hed_miss2_p_lag2["3-3"])) { + if(!isTRUE(all.equal(test_Hed_miss2_p_lag2["3-3"], Hed_missing_period2$age["3-1"], check.attributes = FALSE))) + stop("'lag(Hed_missing_period2$age, 2)' for '3-3' is not the expected value of '3-1' of original data 'Hed_missing_period2$age'") + } else stop("'lag(Hed_missing_period2$age, 2)' is NA for '3-3' but should be the value of '3-1' from original data 'Hed_missing_period2$age'") > > # lag(, 3) > if (!is.na(test_Hed_miss2_p_lag3["4-7"])) { + if(!isTRUE(all.equal(test_Hed_miss2_p_lag3["4-7"], Hed_missing_period2$age["4-4"], check.attributes = FALSE))) + stop("'lag(Hed_missing_period2$age, 3)' for '4-7' is not the expected value of '4-4' of original data 'Hed_missing_period2$age'") + } else stop("'lag(Hed_missing_period2$age, 3)' is NA for '4-7' but should be the value of '4-4' from original data 'Hed_missing_period2$age'") > > > ############ (5) lagt and lagr should yield same results on data with consecutive time periods #################### > data("Grunfeld", package = "plm") > Grunfeld <- pdata.frame(Grunfeld) > > if (!isTRUE(identical(plm:::lagt.pseries(Grunfeld$inv, k = c(-3,-2,-1,0,1,2,3)), plm:::lagr.pseries(Grunfeld$inv, k = c(-3,-2,-1,0,1,2,3))))) + stop("lag and lagt not same on consecutive data.frame (but must be!)") > > > ########### (6) NA in time index ############## > dfNA <- data.frame(id=c(1,1,2,11,11), + time=c(1,2,9,NA,NA), + a=c(1,2,3,3.1,3.2), + b=c(1,2,3,3.1,3.2)) > > pdfNA <- pdata.frame(dfNA) Warning message: In pdata.frame(dfNA) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > > if (!isTRUE(all.equal(as.numeric(plm:::lagt.pseries(pdfNA$a)), c(NA, 1.0, NA, NA, NA), check.attributes = FALSE))) + stop("NA in time period not dealt with correctly") > > > ############## messy data set with lots of NAs ############ > #### commented because it needs several extra packages and loads data from the internet > # library(haven) > # > # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") > # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) > # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) > # > # > # ### on a consecutive pdata.frame, plm:::lagr and plm:::lagt should yield same results (if no NA in id or time) > # pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) > # pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) > # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8, balanced = TRUE) > # > # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec$age), plm:::lagt.pseries(pnlswork_r8_consec$age))) > # stop("lagr and lagt not same on consecutive data.frame (but must be!)") > # > # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec_bal$age), plm:::lagt.pseries(pnlswork_r8_consec_bal$age))) > # stop("lagr and lagt not same on consecutive data.frame (but must be!)") > # > ## ########### compare results to statar::tlag ######################## > # #### commented because it needs several extra packages > # ## statar::tlag (and tlead) also works on the numbers of the time variable > # ## > # ### install.packages("statar") > # #### devtools::install_github("matthieugomez/statar") > # ## library(dplyr) > # ## > # ## lag 1 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel = statar::tlag(age, n = 1, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agel, as.numeric(plm:::lagt.pseries(pnlswork_r8$age))))) stop("not same") > # ## lag 2 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel2 = statar::tlag(age, n = 2, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agel2, as.numeric(plm:::lagt.pseries(pnlswork_r8$age, 2))))) stop("not same") > # ## lag 3 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel2 = statar::tlag(age, n = 3, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agel2, as.numeric(plm:::lagt.pseries(pnlswork_r8$age, 3))))) stop("not same") > # > # ## lead 1 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead = statar::tlead(age, n = 1, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agelead, as.numeric(plm:::leadt.pseries(pnlswork_r8$age))))) stop("not same") > # ## lead 2 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead2 = statar::tlead(age, n = 2, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agelead2, as.numeric(plm:::leadt.pseries(pnlswork_r8$age, 2))))) stop("not same") > # ## lead 3 > # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead3 = statar::tlead(age, n = 3, time = year)) > # if (!isTRUE(all.equal(nlswork_r8_statar$agelead3, as.numeric(plm:::leadt.pseries(pnlswork_r8$age, 3))))) stop("not same") > > > > proc.time() user system elapsed 3.00 0.54 3.70 plm/inst/tests/test_lag_lead.R0000644000176200001440000003110014124132276016070 0ustar liggesusers# tests of lagr and leadr (shifting of rows), i.e., lag(..., shift = "row") # # (1) test of lagging of index variable # (2) some dropped factor levels / whole period missing # (3) general tests # (4) test with non-consecutive time periods # # ad (2) error prior to rev. 207: # the lagging resulted in an error with factors in some cases, # because some factor levels can get lost due to the lagging # and the old code was not capable to manage this # # fixed in rev. 207 with better handling of factor levels and simpler code library(plm) data("Grunfeld", package = "plm") Grunfeld$fac <- factor(c(200:2, 1)) Grunfeld <- pdata.frame(Grunfeld) ############## (1) test of lagging of index variable ########## ## test of lagging of index variable plm:::lagr.pseries(Grunfeld$firm) # variable identical to an index "on character level" Grunfeld$firm2 <- Grunfeld$firm plm:::lagr.pseries(Grunfeld$firm2) ############## (2.1) tests with eliminated factor levels ########## # lag by 1 eliminates some factor levels (e.g., "1" in the last observations) # 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(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(levels(plm:::leadr.pseries(Grunfeld$fac))) == 200)) stop("plm:::leadr.pseries: wrong factor levels") # 200 ############### (2.2) test for case with a time period missing from whole data set data("Grunfeld", package = "plm") obs_3rd <- 3 + 20*c(0:9) Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) # illustration: levels(Grunfeld_wo_1937$year) # no year 1937 anymore and no level for 1937 anymore (a year in between, i.e., not consecutive series anymore) as.numeric(Grunfeld_wo_1937$year) # as.numeric produces a consecutive series! any(diff(as.numeric(Grunfeld_wo_1937$year)) > 1) # FALSE -> no gap detected as.numeric(as.character(Grunfeld_wo_1937$year)) # use as.character before as.numeric! any(diff(as.numeric(as.character(Grunfeld_wo_1937$year))) > 1) # TRUE -> gap now detected ############## (3) some general tests ########## data("Grunfeld", package = "plm") Grunfeld$fac <- factor(c(200:2, 1)) Grunfeld <- pdata.frame(Grunfeld) ## some more general testing of plm::lagr and plm:::leadr # do nothing if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, 0), Grunfeld$fac))) stop("'plm:::lagr.pseries( , 0)' not equal to 'do nothing'") if (!isTRUE(all.equal(plm:::leadr.pseries(Grunfeld$fac, 0), Grunfeld$fac))) stop("'plm:::leadr.pseries( , 0)' not equal to 'do nothing'") # identical is even stricter than all.equal if (!identical(plm:::lagr.pseries(Grunfeld$fac, 0), Grunfeld$fac)) stop("'plm:::lagr.pseries( , 0)' not identical to 'do nothing'") if (!identical(plm:::leadr.pseries(Grunfeld$fac, 0), Grunfeld$fac)) stop("'plm:::leadr.pseries( , 0)' not identical to 'do nothing'") # plm:::lagr.pseries( , -k) == plm:::leadr.pseries( , k) if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, -1), plm:::leadr.pseries(Grunfeld$fac, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, 1), plm:::leadr.pseries(Grunfeld$fac, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") # identical is even stricter than all.equal if (!identical(plm:::lagr.pseries(Grunfeld$fac, -1), plm:::leadr.pseries(Grunfeld$fac, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") if (!identical(plm:::lagr.pseries(Grunfeld$fac, 1), plm:::leadr.pseries(Grunfeld$fac, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") # with numeric if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -1), plm:::leadr.pseries(Grunfeld$inv, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 1), plm:::leadr.pseries(Grunfeld$inv, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") # identical is even stricter than all.equal if (!identical(plm:::lagr.pseries(Grunfeld$inv, -1), plm:::leadr.pseries(Grunfeld$inv, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") if (!identical(plm:::lagr.pseries(Grunfeld$inv, 1), plm:::leadr.pseries(Grunfeld$inv, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") # with logical Grunfeld$log <- rep(c(T, T, F, T), 50) if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$log, -1), plm:::leadr.pseries(Grunfeld$log, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$log, 1), plm:::leadr.pseries(Grunfeld$log, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") # identical is even stricter than all.equal if (!identical(plm:::lagr.pseries(Grunfeld$log, -1), plm:::leadr.pseries(Grunfeld$log, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") if (!identical(plm:::lagr.pseries(Grunfeld$log, 1), plm:::leadr.pseries(Grunfeld$log, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") ## other k's if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -5), plm:::leadr.pseries(Grunfeld$inv, 5)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 5), plm:::leadr.pseries(Grunfeld$inv, -5)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -3), plm:::leadr.pseries(Grunfeld$inv, 3)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 3), plm:::leadr.pseries(Grunfeld$inv, -3)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") if (!identical(plm:::lagr.pseries(Grunfeld$inv, -3), plm:::leadr.pseries(Grunfeld$inv, 3))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") if (!identical(plm:::lagr.pseries(Grunfeld$inv, 3), plm:::leadr.pseries(Grunfeld$inv, -3))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") # should be all NA if(!isTRUE(all(is.na(plm:::lagr.pseries(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id if(!isTRUE(all(is.na(plm:::lagr.pseries(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available if(!isTRUE(all(is.na(plm:::leadr.pseries(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id if(!isTRUE(all(is.na(plm:::leadr.pseries(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available ## length(k) > 1 plm:::lagr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)) plm:::leadr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)) if(!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)), plm:::leadr.pseries(Grunfeld$inv, -1*c(-2, -1, 0, 1, 2)), check.attributes = FALSE))) stop("'plm:::lagr.pseries( , c())' not equal to 'plm:::leadr.pseries( , -1*c())'") # produces a matrix of characters: # standard R behaviour for factor input to matrix - not beautiful but "correct" plm:::leadr.pseries(Grunfeld$fac, c(-2, -1, 0, 1, 2)) # other data set (different time periods) # Hedonic is an unbalanced panel, townid is the individual index data("Hedonic", package = "plm") Hed <- pdata.frame(Hedonic, index = "townid") head(Hed$age, 20) head(plm:::lagr.pseries(Hed$age), 20) head(plm:::lagr.pseries(Hed$age, c(0,1,2)), 20) if (!isTRUE(all.equal(plm:::lagr.pseries(Hed$age, c(0,1,2,3,4,5)), plm:::leadr.pseries(Hed$age, -1*c(0,1,2,3,4,5)), check.attributes = FALSE))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries , -1)'") # diff if (!isTRUE(all.equal(diff(Grunfeld$inv), Grunfeld$inv - plm:::lagr.pseries(Grunfeld$inv)))) stop("'diff()' not corresponding to differences with 'plm:::lagr.pseries()'") if (!isTRUE(all.equal(diff(Grunfeld$inv, 2), Grunfeld$inv - plm:::lagr.pseries(Grunfeld$inv, 2)))) stop("'diff( , 2)' not corresponding to differences with 'plm:::lagr.pseries( , 2)'") ############## (4) test with non-consecutive time periods #### # this is to demonstrate the behaviour of lagr for non-consecutive data # data("Grunfeld", package = "plm") pGrunfeld_missing_period <- pdata.frame(Grunfeld[-2, ]) # delete one time period of first individual (1-1936 is missing (not NA)) is.pconsecutive(pGrunfeld_missing_period) head(pGrunfeld_missing_period$inv, 25) head(test_Grun_miss_p_lag1 <- plm:::lagr.pseries(pGrunfeld_missing_period$inv), 25) # correct: additional NA for the missing time period is introduced at 1-1937 head(plm:::lagr.pseries(pGrunfeld_missing_period$inv, 2), 25) head(test_Grun_miss_p_lag3 <- plm:::lagr.pseries(pGrunfeld_missing_period$inv, 3), 25) # 1-1938 is NA for lagr (for lagt non-NA (former 1-1935: 317.6) # with different data set data("Hedonic", package = "plm") Hed_missing_period <- pdata.frame(Hedonic, index = "townid") Hed_missing_period <- as.data.frame(Hed_missing_period) Hed_missing_period <- Hed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 Hed_missing_period <- pdata.frame(Hed_missing_period, index = c("townid", "time")) is.pconsecutive(Hed_missing_period) head(Hed_missing_period$age, 20) head(test_Hed_miss_p_lag1 <- plm:::lagr.pseries(Hed_missing_period$age), 20) # correct: plm:::lagr.pseries(, 1): additional NAs introduced at (among others) 3-3 and 4-6 head(test_Hed_miss_p_lag2 <- plm:::lagr.pseries(Hed_missing_period$age, 2), 20) # plm:::lagr.pseries(, 2): 4-6 is NA (for lagt non-NA (former 4-4: 85.89996) # 3-3 is NA (for lagt non-NA (former 3-1: 45.79999)) head(plm:::lagr.pseries(Hed_missing_period$age, c(0,1,2)), 20) # view all at once ##### delete two consecutive time periods data("Hedonic", package = "plm") Hed_missing_period2 <- pdata.frame(Hedonic, index = "townid") Hed_missing_period2 <- as.data.frame(Hed_missing_period2) Hed_missing_period2 <- Hed_missing_period2[-c(5,11,12), ] # delete 3-2, 4-5, 4-6 Hed_missing_period2 <- pdata.frame(Hed_missing_period2, index = c("townid", "time")) is.pconsecutive(Hed_missing_period2) head(Hed_missing_period2$age, 20) head(test_Hed_miss2_p_lag1 <- plm:::lagr.pseries(Hed_missing_period2$age), 20) # correct: plm:::lagr.pseries(, 1): additional NAs introduced at 3-3 and 4-6 head(test_Hed_miss2_p_lag2 <- plm:::lagr.pseries(Hed_missing_period2$age, 2), 20) # 3-3 is NA (for lagt former 3-1 (45.79999)) head(test_Hed_miss2_p_lag3 <- plm:::lagr.pseries(Hed_missing_period2$age, 3), 20) # 4-7 is NA (for lagt former 4-4 (85.89996)) head(plm:::lagr.pseries(Hed_missing_period2$age, c(0,1,2,3)), 20) # view all at once ############## messy data set with lots of NAs ############ #### commented because it needs several extra packages and loads data from the internet # library(haven) # # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) # # # ### on a consecutive pdata.frame, plm:::lagr and plm:::lagt should yield same results (if no NA in id or time) # pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) # pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8, balanced = TRUE) # # if (!all.equal(plm::lagr.pseries(pnlswork_r8_consec$age), plm:::lagt.pseries(pnlswork_r8_consec$age))) # stop("lagr and lagt not same on consecutive data.frame (but must be!)") # # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec_bal$age), plm:::lagt.pseries(pnlswork_r8_consec_bal$age))) # stop("lagr and lagt not same on consecutive data.frame (but must be!)") plm/inst/tests/test_ranef.Rout.save0000644000176200001440000004515614124132276017140 0ustar liggesusers R version 3.6.3 (2020-02-29) -- "Holding the Windsock" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## test of ranef() > library(plm) > data("Cigar", package = "plm") > > # note: the formulae used in estimation are different > obj_bal_ind <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "individual") # gives positive estimate for theta > obj_bal_time <- plm(price ~ pop + sales, data = Cigar, model = "random", effect = "time") # gives positive estimate for theta > summary(obj_bal_ind) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = sales ~ pop + price, data = Cigar, effect = "individual", model = "random") Balanced Panel: n = 46, T = 30, N = 1380 Effects: var std.dev share idiosyncratic 229.84 15.16 0.268 individual 627.02 25.04 0.732 theta: 0.8901 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -61.20952 -8.37807 0.61966 7.47058 126.76616 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.3641e+02 4.1699e+00 32.7123 <2e-16 *** pop 5.0781e-04 4.5196e-04 1.1236 0.2612 price -2.1484e-01 1.0679e-02 -20.1175 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 423530 Residual Sum of Squares: 317410 R-Squared: 0.25057 Adj. R-Squared: 0.24948 Chisq: 460.397 on 2 DF, p-value: < 2.22e-16 > summary(obj_bal_time) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = price ~ pop + sales, data = Cigar, effect = "time", model = "random") Balanced Panel: n = 46, T = 30, N = 1380 Effects: var std.dev share idiosyncratic 41.379 6.433 0.554 time 33.264 5.767 0.446 theta: 0.8377 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -14.6856 -6.2149 -2.5633 3.8027 49.1200 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 7.7764e+01 1.8791e+00 41.3830 < 2.2e-16 *** pop 2.3395e-04 5.1615e-05 4.5327 5.825e-06 *** sales -8.1687e-02 8.4936e-03 -9.6175 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 126340 Residual Sum of Squares: 115970 R-Squared: 0.082104 Adj. R-Squared: 0.08077 Chisq: 123.169 on 2 DF, p-value: < 2.22e-16 > > ranef(obj_bal_ind) 1 3 4 5 7 8 -15.7944651 -9.8171737 -7.1695035 -17.7369442 -3.0124669 28.4615124 9 10 11 13 14 15 41.6154573 1.3213865 -5.4988147 -17.6196269 -0.8826409 16.0194286 16 17 18 19 20 21 -10.8182773 -10.2479062 52.8847398 0.4504968 11.7969137 -0.4085639 22 23 24 25 26 27 -3.3157988 3.6640065 -13.7469988 -14.7841676 7.1763488 -11.0484827 28 29 30 31 32 33 -14.6198738 51.8254887 112.0924500 -3.2131140 -29.9070401 -9.7981923 35 36 37 39 40 41 -17.4436069 -1.3609524 -2.5061748 -12.2793676 13.5058893 -5.5305745 42 43 44 45 46 47 -18.7567863 -5.3213460 -15.8621529 -53.8380549 18.4511623 7.6226181 48 49 50 51 -25.4722740 -7.6575310 -14.4304092 13.0113830 > ranef(obj_bal_time) 63 64 65 66 67 68 69 -40.107118 -39.620447 -39.268900 -37.758341 -37.054658 -35.204205 -34.238769 70 71 72 73 74 75 76 -31.483517 -29.317820 -27.560848 -26.991763 -25.621068 -22.667782 -19.162696 77 78 79 80 81 82 83 -17.984822 -12.783243 -10.636099 -7.581342 -4.469280 2.048338 12.706015 84 85 86 87 88 89 90 23.142923 28.263242 34.377851 40.619107 48.921108 58.887947 71.464266 91 92 79.682251 99.399670 > > ### unbalanced one-way tests > > data("Grunfeld", package = "plm") > Grunfeld199 <- Grunfeld[1:199, ] > > mod_unbal_id <- plm(inv ~ value + capital, data = Grunfeld199, model = "random", effect = "individual") > mod_unbal_time <- plm(inv ~ value + capital, data = Grunfeld199, model = "random", effect = "time") > ranef(mod_unbal_id) 1 2 3 4 5 6 -9.5217161 157.8971498 -172.8867226 29.9217807 -54.6663526 34.3565278 7 8 9 10 -7.8857572 0.6826192 -28.1276964 50.2301675 > ranef(mod_unbal_time) 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1951 1952 1953 1954 0 0 0 0 > > Cigar_unbal <- Cigar[1:(nrow(Cigar)-1), ] > > ## same formula this time > obj_unbal_ind <- plm(sales ~ pop, data = Cigar_unbal, model = "random", effect = "individual") # gives positive estimate for theta > obj_unbal_time <- plm(sales ~ pop, data = Cigar_unbal, model = "random", effect = "time") # gives positive estimate for theta > summary(obj_unbal_ind) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = sales ~ pop, data = Cigar_unbal, effect = "individual", model = "random") Unbalanced Panel: n = 46, T = 29-30, N = 1379 Effects: var std.dev share idiosyncratic 297.25 17.24 0.306 individual 672.90 25.94 0.694 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.8775 0.8795 0.8795 0.8795 0.8795 0.8795 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -79.865 -8.851 0.526 0.000 8.733 135.499 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.3741e+02 4.3961e+00 31.2575 < 2.2e-16 *** pop -2.9625e-03 4.6022e-04 -6.4372 1.217e-10 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 425110 Residual Sum of Squares: 412670 R-Squared: 0.029272 Adj. R-Squared: 0.028567 Chisq: 41.4373 on 1 DF, p-value: 1.2172e-10 > summary(obj_unbal_time) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = sales ~ pop, data = Cigar_unbal, effect = "time", model = "random") Unbalanced Panel: n = 46, T = 29-30, N = 1379 Effects: var std.dev share idiosyncratic 863.173 29.380 0.941 time 54.571 7.387 0.059 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.4900 0.4942 0.4942 0.4940 0.4942 0.4942 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -65.024 -15.652 -3.569 0.003 8.662 170.409 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.2685e+02 1.7413e+00 72.8525 < 2.2e-16 *** pop -6.4035e-04 1.6514e-04 -3.8776 0.0001055 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1213200 Residual Sum of Squares: 1200600 R-Squared: 0.010345 Adj. R-Squared: 0.0096263 Chisq: 15.0358 on 1 DF, p-value: 0.00010549 > > ranef(obj_unbal_ind) 1 3 4 5 7 8 -18.5005959 -16.5175085 -15.4126063 45.3509108 -10.0691964 14.7452846 9 10 11 13 14 15 28.4341945 15.3197942 -2.2732403 -29.5894852 21.8660407 20.2045003 16 17 18 19 20 21 -16.9983070 -17.4906773 52.1136395 -1.4565459 -0.6084628 -0.6844186 22 23 24 25 26 27 -0.6770297 18.7888081 -16.9969763 -21.7032125 9.3029721 -23.4788114 28 29 30 31 32 33 -24.8169817 37.6221358 100.2268588 4.8232643 -41.0601497 34.7118192 35 36 37 39 40 41 -30.6792706 20.3586680 -8.2494643 12.4698131 0.6149471 -8.8851025 42 43 44 45 46 47 -31.6181612 -5.3972089 14.3306694 -64.5816094 4.6592013 12.2186127 48 49 50 51 -29.6550563 -16.9150978 -15.0225962 1.1756383 > ranef(obj_unbal_time) 63 64 65 66 67 68 2.1840689 -0.4458102 0.9722171 1.5157005 1.6245628 0.2068228 69 70 71 72 73 74 -0.6921238 -2.7639457 -0.4890980 2.6820932 3.9277757 6.1161651 75 76 77 78 79 80 7.3140219 9.4759779 9.1957832 9.0995970 7.5592267 7.9568186 81 82 83 84 85 86 8.1080736 6.7816983 3.1858157 -1.0607719 -2.1120297 -3.7924067 87 88 89 90 91 92 -6.0557382 -8.6560816 -11.8598359 -15.1564003 -17.0858090 -17.7363679 > > ## two-way balanced > obj_bal_tw <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "twoways") # gives positive estimate for theta > summary(obj_bal_tw) Twoways effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = sales ~ pop + price, data = Cigar, effect = "twoways", model = "random") Balanced Panel: n = 46, T = 30, N = 1380 Effects: var std.dev share idiosyncratic 174.696 13.217 0.215 individual 628.862 25.077 0.773 time 10.413 3.227 0.013 theta: 0.9042 (id) 0.483 (time) 0.4819 (total) Residuals: Min. 1st Qu. Median 3rd Qu. Max. -58.61044 -6.72191 0.15599 5.67123 128.33115 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.4052e+02 4.5154e+00 31.1196 <2e-16 *** pop -1.9055e-05 4.4084e-04 -0.0432 0.9655 price -2.3989e-01 1.7855e-02 -13.4355 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 311890 Residual Sum of Squares: 273640 R-Squared: 0.12261 Adj. R-Squared: 0.12134 Chisq: 192.433 on 2 DF, p-value: < 2.22e-16 > ranef(obj_bal_tw) 1 3 4 5 7 8 -16.2313983 -10.9407671 -8.4070839 -8.0035988 -3.5394647 26.4991483 9 10 11 13 14 15 39.7177104 3.8777211 -5.1844126 -19.6522390 2.6503121 16.3006653 16 17 18 19 20 21 -11.6829305 -11.4349650 52.1389070 0.1959530 10.1000599 -0.7371054 22 23 24 25 26 27 -2.5582962 6.0052270 -13.9084124 -15.9415817 7.2335306 -13.1071681 28 29 30 31 32 33 -16.2253164 50.1149877 110.3969356 -1.5881308 -31.7198448 -2.6728683 35 36 37 39 40 41 -19.5275399 1.7670879 -3.3623632 -8.4818063 11.7369530 -6.5745407 42 43 44 45 46 47 -20.8494465 -5.4741136 -11.0335402 -55.6627609 16.3784126 7.7327316 48 49 50 51 -25.6449876 -9.0717648 -14.3557950 10.7278996 > ranef(obj_bal_tw, effect = "individual") # same as line before 1 3 4 5 7 8 -16.2313983 -10.9407671 -8.4070839 -8.0035988 -3.5394647 26.4991483 9 10 11 13 14 15 39.7177104 3.8777211 -5.1844126 -19.6522390 2.6503121 16.3006653 16 17 18 19 20 21 -11.6829305 -11.4349650 52.1389070 0.1959530 10.1000599 -0.7371054 22 23 24 25 26 27 -2.5582962 6.0052270 -13.9084124 -15.9415817 7.2335306 -13.1071681 28 29 30 31 32 33 -16.2253164 50.1149877 110.3969356 -1.5881308 -31.7198448 -2.6728683 35 36 37 39 40 41 -19.5275399 1.7670879 -3.3623632 -8.4818063 11.7369530 -6.5745407 42 43 44 45 46 47 -20.8494465 -5.4741136 -11.0335402 -55.6627609 16.3784126 7.7327316 48 49 50 51 -25.6449876 -9.0717648 -14.3557950 10.7278996 > ranef(obj_bal_tw, effect = "time") 63 64 65 66 67 68 69 -4.8730347 -7.3464635 -5.9340750 -5.1545167 -4.9379129 -5.9884844 -6.6989482 70 71 72 73 74 75 76 -8.2130475 -5.6496310 -2.2865468 -0.9936552 1.3543836 3.0309237 5.7378570 77 78 79 80 81 82 83 5.6665356 6.4982251 5.3839356 6.2673107 6.9524675 6.8306273 5.2637423 84 85 86 87 88 89 90 3.0305218 2.9219323 2.3839785 1.3038537 0.2722306 -1.0413612 -1.9688282 91 92 -2.3758022 0.5637823 > > ## two-way unbalanced > obj_unbal_tw <- plm(sales ~ pop + price, data = Cigar_unbal, model = "random", effect = "twoways") # gives positive estimate for theta > summary(obj_unbal_tw) Twoways effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = sales ~ pop + price, data = Cigar_unbal, effect = "twoways", model = "random") Unbalanced Panel: n = 46, T = 29-30, N = 1379 Effects: var std.dev share idiosyncratic 174.688 13.217 0.215 individual 629.540 25.091 0.774 time 8.616 2.935 0.011 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.9026463 0.9042675 0.9042675 0.9042334 0.9042675 0.9042675 time 0.4426693 0.4468900 0.4468900 0.4467522 0.4468900 0.4468900 total 0.4417103 0.4459100 0.4459100 0.4457719 0.4459100 0.4459100 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -70.856 -15.317 -3.646 -0.008 8.711 164.621 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.4006e+02 3.1863e-01 439.5515 <2e-16 *** pop 9.7349e-06 3.1270e-05 0.3113 0.7556 price -2.3502e-01 1.1919e-03 -197.1821 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1324300 Residual Sum of Squares: 1196500 R-Squared: 0.096564 Adj. R-Squared: 0.095251 Chisq: 41645.3 on 2 DF, p-value: < 2.22e-16 > ranef(obj_unbal_tw) 1 3 4 5 7 8 -16.2146713 -10.8796414 -8.3461136 -8.5509485 -3.5478700 26.6062307 9 10 11 13 14 15 39.8271766 3.7103860 -5.1955724 -19.5380011 2.4505676 16.3101908 16 17 18 19 20 21 -11.6472052 -11.3717037 52.2346248 0.2050813 10.1824872 -0.7046744 22 23 24 25 26 27 -2.6251433 5.8739757 -13.9277118 -15.8804250 7.2465508 -12.9917476 28 29 30 31 32 33 -16.1427943 50.1972051 110.5214203 -1.7049749 -31.6279424 -3.0885923 35 36 37 39 40 41 -19.4190342 1.6043107 -3.3204880 -8.6977661 11.8238292 -6.4900433 42 43 44 45 46 47 -20.7369591 -5.4619133 -11.3192902 -55.5745775 16.4938017 7.7626656 48 49 50 51 -25.6759667 -9.0000028 -14.3779584 11.0014782 > ranef(obj_unbal_tw, effect = "individual") # same as line before 1 3 4 5 7 8 -16.2146713 -10.8796414 -8.3461136 -8.5509485 -3.5478700 26.6062307 9 10 11 13 14 15 39.8271766 3.7103860 -5.1955724 -19.5380011 2.4505676 16.3101908 16 17 18 19 20 21 -11.6472052 -11.3717037 52.2346248 0.2050813 10.1824872 -0.7046744 22 23 24 25 26 27 -2.6251433 5.8739757 -13.9277118 -15.8804250 7.2465508 -12.9917476 28 29 30 31 32 33 -16.1427943 50.1972051 110.5214203 -1.7049749 -31.6279424 -3.0885923 35 36 37 39 40 41 -19.4190342 1.6043107 -3.3204880 -8.6977661 11.8238292 -6.4900433 42 43 44 45 46 47 -20.7369591 -5.4619133 -11.3192902 -55.5745775 16.4938017 7.7626656 48 49 50 51 -25.6759667 -9.0000028 -14.3779584 11.0014782 > ranef(obj_unbal_tw, effect = "time") 63 64 65 66 67 68 -4.46453098 -6.81122309 -5.47511629 -4.74266415 -4.54069633 -5.54358066 69 70 71 72 73 74 -6.22109853 -7.66618629 -5.24596898 -2.06612408 -0.84363088 1.37590219 75 76 77 78 79 80 2.95347816 5.50550490 5.43306396 6.20203336 5.13777757 5.96139378 81 82 83 84 85 86 6.59847762 6.45904924 4.93558027 2.78156044 2.65962512 2.12723039 87 88 89 90 91 92 1.08051103 0.07255798 -1.20847557 -2.13260772 -2.54875217 0.05825262 > > > > proc.time() user system elapsed 2.39 0.21 2.56 plm/inst/tests/test_fixef_comp_lm_plm.R0000644000176200001440000003617014124132276020033 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") Grunfeld_unbalanced <- Grunfeld[1:199, ] ## fixef() is related to within_intercept() ## see also: ## * test file tests/test_within_intercept.R ## * test file tests/test_fixef.R ## * test file tests/test_fixef2.R ### TODO: ## * test vcov, once the standard errors have been modified to ## accommodate the unbalanced case (see (3)) ## (1) tests of effects in balanced case ## (2) tests of effects in unbalanced case ## (3) tests of standard errors in balanced and unbalanced case ######### (1) balanced ############ # plm oneway individual balanced plm_fe_oneway_ind <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "individual") fixef_plm_oneway_ind_dfirst <- fixef(plm_fe_oneway_ind, type = "dfirst", effect = "individual") if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_ind)), (within_intercept(plm_fe_oneway_ind) + fixef(plm_fe_oneway_ind, type = "dmean", effect = "individual")[as.character(index(plm_fe_oneway_ind)[[1]])] + as.vector(tcrossprod(coef(plm_fe_oneway_ind), as.matrix(plm_fe_oneway_ind$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/id: effects not correct") # plm oneway time balanced plm_fe_oneway_time <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") fixef_plm_oneway_time_dfirst <- fixef(plm_fe_oneway_time, type = "dfirst", effect = "time") if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_time)), (within_intercept(plm_fe_oneway_time) + fixef(plm_fe_oneway_time, type = "dmean", effect = "time")[as.character(index(plm_fe_oneway_time)[[2]])] + as.vector(tcrossprod(coef(plm_fe_oneway_time), as.matrix(plm_fe_oneway_time$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/time: effects not correct") # plm twoways balanced plm_fe_tw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") fixef_plm_tw_ind_dfirst <- fixef(plm_fe_tw, type = "dfirst", effect = "individual") fixef_plm_tw_time_dfirst <- fixef(plm_fe_tw, type = "dfirst", effect = "time") if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_tw)), (within_intercept(plm_fe_tw) + fixef(plm_fe_tw, type = "dmean", effect = "individual")[as.character(index(plm_fe_tw)[[1]])] + fixef(plm_fe_tw, type = "dmean", effect = "time")[as.character(index(plm_fe_tw)[[2]])] + as.vector(tcrossprod(coef(plm_fe_tw), as.matrix(plm_fe_tw$model[ , 2:3])))), check.attributes = FALSE))) stop("2way bal: effects not correct") # lm oneway individual balanced lm_fe_oneway_ind <- lm(inv ~ value + capital + factor(firm), data = Grunfeld) fixef_lm_oneway_ind_dfirst <- lm_fe_oneway_ind$coefficients[4:12] # lm oneway time balanced lm_fe_oneway_time <- lm(inv ~ value + capital + factor(year), data = Grunfeld) fixef_lm_oneway_time_dfirst <- lm_fe_oneway_time$coefficients[4:22] # lm twoways balanced lm_fe_tw <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld) fixef_lm_tw_ind_dfirst <- lm_fe_tw$coefficients[4:12] fixef_lm_tw_time_dfirst <- lm_fe_tw$coefficients[13:31] # Test residuals oneway individual and time; twoway balanced if(!isTRUE(all.equal(residuals(lm_fe_oneway_ind), as.numeric(residuals(plm_fe_oneway_ind)), check.attributes = FALSE))) stop("one-way individual balanced model: residuals do not match (lm vs. plm)") if(!isTRUE(all.equal(residuals(lm_fe_oneway_time), as.numeric(residuals(lm_fe_oneway_time)), check.attributes = FALSE))) stop("one-way time balanced model: residuals do not match (lm vs. plm)") if(!isTRUE(all.equal(residuals(lm_fe_tw), as.numeric(residuals(plm_fe_tw)), check.attributes = FALSE))) stop("two-ways balanced model: residuals do not match (lm vs. plm)") # Test balanced one-way and two-way dfirst fixefs: lm vs. plm if(!isTRUE(all.equal(fixef_lm_oneway_ind_dfirst, as.numeric(fixef_plm_oneway_ind_dfirst), check.attributes = FALSE))) stop("individual effects do not match") if(!isTRUE(all.equal(fixef_lm_oneway_time_dfirst, as.numeric(fixef_plm_oneway_time_dfirst), check.attributes = FALSE))) stop("time effects do not match") if(!isTRUE(all.equal(fixef_lm_tw_ind_dfirst, as.numeric(fixef_plm_tw_ind_dfirst), check.attributes = FALSE))) stop("individual effects do not match") if(!isTRUE(all.equal(fixef_lm_tw_time_dfirst, as.numeric(fixef_plm_tw_time_dfirst), check.attributes = FALSE))) stop("time effects do not match") ######### (2) unbalanced ############ # plm one-way individual unbalanced plm_fe_oneway_ind_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "individual") fixef_plm_oneway_ind_dfirst_u <- fixef(plm_fe_oneway_ind_u, type = "dfirst", effect = "individual") if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_ind_u)), (within_intercept(plm_fe_oneway_ind_u) + fixef(plm_fe_oneway_ind_u, type = "dmean", effect = "individual")[as.character(index(plm_fe_oneway_ind_u)[[1]])] + as.vector(tcrossprod(coef(plm_fe_oneway_ind_u), as.matrix(plm_fe_oneway_ind_u$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/id: effects not correct") # plm one-way time unbalanced plm_fe_oneway_time_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "time") fixef_plm_oneway_time_dfirst_u <- fixef(plm_fe_oneway_time_u, type = "dfirst", effect = "time") if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_time_u)), (within_intercept(plm_fe_oneway_time_u) + fixef(plm_fe_oneway_time_u, type = "dmean", effect = "time")[as.character(index(plm_fe_oneway_time_u)[[2]])] + as.vector(tcrossprod(coef(plm_fe_oneway_time_u), as.matrix(plm_fe_oneway_time_u$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/time: effects not correct") # plm twoways unbalanced plm_fe_tw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "twoways") fixef_plm_tw_ind_dfirst_u <- fixef(plm_fe_tw_u, type = "dfirst", effect = "individual") fixef_plm_tw_time_dfirst_u <- fixef(plm_fe_tw_u, type = "dfirst", effect = "time") ## the level effects in case of 2-way unbalanced are not correct?, hence the dmean specification is not correct? if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_tw_u)), (within_intercept(plm_fe_tw_u) + fixef(plm_fe_tw_u, type = "dmean", effect = "individual")[as.character(index(plm_fe_tw_u)[[1]])] + fixef(plm_fe_tw_u, type = "dmean", effect = "time")[as.character(index(plm_fe_tw_u)[[2]])] + as.vector(tcrossprod(coef(plm_fe_tw_u), as.matrix(plm_fe_tw_u$model[ , 2:3])))), check.attributes = FALSE))) stop("tw unbal: effects not correct") # lm oneway individual unbalanced lm_fe_oneway_ind_u <- lm(inv ~ value + capital + factor(firm), data = Grunfeld_unbalanced) fixef_lm_oneway_ind_dfirst_u <- lm_fe_oneway_ind_u$coefficients[4:12] # lm oneway time unbalanced lm_fe_oneway_time_u <- lm(inv ~ value + capital + factor(year), data = Grunfeld_unbalanced) fixef_lm_oneway_time_dfirst_u <- lm_fe_oneway_time_u$coefficients[4:22] # lm twoways unbalanced lm_fe_tw_u <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) fixef_lm_tw_ind_dfirst_u <- lm_fe_tw_u$coefficients[4:12] fixef_lm_tw_time_dfirst_u <- lm_fe_tw_u$coefficients[13:31] # lm twoways unbalanced with contrast coding Grunfeld_unbalanced_fac <- Grunfeld_unbalanced Grunfeld_unbalanced_fac$firm <- factor(Grunfeld_unbalanced_fac$firm) Grunfeld_unbalanced_fac$year <- factor(Grunfeld_unbalanced_fac$year) lm_fe_tw_u_eff_cod <- lm(inv ~ value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.sum", year="contr.sum")) lm_fe_tw_u_eff_cod_wo_int <- lm(inv ~ 0 + value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.sum", year="contr.sum")) # replicates SAS - 2-way unbalanced lm_fe_tw_u_eff_cod_SAS_w_Int <- lm(inv ~ value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS", year="contr.SAS")) lm_fe_tw_u_eff_cod_SAS <- lm(inv ~ 0 + value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS", year="contr.SAS")) lm_fe_tw_u_eff_cod_SAS$coefficients[3:12] ## correct level specification for individuals? lm_fe_tw_u_eff_cod_SAS$coefficients[3:12] - mean(lm_fe_tw_u_eff_cod_SAS$coefficients[3:12]) ## correct dmean specification for individuals (matches EViews) lm_fe_tw_u_eff_cod_SAS_time <- lm(inv ~ 0 + value + capital + year + firm, data = Grunfeld_unbalanced_fac, contrasts = list(year="contr.SAS", firm="contr.SAS")) lm_fe_tw_u_eff_cod_SAS_time$coefficients[3:22] - mean(lm_fe_tw_u_eff_cod_SAS_time$coefficients[3:22]) ## time effect: does _NOT_ match EViews?! ## oneway unbalanced: SAS matches fixef() lm_fe_tw_u_eff_cod_SAS_1way_unbal_ind <- lm(inv ~ 0 + value + capital + firm, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS")) fixef(plm_fe_oneway_ind_u) lm_fe_tw_u_eff_cod_SAS_1way_unbal_time <- lm(inv ~ 0 + value + capital + year, data = Grunfeld_unbalanced_fac, contrasts = list(year="contr.SAS")) fixef(plm_fe_oneway_time_u) # Test unbalanced residuals oneway individual and time; twoway if(!isTRUE(all.equal(residuals(lm_fe_oneway_ind_u), as.numeric(residuals(plm_fe_oneway_ind_u)), check.attributes = FALSE))) stop("one-way individual unbalanced model: residuals do not match (lm vs. plm)") if(!isTRUE(all.equal(residuals(lm_fe_oneway_time_u), as.numeric(residuals(lm_fe_oneway_time_u)), check.attributes = FALSE))) stop("one-way time unbalanced model: residuals do not match (lm vs. plm)") if(!isTRUE(all.equal(residuals(lm_fe_tw_u), as.numeric(residuals(plm_fe_tw_u)), check.attributes = FALSE))) stop("two-ways unbalanced model: residuals do not match (lm vs. plm)") # Test unbalanced one-way and two-way dfirst fixefs: lm vs. plm if(!isTRUE(all.equal(fixef_lm_oneway_ind_dfirst_u, as.numeric(fixef_plm_oneway_ind_dfirst_u), check.attributes = FALSE))) stop("oneway individual unbalanced: dfirst fixefs do not match") if(!isTRUE(all.equal(fixef_lm_oneway_time_dfirst_u, as.numeric(fixef_plm_oneway_time_dfirst_u), check.attributes = FALSE))) stop("oneway time unbalanced: dfirst fixefs do not match") if(!isTRUE(all.equal(fixef_lm_tw_ind_dfirst_u, as.numeric(fixef_plm_tw_ind_dfirst_u), check.attributes = FALSE))) stop("two-ways individual unbalanced: dfirst fixefs do not match") if(!isTRUE(all.equal(fixef_lm_tw_time_dfirst_u, as.numeric(fixef_plm_tw_time_dfirst_u), check.attributes = FALSE))) stop("two-ways time unbalanced: dfirst fixefs do not match") #### test with levels: first component of individual and time effect _in levels_ equal? # ## balanced plm_fw_tw_ind_level <- fixef(plm_fe_tw, type = "level", effect = "individual") plm_fw_tw_time_level <- fixef(plm_fe_tw, type = "level", effect = "time") if(isTRUE(!all.equal(plm_fw_tw_ind_level[1], plm_fw_tw_time_level[1], check.attributes = FALSE))) { stop("two-ways balanced levels: first components of individual and time effect in levels are not equal") } ## unbalanced plm_fw_tw_ind_level_u <- fixef(plm_fe_tw_u, type = "level", effect = "individual") plm_fw_tw_time_level_u <- fixef(plm_fe_tw_u, type = "level", effect = "time") if(isTRUE(!all.equal(plm_fw_tw_ind_level_u[1], plm_fw_tw_time_level_u[1], check.attributes = FALSE))) { stop("two-ways unbalanced levels: first components of individual and time effect in levels are not equal") } ######### (3) Test of standard errors, balanced and unbalanced ############ # oneway ind, time balanced sum_lm_fe_oneway_ind <- summary(lm_fe_oneway_ind) sum_lm_fe_oneway_time <- summary(lm_fe_oneway_time) sum_plm_fixef_lm_oneway_ind_dfirst <- summary(fixef_plm_oneway_ind_dfirst) sum_plm_fixef_lm_oneway_time_dfirst <- summary(fixef_plm_oneway_time_dfirst) # twoways ind, time balanced sum_lm_fe_tw <- summary(lm_fe_tw) sum_plm_fixef_lm_tw_ind_dfirst <- summary(fixef_plm_tw_ind_dfirst) sum_plm_fixef_lm_tw_time_dfirst <- summary(fixef_plm_tw_time_dfirst) # oneway ind, time unbalanced sum_lm_fe_oneway_ind_u <- summary(lm_fe_oneway_ind_u) sum_lm_fe_oneway_time_u <- summary(lm_fe_oneway_time_u) sum_plm_fixef_lm_oneway_ind_dfirst_u <- summary(fixef_plm_oneway_ind_dfirst_u) sum_plm_fixef_lm_oneway_time_dfirst_u <- summary(fixef_plm_oneway_time_dfirst_u) # twoways ind, time unbalanced sum_lm_fe_tw_u <- summary(lm_fe_tw_u) sum_plm_fixef_lm_tw_ind_dfirst_u <- summary(fixef_plm_tw_ind_dfirst_u) sum_plm_fixef_lm_tw_time_dfirst_u <- summary(fixef_plm_tw_time_dfirst_u) # one-way balanced if(!isTRUE(all.equal(sum_lm_fe_oneway_ind[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_oneway_ind_dfirst[ , "Std. Error"], check.attributes = FALSE))) stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") if(!isTRUE(all.equal(sum_lm_fe_oneway_time[["coefficients"]][c(4:22) , "Std. Error"], sum_plm_fixef_lm_oneway_time_dfirst[ , "Std. Error"], check.attributes = FALSE))) stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") # one-way unbalanced if(!isTRUE(all.equal(sum_lm_fe_oneway_ind_u[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_oneway_ind_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") if(!isTRUE(all.equal(sum_lm_fe_oneway_time_u[["coefficients"]][c(4:22) , "Std. Error"], sum_plm_fixef_lm_oneway_time_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") # two-ways balanced ##### Tests deactivated as SEs are currently not computed for two-way FE #if(!isTRUE(all.equal(sum_lm_fe_tw[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_tw_ind_dfirst[ , "Std. Error"], check.attributes = FALSE))) # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") #if(!isTRUE(all.equal(sum_lm_fe_tw[["coefficients"]][c(13:31) , "Std. Error"], sum_plm_fixef_lm_tw_time_dfirst[ , "Std. Error"], check.attributes = FALSE))) # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") # two-ways unbalanced - does not yet match # if (!isTRUE(all.equal(sum_lm_fe_tw_u[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_tw_ind_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") # if (!isTRUE(all.equal(sum_lm_fe_tw_u[["coefficients"]][c(13:31) , "Std. Error"], sum_plm_fixef_lm_tw_time_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") plm/inst/tests/test_lagt_leadt.R0000644000176200001440000004042314124132276016450 0ustar liggesusers# tests of lagt and leadt (note the "t") respecting time periods (not just shifting of rows) # -> there is also a test file (test_lag_lead_factor_levels.R) for plm::lagr which does not # treat the time variable as a numeric value (merely shifts rows) # # The lagging with respect to the time dimension is the default for lag since # plm version 1.7-0, i.e., lag(..., shift = "time") is a wrapper for plm::lagt # # # (1) test of lagging of index variable # (2) some dropped factor levels / whole period missing # (3) general tests # (4) tests with non-consecutive time periods # (5) lagt and lag should yield same results on data with consecutive time periods # (6) NA in time index library(plm) data("Grunfeld", package = "plm") Grunfeld$fac <- factor(c(200:2, 1)) Grunfeld <- pdata.frame(Grunfeld) ############## (1) test of lagging of index variable ########## ## test of lagging of index variable lag(Grunfeld$firm) # variable identical to an index "on character level" Grunfeld$firm2 <- Grunfeld$firm lag(Grunfeld$firm2) ############## (2.1) tests with eliminated factor levels ########## # lag by 1 eliminates some factor levels (e.g., "1" in the last observations) # 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(levels(lag(Grunfeld$fac))) == 200)) stop("wrong factor levels") # 200 # lead eliminates e.g., level "200" lead(Grunfeld$fac) if (!(length(unique(Grunfeld$fac)) == 200)) stop("wrong factor levels") # 200 if (!(length(unique(lead(Grunfeld$fac))) == 191)) stop("wrong factor levels") # 191 if (!(length(levels(lead(Grunfeld$fac))) == 200)) stop("wrong factor levels") # 200 ############### (2.2) test for case with a time period missing from whole data set data("Grunfeld", package = "plm") obs_3rd <- 3 + 20*c(0:9) Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) # illustration: levels(Grunfeld_wo_1937$year) # no year 1937 anymore and no level for 1937 anymore as.numeric(Grunfeld_wo_1937$year) # as.numeric produces a consecutive series! any(diff(as.numeric(Grunfeld_wo_1937$year)) > 1) # -> no gap detected as.numeric(as.character(Grunfeld_wo_1937$year)) # use as.character before as.numeric! any(diff(as.numeric(as.character(Grunfeld_wo_1937$year))) > 1) # -> gap now detected # formal test: if (!is.na(lag( Grunfeld_wo_1937$inv)["1-1938"])) stop("missing time period not detected (year 1937 is missing from whole data set)") if (!is.na(lead(Grunfeld_wo_1937$inv)["1-1936"])) stop("missing time period not detected (year 1937 is missing from whole data set)") ############## (3) some general tests ########## data("Grunfeld", package = "plm") Grunfeld$fac <- factor(c(200:2, 1)) Grunfeld <- pdata.frame(Grunfeld) ## some more general testing of lag and lead # do nothing if (!isTRUE(all.equal(lag(Grunfeld$fac, 0), Grunfeld$fac))) stop("'lag( , 0)' not equal to 'do nothing'") if (!isTRUE(all.equal(lead(Grunfeld$fac, 0), Grunfeld$fac))) stop("'lead( , 0)' not equal to 'do nothing'") # identical is even stricter than all.equal if (!identical(lag(Grunfeld$fac, 0), Grunfeld$fac)) stop("'lag( , 0)' not identical to 'do nothing'") if (!identical(lead(Grunfeld$fac, 0), Grunfeld$fac)) stop("'lead( , 0)' not identical to 'do nothing'") # lag( , -k) == lead( , k) if (!isTRUE(all.equal(lag(Grunfeld$fac, -1), lead(Grunfeld$fac, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") if (!isTRUE(all.equal(lag(Grunfeld$fac, 1), lead(Grunfeld$fac, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") # identical is even stricter than all.equal if (!identical(lag(Grunfeld$fac, -1), lead(Grunfeld$fac, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") if (!identical(lag(Grunfeld$fac, 1), lead(Grunfeld$fac, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") # with numeric if (!isTRUE(all.equal(lag(Grunfeld$inv, -1), lead(Grunfeld$inv, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") if (!isTRUE(all.equal(lag(Grunfeld$inv, 1), lead(Grunfeld$inv, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") if (!identical(lag(Grunfeld$inv, -1), lead(Grunfeld$inv, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") if (!identical(lag(Grunfeld$inv, 1), lead(Grunfeld$inv, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") # with logical Grunfeld$log <- rep(c(T, T, F, T), 50) if (!isTRUE(all.equal(lag(Grunfeld$log, -1), lead(Grunfeld$log, 1)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") if (!isTRUE(all.equal(lag(Grunfeld$log, 1), lead(Grunfeld$log, -1)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") if (!identical(lag(Grunfeld$log, -1), lead(Grunfeld$log, 1))) stop("'lag( , -1)' not identical to 'lead( , 1)'") if (!identical(lag(Grunfeld$log, 1), lead(Grunfeld$log, -1))) stop("'lag( , 1)' not identical to 'lead( , -1)'") ## other k's if (!isTRUE(all.equal(lag(Grunfeld$inv, -5), lead(Grunfeld$inv, 5)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") if (!isTRUE(all.equal(lag(Grunfeld$inv, 5), lead(Grunfeld$inv, -5)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") if (!isTRUE(all.equal(lag(Grunfeld$inv, -3), lead(Grunfeld$inv, 3)))) stop("'lag( , -1)' not equal to 'lead( , 1)'") if (!isTRUE(all.equal(lag(Grunfeld$inv, 3), lead(Grunfeld$inv, -3)))) stop("'lag( , 1)' not equal to 'lead( , -1)'") if (!identical(lag(Grunfeld$inv, -3), lead(Grunfeld$inv, 3))) stop("'lag( , -1)' not identical to 'lead( , 1)'") if (!identical(lag(Grunfeld$inv, 3), lead(Grunfeld$inv, -3))) stop("'lag( , 1)' not identical to 'lead( , -1)'") # should be all NA if(!isTRUE(all(is.na(lag(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id if(!isTRUE(all(is.na(lag(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available if(!isTRUE(all(is.na(lead(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id if(!isTRUE(all(is.na(lead(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available ## length(k) > 1 lag(Grunfeld$inv, c(-2, -1, 0, 1, 2)) lead(Grunfeld$inv, c(-2, -1, 0, 1, 2)) if(!isTRUE(all.equal(lag(Grunfeld$inv, c(-2, -1, 0, 1, 2)), lead(Grunfeld$inv, -1*c(-2, -1, 0, 1, 2)), check.attributes = FALSE))) stop("'lag( , c())' not equal to 'lead( , -1*c())'") # produces a matrix of characters: # standard R behaviour for factor input to matrix - not beautiful but "correct" lag(Grunfeld$fac, c(-2, -1, 0, 1, 2)) # other data set (different time periods) # Hedonic is an unbalanced panel, townid is the individual index data("Hedonic", package = "plm") Hed <- pdata.frame(Hedonic, index = "townid") head(Hed$age, 20) head(lag(Hed$age), 20) head(lag(Hed$age, c(0,1,2)), 20) if (!isTRUE(all.equal(lag(Hed$age, c(0,1,2,3,4,5)), lead(Hed$age, -1*c(0,1,2,3,4,5)), check.attributes = FALSE))) stop("'lag( , 1)' not equal to 'lead( , -1)'") # diff if (!isTRUE(all.equal(diff(Grunfeld$inv), Grunfeld$inv - lag(Grunfeld$inv)))) stop("'diff()' not corresponding to differences with 'lag()'") if (!isTRUE(all.equal(diff(Grunfeld$inv, 2), Grunfeld$inv - lag(Grunfeld$inv, 2)))) stop("'diff( , 2)' not corresponding to differences with 'lag( , 2)'") ############## (4) test with non-consecutive time periods #### data("Grunfeld", package = "plm") pGrunfeld_missing_period <- pdata.frame(Grunfeld[-2, ]) # delete one time period of first individual (1-1936 is missing (not NA)) is.pconsecutive(pGrunfeld_missing_period) head(pGrunfeld_missing_period$inv, 25) head(test_Grun_miss_p_lag1 <- lag(pGrunfeld_missing_period$inv), 25) # correct: additional NA for the missing time period is introduced at 1-1937 head(lag(pGrunfeld_missing_period$inv, 2), 25) head(test_Grun_miss_p_lag3 <- lag(pGrunfeld_missing_period$inv, 3), 25) # correct: 1-1938 should be non-NA (former 1-1935: 317.6) ### formal test for correct value if (!is.na(test_Grun_miss_p_lag1["1-1937"])) stop("lag(pGrunfeld_missing_period$inv, 1)' for '1-1937' contains a value but should be 'NA'") if (!is.na(test_Grun_miss_p_lag3["1-1938"])) { if(!isTRUE(all.equal(test_Grun_miss_p_lag3["1-1938"], pGrunfeld_missing_period$inv["1-1935"], check.attributes = FALSE))) stop("'lag(pGrunfeld_missing_period$inv, 3)' for '1-1938' is not the expected value of '1-1935' of original data 'pGrunfeld_missing_period$inv'") } else stop("'lag(pGrunfeld_missing_period$inv, 3)' is NA for '1-1938' but should be the value of '1-1935' from original data 'pGrunfeld_missing_period$inv'") length(pGrunfeld_missing_period$inv) == length(lag(pGrunfeld_missing_period$inv)) # with different data set data("Hedonic", package = "plm") Hed_missing_period <- pdata.frame(Hedonic, index = "townid") Hed_missing_period <- as.data.frame(Hed_missing_period) Hed_missing_period <- Hed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 Hed_missing_period <- pdata.frame(Hed_missing_period, index = c("townid", "time")) is.pconsecutive(Hed_missing_period) head(Hed_missing_period$age, 20) head(test_Hed_miss_p_lag1 <- lag(Hed_missing_period$age), 20) # correct: lag(, 1): additional NAs introduced at (among others) 3-3 and 4-6 head(test_Hed_miss_p_lag2 <- lag(Hed_missing_period$age, 2), 20) # correct: lag(, 2): 4-6 should be former 4-4: 85.89996 # 3-3 should be former 3-1: 45.79999 head(lag(Hed_missing_period$age, c(0,1,2)), 20) # view all at once ### formal tests for correct values # lag(, 1) if(!is.na(test_Hed_miss_p_lag1["3-3"])) stop("lag(Hed_missing_period$age, 1)' for '3-3' contains a value but should be 'NA'") if(!is.na(test_Hed_miss_p_lag1["4-6"])) stop("lag(Hed_missing_period$age, 1)' for '4-6' contains a value but should be 'NA'") # lag(, 2) if (!is.na(test_Hed_miss_p_lag2["3-3"])) { if(!isTRUE(all.equal(test_Hed_miss_p_lag2["3-3"], Hed_missing_period$age["3-1"], check.attributes = FALSE))) stop("'lag(Hed_missing_period$age, 2)' for '3-3' is not the expected value of '3-1' of original data 'Hed_missing_period$age'") } else stop("'lag(Hed_missing_period$age, 2)' is NA for '3-3' but should be the value of '3-1' from original data 'Hed_missing_period$age'") if (!is.na(test_Hed_miss_p_lag2["4-6"])) { if(!isTRUE(all.equal(test_Hed_miss_p_lag2["4-6"], Hed_missing_period$age["4-4"], check.attributes = FALSE))) stop("'lag(Hed_missing_period$age, 2)' for '4-6' is not the expected value of '4-4' of original data 'Hed_missing_period$age'") } else stop("'lag(Hed_missing_period$age, 2)' is NA for '4-6' but should be the value of '4-4' from original data 'Hed_missing_period$age'") ##### delete two consecutive time periods data("Hedonic", package = "plm") Hed_missing_period2 <- pdata.frame(Hedonic, index = "townid") Hed_missing_period2 <- as.data.frame(Hed_missing_period2) Hed_missing_period2 <- Hed_missing_period2[-c(5,11,12), ] # delete 3-2, 4-5, 4-6 Hed_missing_period2 <- pdata.frame(Hed_missing_period2, index = c("townid", "time")) is.pconsecutive(Hed_missing_period2) head(Hed_missing_period2$age, 20) head(test_Hed_miss2_p_lag1 <- lag(Hed_missing_period2$age), 20) # correct: lag(, 1): additional NAs introduced at 3-3 and 4-6 head(test_Hed_miss2_p_lag2 <- lag(Hed_missing_period2$age, 2), 20) # correct: 3-3 should be former 3-1 (45.79999) head(test_Hed_miss2_p_lag3 <- lag(Hed_missing_period2$age, 3), 20) # correct: 4-7 should be former 4-4 (85.89996) head(lag(Hed_missing_period2$age, c(0,1,2,3)), 20) # view all at once ### formal tests for correct values ## lag(, 2) if (!is.na(test_Hed_miss2_p_lag2["3-3"])) { if(!isTRUE(all.equal(test_Hed_miss2_p_lag2["3-3"], Hed_missing_period2$age["3-1"], check.attributes = FALSE))) stop("'lag(Hed_missing_period2$age, 2)' for '3-3' is not the expected value of '3-1' of original data 'Hed_missing_period2$age'") } else stop("'lag(Hed_missing_period2$age, 2)' is NA for '3-3' but should be the value of '3-1' from original data 'Hed_missing_period2$age'") # lag(, 3) if (!is.na(test_Hed_miss2_p_lag3["4-7"])) { if(!isTRUE(all.equal(test_Hed_miss2_p_lag3["4-7"], Hed_missing_period2$age["4-4"], check.attributes = FALSE))) stop("'lag(Hed_missing_period2$age, 3)' for '4-7' is not the expected value of '4-4' of original data 'Hed_missing_period2$age'") } else stop("'lag(Hed_missing_period2$age, 3)' is NA for '4-7' but should be the value of '4-4' from original data 'Hed_missing_period2$age'") ############ (5) lagt and lagr should yield same results on data with consecutive time periods #################### data("Grunfeld", package = "plm") Grunfeld <- pdata.frame(Grunfeld) if (!isTRUE(identical(plm:::lagt.pseries(Grunfeld$inv, k = c(-3,-2,-1,0,1,2,3)), plm:::lagr.pseries(Grunfeld$inv, k = c(-3,-2,-1,0,1,2,3))))) stop("lag and lagt not same on consecutive data.frame (but must be!)") ########### (6) NA in time index ############## dfNA <- data.frame(id=c(1,1,2,11,11), time=c(1,2,9,NA,NA), a=c(1,2,3,3.1,3.2), b=c(1,2,3,3.1,3.2)) pdfNA <- pdata.frame(dfNA) if (!isTRUE(all.equal(as.numeric(plm:::lagt.pseries(pdfNA$a)), c(NA, 1.0, NA, NA, NA), check.attributes = FALSE))) stop("NA in time period not dealt with correctly") ############## messy data set with lots of NAs ############ #### commented because it needs several extra packages and loads data from the internet # library(haven) # # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) # # # ### on a consecutive pdata.frame, plm:::lagr and plm:::lagt should yield same results (if no NA in id or time) # pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) # pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8, balanced = TRUE) # # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec$age), plm:::lagt.pseries(pnlswork_r8_consec$age))) # stop("lagr and lagt not same on consecutive data.frame (but must be!)") # # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec_bal$age), plm:::lagt.pseries(pnlswork_r8_consec_bal$age))) # stop("lagr and lagt not same on consecutive data.frame (but must be!)") # ## ########### compare results to statar::tlag ######################## # #### commented because it needs several extra packages # ## statar::tlag (and tlead) also works on the numbers of the time variable # ## # ### install.packages("statar") # #### devtools::install_github("matthieugomez/statar") # ## library(dplyr) # ## # ## lag 1 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel = statar::tlag(age, n = 1, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agel, as.numeric(plm:::lagt.pseries(pnlswork_r8$age))))) stop("not same") # ## lag 2 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel2 = statar::tlag(age, n = 2, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agel2, as.numeric(plm:::lagt.pseries(pnlswork_r8$age, 2))))) stop("not same") # ## lag 3 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agel2 = statar::tlag(age, n = 3, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agel2, as.numeric(plm:::lagt.pseries(pnlswork_r8$age, 3))))) stop("not same") # # ## lead 1 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead = statar::tlead(age, n = 1, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agelead, as.numeric(plm:::leadt.pseries(pnlswork_r8$age))))) stop("not same") # ## lead 2 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead2 = statar::tlead(age, n = 2, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agelead2, as.numeric(plm:::leadt.pseries(pnlswork_r8$age, 2))))) stop("not same") # ## lead 3 # nlswork_r8_statar <- dplyr::mutate(dplyr::group_by(nlswork_r8, idcode), agelead3 = statar::tlead(age, n = 3, time = year)) # if (!isTRUE(all.equal(nlswork_r8_statar$agelead3, as.numeric(plm:::leadt.pseries(pnlswork_r8$age, 3))))) stop("not same") plm/inst/tests/test_transformations.R0000644000176200001440000005726714124132276017617 0ustar liggesusers## Run tests for B/between, Within, and Sum transformation ## contains base-R and collapse version of transformation functions, ## incl. the dispatching mechanism. ## ## Equivalence of base-R and collapse versions is not tested for here, ## but in file test_transformations_collapse.R # data library("plm") #### set up test input data #### data("Grunfeld", package = "plm") class(Grunfeld) Grunfeld[10, "inv"] <- NA pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) #capital <- pGrunfeld$capital inv <- pGrunfeld$inv rm.rows <- c(1:5,50:58, 154:160) pGrunfeld_unbal <-pGrunfeld[-rm.rows, ] inv_unbal <- pGrunfeld_unbal[ , "inv"] l.na <- is.na(inv_unbal) inv_unbal_wona <- inv_unbal[!l.na] i <- index(inv_unbal)[!l.na, ] inv_unbal_wona <- plm:::add_pseries_features(inv_unbal_wona, i) mat <- as.matrix(pGrunfeld[ , 3:5]) attr(mat, "index") <- index(pGrunfeld) mat_unbal <- as.matrix(Grunfeld[-rm.rows , 3:5]) attr(mat_unbal, "index") <- index(pGrunfeld_unbal) mat_noindex <- mat attr(mat_noindex, "index") <- NULL mat_index <- attr(mat, "index") mat_noindex_unbal <- mat[-rm.rows , ] attr(mat_noindex_unbal, "index") <- NULL mat_index_unbal <- attr(mat, "index")[-rm.rows, ] Grunfeld_unbal_wona <- na.omit(Grunfeld[ , 3:5]) mat_unbal_wona <- as.matrix(Grunfeld_unbal_wona) attr(mat_unbal_wona, "index") <- index(pGrunfeld[-attr(Grunfeld_unbal_wona, "na.action"), ]) #### Sum - default #### # individual xS1_d_ind <- Sum(as.numeric(inv), effect = index(inv)[[1L]]) # default xS1_d_ind_narm <- Sum(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xS1_d_ind_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xS1_d_ind_narm_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time xS1_d_ti <- Sum(as.numeric(inv), effect = index(inv)[[2L]]) # default xS1_d_ti_narm <- Sum(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xS1_d_ti_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xS1_d_ti_narm_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) #### Sum - pseries #### # individual xS1_ind <- Sum(inv, effect = "individual") # default xS1_ind_narm <- Sum(inv, effect = "individual", na.rm = TRUE) xS1_ind_unbal <- Sum(inv_unbal, effect = "individual") # default xS1_ind_narm_unbal <- Sum(inv_unbal, effect = "individual", na.rm = TRUE) # time xS1_ti <- Sum(inv, effect = "time") # default xS1_ti_narm <- Sum(inv, effect = "time", na.rm = TRUE) xS1_ti_unbal <- Sum(inv_unbal, effect = "time") # default xS1_ti_narm_unbal <- Sum(inv_unbal, effect = "time", na.rm = TRUE) #### Sum - matrix #### # individual xS1_mat_ind <- Sum(mat, effect = "individual") # default xS1_mat_ind_narm <- Sum(mat, effect = "individual", na.rm = TRUE) xS1_mat_no_index_ind <- Sum(mat_noindex, effect = mat_index[[1L]]) # default xS1_mat_no_index_ind_narm <- Sum(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) xS1_mat_ind_unbal <- Sum(mat_unbal, effect = "individual") # default xS1_mat_ind_narm_unbal <- Sum(mat_unbal, effect = "individual", na.rm = TRUE) xS1_mat_no_index_ind_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xS1_mat_no_index_ind_narm_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) # time xS1_mat_ti <- Sum(mat, effect = "time") # default xS1_mat_ti_narm <- Sum(mat, effect = "time", na.rm = TRUE) xS1_mat_no_index_ti <- Sum(mat_noindex, effect = mat_index[[2L]]) # default xS1_mat_no_index_ti_narm <- Sum(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) xS1_mat_ti_unbal <- Sum(mat_unbal, effect = "time") # default xS1_mat_ti_narm_unbal <- Sum(mat_unbal, effect = "time", na.rm = TRUE) xS1_mat_no_index_ti_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xS1_mat_no_index_ti_narm_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) #### between/Between - default #### # individual xb1_d_ind <- between(as.numeric(inv), effect = index(inv)[[1L]]) # default xb1_d_ind_narm <- between(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xB1_d_ind <- Between(as.numeric(inv), effect = index(inv)[[1L]]) # default xB1_d_ind_narm <- Between(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xb1_d_ind_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xb1_d_ind_narm_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) xB1_d_ind_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xB1_d_ind_narm_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time xb1_d_ti <- between(as.numeric(inv), effect = index(inv)[[2L]]) # default xb1_d_ti_narm <- between(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xB1_d_ti <- Between(as.numeric(inv), effect = index(inv)[[2L]]) # default xB1_d_ti_narm <- Between(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xb1_d_ti_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xb1_d_ti_narm_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) xB1_d_ti_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xB1_d_ti_narm_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) #### between/Between - pseries #### xb1_ind <- between(inv, effect = "individual") # default xb1_ind_narm <- between(inv, effect = "individual", na.rm = TRUE) xB1_ind <- Between(inv, effect = "individual") # default xB1_ind_narm <- Between(inv, effect = "individual", na.rm = TRUE) xb1_ind_unbal <- between(inv_unbal, effect = "individual") # default xb1_ind_unbal_narm <- between(inv_unbal, effect = "individual", na.rm = TRUE) xB1_ind_unbal <- Between(inv_unbal, effect = "individual") # default xB1_ind_unbal_narm <- Between(inv_unbal, effect = "individual", na.rm = TRUE) # time xb1_ti <- between(inv, effect = "time") # default xb1_ti_narm <- between(inv, effect = "time", na.rm = TRUE) xB1_ti <- Between(inv, effect = "time") # default xB1_ti_narm <- Between(inv, effect = "time", na.rm = TRUE) xb1_ti_unbal <- between(inv_unbal, effect = "time") # default xb1_ti_unbal_narm <- between(inv_unbal, effect = "time", na.rm = TRUE) xB1_ti_unbal <- Between(inv_unbal, effect = "time") # default xB1_ti_unbal_narm <- Between(inv_unbal, effect = "time", na.rm = TRUE) #### between/Between - matrix #### # individual xb1_mat_ind <- between(mat, effect = "individual") # default xb1_mat_ind_narm <- between(mat, effect = "individual", na.rm = TRUE) xB1_mat_ind <- Between(mat, effect = "individual") # default xB1_mat_ind_narm <- Between(mat, effect = "individual", na.rm = TRUE) xb1_mat_noindex_ind <- between(mat_noindex, effect = mat_index[[1L]]) # default xb1_mat_noindex_ind_narm <- between(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) xB1_mat_noindex_ind <- Between(mat_noindex, effect = mat_index[[1L]]) # default xB1_mat_noindex_ind_narm <- Between(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) # individual unbalanced xb1_mat_unbal_ind <- between(mat_unbal, effect = "individual") # default xb1_mat_unbal_ind_narm <- between(mat_unbal, effect = "individual", na.rm = TRUE) xB1_mat_unbal_ind <- Between(mat_unbal, effect = "individual") # default xB1_mat_unbal_ind_narm <- Between(mat_unbal, effect = "individual", na.rm = TRUE) xb1_mat_noindex_unbal_ind <- between(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xb1_mat_noindex_unbal_ind_narm <- between(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) xB1_mat_noindex_unbal_ind <- Between(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xB1_mat_noindex_unbal_ind_narm <- Between(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) # time xb1_mat_ti <- between(mat, effect = "time") # default xb1_mat_ti_narm <- between(mat, effect = "time", na.rm = TRUE) xB1_mat_ti <- Between(mat, effect = "time") # default xB1_mat_ti_narm <- Between(mat, effect = "time", na.rm = TRUE) xb1_mat_noindex_ti <- between(mat_noindex, effect = mat_index[[2L]]) # default xb1_mat_noindex_ti_narm <- between(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) xB1_mat_noindex_ti <- Between(mat_noindex, effect = mat_index[[2L]]) # default xB1_mat_noindex_ti_narm <- Between(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) # time unbalanced xb1_mat_unbal_ti <- between(mat_unbal, effect = "time") # default xb1_mat_unbal_ti_narm <- between(mat_unbal, effect = "time", na.rm = TRUE) xB1_mat_unbal_ti <- Between(mat_unbal, effect = "time") # default xB1_mat_unbal_ti_narm <- Between(mat_unbal, effect = "time", na.rm = TRUE) xb1_mat_noindex_unbal_ti <- between(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xb1_mat_noindex_unbal_ti_narm <- between(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) xB1_mat_noindex_unbal_ti <- Between(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xB1_mat_noindex_unbal_ti_narm <- Between(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) #### within - default #### # # individual (balanced + unbalanced) xW1_d_ind <- Within(as.numeric(inv), effect = index(inv)[[1L]]) xW1_d_ind_narm <- Within(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xW1_d_ind_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) xW1_d_ind_narm_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time (balanced + unbalanced) xW1_d_ti <- Within(as.numeric(inv), effect = index(inv)[[2L]]) xW1_d_ti_narm <- Within(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xW1_d_ti_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) xW1_d_ti_narm_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) # NB: Within.default does not handle twoways effects #### within - pseries #### xW1_ind <- Within(inv, effect = "individual") # default xW1_ind_narm <- Within(inv, effect = "individual", na.rm = TRUE) xW1_ind_unbal <- Within(inv_unbal, effect = "individual") # default xW1_ind_narm_unbal <- Within(inv_unbal, effect = "individual", na.rm = TRUE) # time xW1_ti <- Within(inv, effect = "time") # default xW1_ti_narm <- Within(inv, effect = "time", na.rm = TRUE) xW1_ti_unbal <- Within(inv_unbal, effect = "time") # default xW1_ti_narm_unbal <- Within(inv_unbal, effect = "time", na.rm = TRUE) # twoways # need to use non-NA data for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) ## so these cannot work # W1_tw <- Within.pseries(inv, effect = "twoways") # default # W1_tw_narm <- Within.pseries(inv, effect = "twoways", na.rm = TRUE) ## but these: xW1_tw_unbal_wona <- Within(inv_unbal_wona, effect = "twoways") # default xW1_tw_narm_unbal_wona <- Within(inv_unbal_wona, effect = "twoways", na.rm = TRUE) #### within - matrix #### # individual effect - balanced xW1_mat_ind <- Within(mat, effect = "individual") # default xW1_mat_ind_narm <- Within(mat, effect = "individual", na.rm = TRUE) # individual effect - unbalanced xW1_mat_unbal_ind <- Within(mat_unbal, effect = "individual") # default xW1_mat_unbal_ind_narm <- Within(mat_unbal, effect = "individual", na.rm = TRUE) # time effect - balanced xW1_mat_ti <- Within(mat, effect = "time") # default xW1_mat_ti_narm <- Within(mat, effect = "time", na.rm = TRUE) # time effect - unbalanced xW1_mat_unbal_ti <- Within(mat_unbal, effect = "time") # default xW1_mat_unbal_ti_narm <- Within(mat_unbal, effect = "time", na.rm = TRUE) # twoways - balanced xW1_mat_tw <- Within(mat, effect = "twoways") # default xW1_mat_tw_narm <- Within(mat, effect = "twoways", na.rm = TRUE) # twoways - unbalanced # need to use non-NA data for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) xW1_mat_unbal_tw <- Within(mat_unbal_wona, effect = "twoways") # default xW1_mat_unbal_tw_narm <- Within(mat_unbal_wona, effect = "twoways", na.rm = TRUE) ###################### same but with fast functions ############################ ## Run tests only if package 'collapse' is available (as it is Suggests dependency) collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE if(collapse.avail) { options("plm.fast" = TRUE) #### Sum - default #### # individual xS1_d_ind <- Sum(as.numeric(inv), effect = index(inv)[[1L]]) # default xS1_d_ind_narm <- Sum(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xS1_d_ind_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xS1_d_ind_narm_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time xS1_d_ti <- Sum(as.numeric(inv), effect = index(inv)[[2L]]) # default xS1_d_ti_narm <- Sum(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xS1_d_ti_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xS1_d_ti_narm_unbal <- Sum(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) #### Sum - pseries #### # individual xS1_ind <- Sum(inv, effect = "individual") # default xS1_ind_narm <- Sum(inv, effect = "individual", na.rm = TRUE) xS1_ind_unbal <- Sum(inv_unbal, effect = "individual") # default xS1_ind_narm_unbal <- Sum(inv_unbal, effect = "individual", na.rm = TRUE) # time xS1_ti <- Sum(inv, effect = "time") # default xS1_ti_narm <- Sum(inv, effect = "time", na.rm = TRUE) xS1_ti_unbal <- Sum(inv_unbal, effect = "time") # default xS1_ti_narm_unbal <- Sum(inv_unbal, effect = "time", na.rm = TRUE) #### Sum - matrix #### # individual xS1_mat_ind <- Sum(mat, effect = "individual") # default xS1_mat_ind_narm <- Sum(mat, effect = "individual", na.rm = TRUE) xS1_mat_no_index_ind <- Sum(mat_noindex, effect = mat_index[[1L]]) # default xS1_mat_no_index_ind_narm <- Sum(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) xS1_mat_ind_unbal <- Sum(mat_unbal, effect = "individual") # default xS1_mat_ind_narm_unbal <- Sum(mat_unbal, effect = "individual", na.rm = TRUE) xS1_mat_no_index_ind_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xS1_mat_no_index_ind_narm_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) # time xS1_mat_ti <- Sum(mat, effect = "time") # default xS1_mat_ti_narm <- Sum(mat, effect = "time", na.rm = TRUE) xS1_mat_no_index_ti <- Sum(mat_noindex, effect = mat_index[[2L]]) # default xS1_mat_no_index_ti_narm <- Sum(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) xS1_mat_ti_unbal <- Sum(mat_unbal, effect = "time") # default xS1_mat_ti_narm_unbal <- Sum(mat_unbal, effect = "time", na.rm = TRUE) xS1_mat_no_index_ti_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xS1_mat_no_index_ti_narm_unbal <- Sum(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) #### between/Between - default #### # individual xb1_d_ind <- between(as.numeric(inv), effect = index(inv)[[1L]]) # default xb1_d_ind_narm <- between(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xB1_d_ind <- Between(as.numeric(inv), effect = index(inv)[[1L]]) # default xB1_d_ind_narm <- Between(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xb1_d_ind_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xb1_d_ind_narm_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) xB1_d_ind_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) # default xB1_d_ind_narm_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time xb1_d_ti <- between(as.numeric(inv), effect = index(inv)[[2L]]) # default xb1_d_ti_narm <- between(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xB1_d_ti <- Between(as.numeric(inv), effect = index(inv)[[2L]]) # default xB1_d_ti_narm <- Between(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xb1_d_ti_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xb1_d_ti_narm_unbal <- between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) xB1_d_ti_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) # default xB1_d_ti_narm_unbal <- Between(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) #### between/Between - pseries #### xb1_ind <- between(inv, effect = "individual") # default xb1_ind_narm <- between(inv, effect = "individual", na.rm = TRUE) xB1_ind <- Between(inv, effect = "individual") # default xB1_ind_narm <- Between(inv, effect = "individual", na.rm = TRUE) xb1_ind_unbal <- between(inv_unbal, effect = "individual") # default xb1_ind_unbal_narm <- between(inv_unbal, effect = "individual", na.rm = TRUE) xB1_ind_unbal <- Between(inv_unbal, effect = "individual") # default xB1_ind_unbal_narm <- Between(inv_unbal, effect = "individual", na.rm = TRUE) # time xb1_ti <- between(inv, effect = "time") # default xb1_ti_narm <- between(inv, effect = "time", na.rm = TRUE) xB1_ti <- Between(inv, effect = "time") # default xB1_ti_narm <- Between(inv, effect = "time", na.rm = TRUE) xb1_ti_unbal <- between(inv_unbal, effect = "time") # default xb1_ti_unbal_narm <- between(inv_unbal, effect = "time", na.rm = TRUE) xB1_ti_unbal <- Between(inv_unbal, effect = "time") # default xB1_ti_unbal_narm <- Between(inv_unbal, effect = "time", na.rm = TRUE) #### between/Between - matrix #### # individual xb1_mat_ind <- between(mat, effect = "individual") # default xb1_mat_ind_narm <- between(mat, effect = "individual", na.rm = TRUE) xB1_mat_ind <- Between(mat, effect = "individual") # default xB1_mat_ind_narm <- Between(mat, effect = "individual", na.rm = TRUE) xb1_mat_noindex_ind <- between(mat_noindex, effect = mat_index[[1L]]) # default xb1_mat_noindex_ind_narm <- between(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) xB1_mat_noindex_ind <- Between(mat_noindex, effect = mat_index[[1L]]) # default xB1_mat_noindex_ind_narm <- Between(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) # individual unbalanced xb1_mat_unbal_ind <- between(mat_unbal, effect = "individual") # default xb1_mat_unbal_ind_narm <- between(mat_unbal, effect = "individual", na.rm = TRUE) xB1_mat_unbal_ind <- Between(mat_unbal, effect = "individual") # default xB1_mat_unbal_ind_narm <- Between(mat_unbal, effect = "individual", na.rm = TRUE) xb1_mat_noindex_unbal_ind <- between(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xb1_mat_noindex_unbal_ind_narm <- between(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) xB1_mat_noindex_unbal_ind <- Between(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default xB1_mat_noindex_unbal_ind_narm <- Between(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) # time xb1_mat_ti <- between(mat, effect = "time") # default xb1_mat_ti_narm <- between(mat, effect = "time", na.rm = TRUE) xB1_mat_ti <- Between(mat, effect = "time") # default xB1_mat_ti_narm <- Between(mat, effect = "time", na.rm = TRUE) xb1_mat_noindex_ti <- between(mat_noindex, effect = mat_index[[2L]]) # default xb1_mat_noindex_ti_narm <- between(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) xB1_mat_noindex_ti <- Between(mat_noindex, effect = mat_index[[2L]]) # default xB1_mat_noindex_ti_narm <- Between(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) # time unbalanced xb1_mat_unbal_ti <- between(mat_unbal, effect = "time") # default xb1_mat_unbal_ti_narm <- between(mat_unbal, effect = "time", na.rm = TRUE) xB1_mat_unbal_ti <- Between(mat_unbal, effect = "time") # default xB1_mat_unbal_ti_narm <- Between(mat_unbal, effect = "time", na.rm = TRUE) xb1_mat_noindex_unbal_ti <- between(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xb1_mat_noindex_unbal_ti_narm <- between(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) xB1_mat_noindex_unbal_ti <- Between(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default xB1_mat_noindex_unbal_ti_narm <- Between(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) #### within - default #### # # individual (balanced + unbalanced) xW1_d_ind <- Within(as.numeric(inv), effect = index(inv)[[1L]]) xW1_d_ind_narm <- Within(as.numeric(inv), effect = index(inv)[[1L]], na.rm = TRUE) xW1_d_ind_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]]) xW1_d_ind_narm_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[1L]], na.rm = TRUE) # time (balanced + unbalanced) xW1_d_ti <- Within(as.numeric(inv), effect = index(inv)[[2L]]) xW1_d_ti_narm <- Within(as.numeric(inv), effect = index(inv)[[2L]], na.rm = TRUE) xW1_d_ti_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]]) xW1_d_ti_narm_unbal <- Within(as.numeric(inv_unbal), effect = index(inv_unbal)[[2L]], na.rm = TRUE) # NB: Within.default does not handle twoways effects #### within - pseries #### xW1_ind <- Within(inv, effect = "individual") # default xW1_ind_narm <- Within(inv, effect = "individual", na.rm = TRUE) xW1_ind_unbal <- Within(inv_unbal, effect = "individual") # default xW1_ind_narm_unbal <- Within(inv_unbal, effect = "individual", na.rm = TRUE) # time xW1_ti <- Within(inv, effect = "time") # default xW1_ti_narm <- Within(inv, effect = "time", na.rm = TRUE) xW1_ti_unbal <- Within(inv_unbal, effect = "time") # default xW1_ti_narm_unbal <- Within(inv_unbal, effect = "time", na.rm = TRUE) # twoways # need to use non-NA data for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) ## so these cannot work # W1_tw <- Within.pseries(inv, effect = "twoways") # default # W1_tw_narm <- Within.pseries(inv, effect = "twoways", na.rm = TRUE) ## but these: xW1_tw_unbal_wona <- Within(inv_unbal_wona, effect = "twoways") # default xW1_tw_narm_unbal_wona <- Within(inv_unbal_wona, effect = "twoways", na.rm = TRUE) #### within - matrix #### # individual effect - balanced xW1_mat_ind <- Within(mat, effect = "individual") # default xW1_mat_ind_narm <- Within(mat, effect = "individual", na.rm = TRUE) # individual effect - unbalanced xW1_mat_unbal_ind <- Within(mat_unbal, effect = "individual") # default xW1_mat_unbal_ind_narm <- Within(mat_unbal, effect = "individual", na.rm = TRUE) # time effect - balanced xW1_mat_ti <- Within(mat, effect = "time") # default xW1_mat_ti_narm <- Within(mat, effect = "time", na.rm = TRUE) # time effect - unbalanced xW1_mat_unbal_ti <- Within(mat_unbal, effect = "time") # default xW1_mat_unbal_ti_narm <- Within(mat_unbal, effect = "time", na.rm = TRUE) # twoways - balanced xW1_mat_tw <- Within(mat, effect = "twoways") # default xW1_mat_tw_narm <- Within(mat, effect = "twoways", na.rm = TRUE) # twoways - unbalanced # need to use non-NA data for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) xW1_mat_unbal_tw <- Within(mat_unbal_wona, effect = "twoways") # default xW1_mat_unbal_tw_narm <- Within(mat_unbal_wona, effect = "twoways", na.rm = TRUE) }plm/inst/tests/test_pggls.Rout.save0000644000176200001440000001773014155651544017166 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Produc", package = "plm") > > zz_default <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc) > > summary(zz_default) # is within, check if correctly identified in print output Oneway (individual) effect Within FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.117504866 -0.023705713 -0.004716909 0.017288320 0.177767615 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) -0.00104277 0.02900641 -0.0359 0.9713 log(pc) 0.17151298 0.01807934 9.4867 < 2.2e-16 *** log(emp) 0.84449144 0.02042362 41.3488 < 2.2e-16 *** unemp -0.00357102 0.00047319 -7.5468 4.462e-14 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 1.1623 Multiple R-squared: 0.99863 > > zz_wi <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, model = "within") > summary(zz_wi) Oneway (individual) effect Within FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.117504866 -0.023705713 -0.004716909 0.017288320 0.177767615 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) -0.00104277 0.02900641 -0.0359 0.9713 log(pc) 0.17151298 0.01807934 9.4867 < 2.2e-16 *** log(emp) 0.84449144 0.02042362 41.3488 < 2.2e-16 *** unemp -0.00357102 0.00047319 -7.5468 4.462e-14 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 1.1623 Multiple R-squared: 0.99863 > > zz_pool <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, model = "pooling") > summary(zz_pool) Oneway (individual) effect General FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "pooling") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.255736 -0.070199 -0.014124 -0.008909 0.039118 0.455461 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.26388494 0.10077679 22.4643 < 2.2e-16 *** log(pcap) 0.10566584 0.02004106 5.2725 1.346e-07 *** log(pc) 0.21643137 0.01539471 14.0588 < 2.2e-16 *** log(emp) 0.71293894 0.01863632 38.2553 < 2.2e-16 *** unemp -0.00447265 0.00045214 -9.8921 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 7.5587 Multiple R-squared: 0.99111 > > zz_fd <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, model = "fd") > summary(zz_fd) Oneway (individual) effect First-Difference FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.0847594 -0.0103758 0.0024378 0.0007254 0.0133336 0.1018213 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 0.00942926 0.00106337 8.8673 < 2e-16 *** log(pcap) -0.04400764 0.02911083 -1.5117 0.13060 log(pc) -0.03100727 0.01248722 -2.4831 0.01302 * log(emp) 0.87411813 0.02077388 42.0777 < 2e-16 *** unemp -0.00483240 0.00040668 -11.8825 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.33459 Multiple R-squared: 0.99961 > > zz_wi_t <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, model = "within", effect = "time") > summary(zz_wi_t) Oneway (time) effect Within FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time", model = "within") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.223571390 -0.058341036 -0.001293562 0.048932542 0.358330871 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) 0.1647758 0.0010173 161.980 < 2.2e-16 *** log(pc) 0.3034768 0.0016782 180.838 < 2.2e-16 *** log(emp) 0.5889347 0.0016124 365.245 < 2.2e-16 *** unemp -0.0060831 0.0001342 -45.327 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 6.0629 Multiple R-squared: 0.99287 > > zz_pool_t <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, + data = Produc, model = "pooling", effect = "time") > summary(zz_pool_t) Oneway (time) effect General FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time", model = "pooling") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.2322110 -0.0611463 -0.0003261 -0.0002164 0.0510696 0.3512185 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.64508430 0.01162922 141.461 < 2.2e-16 *** log(pcap) 0.15507564 0.00099705 155.535 < 2.2e-16 *** log(pc) 0.30880784 0.00229903 134.321 < 2.2e-16 *** log(emp) 0.59426830 0.00239355 248.280 < 2.2e-16 *** unemp -0.00681164 0.00013671 -49.825 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 6.2942 Multiple R-squared: 0.99259 > > ## effect = "time" for FD model not supported as senseless (individ. dimension > ## does not have a natural order) > > > ## do not run as additional package is needed > # library(wooldridge) > # data("jtrain", package = "wooldridge") > # pjtrain <- pdata.frame(jtrain, index = c("fcode", "year")) > # > # ## no examples in Wooldridge (2002/2010), Ch. 10 for the RE GLS, FE GLS, FD GLS models > # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "pooling") > # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "within") > # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "fd") # errored in 1.6-5, run in 1.6-6 (but gives nointercept), with intercept in 1.7-0 (rev. 746) > # > # > # summary(plm(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "random")) # W (2010), p. 297 > # summary(plm(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "within")) # W (2010), p. 307 > # summary(plm(lscrap ~ d89 + union + grant + grant_1, data = pjtrain, model = "fd")) # W (2010), p. 319 > > ## Results in Wooldridge, Ch. 10 for plm random, p. 297 > ## 0.415 intercept > ## -0.093 d88 > ## -0.270 d89 > ## +0.548 union > ## -0.215 grant > ## -0.377 grant_t-1 > > proc.time() user system elapsed 2.64 0.34 3.00 plm/inst/tests/test_plmtest_unbalanced.R0000644000176200001440000003576514154734502020234 0ustar liggesusers# Test of new plmtest implementation (handling unbalanced panels) # # compare to grunfeld data example in Baltagi (2013), Econometric Analysis of Panel Data, 5th ed., p. 74-75 (Table 4.1/4.2) # also Baltagi (2005), Econometric Analysis of Panel Data, 3rd ed., p. 65-66 (just Table 4.1, # table 4.2 in Baltagi (2005) is only Stata's xttest0 # for Breusch-Pagan with chi2(1) = 798.16, Prob > chi2 = 0.0000) # # => statistics and p-values match => implementation of balanced tests is ok. # # The text book only supplies examples for the balanced Grunfeld data # Thus, there are no reference values for an _un_balanced data set. # -> compare calculation of EViews on an unbalanced data set (grunfeld without last observation) # unbalanced formulas reduce in the case of a balanced panel to the formula for balanced panels: # # balanced panel: => test output as in the text book => implementation is ok. # unbalanced panel: => test statistics for unbalanced panel differ from balanced panel # => test matches calculation of EViews # Tables from Baltagi # # Table 4.1 ############ [statistic (critical values at 5% level)] ## note: SLM statistic is not implemented in plm # ind time twoways #--------------------------------- # [...] ##### Grunfeld data set - balanced #### # Table 4.2 [Output from EViews], similiar 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 ##### In (at least) EViews 9, the LM tests are implemented, no need for add-in; ##### SLM is not outputted anymore but std. Honda and std. KW ##### and p-values for negative one-sided statistics are not ##### printed anymore (see unbalanced example below). ########### [statistic (p-values)] # ind time twoways #--------------------------------- ## note: SLM statistic is not implemented in plm # [...] ############ unbalanced ########################################## ##### Grunfeld unbalanced data set [see below] ##### (last observation deleted, i. e. first 199 obs) # Own computation with EViews 9 ##### In EViews 9, the LM tests are implemented, no need for add-in anymore; ##### SLM is not outputted but std. Honda and std. KW ##### p-values for the negative one-sided statistics ##### [in this example (std.) Honda, KW] ##### are not printed in EViews 9; from the help file: ########### [statistic (p-values)] # ind time twoways #--------------------------------- # [...] # ## note: standardizised HO statistic is not implemented in plm ## note: standardizised KW statistic is not implemented in plm options(digits = 10) Sys.setenv(LANG = "en") require(plm) data("Grunfeld", package = "plm") Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) fe_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within") re_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random") pool_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="pooling") # Make an unbalanced data set Grunfeldpdata_unbalanced <- Grunfeld[1:(nrow(Grunfeld)-1), ] Grunfeldpdata_unbalanced <- pdata.frame(Grunfeldpdata_unbalanced, index=c("firm"), drop.index = F) fe_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="within") re_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="random") pool_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="pooling") # Produc # data("Produc", package = "plm") # form_produc <- formula(gsp ~ log(pc) + log(pcap) + log(emp) + unemp) # produc_pool <- plm(form_produc, data = Produc, model="pooling") # Hedonic # Stastics heavily differ for this unbalanced data, depending on one applies the # balanced tests (v1.4-0) to this unbalanced data or the unbalanced test # # balanced test of v1.4-0: 849.45815 (individual effects) and 600.20821 (time effects) # unbalanced test: 25.011274 (individual effects) and 1.5571417 (time effects) data("Hedonic", package = "plm") pHedonic <- pdata.frame(Hedonic, index = "townid", drop.index = F) form_hedonic <- formula(mv ~ crim) hedonic_pool <- plm(form_hedonic, data = pHedonic, model="pooling") plmtest(hedonic_pool) plmtest(hedonic_pool, effect = "time") ### generalized version of plmtest() to handle also unbalanced panels # individual effect print(honda_ind <- plmtest(pool_grunfeld, type="honda")) print(honda_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda")) print(bp_ind <- plmtest(pool_grunfeld, type="bp")) print(bp_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp")) print(kw_ind <- plmtest(pool_grunfeld, type="kw")) print(kw_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw")) # Note: ghm is only for twoways, hence not in this section # time effect print(honda_time <- plmtest(pool_grunfeld, type="honda", effect="time")) print(honda_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda", effect="time")) print(bp_time <- plmtest(pool_grunfeld, type="bp", effect="time")) print(bp_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp", effect="time")) print(kw_time <- plmtest(pool_grunfeld, type="kw", effect="time")) print(kw_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw", effect="time")) # Note: ghm is only for twoways, hence not in this section # twoways effect print(honda_tw <- plmtest(pool_grunfeld, type="honda", effect="twoways")) print(honda_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda", effect="twoways")) print(bp_tw <- plmtest(pool_grunfeld, type="bp", effect="twoways")) print(bp_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp", effect="twoways")) print(kw_tw <- plmtest(pool_grunfeld, type="kw", effect="twoways")) print(kw_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw", effect="twoways")) print(ghm_tw <- plmtest(pool_grunfeld, type="ghm", effect="twoways")) print(ghm_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="ghm", effect="twoways")) ### Test of formula interface # individual effect print(honda_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda")) print(honda_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda")) print(bp_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp")) print(bp_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp")) print(kw_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw")) print(kw_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw")) # Note: ghm is only for twoways, hence not in this section # time effect print(honda_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda", effect="time")) print(honda_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda", effect="time")) print(bp_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp", effect="time")) print(bp_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp", effect="time")) print(kw_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw", effect="time")) print(kw_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw", effect="time")) # Note: ghm is only for twoways, hence not in this section # twoways effect print(honda_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda", effect="twoways")) print(honda_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda", effect="twoways")) print(bp_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp", effect="twoways")) print(bp_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp", effect="twoways")) print(kw_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw", effect="twoways")) print(kw_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw", effect="twoways")) print(ghm_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="ghm", effect="twoways")) print(ghm_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="ghm", effect="twoways")) # Should all be TRUE if(!all( identical(honda_ind, honda_ind_form), identical(honda_ind_unbalanced, honda_ind_unbalanced_form), identical(bp_ind, bp_ind_form), identical(bp_ind_unbalanced, bp_ind_unbalanced_form), identical(kw_ind, kw_ind_form), identical(kw_ind_unbalanced, kw_ind_unbalanced_form), identical(honda_time, honda_time_form), identical(honda_time_unbalanced, honda_time_unbalanced_form), identical(bp_time, bp_time_form), identical(bp_time_unbalanced, bp_time_unbalanced_form), identical(kw_time, kw_time_form), identical(kw_time_unbalanced, kw_time_unbalanced_form), identical(honda_tw, honda_tw_form), identical(honda_tw_unbalanced, honda_tw_unbalanced_form), identical(bp_tw, bp_tw_form), identical(bp_tw_unbalanced, bp_tw_unbalanced_form), identical(kw_tw, kw_tw_form), identical(kw_tw_unbalanced, kw_tw_unbalanced_form), identical(ghm_tw, ghm_tw_form), identical(ghm_tw_unbalanced, ghm_tw_unbalanced_form))) stop("results of plm and formula interface differ!") # Tests - unbalanced - statistics should be "sufficiently different" from balanced statistics, # thus results should be TRUE # individual abs(honda_ind_unbalanced$statistic - honda_ind$statistic) > 0.0001 abs(bp_ind_unbalanced$statistic - bp_ind$statistic) > 0.0001 abs(kw_ind_unbalanced$statistic - kw_ind$statistic) > 0.0001 # time abs(honda_time_unbalanced$statistic - honda_time$statistic) > 0.0001 abs(bp_time_unbalanced$statistic - bp_time$statistic) > 0.0001 abs(kw_time_unbalanced$statistic - kw_time$statistic) > 0.0001 # twoways abs(honda_tw_unbalanced$statistic - honda_tw$statistic) > 0.0001 abs(bp_tw_unbalanced$statistic - bp_tw$statistic) > 0.0001 abs(kw_tw_unbalanced$statistic - kw_tw$statistic) > 0.0001 abs(ghm_tw_unbalanced$statistic - ghm_tw$statistic) > 0.0001 ########## resamble critical values at alpha = 0.05 from Table 4.1 (Baltagi (2013), p. 74) alpha <- 0.05 #### honda and kw oneway and twoway -> 1.645 qnorm(alpha, lower.tail = F) # => pnorm(qnorm(alpha, lower.tail = F), lower.tail = F) # honda (kw) p-value implementation as in plm_v1.4-0 (CRAN as of 2015-11-08): # leads to the 10% level (not 5%): # see also above the table for the unbalanced Grunfeld data on how EViews handles negative statistics for Honda and KW pnorm(abs(1.645), lower.tail = FALSE)*2 # CRAN v1.4-0 # correct is -> p=0.05 pnorm(abs(1.645), lower.tail = FALSE) #### bp: df=1 (oneway) -> 3.841 #### df=2 (twoway) -> 5.991 qchisq(alpha, df=1, lower.tail = F) # H0_a, H0_b qchisq(alpha, df=2, lower.tail = F) # H0_c # => pchisq(qchisq(alpha, df = 1, lower.tail = F), df=1, lower.tail = F) pchisq(qchisq(alpha, df = 2, lower.tail = F), df=2, lower.tail = F) #### ghm test for p-value of mixed chi-square distribution (more often called chi-bar-square) # as implemented in fixed version. # (was simple chisquare in plm_v1.4-0 on CRAN -> wrong) # # Baltagi (2013), p. 88 (note 2), p. 209 (note 10) gives critical values for 0.01, 0.05, 0.10 levels # 4.321 is a typo in the notes of Baltagi's textbook, should be 4.231 [confirmed by private email from Badi Baltagi] crit <- c(7.289, 4.231, 2.952) # without typo # crit <- c(7.289, 4.312, 2.952) # with typo from text book p.vals <- (1/4)*pchisq(crit, df=0, lower.tail = F) + (1/2) * pchisq(crit, df=1, lower.tail = F) + (1/4) * pchisq(crit, df=2, lower.tail = F) # Baltagi (2013), p. 73, 74 contains another example of the mixed chi-square (chi-bar-square) distibution of another statistic # The p-values for that example is also reassembled here crit_2 <- c(2.706) # for alpha=0.05 p.val_2 <- (1/2)*pchisq(crit_2, df=0, lower.tail = F) + (1/2) * pchisq(crit_2, df=1, lower.tail = F) ################# Replicate an example from Stata ## example 1 in this manual: ## http://www.stata.com/manuals/xtxtregpostestimation.pdf ## It is an unbalanced panel # require(haven) # required to read Stata data file # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # nlswork$race <- factor(nlswork$race) # fix data # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) # # # note STAT 14 uses by default a different method compared to plm's Swamy–Arora variance component estimator # # This is why in comparison with web examples from Stata the random effects coefficients slightly differ # plm_re_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south # , data = pnlswork, model = "random") # # # reassembles the FE estimation by Stata in Example 2 of http://www.stata.com/manuals13/xtxtreg.pdf # plm_fe_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south # , data = pnlswork, model = "within") # # plm_pool_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south # , data = pnlswork, model = "pooling") # # # # Reassembles Exmaple 1 in http://www.stata.com/manuals14/xtxtregpostestimation.pdf # # use modified plmtest() as a wrapper # options(digits = 10) # plmtest(plm_pool_nlswork, type="bp") # # # ## Lagrange Multiplier Test - individual effects - Breusch-Pagan Test for unbalanced Panels as in Baltagi/Li (1990) # # ## data: ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + ... # # ## BP_unbalanced = 14779.984, df = 1, p-value < 2.2204e-16 # # ## alternative hypothesis: significant effects plm/inst/tests/test_lag_lead.Rout.save0000644000176200001440000020111414124132276017561 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests of lagr and leadr (shifting of rows), i.e., lag(..., shift = "row") > # > # (1) test of lagging of index variable > # (2) some dropped factor levels / whole period missing > # (3) general tests > # (4) test with non-consecutive time periods > # > # ad (2) error prior to rev. 207: > # the lagging resulted in an error with factors in some cases, > # because some factor levels can get lost due to the lagging > # and the old code was not capable to manage this > # > # fixed in rev. 207 with better handling of factor levels and simpler code > > > library(plm) > data("Grunfeld", package = "plm") > > Grunfeld$fac <- factor(c(200:2, 1)) > Grunfeld <- pdata.frame(Grunfeld) > > > ############## (1) test of lagging of index variable ########## > ## test of lagging of index variable > plm:::lagr.pseries(Grunfeld$firm) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1 1 1 1 1 1 1 1 1 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 1 1 1 1 1 1 1 1 1 1 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 2 2 2 2 2 2 2 2 2 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 2 2 2 2 2 2 2 2 2 2 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 3 3 3 3 3 3 3 3 3 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 3 3 3 3 3 3 3 3 3 3 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4 4 4 4 4 4 4 4 4 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 4 4 4 4 4 4 4 4 4 4 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5 5 5 5 5 5 5 5 5 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 5 5 5 5 5 5 5 5 5 5 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 6 6 6 6 6 6 6 6 6 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 6 6 6 6 6 6 6 6 6 6 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 7 7 7 7 7 7 7 7 7 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 7 7 7 7 7 7 7 7 7 7 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 8 8 8 8 8 8 8 8 8 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 8 8 8 8 8 8 8 8 8 8 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 9 9 9 9 9 9 9 9 9 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 9 9 9 9 9 9 9 9 9 9 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 10 10 10 10 10 10 10 10 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > > # variable identical to an index "on character level" > Grunfeld$firm2 <- Grunfeld$firm > plm:::lagr.pseries(Grunfeld$firm2) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1 1 1 1 1 1 1 1 1 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 1 1 1 1 1 1 1 1 1 1 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 2 2 2 2 2 2 2 2 2 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 2 2 2 2 2 2 2 2 2 2 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 3 3 3 3 3 3 3 3 3 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 3 3 3 3 3 3 3 3 3 3 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 4 4 4 4 4 4 4 4 4 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 4 4 4 4 4 4 4 4 4 4 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 5 5 5 5 5 5 5 5 5 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 5 5 5 5 5 5 5 5 5 5 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 6 6 6 6 6 6 6 6 6 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 6 6 6 6 6 6 6 6 6 6 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 7 7 7 7 7 7 7 7 7 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 7 7 7 7 7 7 7 7 7 7 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 8 8 8 8 8 8 8 8 8 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 8 8 8 8 8 8 8 8 8 8 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 9 9 9 9 9 9 9 9 9 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 9 9 9 9 9 9 9 9 9 9 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 10 10 10 10 10 10 10 10 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 10 10 10 10 10 10 10 10 10 10 Levels: 1 2 3 4 5 6 7 8 9 10 > > > ############## (2.1) tests with eliminated factor levels ########## > > # lag by 1 eliminates some factor levels (e.g., "1" in the last observations) > # from the sample's unique factor levels, but it should stay in the levels > plm:::lagr.pseries(Grunfeld$fac) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 200 199 198 197 196 195 194 193 192 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 191 190 189 188 187 186 185 184 183 182 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 180 179 178 177 176 175 174 173 172 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 171 170 169 168 167 166 165 164 163 162 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 160 159 158 157 156 155 154 153 152 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 151 150 149 148 147 146 145 144 143 142 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 140 139 138 137 136 135 134 133 132 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 131 130 129 128 127 126 125 124 123 122 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 120 119 118 117 116 115 114 113 112 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 111 110 109 108 107 106 105 104 103 102 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 100 99 98 97 96 95 94 93 92 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 91 90 89 88 87 86 85 84 83 82 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 80 79 78 77 76 75 74 73 72 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 71 70 69 68 67 66 65 64 63 62 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 60 59 58 57 56 55 54 53 52 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 51 50 49 48 47 46 45 44 43 42 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 40 39 38 37 36 35 34 33 32 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 31 30 29 28 27 26 25 24 23 22 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 20 19 18 17 16 15 14 13 12 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 11 10 9 8 7 6 5 4 3 2 200 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ... 200 > 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(levels(plm:::lagr.pseries(Grunfeld$fac))) == 200)) stop("wrong factor levels") # 200 > > # plm::lead eliminates e.g., level "200" > plm:::leadr.pseries(Grunfeld$fac) 1-1935 1-1936 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 199 198 197 196 195 194 193 192 191 190 1-1945 1-1946 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 189 188 187 186 185 184 183 182 181 2-1935 2-1936 2-1937 2-1938 2-1939 2-1940 2-1941 2-1942 2-1943 2-1944 179 178 177 176 175 174 173 172 171 170 2-1945 2-1946 2-1947 2-1948 2-1949 2-1950 2-1951 2-1952 2-1953 2-1954 169 168 167 166 165 164 163 162 161 3-1935 3-1936 3-1937 3-1938 3-1939 3-1940 3-1941 3-1942 3-1943 3-1944 159 158 157 156 155 154 153 152 151 150 3-1945 3-1946 3-1947 3-1948 3-1949 3-1950 3-1951 3-1952 3-1953 3-1954 149 148 147 146 145 144 143 142 141 4-1935 4-1936 4-1937 4-1938 4-1939 4-1940 4-1941 4-1942 4-1943 4-1944 139 138 137 136 135 134 133 132 131 130 4-1945 4-1946 4-1947 4-1948 4-1949 4-1950 4-1951 4-1952 4-1953 4-1954 129 128 127 126 125 124 123 122 121 5-1935 5-1936 5-1937 5-1938 5-1939 5-1940 5-1941 5-1942 5-1943 5-1944 119 118 117 116 115 114 113 112 111 110 5-1945 5-1946 5-1947 5-1948 5-1949 5-1950 5-1951 5-1952 5-1953 5-1954 109 108 107 106 105 104 103 102 101 6-1935 6-1936 6-1937 6-1938 6-1939 6-1940 6-1941 6-1942 6-1943 6-1944 99 98 97 96 95 94 93 92 91 90 6-1945 6-1946 6-1947 6-1948 6-1949 6-1950 6-1951 6-1952 6-1953 6-1954 89 88 87 86 85 84 83 82 81 7-1935 7-1936 7-1937 7-1938 7-1939 7-1940 7-1941 7-1942 7-1943 7-1944 79 78 77 76 75 74 73 72 71 70 7-1945 7-1946 7-1947 7-1948 7-1949 7-1950 7-1951 7-1952 7-1953 7-1954 69 68 67 66 65 64 63 62 61 8-1935 8-1936 8-1937 8-1938 8-1939 8-1940 8-1941 8-1942 8-1943 8-1944 59 58 57 56 55 54 53 52 51 50 8-1945 8-1946 8-1947 8-1948 8-1949 8-1950 8-1951 8-1952 8-1953 8-1954 49 48 47 46 45 44 43 42 41 9-1935 9-1936 9-1937 9-1938 9-1939 9-1940 9-1941 9-1942 9-1943 9-1944 39 38 37 36 35 34 33 32 31 30 9-1945 9-1946 9-1947 9-1948 9-1949 9-1950 9-1951 9-1952 9-1953 9-1954 29 28 27 26 25 24 23 22 21 10-1935 10-1936 10-1937 10-1938 10-1939 10-1940 10-1941 10-1942 10-1943 10-1944 19 18 17 16 15 14 13 12 11 10 10-1945 10-1946 10-1947 10-1948 10-1949 10-1950 10-1951 10-1952 10-1953 10-1954 9 8 7 6 5 4 3 2 1 200 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ... 200 > 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(levels(plm:::leadr.pseries(Grunfeld$fac))) == 200)) stop("plm:::leadr.pseries: wrong factor levels") # 200 > > > ############### (2.2) test for case with a time period missing from whole data set > data("Grunfeld", package = "plm") > obs_3rd <- 3 + 20*c(0:9) > Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) > > # illustration: > levels(Grunfeld_wo_1937$year) # no year 1937 anymore and no level for 1937 anymore (a year in between, i.e., not consecutive series anymore) [1] "1935" "1936" "1938" "1939" "1940" "1941" "1942" "1943" "1944" "1945" [11] "1946" "1947" "1948" "1949" "1950" "1951" "1952" "1953" "1954" > as.numeric(Grunfeld_wo_1937$year) # as.numeric produces a consecutive series! [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 [26] 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 [51] 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [76] 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 [101] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 [126] 12 13 14 15 16 17 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 [151] 18 19 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 1 2 3 4 [176] 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 > any(diff(as.numeric(Grunfeld_wo_1937$year)) > 1) # FALSE -> no gap detected [1] FALSE > > as.numeric(as.character(Grunfeld_wo_1937$year)) # use as.character before as.numeric! [1] 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 [16] 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 [31] 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 [46] 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 [61] 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 [76] 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 [91] 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 [106] 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 [121] 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1935 1936 [136] 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 [151] 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 [166] 1949 1950 1951 1952 1953 1954 1935 1936 1938 1939 1940 1941 1942 1943 1944 [181] 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 > any(diff(as.numeric(as.character(Grunfeld_wo_1937$year))) > 1) # TRUE -> gap now detected [1] TRUE > > > > ############## (3) some general tests ########## > data("Grunfeld", package = "plm") > > Grunfeld$fac <- factor(c(200:2, 1)) > Grunfeld <- pdata.frame(Grunfeld) > ## some more general testing of plm::lagr and plm:::leadr > # do nothing > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, 0), Grunfeld$fac))) stop("'plm:::lagr.pseries( , 0)' not equal to 'do nothing'") > if (!isTRUE(all.equal(plm:::leadr.pseries(Grunfeld$fac, 0), Grunfeld$fac))) stop("'plm:::leadr.pseries( , 0)' not equal to 'do nothing'") > # identical is even stricter than all.equal > if (!identical(plm:::lagr.pseries(Grunfeld$fac, 0), Grunfeld$fac)) stop("'plm:::lagr.pseries( , 0)' not identical to 'do nothing'") > if (!identical(plm:::leadr.pseries(Grunfeld$fac, 0), Grunfeld$fac)) stop("'plm:::leadr.pseries( , 0)' not identical to 'do nothing'") > > > # plm:::lagr.pseries( , -k) == plm:::leadr.pseries( , k) > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, -1), plm:::leadr.pseries(Grunfeld$fac, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$fac, 1), plm:::leadr.pseries(Grunfeld$fac, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") > # identical is even stricter than all.equal > if (!identical(plm:::lagr.pseries(Grunfeld$fac, -1), plm:::leadr.pseries(Grunfeld$fac, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") > if (!identical(plm:::lagr.pseries(Grunfeld$fac, 1), plm:::leadr.pseries(Grunfeld$fac, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") > > # with numeric > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -1), plm:::leadr.pseries(Grunfeld$inv, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 1), plm:::leadr.pseries(Grunfeld$inv, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") > # identical is even stricter than all.equal > if (!identical(plm:::lagr.pseries(Grunfeld$inv, -1), plm:::leadr.pseries(Grunfeld$inv, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") > if (!identical(plm:::lagr.pseries(Grunfeld$inv, 1), plm:::leadr.pseries(Grunfeld$inv, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") > > > > # with logical > Grunfeld$log <- rep(c(T, T, F, T), 50) > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$log, -1), plm:::leadr.pseries(Grunfeld$log, 1)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$log, 1), plm:::leadr.pseries(Grunfeld$log, -1)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") > # identical is even stricter than all.equal > if (!identical(plm:::lagr.pseries(Grunfeld$log, -1), plm:::leadr.pseries(Grunfeld$log, 1))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") > if (!identical(plm:::lagr.pseries(Grunfeld$log, 1), plm:::leadr.pseries(Grunfeld$log, -1))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") > > > ## other k's > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -5), plm:::leadr.pseries(Grunfeld$inv, 5)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 5), plm:::leadr.pseries(Grunfeld$inv, -5)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") > > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, -3), plm:::leadr.pseries(Grunfeld$inv, 3)))) stop("'plm:::lagr.pseries( , -1)' not equal to 'plm:::leadr.pseries( , 1)'") > if (!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, 3), plm:::leadr.pseries(Grunfeld$inv, -3)))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries( , -1)'") > > if (!identical(plm:::lagr.pseries(Grunfeld$inv, -3), plm:::leadr.pseries(Grunfeld$inv, 3))) stop("'plm:::lagr.pseries( , -1)' not identical to 'plm:::leadr.pseries( , 1)'") > if (!identical(plm:::lagr.pseries(Grunfeld$inv, 3), plm:::leadr.pseries(Grunfeld$inv, -3))) stop("'plm:::lagr.pseries( , 1)' not identical to 'plm:::leadr.pseries( , -1)'") > > > > # should be all NA > if(!isTRUE(all(is.na(plm:::lagr.pseries(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id > if(!isTRUE(all(is.na(plm:::lagr.pseries(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available > if(!isTRUE(all(is.na(plm:::leadr.pseries(Grunfeld$inv, 20))))) stop("all-NA case not correct") # 20 is no of obs per id > if(!isTRUE(all(is.na(plm:::leadr.pseries(Grunfeld$inv, 21))))) stop("all-NA case not correct") # 21 is more than obs per id available > > ## length(k) > 1 > plm:::lagr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 410.60 391.80 317.60 NA NA 1-1936 257.70 410.60 391.80 317.60 NA 1-1937 330.80 257.70 410.60 391.80 317.60 1-1938 461.20 330.80 257.70 410.60 391.80 1-1939 512.00 461.20 330.80 257.70 410.60 1-1940 448.00 512.00 461.20 330.80 257.70 1-1941 499.60 448.00 512.00 461.20 330.80 1-1942 547.50 499.60 448.00 512.00 461.20 1-1943 561.20 547.50 499.60 448.00 512.00 1-1944 688.10 561.20 547.50 499.60 448.00 1-1945 568.90 688.10 561.20 547.50 499.60 1-1946 529.20 568.90 688.10 561.20 547.50 1-1947 555.10 529.20 568.90 688.10 561.20 1-1948 642.90 555.10 529.20 568.90 688.10 1-1949 755.90 642.90 555.10 529.20 568.90 1-1950 891.20 755.90 642.90 555.10 529.20 1-1951 1304.40 891.20 755.90 642.90 555.10 1-1952 1486.70 1304.40 891.20 755.90 642.90 1-1953 NA 1486.70 1304.40 891.20 755.90 1-1954 NA NA 1486.70 1304.40 891.20 2-1935 469.90 355.30 209.90 NA NA 2-1936 262.30 469.90 355.30 209.90 NA 2-1937 230.40 262.30 469.90 355.30 209.90 2-1938 361.60 230.40 262.30 469.90 355.30 2-1939 472.80 361.60 230.40 262.30 469.90 2-1940 445.60 472.80 361.60 230.40 262.30 2-1941 361.60 445.60 472.80 361.60 230.40 2-1942 288.20 361.60 445.60 472.80 361.60 2-1943 258.70 288.20 361.60 445.60 472.80 2-1944 420.30 258.70 288.20 361.60 445.60 2-1945 420.50 420.30 258.70 288.20 361.60 2-1946 494.50 420.50 420.30 258.70 288.20 2-1947 405.10 494.50 420.50 420.30 258.70 2-1948 418.80 405.10 494.50 420.50 420.30 2-1949 588.20 418.80 405.10 494.50 420.50 2-1950 645.50 588.20 418.80 405.10 494.50 2-1951 641.00 645.50 588.20 418.80 405.10 2-1952 459.30 641.00 645.50 588.20 418.80 2-1953 NA 459.30 641.00 645.50 588.20 2-1954 NA NA 459.30 641.00 645.50 3-1935 77.20 45.00 33.10 NA NA 3-1936 44.60 77.20 45.00 33.10 NA 3-1937 48.10 44.60 77.20 45.00 33.10 3-1938 74.40 48.10 44.60 77.20 45.00 3-1939 113.00 74.40 48.10 44.60 77.20 3-1940 91.90 113.00 74.40 48.10 44.60 3-1941 61.30 91.90 113.00 74.40 48.10 3-1942 56.80 61.30 91.90 113.00 74.40 3-1943 93.60 56.80 61.30 91.90 113.00 3-1944 159.90 93.60 56.80 61.30 91.90 3-1945 147.20 159.90 93.60 56.80 61.30 3-1946 146.30 147.20 159.90 93.60 56.80 3-1947 98.30 146.30 147.20 159.90 93.60 3-1948 93.50 98.30 146.30 147.20 159.90 3-1949 135.20 93.50 98.30 146.30 147.20 3-1950 157.30 135.20 93.50 98.30 146.30 3-1951 179.50 157.30 135.20 93.50 98.30 3-1952 189.60 179.50 157.30 135.20 93.50 3-1953 NA 189.60 179.50 157.30 135.20 3-1954 NA NA 189.60 179.50 157.30 4-1935 66.26 72.76 40.29 NA NA 4-1936 51.60 66.26 72.76 40.29 NA 4-1937 52.41 51.60 66.26 72.76 40.29 4-1938 69.41 52.41 51.60 66.26 72.76 4-1939 68.35 69.41 52.41 51.60 66.26 4-1940 46.80 68.35 69.41 52.41 51.60 4-1941 47.40 46.80 68.35 69.41 52.41 4-1942 59.57 47.40 46.80 68.35 69.41 4-1943 88.78 59.57 47.40 46.80 68.35 4-1944 74.12 88.78 59.57 47.40 46.80 4-1945 62.68 74.12 88.78 59.57 47.40 4-1946 89.36 62.68 74.12 88.78 59.57 4-1947 78.98 89.36 62.68 74.12 88.78 4-1948 100.66 78.98 89.36 62.68 74.12 4-1949 160.62 100.66 78.98 89.36 62.68 4-1950 145.00 160.62 100.66 78.98 89.36 4-1951 174.93 145.00 160.62 100.66 78.98 4-1952 172.49 174.93 145.00 160.62 100.66 4-1953 NA 172.49 174.93 145.00 160.62 4-1954 NA NA 172.49 174.93 145.00 5-1935 74.24 50.73 39.68 NA NA 5-1936 53.51 74.24 50.73 39.68 NA 5-1937 42.65 53.51 74.24 50.73 39.68 5-1938 46.48 42.65 53.51 74.24 50.73 5-1939 61.40 46.48 42.65 53.51 74.24 5-1940 39.67 61.40 46.48 42.65 53.51 5-1941 62.24 39.67 61.40 46.48 42.65 5-1942 52.32 62.24 39.67 61.40 46.48 5-1943 63.21 52.32 62.24 39.67 61.40 5-1944 59.37 63.21 52.32 62.24 39.67 5-1945 58.02 59.37 63.21 52.32 62.24 5-1946 70.34 58.02 59.37 63.21 52.32 5-1947 67.42 70.34 58.02 59.37 63.21 5-1948 55.74 67.42 70.34 58.02 59.37 5-1949 80.30 55.74 67.42 70.34 58.02 5-1950 85.40 80.30 55.74 67.42 70.34 5-1951 91.90 85.40 80.30 55.74 67.42 5-1952 81.43 91.90 85.40 80.30 55.74 5-1953 NA 81.43 91.90 85.40 80.30 5-1954 NA NA 81.43 91.90 85.40 6-1935 25.94 25.98 20.36 NA NA 6-1936 27.53 25.94 25.98 20.36 NA 6-1937 24.60 27.53 25.94 25.98 20.36 6-1938 28.54 24.60 27.53 25.94 25.98 6-1939 43.41 28.54 24.60 27.53 25.94 6-1940 42.81 43.41 28.54 24.60 27.53 6-1941 27.84 42.81 43.41 28.54 24.60 6-1942 32.60 27.84 42.81 43.41 28.54 6-1943 39.03 32.60 27.84 42.81 43.41 6-1944 50.17 39.03 32.60 27.84 42.81 6-1945 51.85 50.17 39.03 32.60 27.84 6-1946 64.03 51.85 50.17 39.03 32.60 6-1947 68.16 64.03 51.85 50.17 39.03 6-1948 77.34 68.16 64.03 51.85 50.17 6-1949 95.30 77.34 68.16 64.03 51.85 6-1950 99.49 95.30 77.34 68.16 64.03 6-1951 127.52 99.49 95.30 77.34 68.16 6-1952 135.72 127.52 99.49 95.30 77.34 6-1953 NA 135.72 127.52 99.49 95.30 6-1954 NA NA 135.72 127.52 99.49 7-1935 32.78 23.21 24.43 NA NA 7-1936 32.54 32.78 23.21 24.43 NA 7-1937 26.65 32.54 32.78 23.21 24.43 7-1938 33.71 26.65 32.54 32.78 23.21 7-1939 43.50 33.71 26.65 32.54 32.78 7-1940 34.46 43.50 33.71 26.65 32.54 7-1941 44.28 34.46 43.50 33.71 26.65 7-1942 70.80 44.28 34.46 43.50 33.71 7-1943 44.12 70.80 44.28 34.46 43.50 7-1944 48.98 44.12 70.80 44.28 34.46 7-1945 48.51 48.98 44.12 70.80 44.28 7-1946 50.00 48.51 48.98 44.12 70.80 7-1947 50.59 50.00 48.51 48.98 44.12 7-1948 42.53 50.59 50.00 48.51 48.98 7-1949 64.77 42.53 50.59 50.00 48.51 7-1950 72.68 64.77 42.53 50.59 50.00 7-1951 73.86 72.68 64.77 42.53 50.59 7-1952 89.51 73.86 72.68 64.77 42.53 7-1953 NA 89.51 73.86 72.68 64.77 7-1954 NA NA 89.51 73.86 72.68 8-1935 35.05 25.90 12.93 NA NA 8-1936 22.89 35.05 25.90 12.93 NA 8-1937 18.84 22.89 35.05 25.90 12.93 8-1938 28.57 18.84 22.89 35.05 25.90 8-1939 48.51 28.57 18.84 22.89 35.05 8-1940 43.34 48.51 28.57 18.84 22.89 8-1941 37.02 43.34 48.51 28.57 18.84 8-1942 37.81 37.02 43.34 48.51 28.57 8-1943 39.27 37.81 37.02 43.34 48.51 8-1944 53.46 39.27 37.81 37.02 43.34 8-1945 55.56 53.46 39.27 37.81 37.02 8-1946 49.56 55.56 53.46 39.27 37.81 8-1947 32.04 49.56 55.56 53.46 39.27 8-1948 32.24 32.04 49.56 55.56 53.46 8-1949 54.38 32.24 32.04 49.56 55.56 8-1950 71.78 54.38 32.24 32.04 49.56 8-1951 90.08 71.78 54.38 32.24 32.04 8-1952 68.60 90.08 71.78 54.38 32.24 8-1953 NA 68.60 90.08 71.78 54.38 8-1954 NA NA 68.60 90.08 71.78 9-1935 30.65 23.39 26.63 NA NA 9-1936 20.89 30.65 23.39 26.63 NA 9-1937 28.78 20.89 30.65 23.39 26.63 9-1938 26.93 28.78 20.89 30.65 23.39 9-1939 32.08 26.93 28.78 20.89 30.65 9-1940 32.21 32.08 26.93 28.78 20.89 9-1941 35.69 32.21 32.08 26.93 28.78 9-1942 62.47 35.69 32.21 32.08 26.93 9-1943 52.32 62.47 35.69 32.21 32.08 9-1944 56.95 52.32 62.47 35.69 32.21 9-1945 54.32 56.95 52.32 62.47 35.69 9-1946 40.53 54.32 56.95 52.32 62.47 9-1947 32.54 40.53 54.32 56.95 52.32 9-1948 43.48 32.54 40.53 54.32 56.95 9-1949 56.49 43.48 32.54 40.53 54.32 9-1950 65.98 56.49 43.48 32.54 40.53 9-1951 66.11 65.98 56.49 43.48 32.54 9-1952 49.34 66.11 65.98 56.49 43.48 9-1953 NA 49.34 66.11 65.98 56.49 9-1954 NA NA 49.34 66.11 65.98 10-1935 2.19 2.00 2.54 NA NA 10-1936 1.99 2.19 2.00 2.54 NA 10-1937 2.03 1.99 2.19 2.00 2.54 10-1938 1.81 2.03 1.99 2.19 2.00 10-1939 2.14 1.81 2.03 1.99 2.19 10-1940 1.86 2.14 1.81 2.03 1.99 10-1941 0.93 1.86 2.14 1.81 2.03 10-1942 1.18 0.93 1.86 2.14 1.81 10-1943 1.36 1.18 0.93 1.86 2.14 10-1944 2.24 1.36 1.18 0.93 1.86 10-1945 3.81 2.24 1.36 1.18 0.93 10-1946 5.66 3.81 2.24 1.36 1.18 10-1947 4.21 5.66 3.81 2.24 1.36 10-1948 3.42 4.21 5.66 3.81 2.24 10-1949 4.67 3.42 4.21 5.66 3.81 10-1950 6.00 4.67 3.42 4.21 5.66 10-1951 6.53 6.00 4.67 3.42 4.21 10-1952 5.12 6.53 6.00 4.67 3.42 10-1953 NA 5.12 6.53 6.00 4.67 10-1954 NA NA 5.12 6.53 6.00 > plm:::leadr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 NA NA 317.60 391.80 410.60 1-1936 NA 317.60 391.80 410.60 257.70 1-1937 317.60 391.80 410.60 257.70 330.80 1-1938 391.80 410.60 257.70 330.80 461.20 1-1939 410.60 257.70 330.80 461.20 512.00 1-1940 257.70 330.80 461.20 512.00 448.00 1-1941 330.80 461.20 512.00 448.00 499.60 1-1942 461.20 512.00 448.00 499.60 547.50 1-1943 512.00 448.00 499.60 547.50 561.20 1-1944 448.00 499.60 547.50 561.20 688.10 1-1945 499.60 547.50 561.20 688.10 568.90 1-1946 547.50 561.20 688.10 568.90 529.20 1-1947 561.20 688.10 568.90 529.20 555.10 1-1948 688.10 568.90 529.20 555.10 642.90 1-1949 568.90 529.20 555.10 642.90 755.90 1-1950 529.20 555.10 642.90 755.90 891.20 1-1951 555.10 642.90 755.90 891.20 1304.40 1-1952 642.90 755.90 891.20 1304.40 1486.70 1-1953 755.90 891.20 1304.40 1486.70 NA 1-1954 891.20 1304.40 1486.70 NA NA 2-1935 NA NA 209.90 355.30 469.90 2-1936 NA 209.90 355.30 469.90 262.30 2-1937 209.90 355.30 469.90 262.30 230.40 2-1938 355.30 469.90 262.30 230.40 361.60 2-1939 469.90 262.30 230.40 361.60 472.80 2-1940 262.30 230.40 361.60 472.80 445.60 2-1941 230.40 361.60 472.80 445.60 361.60 2-1942 361.60 472.80 445.60 361.60 288.20 2-1943 472.80 445.60 361.60 288.20 258.70 2-1944 445.60 361.60 288.20 258.70 420.30 2-1945 361.60 288.20 258.70 420.30 420.50 2-1946 288.20 258.70 420.30 420.50 494.50 2-1947 258.70 420.30 420.50 494.50 405.10 2-1948 420.30 420.50 494.50 405.10 418.80 2-1949 420.50 494.50 405.10 418.80 588.20 2-1950 494.50 405.10 418.80 588.20 645.50 2-1951 405.10 418.80 588.20 645.50 641.00 2-1952 418.80 588.20 645.50 641.00 459.30 2-1953 588.20 645.50 641.00 459.30 NA 2-1954 645.50 641.00 459.30 NA NA 3-1935 NA NA 33.10 45.00 77.20 3-1936 NA 33.10 45.00 77.20 44.60 3-1937 33.10 45.00 77.20 44.60 48.10 3-1938 45.00 77.20 44.60 48.10 74.40 3-1939 77.20 44.60 48.10 74.40 113.00 3-1940 44.60 48.10 74.40 113.00 91.90 3-1941 48.10 74.40 113.00 91.90 61.30 3-1942 74.40 113.00 91.90 61.30 56.80 3-1943 113.00 91.90 61.30 56.80 93.60 3-1944 91.90 61.30 56.80 93.60 159.90 3-1945 61.30 56.80 93.60 159.90 147.20 3-1946 56.80 93.60 159.90 147.20 146.30 3-1947 93.60 159.90 147.20 146.30 98.30 3-1948 159.90 147.20 146.30 98.30 93.50 3-1949 147.20 146.30 98.30 93.50 135.20 3-1950 146.30 98.30 93.50 135.20 157.30 3-1951 98.30 93.50 135.20 157.30 179.50 3-1952 93.50 135.20 157.30 179.50 189.60 3-1953 135.20 157.30 179.50 189.60 NA 3-1954 157.30 179.50 189.60 NA NA 4-1935 NA NA 40.29 72.76 66.26 4-1936 NA 40.29 72.76 66.26 51.60 4-1937 40.29 72.76 66.26 51.60 52.41 4-1938 72.76 66.26 51.60 52.41 69.41 4-1939 66.26 51.60 52.41 69.41 68.35 4-1940 51.60 52.41 69.41 68.35 46.80 4-1941 52.41 69.41 68.35 46.80 47.40 4-1942 69.41 68.35 46.80 47.40 59.57 4-1943 68.35 46.80 47.40 59.57 88.78 4-1944 46.80 47.40 59.57 88.78 74.12 4-1945 47.40 59.57 88.78 74.12 62.68 4-1946 59.57 88.78 74.12 62.68 89.36 4-1947 88.78 74.12 62.68 89.36 78.98 4-1948 74.12 62.68 89.36 78.98 100.66 4-1949 62.68 89.36 78.98 100.66 160.62 4-1950 89.36 78.98 100.66 160.62 145.00 4-1951 78.98 100.66 160.62 145.00 174.93 4-1952 100.66 160.62 145.00 174.93 172.49 4-1953 160.62 145.00 174.93 172.49 NA 4-1954 145.00 174.93 172.49 NA NA 5-1935 NA NA 39.68 50.73 74.24 5-1936 NA 39.68 50.73 74.24 53.51 5-1937 39.68 50.73 74.24 53.51 42.65 5-1938 50.73 74.24 53.51 42.65 46.48 5-1939 74.24 53.51 42.65 46.48 61.40 5-1940 53.51 42.65 46.48 61.40 39.67 5-1941 42.65 46.48 61.40 39.67 62.24 5-1942 46.48 61.40 39.67 62.24 52.32 5-1943 61.40 39.67 62.24 52.32 63.21 5-1944 39.67 62.24 52.32 63.21 59.37 5-1945 62.24 52.32 63.21 59.37 58.02 5-1946 52.32 63.21 59.37 58.02 70.34 5-1947 63.21 59.37 58.02 70.34 67.42 5-1948 59.37 58.02 70.34 67.42 55.74 5-1949 58.02 70.34 67.42 55.74 80.30 5-1950 70.34 67.42 55.74 80.30 85.40 5-1951 67.42 55.74 80.30 85.40 91.90 5-1952 55.74 80.30 85.40 91.90 81.43 5-1953 80.30 85.40 91.90 81.43 NA 5-1954 85.40 91.90 81.43 NA NA 6-1935 NA NA 20.36 25.98 25.94 6-1936 NA 20.36 25.98 25.94 27.53 6-1937 20.36 25.98 25.94 27.53 24.60 6-1938 25.98 25.94 27.53 24.60 28.54 6-1939 25.94 27.53 24.60 28.54 43.41 6-1940 27.53 24.60 28.54 43.41 42.81 6-1941 24.60 28.54 43.41 42.81 27.84 6-1942 28.54 43.41 42.81 27.84 32.60 6-1943 43.41 42.81 27.84 32.60 39.03 6-1944 42.81 27.84 32.60 39.03 50.17 6-1945 27.84 32.60 39.03 50.17 51.85 6-1946 32.60 39.03 50.17 51.85 64.03 6-1947 39.03 50.17 51.85 64.03 68.16 6-1948 50.17 51.85 64.03 68.16 77.34 6-1949 51.85 64.03 68.16 77.34 95.30 6-1950 64.03 68.16 77.34 95.30 99.49 6-1951 68.16 77.34 95.30 99.49 127.52 6-1952 77.34 95.30 99.49 127.52 135.72 6-1953 95.30 99.49 127.52 135.72 NA 6-1954 99.49 127.52 135.72 NA NA 7-1935 NA NA 24.43 23.21 32.78 7-1936 NA 24.43 23.21 32.78 32.54 7-1937 24.43 23.21 32.78 32.54 26.65 7-1938 23.21 32.78 32.54 26.65 33.71 7-1939 32.78 32.54 26.65 33.71 43.50 7-1940 32.54 26.65 33.71 43.50 34.46 7-1941 26.65 33.71 43.50 34.46 44.28 7-1942 33.71 43.50 34.46 44.28 70.80 7-1943 43.50 34.46 44.28 70.80 44.12 7-1944 34.46 44.28 70.80 44.12 48.98 7-1945 44.28 70.80 44.12 48.98 48.51 7-1946 70.80 44.12 48.98 48.51 50.00 7-1947 44.12 48.98 48.51 50.00 50.59 7-1948 48.98 48.51 50.00 50.59 42.53 7-1949 48.51 50.00 50.59 42.53 64.77 7-1950 50.00 50.59 42.53 64.77 72.68 7-1951 50.59 42.53 64.77 72.68 73.86 7-1952 42.53 64.77 72.68 73.86 89.51 7-1953 64.77 72.68 73.86 89.51 NA 7-1954 72.68 73.86 89.51 NA NA 8-1935 NA NA 12.93 25.90 35.05 8-1936 NA 12.93 25.90 35.05 22.89 8-1937 12.93 25.90 35.05 22.89 18.84 8-1938 25.90 35.05 22.89 18.84 28.57 8-1939 35.05 22.89 18.84 28.57 48.51 8-1940 22.89 18.84 28.57 48.51 43.34 8-1941 18.84 28.57 48.51 43.34 37.02 8-1942 28.57 48.51 43.34 37.02 37.81 8-1943 48.51 43.34 37.02 37.81 39.27 8-1944 43.34 37.02 37.81 39.27 53.46 8-1945 37.02 37.81 39.27 53.46 55.56 8-1946 37.81 39.27 53.46 55.56 49.56 8-1947 39.27 53.46 55.56 49.56 32.04 8-1948 53.46 55.56 49.56 32.04 32.24 8-1949 55.56 49.56 32.04 32.24 54.38 8-1950 49.56 32.04 32.24 54.38 71.78 8-1951 32.04 32.24 54.38 71.78 90.08 8-1952 32.24 54.38 71.78 90.08 68.60 8-1953 54.38 71.78 90.08 68.60 NA 8-1954 71.78 90.08 68.60 NA NA 9-1935 NA NA 26.63 23.39 30.65 9-1936 NA 26.63 23.39 30.65 20.89 9-1937 26.63 23.39 30.65 20.89 28.78 9-1938 23.39 30.65 20.89 28.78 26.93 9-1939 30.65 20.89 28.78 26.93 32.08 9-1940 20.89 28.78 26.93 32.08 32.21 9-1941 28.78 26.93 32.08 32.21 35.69 9-1942 26.93 32.08 32.21 35.69 62.47 9-1943 32.08 32.21 35.69 62.47 52.32 9-1944 32.21 35.69 62.47 52.32 56.95 9-1945 35.69 62.47 52.32 56.95 54.32 9-1946 62.47 52.32 56.95 54.32 40.53 9-1947 52.32 56.95 54.32 40.53 32.54 9-1948 56.95 54.32 40.53 32.54 43.48 9-1949 54.32 40.53 32.54 43.48 56.49 9-1950 40.53 32.54 43.48 56.49 65.98 9-1951 32.54 43.48 56.49 65.98 66.11 9-1952 43.48 56.49 65.98 66.11 49.34 9-1953 56.49 65.98 66.11 49.34 NA 9-1954 65.98 66.11 49.34 NA NA 10-1935 NA NA 2.54 2.00 2.19 10-1936 NA 2.54 2.00 2.19 1.99 10-1937 2.54 2.00 2.19 1.99 2.03 10-1938 2.00 2.19 1.99 2.03 1.81 10-1939 2.19 1.99 2.03 1.81 2.14 10-1940 1.99 2.03 1.81 2.14 1.86 10-1941 2.03 1.81 2.14 1.86 0.93 10-1942 1.81 2.14 1.86 0.93 1.18 10-1943 2.14 1.86 0.93 1.18 1.36 10-1944 1.86 0.93 1.18 1.36 2.24 10-1945 0.93 1.18 1.36 2.24 3.81 10-1946 1.18 1.36 2.24 3.81 5.66 10-1947 1.36 2.24 3.81 5.66 4.21 10-1948 2.24 3.81 5.66 4.21 3.42 10-1949 3.81 5.66 4.21 3.42 4.67 10-1950 5.66 4.21 3.42 4.67 6.00 10-1951 4.21 3.42 4.67 6.00 6.53 10-1952 3.42 4.67 6.00 6.53 5.12 10-1953 4.67 6.00 6.53 5.12 NA 10-1954 6.00 6.53 5.12 NA NA > if(!isTRUE(all.equal(plm:::lagr.pseries(Grunfeld$inv, c(-2, -1, 0, 1, 2)), + plm:::leadr.pseries(Grunfeld$inv, -1*c(-2, -1, 0, 1, 2)), check.attributes = FALSE))) stop("'plm:::lagr.pseries( , c())' not equal to 'plm:::leadr.pseries( , -1*c())'") > # produces a matrix of characters: > # standard R behaviour for factor input to matrix - not beautiful but "correct" > plm:::leadr.pseries(Grunfeld$fac, c(-2, -1, 0, 1, 2)) -2 -1 0 1 2 1-1935 NA NA "200" "199" "198" 1-1936 NA "200" "199" "198" "197" 1-1937 "200" "199" "198" "197" "196" 1-1938 "199" "198" "197" "196" "195" 1-1939 "198" "197" "196" "195" "194" 1-1940 "197" "196" "195" "194" "193" 1-1941 "196" "195" "194" "193" "192" 1-1942 "195" "194" "193" "192" "191" 1-1943 "194" "193" "192" "191" "190" 1-1944 "193" "192" "191" "190" "189" 1-1945 "192" "191" "190" "189" "188" 1-1946 "191" "190" "189" "188" "187" 1-1947 "190" "189" "188" "187" "186" 1-1948 "189" "188" "187" "186" "185" 1-1949 "188" "187" "186" "185" "184" 1-1950 "187" "186" "185" "184" "183" 1-1951 "186" "185" "184" "183" "182" 1-1952 "185" "184" "183" "182" "181" 1-1953 "184" "183" "182" "181" NA 1-1954 "183" "182" "181" NA NA 2-1935 NA NA "180" "179" "178" 2-1936 NA "180" "179" "178" "177" 2-1937 "180" "179" "178" "177" "176" 2-1938 "179" "178" "177" "176" "175" 2-1939 "178" "177" "176" "175" "174" 2-1940 "177" "176" "175" "174" "173" 2-1941 "176" "175" "174" "173" "172" 2-1942 "175" "174" "173" "172" "171" 2-1943 "174" "173" "172" "171" "170" 2-1944 "173" "172" "171" "170" "169" 2-1945 "172" "171" "170" "169" "168" 2-1946 "171" "170" "169" "168" "167" 2-1947 "170" "169" "168" "167" "166" 2-1948 "169" "168" "167" "166" "165" 2-1949 "168" "167" "166" "165" "164" 2-1950 "167" "166" "165" "164" "163" 2-1951 "166" "165" "164" "163" "162" 2-1952 "165" "164" "163" "162" "161" 2-1953 "164" "163" "162" "161" NA 2-1954 "163" "162" "161" NA NA 3-1935 NA NA "160" "159" "158" 3-1936 NA "160" "159" "158" "157" 3-1937 "160" "159" "158" "157" "156" 3-1938 "159" "158" "157" "156" "155" 3-1939 "158" "157" "156" "155" "154" 3-1940 "157" "156" "155" "154" "153" 3-1941 "156" "155" "154" "153" "152" 3-1942 "155" "154" "153" "152" "151" 3-1943 "154" "153" "152" "151" "150" 3-1944 "153" "152" "151" "150" "149" 3-1945 "152" "151" "150" "149" "148" 3-1946 "151" "150" "149" "148" "147" 3-1947 "150" "149" "148" "147" "146" 3-1948 "149" "148" "147" "146" "145" 3-1949 "148" "147" "146" "145" "144" 3-1950 "147" "146" "145" "144" "143" 3-1951 "146" "145" "144" "143" "142" 3-1952 "145" "144" "143" "142" "141" 3-1953 "144" "143" "142" "141" NA 3-1954 "143" "142" "141" NA NA 4-1935 NA NA "140" "139" "138" 4-1936 NA "140" "139" "138" "137" 4-1937 "140" "139" "138" "137" "136" 4-1938 "139" "138" "137" "136" "135" 4-1939 "138" "137" "136" "135" "134" 4-1940 "137" "136" "135" "134" "133" 4-1941 "136" "135" "134" "133" "132" 4-1942 "135" "134" "133" "132" "131" 4-1943 "134" "133" "132" "131" "130" 4-1944 "133" "132" "131" "130" "129" 4-1945 "132" "131" "130" "129" "128" 4-1946 "131" "130" "129" "128" "127" 4-1947 "130" "129" "128" "127" "126" 4-1948 "129" "128" "127" "126" "125" 4-1949 "128" "127" "126" "125" "124" 4-1950 "127" "126" "125" "124" "123" 4-1951 "126" "125" "124" "123" "122" 4-1952 "125" "124" "123" "122" "121" 4-1953 "124" "123" "122" "121" NA 4-1954 "123" "122" "121" NA NA 5-1935 NA NA "120" "119" "118" 5-1936 NA "120" "119" "118" "117" 5-1937 "120" "119" "118" "117" "116" 5-1938 "119" "118" "117" "116" "115" 5-1939 "118" "117" "116" "115" "114" 5-1940 "117" "116" "115" "114" "113" 5-1941 "116" "115" "114" "113" "112" 5-1942 "115" "114" "113" "112" "111" 5-1943 "114" "113" "112" "111" "110" 5-1944 "113" "112" "111" "110" "109" 5-1945 "112" "111" "110" "109" "108" 5-1946 "111" "110" "109" "108" "107" 5-1947 "110" "109" "108" "107" "106" 5-1948 "109" "108" "107" "106" "105" 5-1949 "108" "107" "106" "105" "104" 5-1950 "107" "106" "105" "104" "103" 5-1951 "106" "105" "104" "103" "102" 5-1952 "105" "104" "103" "102" "101" 5-1953 "104" "103" "102" "101" NA 5-1954 "103" "102" "101" NA NA 6-1935 NA NA "100" "99" "98" 6-1936 NA "100" "99" "98" "97" 6-1937 "100" "99" "98" "97" "96" 6-1938 "99" "98" "97" "96" "95" 6-1939 "98" "97" "96" "95" "94" 6-1940 "97" "96" "95" "94" "93" 6-1941 "96" "95" "94" "93" "92" 6-1942 "95" "94" "93" "92" "91" 6-1943 "94" "93" "92" "91" "90" 6-1944 "93" "92" "91" "90" "89" 6-1945 "92" "91" "90" "89" "88" 6-1946 "91" "90" "89" "88" "87" 6-1947 "90" "89" "88" "87" "86" 6-1948 "89" "88" "87" "86" "85" 6-1949 "88" "87" "86" "85" "84" 6-1950 "87" "86" "85" "84" "83" 6-1951 "86" "85" "84" "83" "82" 6-1952 "85" "84" "83" "82" "81" 6-1953 "84" "83" "82" "81" NA 6-1954 "83" "82" "81" NA NA 7-1935 NA NA "80" "79" "78" 7-1936 NA "80" "79" "78" "77" 7-1937 "80" "79" "78" "77" "76" 7-1938 "79" "78" "77" "76" "75" 7-1939 "78" "77" "76" "75" "74" 7-1940 "77" "76" "75" "74" "73" 7-1941 "76" "75" "74" "73" "72" 7-1942 "75" "74" "73" "72" "71" 7-1943 "74" "73" "72" "71" "70" 7-1944 "73" "72" "71" "70" "69" 7-1945 "72" "71" "70" "69" "68" 7-1946 "71" "70" "69" "68" "67" 7-1947 "70" "69" "68" "67" "66" 7-1948 "69" "68" "67" "66" "65" 7-1949 "68" "67" "66" "65" "64" 7-1950 "67" "66" "65" "64" "63" 7-1951 "66" "65" "64" "63" "62" 7-1952 "65" "64" "63" "62" "61" 7-1953 "64" "63" "62" "61" NA 7-1954 "63" "62" "61" NA NA 8-1935 NA NA "60" "59" "58" 8-1936 NA "60" "59" "58" "57" 8-1937 "60" "59" "58" "57" "56" 8-1938 "59" "58" "57" "56" "55" 8-1939 "58" "57" "56" "55" "54" 8-1940 "57" "56" "55" "54" "53" 8-1941 "56" "55" "54" "53" "52" 8-1942 "55" "54" "53" "52" "51" 8-1943 "54" "53" "52" "51" "50" 8-1944 "53" "52" "51" "50" "49" 8-1945 "52" "51" "50" "49" "48" 8-1946 "51" "50" "49" "48" "47" 8-1947 "50" "49" "48" "47" "46" 8-1948 "49" "48" "47" "46" "45" 8-1949 "48" "47" "46" "45" "44" 8-1950 "47" "46" "45" "44" "43" 8-1951 "46" "45" "44" "43" "42" 8-1952 "45" "44" "43" "42" "41" 8-1953 "44" "43" "42" "41" NA 8-1954 "43" "42" "41" NA NA 9-1935 NA NA "40" "39" "38" 9-1936 NA "40" "39" "38" "37" 9-1937 "40" "39" "38" "37" "36" 9-1938 "39" "38" "37" "36" "35" 9-1939 "38" "37" "36" "35" "34" 9-1940 "37" "36" "35" "34" "33" 9-1941 "36" "35" "34" "33" "32" 9-1942 "35" "34" "33" "32" "31" 9-1943 "34" "33" "32" "31" "30" 9-1944 "33" "32" "31" "30" "29" 9-1945 "32" "31" "30" "29" "28" 9-1946 "31" "30" "29" "28" "27" 9-1947 "30" "29" "28" "27" "26" 9-1948 "29" "28" "27" "26" "25" 9-1949 "28" "27" "26" "25" "24" 9-1950 "27" "26" "25" "24" "23" 9-1951 "26" "25" "24" "23" "22" 9-1952 "25" "24" "23" "22" "21" 9-1953 "24" "23" "22" "21" NA 9-1954 "23" "22" "21" NA NA 10-1935 NA NA "20" "19" "18" 10-1936 NA "20" "19" "18" "17" 10-1937 "20" "19" "18" "17" "16" 10-1938 "19" "18" "17" "16" "15" 10-1939 "18" "17" "16" "15" "14" 10-1940 "17" "16" "15" "14" "13" 10-1941 "16" "15" "14" "13" "12" 10-1942 "15" "14" "13" "12" "11" 10-1943 "14" "13" "12" "11" "10" 10-1944 "13" "12" "11" "10" "9" 10-1945 "12" "11" "10" "9" "8" 10-1946 "11" "10" "9" "8" "7" 10-1947 "10" "9" "8" "7" "6" 10-1948 "9" "8" "7" "6" "5" 10-1949 "8" "7" "6" "5" "4" 10-1950 "7" "6" "5" "4" "3" 10-1951 "6" "5" "4" "3" "2" 10-1952 "5" "4" "3" "2" "1" 10-1953 "4" "3" "2" "1" NA 10-1954 "3" "2" "1" NA NA > > # other data set (different time periods) > # Hedonic is an unbalanced panel, townid is the individual index > data("Hedonic", package = "plm") > Hed <- pdata.frame(Hedonic, index = "townid") > head(Hed$age, 20) 1-1 2-1 2-2 3-1 3-2 3-3 4-1 4-2 65.19995 78.89996 61.09998 45.79999 54.19998 58.69998 66.59998 96.09998 4-3 4-4 4-5 4-6 4-7 5-1 5-2 5-3 100.00000 85.89996 94.29999 82.89996 39.00000 61.79999 84.50000 56.50000 5-4 5-5 5-6 5-7 29.29999 81.69995 36.59998 69.50000 > head(plm:::lagr.pseries(Hed$age), 20) 1-1 2-1 2-2 3-1 3-2 3-3 4-1 4-2 NA NA 78.89996 NA 45.79999 54.19998 NA 66.59998 4-3 4-4 4-5 4-6 4-7 5-1 5-2 5-3 96.09998 100.00000 85.89996 94.29999 82.89996 NA 61.79999 84.50000 5-4 5-5 5-6 5-7 56.50000 29.29999 81.69995 36.59998 > head(plm:::lagr.pseries(Hed$age, c(0,1,2)), 20) 0 1 2 1-1 65.19995 NA NA 2-1 78.89996 NA NA 2-2 61.09998 78.89996 NA 3-1 45.79999 NA NA 3-2 54.19998 45.79999 NA 3-3 58.69998 54.19998 45.79999 4-1 66.59998 NA NA 4-2 96.09998 66.59998 NA 4-3 100.00000 96.09998 66.59998 4-4 85.89996 100.00000 96.09998 4-5 94.29999 85.89996 100.00000 4-6 82.89996 94.29999 85.89996 4-7 39.00000 82.89996 94.29999 5-1 61.79999 NA NA 5-2 84.50000 61.79999 NA 5-3 56.50000 84.50000 61.79999 5-4 29.29999 56.50000 84.50000 5-5 81.69995 29.29999 56.50000 5-6 36.59998 81.69995 29.29999 5-7 69.50000 36.59998 81.69995 > if (!isTRUE(all.equal(plm:::lagr.pseries(Hed$age, c(0,1,2,3,4,5)), plm:::leadr.pseries(Hed$age, -1*c(0,1,2,3,4,5)), check.attributes = FALSE))) stop("'plm:::lagr.pseries( , 1)' not equal to 'plm:::leadr.pseries , -1)'") > > > > # diff > if (!isTRUE(all.equal(diff(Grunfeld$inv), Grunfeld$inv - plm:::lagr.pseries(Grunfeld$inv)))) stop("'diff()' not corresponding to differences with 'plm:::lagr.pseries()'") > if (!isTRUE(all.equal(diff(Grunfeld$inv, 2), Grunfeld$inv - plm:::lagr.pseries(Grunfeld$inv, 2)))) stop("'diff( , 2)' not corresponding to differences with 'plm:::lagr.pseries( , 2)'") > > > > ############## (4) test with non-consecutive time periods #### > # this is to demonstrate the behaviour of lagr for non-consecutive data > # > data("Grunfeld", package = "plm") > > pGrunfeld_missing_period <- pdata.frame(Grunfeld[-2, ]) # delete one time period of first individual (1-1936 is missing (not NA)) > > is.pconsecutive(pGrunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > head(pGrunfeld_missing_period$inv, 25) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 317.6 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 561.2 688.1 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 568.9 529.2 555.1 642.9 755.9 891.2 1304.4 1486.7 209.9 355.3 469.9 2-1938 2-1939 2-1940 262.3 230.4 361.6 > head(test_Grun_miss_p_lag1 <- plm:::lagr.pseries(pGrunfeld_missing_period$inv), 25) # correct: additional NA for the missing time period is introduced at 1-1937 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 561.2 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 688.1 568.9 529.2 555.1 642.9 755.9 891.2 1304.4 NA 209.9 355.3 2-1938 2-1939 2-1940 469.9 262.3 230.4 > head(plm:::lagr.pseries(pGrunfeld_missing_period$inv, 2), 25) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA NA NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 547.5 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 561.2 688.1 568.9 529.2 555.1 642.9 755.9 891.2 NA NA 209.9 2-1938 2-1939 2-1940 355.3 469.9 262.3 > head(test_Grun_miss_p_lag3 <- plm:::lagr.pseries(pGrunfeld_missing_period$inv, 3), 25) # 1-1938 is NA for lagr (for lagt non-NA (former 1-1935: 317.6) 1-1935 1-1937 1-1938 1-1939 1-1940 1-1941 1-1942 1-1943 1-1944 1-1945 1-1946 NA NA NA NA 410.6 257.7 330.8 461.2 512.0 448.0 499.6 1-1947 1-1948 1-1949 1-1950 1-1951 1-1952 1-1953 1-1954 2-1935 2-1936 2-1937 547.5 561.2 688.1 568.9 529.2 555.1 642.9 755.9 NA NA NA 2-1938 2-1939 2-1940 209.9 355.3 469.9 > > > # with different data set > data("Hedonic", package = "plm") > Hed_missing_period <- pdata.frame(Hedonic, index = "townid") > Hed_missing_period <- as.data.frame(Hed_missing_period) > Hed_missing_period <- Hed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 > Hed_missing_period <- pdata.frame(Hed_missing_period, index = c("townid", "time")) > > is.pconsecutive(Hed_missing_period) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > head(Hed_missing_period$age, 20) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 65.19995 78.89996 61.09998 45.79999 58.69998 66.59998 96.09998 100.00000 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 85.89996 82.89996 39.00000 61.79999 84.50000 56.50000 29.29999 81.69995 5-6 5-7 5-8 5-9 36.59998 69.50000 98.09998 89.19995 > head(test_Hed_miss_p_lag1 <- plm:::lagr.pseries(Hed_missing_period$age), 20) # correct: plm:::lagr.pseries(, 1): additional NAs introduced at (among others) 3-3 and 4-6 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA 78.89996 NA NA NA 66.59998 96.09998 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 100.00000 NA 82.89996 NA 61.79999 84.50000 56.50000 29.29999 5-6 5-7 5-8 5-9 81.69995 36.59998 69.50000 98.09998 > head(test_Hed_miss_p_lag2 <- plm:::lagr.pseries(Hed_missing_period$age, 2), 20) # plm:::lagr.pseries(, 2): 4-6 is NA (for lagt non-NA (former 4-4: 85.89996) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA NA NA NA 66.59998 4-4 4-6 4-7 5-1 5-2 5-3 5-4 5-5 96.09998 NA NA NA NA 61.79999 84.50000 56.50000 5-6 5-7 5-8 5-9 29.29999 81.69995 36.59998 69.50000 > # 3-3 is NA (for lagt non-NA (former 3-1: 45.79999)) > > head(plm:::lagr.pseries(Hed_missing_period$age, c(0,1,2)), 20) # view all at once 0 1 2 1-1 65.19995 NA NA 2-1 78.89996 NA NA 2-2 61.09998 78.89996 NA 3-1 45.79999 NA NA 3-3 58.69998 NA NA 4-1 66.59998 NA NA 4-2 96.09998 66.59998 NA 4-3 100.00000 96.09998 66.59998 4-4 85.89996 100.00000 96.09998 4-6 82.89996 NA NA 4-7 39.00000 82.89996 NA 5-1 61.79999 NA NA 5-2 84.50000 61.79999 NA 5-3 56.50000 84.50000 61.79999 5-4 29.29999 56.50000 84.50000 5-5 81.69995 29.29999 56.50000 5-6 36.59998 81.69995 29.29999 5-7 69.50000 36.59998 81.69995 5-8 98.09998 69.50000 36.59998 5-9 89.19995 98.09998 69.50000 > > > ##### delete two consecutive time periods > data("Hedonic", package = "plm") > Hed_missing_period2 <- pdata.frame(Hedonic, index = "townid") > Hed_missing_period2 <- as.data.frame(Hed_missing_period2) > Hed_missing_period2 <- Hed_missing_period2[-c(5,11,12), ] # delete 3-2, 4-5, 4-6 > Hed_missing_period2 <- pdata.frame(Hed_missing_period2, index = c("townid", "time")) > > is.pconsecutive(Hed_missing_period2) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > head(Hed_missing_period2$age, 20) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 65.19995 78.89996 61.09998 45.79999 58.69998 66.59998 96.09998 100.00000 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 85.89996 39.00000 61.79999 84.50000 56.50000 29.29999 81.69995 36.59998 5-7 5-8 5-9 5-10 69.50000 98.09998 89.19995 91.69995 > head(test_Hed_miss2_p_lag1 <- plm:::lagr.pseries(Hed_missing_period2$age), 20) # correct: plm:::lagr.pseries(, 1): additional NAs introduced at 3-3 and 4-6 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA 78.89996 NA NA NA 66.59998 96.09998 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 100.00000 NA NA 61.79999 84.50000 56.50000 29.29999 81.69995 5-7 5-8 5-9 5-10 36.59998 69.50000 98.09998 89.19995 > head(test_Hed_miss2_p_lag2 <- plm:::lagr.pseries(Hed_missing_period2$age, 2), 20) # 3-3 is NA (for lagt former 3-1 (45.79999)) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA NA NA NA 66.59998 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 96.09998 NA NA NA 61.79999 84.50000 56.50000 29.29999 5-7 5-8 5-9 5-10 81.69995 36.59998 69.50000 98.09998 > head(test_Hed_miss2_p_lag3 <- plm:::lagr.pseries(Hed_missing_period2$age, 3), 20) # 4-7 is NA (for lagt former 4-4 (85.89996)) 1-1 2-1 2-2 3-1 3-3 4-1 4-2 4-3 NA NA NA NA NA NA NA NA 4-4 4-7 5-1 5-2 5-3 5-4 5-5 5-6 66.59998 NA NA NA NA 61.79999 84.50000 56.50000 5-7 5-8 5-9 5-10 29.29999 81.69995 36.59998 69.50000 > head(plm:::lagr.pseries(Hed_missing_period2$age, c(0,1,2,3)), 20) # view all at once 0 1 2 3 1-1 65.19995 NA NA NA 2-1 78.89996 NA NA NA 2-2 61.09998 78.89996 NA NA 3-1 45.79999 NA NA NA 3-3 58.69998 NA NA NA 4-1 66.59998 NA NA NA 4-2 96.09998 66.59998 NA NA 4-3 100.00000 96.09998 66.59998 NA 4-4 85.89996 100.00000 96.09998 66.59998 4-7 39.00000 NA NA NA 5-1 61.79999 NA NA NA 5-2 84.50000 61.79999 NA NA 5-3 56.50000 84.50000 61.79999 NA 5-4 29.29999 56.50000 84.50000 61.79999 5-5 81.69995 29.29999 56.50000 84.50000 5-6 36.59998 81.69995 29.29999 56.50000 5-7 69.50000 36.59998 81.69995 29.29999 5-8 98.09998 69.50000 36.59998 81.69995 5-9 89.19995 98.09998 69.50000 36.59998 5-10 91.69995 89.19995 98.09998 69.50000 > > > ############## messy data set with lots of NAs ############ > #### commented because it needs several extra packages and loads data from the internet > # library(haven) > # > # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") > # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) > # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) > # > # > # ### on a consecutive pdata.frame, plm:::lagr and plm:::lagt should yield same results (if no NA in id or time) > # pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) > # pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) > # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8, balanced = TRUE) > # > # if (!all.equal(plm::lagr.pseries(pnlswork_r8_consec$age), plm:::lagt.pseries(pnlswork_r8_consec$age))) > # stop("lagr and lagt not same on consecutive data.frame (but must be!)") > # > # if (!all.equal(plm:::lagr.pseries(pnlswork_r8_consec_bal$age), plm:::lagt.pseries(pnlswork_r8_consec_bal$age))) > # stop("lagr and lagt not same on consecutive data.frame (but must be!)") > > > > proc.time() user system elapsed 3.67 0.42 4.26 plm/inst/tests/test_transformations_collapse.R0000644000176200001440000015074014155212216021464 0ustar liggesusers## Tests equivalence of collapse to base-R version of transformation functions ## B/between, Within, Sum. ## Run tests only if package 'collapse', 'fixest', and 'lfe' are available ## (as they are 'Suggests' dependencies) collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE fixest.avail <- if (!requireNamespace("fixest", quietly = TRUE)) FALSE else TRUE lfe.avail <- if (!requireNamespace("lfe", quietly = TRUE)) FALSE else TRUE if(collapse.avail && fixest.avail && lfe.avail) { # data library("plm") # library("collapse") #### set up test input data #### data("wlddev", package = "collapse") class(wlddev) pwlddev <- pdata.frame(wlddev, index = c("iso3c", "year")) PCGDP <- pwlddev$PCGDP LIFEEX <- pwlddev$LIFEEX rm.rows <- c(1:10,50:88, 1000:1030, 10000:10111) pwlddev_unbal <-pwlddev[-rm.rows, ] LIFEEX_unbal <- pwlddev_unbal[ , "LIFEEX"] l.na <- is.na(LIFEEX_unbal) LIFEEX_unbal_wona <- LIFEEX_unbal[!l.na] i <- index(LIFEEX_unbal)[!l.na, ] LIFEEX_unbal_wona <- plm:::add_pseries_features(LIFEEX_unbal_wona, i) mat <- as.matrix(wlddev[ , 8:12]) attr(mat, "index") <- index(pwlddev) mat_unbal <- as.matrix(wlddev[-rm.rows , 8:12]) attr(mat_unbal, "index") <- index(pwlddev_unbal) mat_noindex <- mat attr(mat_noindex, "index") <- NULL mat_index <- attr(mat, "index") mat_noindex_unbal <- mat[-rm.rows , ] attr(mat_noindex_unbal, "index") <- NULL mat_index_unbal <- attr(mat, "index")[-rm.rows, ] ## NB: mat_index_unbal has 215 entries but 216 levels for individual dimension ## -> by intention, for corner case check in between when no index matrix is used # length(unique(mat_index_unbal[[1]])) 215 # length(levels(mat_index_unbal[[1]])) # 216 wlddev_unbal_wona <- na.omit(wlddev[ , 8:12]) mat_unbal_wona <- as.matrix(wlddev_unbal_wona) attr(mat_unbal_wona, "index") <- index(pwlddev[-attr(wlddev_unbal_wona, "na.action"), ]) wlddev_bal_wona <- na.omit(wlddev[wlddev$iso3c %in% c("ARG", "BLR", "CHN", "COL") , c(2, 4, 8:12)]) pwlddev_bal_wona <- pdata.frame(wlddev_bal_wona, index = c("iso3c", "year")) pwlddev_bal_wona <- make.pbalanced(pwlddev_bal_wona, balance.type = "shared.times") pdim(pwlddev_bal_wona) mat_bal_wona <- as.matrix(pwlddev_bal_wona[ , 3:7]) attr(mat_bal_wona, "index") <- index(pwlddev_bal_wona) #### Sum - default #### # individual options("plm.fast" = FALSE) S1_d_ind <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default S1_d_ind_narm <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) S1_d_ind_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default S1_d_ind_narm_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) S2_d_ind_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default S2_d_ind_narm_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) S2_d_ind <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default S2_d_ind_narm <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_d_ind, S2_d_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ind_narm, S2_d_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ind_unbal, S2_d_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ind_narm_unbal, S2_d_ind_narm_unbal, check.attributes = TRUE))) # TRUE rm( S1_d_ind, S2_d_ind, S1_d_ind_narm, S2_d_ind_narm, S1_d_ind_unbal, S2_d_ind_unbal, S1_d_ind_narm_unbal, S2_d_ind_narm_unbal) # time options("plm.fast" = FALSE) S1_d_ti <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default S1_d_ti_narm <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) S1_d_ti_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default S1_d_ti_narm_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) S2_d_ti <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default S2_d_ti_narm <- plm:::Sum.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) S2_d_ti_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default S2_d_ti_narm_unbal <- plm:::Sum.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_d_ti, S2_d_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ti_narm, S2_d_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ti_unbal, S2_d_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_d_ti_narm_unbal, S2_d_ti_narm_unbal, check.attributes = TRUE))) # TRUE # be gentle with the memory rm( S1_d_ti, S2_d_ti, S1_d_ti_narm, S2_d_ti_narm, S1_d_ti_unbal, S2_d_ti_unbal, S1_d_ti_narm_unbal, S2_d_ti_narm_unbal) #### Sum - pseries #### # individual options("plm.fast" = FALSE) S1_ind <- plm:::Sum.pseries(LIFEEX, effect = "individual") # default S1_ind_narm <- plm:::Sum.pseries(LIFEEX, effect = "individual", na.rm = TRUE) S1_ind_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "individual") # default S1_ind_narm_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) options("plm.fast" = TRUE) S2_ind <- plm:::Sum.pseries(LIFEEX, effect = "individual") # default S2_ind_narm <- plm:::Sum.pseries(LIFEEX, effect = "individual", na.rm = TRUE) S2_ind_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "individual") # default S2_ind_narm_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_ind, S2_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ind_narm, S2_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ind_unbal, S2_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ind_narm_unbal, S2_ind_narm_unbal, check.attributes = TRUE))) # TRUE rm( S1_ind, S2_ind, S1_ind_narm, S2_ind_narm, S1_ind_unbal, S2_ind_unbal, S1_ind_narm_unbal, S2_ind_narm_unbal) # time options("plm.fast" = FALSE) S1_ti <- plm:::Sum.pseries(LIFEEX, effect = "time") # default S1_ti_narm <- plm:::Sum.pseries(LIFEEX, effect = "time", na.rm = TRUE) S1_ti_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "time") # default S1_ti_narm_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) options("plm.fast" = TRUE) S2_ti <- plm:::Sum.pseries(LIFEEX, effect = "time") # default S2_ti_narm <- plm:::Sum.pseries(LIFEEX, effect = "time", na.rm = TRUE) S2_ti_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "time") # default S2_ti_narm_unbal <- plm:::Sum.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_ti, S2_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ti_narm, S2_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ti_unbal, S2_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_ti_narm_unbal, S2_ti_narm_unbal, check.attributes = TRUE))) # TRUE rm( S1_ti, S2_ti, S1_ti_narm, S2_ti_narm, S1_ti_unbal, S2_ti_unbal, S1_ti_narm_unbal, S2_ti_narm_unbal) #### Sum - matrix #### # individual options("plm.fast" = FALSE) S1_mat_ind <- plm:::Sum.matrix(mat, effect = "individual") # default S1_mat_ind_narm <- plm:::Sum.matrix(mat, effect = "individual", na.rm = TRUE) S1_mat_no_index_ind <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[1L]]) # default S1_mat_no_index_ind_narm <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) S1_mat_ind_unbal <- plm:::Sum.matrix(mat_unbal, effect = "individual") # default S1_mat_ind_narm_unbal <- plm:::Sum.matrix(mat_unbal, effect = "individual", na.rm = TRUE) S1_mat_no_index_ind_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default S1_mat_no_index_ind_narm_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) S2_mat_ind <- plm:::Sum.matrix(mat, effect = "individual") # default S2_mat_ind_narm <- plm:::Sum.matrix(mat, effect = "individual", na.rm = TRUE) S2_mat_no_index_ind <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[1L]]) # default S2_mat_no_index_ind_narm <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) S2_mat_ind_unbal <- plm:::Sum.matrix(mat_unbal, effect = "individual") # default S2_mat_ind_narm_unbal <- plm:::Sum.matrix(mat_unbal, effect = "individual", na.rm = TRUE) S2_mat_no_index_ind_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default S2_mat_no_index_ind_narm_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_mat_ind, S2_mat_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ind_narm, S2_mat_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ind_unbal, S2_mat_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ind_narm_unbal, S2_mat_ind_narm_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ind, S2_mat_no_index_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ind_narm, S2_mat_no_index_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ind_unbal, S2_mat_no_index_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ind_narm_unbal, S2_mat_no_index_ind_narm_unbal, check.attributes = TRUE))) # TRUE # time options("plm.fast" = FALSE) S1_mat_ti <- plm:::Sum.matrix(mat, effect = "time") # default S1_mat_ti_narm <- plm:::Sum.matrix(mat, effect = "time", na.rm = TRUE) S1_mat_no_index_ti <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[2L]]) # default S1_mat_no_index_ti_narm <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) S1_mat_ti_unbal <- plm:::Sum.matrix(mat_unbal, effect = "time") # default S1_mat_ti_narm_unbal <- plm:::Sum.matrix(mat_unbal, effect = "time", na.rm = TRUE) S1_mat_no_index_ti_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default S1_mat_no_index_ti_narm_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) S2_mat_ti <- plm:::Sum.matrix(mat, effect = "time") # default S2_mat_ti_narm <- plm:::Sum.matrix(mat, effect = "time", na.rm = TRUE) S2_mat_no_index_ti <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[2L]]) # default S2_mat_no_index_ti_narm <- plm:::Sum.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) S2_mat_ti_unbal <- plm:::Sum.matrix(mat_unbal, effect = "time") # default S2_mat_ti_narm_unbal <- plm:::Sum.matrix(mat_unbal, effect = "time", na.rm = TRUE) S2_mat_no_index_ti_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default S2_mat_no_index_ti_narm_unbal <- plm:::Sum.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(S1_mat_ti, S2_mat_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ti_narm, S2_mat_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ti, S2_mat_no_index_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ti_narm, S2_mat_no_index_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ti_unbal, S2_mat_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_ti_narm_unbal, S2_mat_ti_narm_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ti_unbal, S2_mat_no_index_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(S1_mat_no_index_ti_narm_unbal, S2_mat_no_index_ti_narm_unbal, check.attributes = TRUE))) # TRUE #### between/Between - default #### # individual options("plm.fast" = FALSE) b1_d_ind <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default b1_d_ind_narm <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) b1_d_ind_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default b1_d_ind_narm_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) B1_d_ind <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default B1_d_ind_narm <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) B1_d_ind_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default B1_d_ind_narm_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) b2_d_ind <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default b2_d_ind_narm <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) B2_d_ind <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) # default B2_d_ind_narm <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) b2_d_ind_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default b2_d_ind_narm_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) B2_d_ind_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) # default B2_d_ind_narm_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_d_ind, b2_d_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ind_narm, b2_d_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ind_unbal, b2_d_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ind_narm_unbal, b2_d_ind_narm_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ind, B2_d_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ind_narm, B2_d_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ind_unbal, B2_d_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ind_narm_unbal, B2_d_ind_narm_unbal, check.attributes = TRUE))) # TRUE # time options("plm.fast" = FALSE) b1_d_ti <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default b1_d_ti_narm <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) b1_d_ti_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default b1_d_ti_narm_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) B1_d_ti <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default B1_d_ti_narm <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) B1_d_ti_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default B1_d_ti_narm_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) b2_d_ti <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default b2_d_ti_narm <- plm:::between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) b2_d_ti_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default b2_d_ti_narm_unbal <- plm:::between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) B2_d_ti <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) # default B2_d_ti_narm <- plm:::Between.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) B2_d_ti_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) # default B2_d_ti_narm_unbal <- plm:::Between.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_d_ti, b2_d_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ti_narm, b2_d_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ti_unbal, b2_d_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_d_ti_narm_unbal, b2_d_ti_narm_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ti, B2_d_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ti_narm, B2_d_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ti_unbal, B2_d_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_d_ti_narm_unbal, B2_d_ti_narm_unbal, check.attributes = TRUE))) # TRUE #### between/Between - pseries #### options("plm.fast" = FALSE) b1_ind <- plm:::between.pseries(LIFEEX, effect = "individual") # default b1_ind_narm <- plm:::between.pseries(LIFEEX, effect = "individual", na.rm = TRUE) b1_ind_unbal <- plm:::between.pseries(LIFEEX_unbal, effect = "individual") # default b1_ind_unbal_narm <- plm:::between.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) B1_ind <- plm:::Between.pseries(LIFEEX, effect = "individual") # default B1_ind_narm <- plm:::Between.pseries(LIFEEX, effect = "individual", na.rm = TRUE) B1_ind_unbal <- plm:::Between.pseries(LIFEEX_unbal, effect = "individual") # default B1_ind_unbal_narm <- plm:::Between.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) options("plm.fast" = TRUE) b2_ind <- plm:::between.pseries(LIFEEX, effect = "individual") b2_ind_narm <- plm:::between.pseries(LIFEEX, effect = "individual", na.rm = TRUE) b2_ind_unbal <- plm:::between.pseries(LIFEEX_unbal, effect = "individual") b2_ind_unbal_narm <- plm:::between.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) B2_ind <- plm:::Between.pseries(LIFEEX, effect = "individual") B2_ind_narm <- plm:::Between.pseries(LIFEEX, effect = "individual", na.rm = TRUE) B2_ind_unbal <- plm:::Between.pseries(LIFEEX_unbal, effect = "individual") B2_ind_unbal_narm <- plm:::Between.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_ind, b2_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ind_narm, b2_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ind, B2_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ind_narm, B2_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ind_unbal, b2_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ind_unbal_narm, b2_ind_unbal_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ind_unbal, B2_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ind_unbal_narm, B2_ind_unbal_narm, check.attributes = TRUE))) # TRUE # time options("plm.fast" = FALSE) b1_ti <- plm:::between.pseries(LIFEEX, effect = "time") # default b1_ti_narm <- plm:::between.pseries(LIFEEX, effect = "time", na.rm = TRUE) b1_ti_unbal <- plm:::between.pseries(LIFEEX_unbal, effect = "time") # default b1_ti_unbal_narm <- plm:::between.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) B1_ti <- plm:::Between.pseries(LIFEEX, effect = "time") # default B1_ti_narm <- plm:::Between.pseries(LIFEEX, effect = "time", na.rm = TRUE) B1_ti_unbal <- plm:::Between.pseries(LIFEEX_unbal, effect = "time") # default B1_ti_unbal_narm <- plm:::Between.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) options("plm.fast" = TRUE) b2_ti <- plm:::between.pseries(LIFEEX, effect = "time") b2_ti_narm <- plm:::between.pseries(LIFEEX, effect = "time", na.rm = TRUE) b2_ti_unbal <- plm:::between.pseries(LIFEEX_unbal, effect = "time") b2_ti_unbal_narm <- plm:::between.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) B2_ti <- plm:::Between.pseries(LIFEEX, effect = "time") B2_ti_narm <- plm:::Between.pseries(LIFEEX, effect = "time", na.rm = TRUE) B2_ti_unbal <- plm:::Between.pseries(LIFEEX_unbal, effect = "time") B2_ti_unbal_narm <- plm:::Between.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_ti, b2_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ti_narm, b2_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ti, B2_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ti_narm, B2_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ti_unbal, b2_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_ti_unbal_narm, b2_ti_unbal_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ti_unbal, B2_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_ti_unbal_narm, B2_ti_unbal_narm, check.attributes = TRUE))) # TRUE #### between/Between - matrix #### # individual options("plm.fast" = FALSE) b1_mat_ind <- plm:::between.matrix(mat, effect = "individual") # default b1_mat_ind_narm <- plm:::between.matrix(mat, effect = "individual", na.rm = TRUE) b1_mat_unbal_ind <- plm:::between.matrix(mat_unbal, effect = "individual") # default b1_mat_unbal_ind_narm <- plm:::between.matrix(mat_unbal, effect = "individual", na.rm = TRUE) b1_mat_noindex_ind <- plm:::between.matrix(mat_noindex, effect = mat_index[[1L]]) # default b1_mat_noindex_ind_narm <- plm:::between.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) b1_mat_noindex_unbal_ind <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default b1_mat_noindex_unbal_ind_narm <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) B1_mat_ind <- plm:::Between.matrix(mat, effect = "individual") # default B1_mat_ind_narm <- plm:::Between.matrix(mat, effect = "individual", na.rm = TRUE) B1_mat_unbal_ind <- plm:::Between.matrix(mat_unbal, effect = "individual") # default B1_mat_unbal_ind_narm <- plm:::Between.matrix(mat_unbal, effect = "individual", na.rm = TRUE) B1_mat_noindex_ind <- plm:::Between.matrix(mat_noindex, effect = mat_index[[1L]]) # default B1_mat_noindex_ind_narm <- plm:::Between.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) B1_mat_noindex_unbal_ind <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default B1_mat_noindex_unbal_ind_narm <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) b2_mat_ind <- plm:::between.matrix(mat, effect = "individual") b2_mat_ind_narm <- plm:::between.matrix(mat, effect = "individual", na.rm = TRUE) b2_mat_unbal_ind <- plm:::between.matrix(mat_unbal, effect = "individual") b2_mat_unbal_ind_narm <- plm:::between.matrix(mat_unbal, effect = "individual", na.rm = TRUE) b2_mat_noindex_ind <- plm:::between.matrix(mat_noindex, effect = mat_index[[1L]]) # default b2_mat_noindex_ind_narm <- plm:::between.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) b2_mat_noindex_unbal_ind <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default b2_mat_noindex_unbal_ind_narm <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) B2_mat_ind <- plm:::Between.matrix(mat, effect = "individual") B2_mat_ind_narm <- plm:::Between.matrix(mat, effect = "individual", na.rm = TRUE) B2_mat_unbal_ind <- plm:::Between.matrix(mat_unbal, effect = "individual") B2_mat_unbal_ind_narm <- plm:::Between.matrix(mat_unbal, effect = "individual", na.rm = TRUE) B2_mat_noindex_ind <- plm:::Between.matrix(mat_noindex, effect = mat_index[[1L]]) # default B2_mat_noindex_ind_narm <- plm:::Between.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) B2_mat_noindex_unbal_ind <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default B2_mat_noindex_unbal_ind_narm <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_mat_ind, b2_mat_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_ind_narm, b2_mat_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_ind, B2_mat_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_ind_narm, B2_mat_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_ind, b2_mat_noindex_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_ind_narm, b2_mat_noindex_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_ind, B2_mat_noindex_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_ind_narm, B2_mat_noindex_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_unbal_ind, b2_mat_unbal_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_unbal_ind_narm, b2_mat_unbal_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_unbal_ind, B2_mat_unbal_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_unbal_ind_narm, B2_mat_unbal_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_unbal_ind, b2_mat_noindex_unbal_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_unbal_ind_narm, b2_mat_noindex_unbal_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_unbal_ind, B2_mat_noindex_unbal_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_unbal_ind_narm, B2_mat_noindex_unbal_ind_narm, check.attributes = TRUE))) # TRUE # time options("plm.fast" = FALSE) b1_mat_ti <- plm:::between.matrix(mat, effect = "time") # default b1_mat_ti_narm <- plm:::between.matrix(mat, effect = "time", na.rm = TRUE) b1_mat_noindex_ti <- plm:::between.matrix(mat_noindex, effect = mat_index[[2L]]) # default b1_mat_noindex_ti_narm <- plm:::between.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) B1_mat_ti <- plm:::Between.matrix(mat, effect = "time") # default B1_mat_ti_narm <- plm:::Between.matrix(mat, effect = "time", na.rm = TRUE) B1_mat_noindex_ti <- plm:::Between.matrix(mat_noindex, effect = mat_index[[2L]]) # default B1_mat_noindex_ti_narm <- plm:::Between.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) b2_mat_ti <- plm:::between.matrix(mat, effect = "time") b2_mat_ti_narm <- plm:::between.matrix(mat, effect = "time", na.rm = TRUE) b2_mat_noindex_ti <- plm:::between.matrix(mat_noindex, effect = mat_index[[2L]]) # default b2_mat_noindex_ti_narm <- plm:::between.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) B2_mat_ti <- plm:::Between.matrix(mat, effect = "time") B2_mat_ti_narm <- plm:::Between.matrix(mat, effect = "time", na.rm = TRUE) B2_mat_noindex_ti <- plm:::Between.matrix(mat_noindex, effect = mat_index[[2L]]) # default B2_mat_noindex_ti_narm <- plm:::Between.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_mat_ti, b2_mat_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_ti_narm, b2_mat_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_ti, B2_mat_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_ti_narm, B2_mat_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_ti, b2_mat_noindex_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_ti_narm, b2_mat_noindex_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_ti, B2_mat_noindex_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_ti_narm, B2_mat_noindex_ti_narm, check.attributes = TRUE))) # TRUE # time unbalanced options("plm.fast" = FALSE) b1_mat_unbal_ti <- plm:::between.matrix(mat_unbal, effect = "time") # default b1_mat_unbal_ti_narm <- plm:::between.matrix(mat_unbal, effect = "time", na.rm = TRUE) b1_mat_noindex_unbal_ti <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default b1_mat_noindex_unbal_ti_narm <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) B1_mat_unbal_ti <- plm:::Between.matrix(mat_unbal, effect = "time") # default B1_mat_unbal_ti_narm <- plm:::Between.matrix(mat_unbal, effect = "time", na.rm = TRUE) B1_mat_noindex_unbal_ti <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default B1_mat_noindex_unbal_ti_narm <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) b2_mat_unbal_ti <- plm:::between.matrix(mat_unbal, effect = "time") b2_mat_unbal_ti_narm <- plm:::between.matrix(mat_unbal, effect = "time", na.rm = TRUE) b2_mat_noindex_unbal_ti <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default b2_mat_noindex_unbal_ti_narm <- plm:::between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) B2_mat_unbal_ti <- plm:::Between.matrix(mat_unbal, effect = "time") B2_mat_unbal_ti_narm <- plm:::Between.matrix(mat_unbal, effect = "time", na.rm = TRUE) B2_mat_noindex_unbal_ti <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default B2_mat_noindex_unbal_ti_narm <- plm:::Between.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(b1_mat_unbal_ti, b2_mat_unbal_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_unbal_ti_narm, b2_mat_unbal_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_unbal_ti, B2_mat_unbal_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_unbal_ti_narm, B2_mat_unbal_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_unbal_ti, b2_mat_noindex_unbal_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(b1_mat_noindex_unbal_ti_narm, b2_mat_noindex_unbal_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_unbal_ti, B2_mat_noindex_unbal_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(B1_mat_noindex_unbal_ti_narm, B2_mat_noindex_unbal_ti_narm, check.attributes = TRUE))) # TRUE #### within - default #### # individual (balanced + unbalanced) options("plm.fast" = FALSE) W1_d_ind <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) W1_d_ind_narm <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) W1_d_ind_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) W1_d_ind_narm_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_d_ind <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]]) W2_d_ind_narm <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[1L]], na.rm = TRUE) W2_d_ind_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]]) W2_d_ind_narm_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_d_ind, W2_d_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ind_narm, W2_d_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ind_unbal, W2_d_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ind_narm_unbal, W2_d_ind_narm_unbal, check.attributes = TRUE))) # TRUE # time (balanced + unbalanced) options("plm.fast" = FALSE) W1_d_ti <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) W1_d_ti_narm <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) W1_d_ti_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) W1_d_ti_narm_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_d_ti <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]]) W2_d_ti_narm <- plm:::Within.default(as.numeric(LIFEEX), effect = index(LIFEEX)[[2L]], na.rm = TRUE) W2_d_ti_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]]) W2_d_ti_narm_unbal <- plm:::Within.default(as.numeric(LIFEEX_unbal), effect = index(LIFEEX_unbal)[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_d_ti, W2_d_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ti_narm, W2_d_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ti_unbal, W2_d_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_d_ti_narm_unbal, W2_d_ti_narm_unbal, check.attributes = TRUE))) # TRUE # NB: Within.default does not handle twoways effects #### within - pseries #### options("plm.fast" = FALSE) W1_ind <- plm:::Within.pseries(LIFEEX, effect = "individual") # default W1_ind_narm <- plm:::Within.pseries(LIFEEX, effect = "individual", na.rm = TRUE) W1_ind_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "individual") # default W1_ind_narm_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) options("plm.fast" = TRUE) W2_ind <- plm:::Within.pseries(LIFEEX, effect = "individual") W2_ind_narm <- plm:::Within.pseries(LIFEEX, effect = "individual", na.rm = TRUE) W2_ind_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "individual") W2_ind_narm_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "individual", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_ind, W2_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ind_narm, W2_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ind_unbal, W2_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ind_narm_unbal, W2_ind_narm_unbal, check.attributes = TRUE))) # TRUE # time options("plm.fast" = FALSE) W1_ti <- plm:::Within.pseries(LIFEEX, effect = "time") # default W1_ti_narm <- plm:::Within.pseries(LIFEEX, effect = "time", na.rm = TRUE) W1_ti_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "time") # default W1_ti_narm_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) options("plm.fast" = TRUE) W2_ti <- plm:::Within.pseries(LIFEEX, effect = "time") W2_ti_narm <- plm:::Within.pseries(LIFEEX, effect = "time", na.rm = TRUE) W2_ti_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "time") W2_ti_narm_unbal <- plm:::Within.pseries(LIFEEX_unbal, effect = "time", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_ti, W2_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ti_narm, W2_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ti_unbal, W2_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_ti_narm_unbal, W2_ti_narm_unbal, check.attributes = TRUE))) # TRUE # twoways # need to use non-NA data for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) ## so these tests cannot work # options("plm.fast" = FALSE) # W1_tw <- Within.pseries(LIFEEX, effect = "twoways") # default # W1_tw_narm <- Within.pseries(LIFEEX, effect = "twoways", na.rm = TRUE) # options("plm.fast" = TRUE) # W2_tw <- Within.pseries(LIFEEX, effect = "twoways") # W2_tw_narm <- Within.pseries(LIFEEX, effect = "twoways", na.rm = TRUE) # stopifnot(isTRUE(all.equal(W1_tw, W2_tw, check.attributes = TRUE))) # TRUE # stopifnot(isTRUE(all.equal(W1_tw_narm, W2_tw_narm, check.attributes = TRUE))) # TRUE ## but these: options("plm.fast" = FALSE) W1_tw_unbal_wona <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways") # default W1_tw_narm_unbal_wona <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast" = TRUE) options("plm.fast.pkg.FE.tw" = "collapse") W2_tw_unbal_wona_collapse <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways") W2_tw_narm_unbal_wona_collapse <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "fixest") W2_tw_unbal_wona_fixest <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways") W2_tw_narm_unbal_wona_fixest <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "lfe") W2_tw_unbal_wona_lfe <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways") W2_tw_narm_unbal_wona_lfe <- plm:::Within.pseries(LIFEEX_unbal_wona, effect = "twoways", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_tw_unbal_wona, W2_tw_unbal_wona_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_tw_narm_unbal_wona, W2_tw_narm_unbal_wona_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_tw_unbal_wona, W2_tw_unbal_wona_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_tw_narm_unbal_wona, W2_tw_narm_unbal_wona_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_tw_unbal_wona, W2_tw_unbal_wona_lfe, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_tw_narm_unbal_wona, W2_tw_narm_unbal_wona_lfe, check.attributes = TRUE))) # TRUE #### within - matrix #### # individual effect - balanced options("plm.fast" = FALSE) W1_mat_ind <- plm:::Within.matrix(mat, effect = "individual") # default W1_mat_ind_narm <- plm:::Within.matrix(mat, effect = "individual", na.rm = TRUE) W1_mat_no_index_ind <- plm:::Within.matrix(mat_noindex, effect = mat_index[[1L]]) # default W1_mat_no_index_ind_narm <- plm:::Within.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_mat_ind <- plm:::Within.matrix(mat, effect = "individual") W2_mat_ind_narm <- plm:::Within.matrix(mat, effect = "individual", na.rm = TRUE) W2_mat_no_index_ind <- plm:::Within.matrix(mat_noindex, effect = mat_index[[1L]]) # default W2_mat_no_index_ind_narm <- plm:::Within.matrix(mat_noindex, effect = mat_index[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_ind, W2_mat_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_ind_narm, W2_mat_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ind, W2_mat_no_index_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ind_narm, W2_mat_no_index_ind_narm, check.attributes = TRUE))) # TRUE # individual effect - unbalanced options("plm.fast" = FALSE) W1_mat_unbal_ind <- plm:::Within.matrix(mat_unbal, effect = "individual") # default W1_mat_unbal_ind_narm <- plm:::Within.matrix(mat_unbal, effect = "individual", na.rm = TRUE) W1_mat_no_index_ind_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default W1_mat_no_index_ind_narm_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_mat_unbal_ind <- plm:::Within.matrix(mat_unbal, effect = "individual") W2_mat_unbal_ind_narm <- plm:::Within.matrix(mat_unbal, effect = "individual", na.rm = TRUE) W2_mat_no_index_ind_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]]) # default W2_mat_no_index_ind_narm_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[1L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_unbal_ind, W2_mat_unbal_ind, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_ind_narm, W2_mat_unbal_ind_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ind_unbal, W2_mat_no_index_ind_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ind_narm_unbal, W2_mat_no_index_ind_narm_unbal, check.attributes = TRUE))) # TRUE # time effect - balanced options("plm.fast" = FALSE) W1_mat_ti <- plm:::Within.matrix(mat, effect = "time") # default W1_mat_ti_narm <- plm:::Within.matrix(mat, effect = "time", na.rm = TRUE) W1_mat_no_index_ti <- plm:::Within.matrix(mat_noindex, effect = mat_index[[2L]]) # default W1_mat_no_index_ti_narm <- plm:::Within.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_mat_ti <- plm:::Within.matrix(mat, effect = "time") W2_mat_ti_narm <- plm:::Within.matrix(mat, effect = "time", na.rm = TRUE) W2_mat_no_index_ti <- plm:::Within.matrix(mat_noindex, effect = mat_index[[2L]]) # default W2_mat_no_index_ti_narm <- plm:::Within.matrix(mat_noindex, effect = mat_index[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_ti, W2_mat_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_ti_narm, W2_mat_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ti, W2_mat_no_index_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ti_narm, W2_mat_no_index_ti_narm, check.attributes = TRUE))) # TRUE # time effect - unbalanced options("plm.fast" = FALSE) W1_mat_unbal_ti <- plm:::Within.matrix(mat_unbal, effect = "time") # default W1_mat_unbal_ti_narm <- plm:::Within.matrix(mat_unbal, effect = "time", na.rm = TRUE) W1_mat_no_index_ti_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default W1_mat_no_index_ti_unbal_narm <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) options("plm.fast" = TRUE) W2_mat_unbal_ti <- plm:::Within.matrix(mat_unbal, effect = "time") W2_mat_unbal_ti_narm <- plm:::Within.matrix(mat_unbal, effect = "time", na.rm = TRUE) W2_mat_no_index_ti_unbal <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]]) # default W2_mat_no_index_ti_unbal_narm <- plm:::Within.matrix(mat_noindex_unbal, effect = mat_index_unbal[[2L]], na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_unbal_ti, W2_mat_unbal_ti, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_ti_narm, W2_mat_unbal_ti_narm, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ti_unbal, W2_mat_no_index_ti_unbal, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_no_index_ti_unbal_narm, W2_mat_no_index_ti_unbal_narm, check.attributes = TRUE))) # TRUE # twoways - balanced ### (twoways not possible within non-index case (as Within.default does not handle more than one factor) options("plm.fast" = FALSE) W1_mat_tw <- plm:::Within.matrix(mat, effect = "twoways") # default W1_mat_tw_narm <- plm:::Within.matrix(mat, effect = "twoways", na.rm = TRUE) options("plm.fast" = TRUE) options("plm.fast.pkg.FE.tw" = "collapse") W2_mat_tw_collapse <- plm:::Within.matrix(mat, effect = "twoways") W2_mat_tw_narm_collapse <- plm:::Within.matrix(mat, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "fixest") W2_mat_tw_fixest <- plm:::Within.matrix(mat, effect = "twoways") W2_mat_tw_narm_fixest <- plm:::Within.matrix(mat, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "lfe") W2_mat_tw_lfe <- plm:::Within.matrix(mat, effect = "twoways") W2_mat_tw_narm_lfe <- plm:::Within.matrix(mat, effect = "twoways", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_tw, W2_mat_tw_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_tw, W2_mat_tw_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_tw, W2_mat_tw_lfe, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_tw_narm, W2_mat_tw_narm_collapse, check.attributes = TRUE))) # TRUE ## These two do not match as the NA-removal process is too different for the two functions: # stopifnot(isTRUE(all.equal(W1_mat_tw_narm, W2_mat_tw_narm_fixest, check.attributes = TRUE))) # TRUE # stopifnot(isTRUE(all.equal(W1_mat_tw_narm, W2_mat_tw_narm_lfe, check.attributes = TRUE))) # TRUE # but can check fixest vs. lfe: stopifnot(isTRUE(all.equal(W2_mat_tw_narm_fixest, W2_mat_tw_narm_lfe, check.attributes = TRUE))) # TRUE ## -> so use a balanced non-NA matrix instead (almost senseless but tests at least a bit of a test for na.rm = TRUE) options("plm.fast" = FALSE) W1_mat_bal_wona_tw_narm <- plm:::Within.matrix(mat_bal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast" = TRUE) options("plm.fast.pkg.FE.tw" = "collapse") W2_mat_bal_wona_tw_narm_collapse <- plm:::Within.matrix(mat_bal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "fixest") W2_mat_bal_wona_tw_narm_fixest <- plm:::Within.matrix(mat_bal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "lfe") W2_mat_bal_wona_tw_narm_lfe <- plm:::Within.matrix(mat_bal_wona, effect = "twoways", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_bal_wona_tw_narm, W2_mat_bal_wona_tw_narm_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_bal_wona_tw_narm, W2_mat_bal_wona_tw_narm_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_bal_wona_tw_narm, W2_mat_bal_wona_tw_narm_lfe, check.attributes = TRUE))) # TRUE # twoways - unbalanced ## need to use non-NA data in test for plm's original 2-way FE unbalanced transformation (due to lm.fit being used) options("plm.fast" = FALSE) W1_mat_unbal_tw <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways") # default W1_mat_unbal_tw_narm <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast" = TRUE) options("plm.fast.pkg.FE.tw" = "collapse") W2_mat_unbal_tw_collapse <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways") W2_mat_unbal_tw_narm_collapse <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "fixest") W2_mat_unbal_tw_fixest <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways") W2_mat_unbal_tw_narm_fixest <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways", na.rm = TRUE) options("plm.fast.pkg.FE.tw" = "lfe") W2_mat_unbal_tw_lfe <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways") W2_mat_unbal_tw_narm_lfe <- plm:::Within.matrix(mat_unbal_wona, effect = "twoways", na.rm = TRUE) stopifnot(isTRUE(all.equal(W1_mat_unbal_tw, W2_mat_unbal_tw_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_tw_narm, W2_mat_unbal_tw_narm_collapse, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_tw, W2_mat_unbal_tw_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_tw_narm, W2_mat_unbal_tw_narm_fixest, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_tw, W2_mat_unbal_tw_lfe, check.attributes = TRUE))) # TRUE stopifnot(isTRUE(all.equal(W1_mat_unbal_tw_narm, W2_mat_unbal_tw_narm_lfe, check.attributes = TRUE))) # TRUE } ### Endif collapse.avail #### Benchmark #### # library("plm") # library("collapse") # library("microbenchmark") # # rm(list = ls()) # data("wlddev", package = "collapse") # form <- LIFEEX ~ PCGDP + GINI # # # produce big data set (taken from collapse's vignette) # wlddevsmall <- get_vars(wlddev, c("iso3c","year","OECD","PCGDP","LIFEEX","GINI","ODA")) # wlddevsmall$iso3c <- as.character(wlddevsmall$iso3c) # data <- replicate(100, wlddevsmall, simplify = FALSE) # rm(wlddevsmall) # uniquify <- function(x, i) { # x$iso3c <- paste0(x$iso3c, i) # x # } # data <- unlist2d(Map(uniquify, data, as.list(1:100)), idcols = FALSE) # data <- pdata.frame(data, index = c("iso3c", "year")) # pdim(data) # Balanced Panel: n = 21600, T = 59, N = 1274400 // but many NAs # # data <- na.omit(data) # # pdim(data) # Unbalanced Panel: n = 13300, T = 1-31, N = 93900 # # times <- 3 # no. of repetitions for benchmark # # onewayFE <- microbenchmark( # {options("plm.fast" = FALSE); plm(form, data = data, model = "within")}, # {options("plm.fast" = TRUE); plm(form, data = data, model = "within")}, # times = times, unit = "relative") # # onewayRE <- microbenchmark( # {options("plm.fast" = FALSE); plm(form, data = data, model = "random")}, # {options("plm.fast" = TRUE); plm(form, data = data, model = "random")}, # times = times, unit = "relative") # # twowayRE <- microbenchmark( # {options("plm.fast" = FALSE); plm(form, data = data, model = "random", effect = "twoways")}, # {options("plm.fast" = TRUE); plm(form, data = data, model = "random", effect = "twoways")}, # times = times, unit = "relative") # # twowayRE2 <- microbenchmark( # {options("plm.fast" = FALSE); plm(form, data = data, model = "random", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "collapse"); plm(form, data = data, model = "random", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "fixest"); plm(form, data = data, model = "random", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "lfe"); plm(form, data = data, model = "random", effect = "twoways")}, # times = times, unit = "relative") # # twowayFE <- microbenchmark( # {options("plm.fast" = FALSE); plm(form, data = data, model = "within", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "collapse"); plm(form, data = data, model = "within", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "fixest"); plm(form, data = data, model = "within", effect = "twoways")}, # {options("plm.fast" = TRUE, "plm.fast.pkg.FE.tw" = "lfe"); plm(form, data = data, model = "within", effect = "twoways")}, # times = times, unit = "relative") # # summary(onewayFE) # summary(onewayRE) # summary(twowayRE) # summary(twowayRE2) # summary(twowayFE) # # # ## 2-FE unbalanced: collapse vs. lfe # # options("plm.fast" = TRUE) # # bench_2FE_collapse <- microbenchmark( # # plm(form, data = data, model = "within", effect = "twoways"), # # times = 10) # # # # assignInNamespace("Within.pseries", Within.pseries.lfe, envir = as.environment("package:plm")) # # assignInNamespace("Within.matrix", Within.matrix.lfe, envir = as.environment("package:plm")) # # # # bench_2FE_lfe <- microbenchmark( # # plm(form, data = data, model = "within", effect = "twoways"), # # times = 10) # # # # print(bench_2FE_collapse, unit = "s") # # print(bench_2FE_lfe, unit = "s") # plm/inst/tests/test_order_between_fixef_ranef.Rout.save0000644000176200001440000005601214126017462023217 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## test for order of output of between() and hence fixef() and ranef() > # -> factor level order or order of appearance in original data > ## "since ever" plm had level order but this was changed to appearance order > # in plm 2.4-0 and changed back in rev. 1307 for plm 2.4-2. > # => factor level order makes more sense! > > library(plm) > data("Crime", package = "plm") > delrows.a <- -c( 1, 2, 10, 12) > delrows.b <- -c(10, 12, 17, 18) > > Crime.unbal.a <- Crime[delrows.a, ] > Crime.unbal.b <- Crime[delrows.b, ] > > pCrime.unbal.a <- pdata.frame(Crime.unbal.a) > pCrime.unbal.b <- pdata.frame(Crime.unbal.b) > > ix.a <- index(pCrime.unbal.a) # unclass for speed > ix.b <- index(pCrime.unbal.b) # unclass for speed > > > ## between.default ## > options("plm.fast" = FALSE) > (bet.def.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[1L]])) # individual effect 1 3 5 7 9 11 0.034391940 0.015474140 0.012567214 0.023045300 0.011377629 0.017200857 13 15 17 19 21 23 0.032455000 0.017586629 0.020962471 0.017366600 0.039442871 0.028431843 25 27 33 35 37 39 0.032358986 0.034631229 0.015917443 0.042880071 0.021380257 0.014575243 41 45 47 49 51 53 0.023992300 0.035043300 0.030550029 0.034224900 0.067890743 0.017250986 55 57 59 61 63 65 0.058186129 0.029536757 0.017862386 0.020703471 0.074278800 0.055787886 67 69 71 77 79 81 0.057398300 0.014432529 0.058849971 0.038219057 0.014213271 0.056345200 83 85 87 89 91 93 0.029073200 0.041145671 0.028005186 0.026968343 0.031636257 0.033900871 97 99 101 105 107 109 0.037949586 0.016884100 0.033216500 0.050111957 0.046693071 0.018805829 111 113 115 117 119 123 0.017072743 0.011638529 0.003969886 0.018748857 0.088685471 0.033205943 125 127 129 131 133 135 0.026654214 0.038546186 0.074577300 0.017199186 0.045760043 0.055046057 137 139 141 143 145 147 0.013920286 0.028755557 0.069616929 0.021547714 0.028503814 0.052672214 149 151 153 155 157 159 0.015863229 0.024475700 0.031010129 0.032982129 0.029920743 0.031549986 161 163 165 167 169 171 0.020215757 0.021013543 0.043897229 0.022721857 0.012540657 0.021906957 173 175 179 181 183 185 0.011458214 0.018268986 0.027953957 0.059263786 0.053565114 0.010661771 187 189 191 193 195 197 0.027964243 0.028849543 0.037460814 0.020500843 0.045657243 0.015046043 > (bet.def.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[1L]])) # individual effect 1 3 5 7 9 11 0.035741357 0.015474140 0.012266840 0.023045300 0.011377629 0.017200857 13 15 17 19 21 23 0.032455000 0.017586629 0.020962471 0.017366600 0.039442871 0.028431843 25 27 33 35 37 39 0.032358986 0.034631229 0.015917443 0.042880071 0.021380257 0.014575243 41 45 47 49 51 53 0.023992300 0.035043300 0.030550029 0.034224900 0.067890743 0.017250986 55 57 59 61 63 65 0.058186129 0.029536757 0.017862386 0.020703471 0.074278800 0.055787886 67 69 71 77 79 81 0.057398300 0.014432529 0.058849971 0.038219057 0.014213271 0.056345200 83 85 87 89 91 93 0.029073200 0.041145671 0.028005186 0.026968343 0.031636257 0.033900871 97 99 101 105 107 109 0.037949586 0.016884100 0.033216500 0.050111957 0.046693071 0.018805829 111 113 115 117 119 123 0.017072743 0.011638529 0.003969886 0.018748857 0.088685471 0.033205943 125 127 129 131 133 135 0.026654214 0.038546186 0.074577300 0.017199186 0.045760043 0.055046057 137 139 141 143 145 147 0.013920286 0.028755557 0.069616929 0.021547714 0.028503814 0.052672214 149 151 153 155 157 159 0.015863229 0.024475700 0.031010129 0.032982129 0.029920743 0.031549986 161 163 165 167 169 171 0.020215757 0.021013543 0.043897229 0.022721857 0.012540657 0.021906957 173 175 179 181 183 185 0.011458214 0.018268986 0.027953957 0.059263786 0.053565114 0.010661771 187 189 191 193 195 197 0.027964243 0.028849543 0.037460814 0.020500843 0.045657243 0.015046043 > > options("plm.fast" = FALSE) > (bet.def.plm.slow.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) 81 82 83 84 85 86 87 0.03267005 0.03258422 0.03088247 0.02945170 0.02995852 0.03228605 0.03350992 > (bet.def.plm.slow.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[2L]])) # year 81 first 81 82 83 84 85 86 87 0.03275022 0.03264823 0.03108788 0.02962723 0.02995852 0.03228605 0.03350992 > > ## Run tests only if package 'collapse' is available > ## (as they are 'Suggests' dependencies) > collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE > > if(collapse.avail) { + + options("plm.fast" = TRUE) # same + (bet.def.plm.fast.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.def.plm.fast.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[2L]])) # year 81 first + + stopifnot(isTRUE(all.equal(names(bet.def.unbal.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(bet.def.unbal.b), levels(ix.b[[1L]])))) + + stopifnot(isTRUE(all.equal(names(bet.def.plm.slow.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(bet.def.plm.slow.unbal.b), levels(ix.b[[2L]])))) + + stopifnot(isTRUE(all.equal(names(bet.def.plm.fast.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(bet.def.plm.fast.unbal.b), levels(ix.b[[2L]])))) + + + stopifnot(isTRUE(all.equal(bet.def.plm.slow.unbal.a, bet.def.plm.fast.unbal.a))) + stopifnot(isTRUE(all.equal(bet.def.plm.slow.unbal.b, bet.def.plm.fast.unbal.b))) + + ## between.pseries ## + options("plm.fast" = FALSE) + (bet.pser.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "individual")) + (bet.pser.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "individual")) + + options("plm.fast" = FALSE) + (bet.pser.plm.slow.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.pser.plm.slow.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "time")) # year 81 first + + options("plm.fast" = TRUE) # same + (bet.pser.plm.fast.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.pser.plm.fast.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "time")) # year 81 first + + stopifnot(isTRUE(all.equal(names(bet.pser.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[1L]])))) + stopifnot(isTRUE(all.equal(names(bet.pser.unbal.b), levels(index(pCrime.unbal.b$crmrte)[[1L]])))) + + stopifnot(isTRUE(all.equal(names(bet.pser.plm.slow.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[2L]])))) + stopifnot(isTRUE(all.equal(names(bet.pser.plm.slow.unbal.a), levels(index(pCrime.unbal.b$crmrte)[[2L]])))) + + stopifnot(isTRUE(all.equal(names(bet.pser.plm.fast.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[2L]])))) + stopifnot(isTRUE(all.equal(names(bet.pser.plm.fast.unbal.a), levels(index(pCrime.unbal.b$crmrte)[[2L]])))) + + + stopifnot(isTRUE(all.equal(bet.pser.plm.slow.unbal.a, bet.pser.plm.fast.unbal.a))) + stopifnot(isTRUE(all.equal(bet.pser.plm.slow.unbal.b, bet.pser.plm.fast.unbal.b))) + + + ## between.matrix - no index case ## + mat_no_index.unbal.a <- as.matrix(Crime.unbal.a[ , 1:6])[ , 3:4] + mat_no_index.unbal.b <- as.matrix(Crime.unbal.b[ , 1:6])[ , 3:4] + + options("plm.fast" = FALSE) + (bet.matnoi.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[1L]])) # individual effect + (bet.matnoi.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[1L]])) # individual effect + + options("plm.fast" = FALSE) + (bet.matnoi.plm.slow.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.matnoi.plm.slow.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[2L]])) # year 81 first + + options("plm.fast" = TRUE) + (bet.matnoi.plm.fast.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.matnoi.plm.fast.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[2L]])) # year 81 first + + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.unbal.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.unbal.b), levels(ix.b[[1L]])))) + + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.slow.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.slow.unbal.b), levels(ix.b[[2L]])))) + + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.fast.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.fast.unbal.b), levels(ix.b[[2L]])))) + + + stopifnot(isTRUE(all.equal(bet.matnoi.plm.slow.unbal.a, bet.matnoi.plm.fast.unbal.a))) + stopifnot(isTRUE(all.equal(bet.matnoi.plm.slow.unbal.b, bet.matnoi.plm.fast.unbal.b))) + + + ## between.matrix - index case ## + mat_index.unbal.a <- mat_no_index.unbal.a + mat_index.unbal.b <- mat_no_index.unbal.b + attr(mat_index.unbal.a, "index") <- ix.a + attr(mat_index.unbal.b, "index") <- ix.b + + options("plm.fast" = FALSE) + (bet.mati.unbal.a <- between(mat_index.unbal.a, effect = "individual")) # individual effect + (bet.mati.unbal.b <- between(mat_index.unbal.b, effect = "individual")) # individual effect + + options("plm.fast" = FALSE) + (bet.mati.plm.slow.unbal.a <- between(mat_index.unbal.a, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.mati.plm.slow.unbal.b <- between(mat_index.unbal.b, effect = "time")) # year 81 first + + options("plm.fast" = TRUE) + (bet.mati.plm.fast.unbal.a <- between(mat_index.unbal.a, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (bet.mati.plm.fast.unbal.b <- between(mat_index.unbal.b, effect = "time")) # year 81 first + + stopifnot(isTRUE(all.equal(rownames(bet.mati.unbal.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.mati.unbal.b), levels(ix.b[[1L]])))) + + stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.slow.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.slow.unbal.b), levels(ix.b[[2L]])))) + + stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.fast.unbal.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.fast.unbal.b), levels(ix.b[[2L]])))) + + + stopifnot(isTRUE(all.equal(bet.mati.plm.slow.unbal.a, bet.mati.plm.fast.unbal.a))) + stopifnot(isTRUE(all.equal(bet.mati.plm.slow.unbal.b, bet.mati.plm.fast.unbal.b))) + + + ### fixef ### + + crime_formula_plm_FE <- lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + + lwsta + lwloc + lpctymle + + FE_id.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "individual") + FE_ti.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "time") + FE_tw.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "twoways") + + FE_id.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "individual") + FE_ti.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "time") + FE_tw.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "twoways") + + options("plm.fast" = FALSE) + (fx_fe_plm.slow.id.a <- fixef(FE_id.a)) + (fx_fe_plm.slow.ti.a <- fixef(FE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_fe_plm.slow.tw.id.a <- fixef(FE_tw.a, effect = "individual")) + (fx_fe_plm.slow.tw.ti.a <- fixef(FE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) + (fx_fe_plm.slow.tw.tw.a <- fixef(FE_tw.a, effect = "twoways")) + + (fx_fe_plm.slow.id.b <- fixef(FE_id.b)) + (fx_fe_plm.slow.ti.b <- fixef(FE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_fe_plm.slow.tw.id.b <- fixef(FE_tw.b, effect = "individual")) + (fx_fe_plm.slow.tw.ti.b <- fixef(FE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) + (fx_fe_plm.slow.tw.tw.b <- fixef(FE_tw.b, effect = "twoways")) + + options("plm.fast" = TRUE) # same + (fx_fe_plm.fast.id.a <- fixef(FE_id.a)) + (fx_fe_plm.fast.ti.a <- fixef(FE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_fe_plm.fast.tw.id.a <- fixef(FE_tw.a, effect = "individual")) + (fx_fe_plm.fast.tw.ti.a <- fixef(FE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) + (fx_fe_plm.fast.tw.tw.a <- fixef(FE_tw.a, effect = "twoways")) + + (fx_fe_plm.fast.id.b <- fixef(FE_id.b)) + (fx_fe_plm.fast.ti.b <- fixef(FE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_fe_plm.fast.tw.id.b <- fixef(FE_tw.b, effect = "individual")) + (fx_fe_plm.fast.tw.ti.b <- fixef(FE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) + (fx_fe_plm.fast.tw.tw.b <- fixef(FE_tw.b, effect = "twoways")) + + + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.a), paste(ix.a[[1L]], ix.a[[2L]], sep = "-")))) + + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.b), paste(ix.b[[1L]], ix.b[[2L]], sep = "-")))) + + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.tw.a), paste(ix.a[[1L]], ix.a[[2L]], sep = "-")))) + + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.tw.b), paste(ix.b[[1L]], ix.b[[2L]], sep = "-")))) + + + + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.id.a, fx_fe_plm.fast.id.a))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.ti.a, fx_fe_plm.fast.ti.a))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.id.a, fx_fe_plm.fast.tw.id.a))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.ti.a, fx_fe_plm.fast.tw.ti.a))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.tw.a, fx_fe_plm.fast.tw.tw.a))) + + + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.id.b, fx_fe_plm.fast.id.b))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.ti.b, fx_fe_plm.fast.ti.b))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.id.b, fx_fe_plm.fast.tw.id.b))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.ti.b, fx_fe_plm.fast.tw.ti.b))) + stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.tw.b, fx_fe_plm.fast.tw.tw.b))) + + ### ranef ### + + crime_formula_plm_RE <- lpctymle ~ lmix + lprbconv + + RE_id.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "individual") + RE_ti.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "time") + RE_tw.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "twoways") + + RE_id.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "individual") + RE_ti.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "time") + RE_tw.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "twoways") + + options("plm.fast" = FALSE) + (fx_re_plm.slow.id.a <- ranef(RE_id.a)) + (fx_re_plm.slow.ti.a <- ranef(RE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_re_plm.slow.tw.id.a <- ranef(RE_tw.a, effect = "individual")) + (fx_re_plm.slow.tw.ti.a <- ranef(RE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) + # (fx_re_plm.slow.tw.tw.a <- ranef(RE_tw.a, effect = "twoways")) # do not have this for ranef + + (fx_re_plm.slow.id.b <- ranef(RE_id.b)) + (fx_re_plm.slow.ti.b <- ranef(RE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_re_plm.slow.tw.id.b <- ranef(RE_tw.b, effect = "individual")) + (fx_re_plm.slow.tw.ti.b <- ranef(RE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) + # (fx_re_plm.slow.tw.tw.b <- ranef(RE_tw.b, effect = "twoways")) # do not have this for ranef + + options("plm.fast" = TRUE) # same + (fx_re_plm.fast.id.a <- ranef(RE_id.a)) + (fx_re_plm.fast.ti.a <- ranef(RE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_re_plm.fast.tw.id.a <- ranef(RE_tw.a, effect = "individual")) + (fx_re_plm.fast.tw.ti.a <- ranef(RE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) + # (fx_re_plm.fast.tw.tw.a <- ranef(RE_tw.a, effect = "twoways")) # do not have this for ranef + + (fx_re_plm.fast.id.b <- ranef(RE_id.b)) + (fx_re_plm.fast.ti.b <- ranef(RE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) + (fx_re_plm.fast.tw.id.b <- ranef(RE_tw.b, effect = "individual")) + (fx_re_plm.fast.tw.ti.b <- ranef(RE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) + # (fx_re_plm.fast.tw.tw.b <- # ranef(RE_tw.b, effect = "twoways")) # do not have this for ranef + + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.ti.a), levels(ix.a[[2L]])))) + # stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.tw.a), levels(ix.a[[2L]])))) # don't have this for ranef + + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.ti.b), levels(ix.b[[2L]])))) + # stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.b), levels(ix.b[[2L]])) # don't have this for ranef + + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.ti.a), levels(ix.a[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.id.a), levels(ix.a[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.ti.a), levels(ix.a[[2L]])))) + # stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.tw.a), levels(ix.a[[2L]])))) # don't have this for ranef + + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.ti.b), levels(ix.b[[2L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.id.b), levels(ix.b[[1L]])))) + stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.ti.b), levels(ix.b[[2L]])))) + # stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.tw.b), levels(ix.b[[2L]])))) # don't have this for ranef + + stopifnot(isTRUE(all.equal(fx_re_plm.slow.id.a, fx_re_plm.fast.id.a))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.ti.a, fx_re_plm.fast.ti.a))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.id.a, fx_re_plm.fast.tw.id.a))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.ti.a, fx_re_plm.fast.tw.ti.a))) + + stopifnot(isTRUE(all.equal(fx_re_plm.slow.id.b, fx_re_plm.fast.id.b))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.ti.b, fx_re_plm.fast.ti.b))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.id.b, fx_re_plm.fast.tw.id.b))) + stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.ti.b, fx_re_plm.fast.tw.ti.b))) + + } > > proc.time() user system elapsed 0.76 0.15 0.89 plm/inst/tests/test_phtest_Hausman_regression.R0000644000176200001440000001656414154734502021607 0ustar liggesusers#### Hausman test (original version and regression-based version) ## ## ## (1) comparison to Baltagi (2013), sec. 4.3.1, example 1 (pp. 81-82) ## (2) comparison to Baltagi (2013), sec. 4.3.2, example 2 (pp. 82-83) ## (3) comparison to Stata ################################## (1) ################################## # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons # Sec 4.3.1, p. 81 (example 1): # #### statistics are: 2.33 for original Hausman (m1) # 2.131 for m2, m3 (for the Grunfeld data) # #### vcov within * 10^-3: # # 0.14058 -0.077468 # 0.3011788 # #### vcov between * 10^-3: # # 0.82630142 -3.7002477 # 36.4572431 options(digits = 10) library(plm) data("Grunfeld", package = "plm") Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) fe_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within") be_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="between") re_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random") pool_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="pooling") # Hausman test # m1, m2, m3 are all mathematically identical; however computer computation differs a little bit phtest(inv ~ value + capital, Grunfeldpdata) # replicates Baltagi's m1 = 2.33 phtest(fe_grun, re_grun) # same as above, replicates Baltagi's m1 = 2.33 phtest(re_grun, fe_grun) phtest(be_grun, re_grun) # replicates Baltagi's m2 = 2.131 phtest(re_grun, be_grun) phtest(be_grun, fe_grun) # replicates Baltagi's m3 = 2.131 [values m2 and m3 coincide in this case] phtest(fe_grun, be_grun) phtest(inv ~ value + capital, Grunfeldpdata, method="aux") # replicates m3 from above in regression test phtest(inv ~ value + capital, Grunfeldpdata, method="aux", vcov = vcovHC) # no comparison value given # replicates variance-covariance matrices vcov(fe_grun)*1000 vcov(be_grun)*1000 ################################## (2) ################################## # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons # Sec 4.3.2, p. 82-83 (example 2): ### Baltagi's Gasoline example data("Gasoline", package = "plm") form <- lgaspcar ~ lincomep + lrpmg + lcarpcap fe <- plm(form, data = Gasoline, model = "within") be <- plm(form, data = Gasoline, model = "between") re <- plm(form, data = Gasoline, model = "random") phtest(fe, re) # replicates Baltagi's m1 = 302.8 phtest(form, data = Gasoline) # same as above (m1) phtest(be, re) # replicates Baltagi's m2 = 27.45 phtest(be, fe) # replicates Baltagi's m3 = 26.507 almost phtest(form, data = Gasoline, method = "aux") # chisq = 26.495054, replicates _almost_ Baltagi's m3 = 26.507 # replicates variance-covariance matrices # # vcov in Baltagi within: # 0.539 0.029 -0.205 # 0.194 0.009 # 0.088 # # vcov in Baltagi between: # 2.422 -1.694 -1.056 # 1.766 0.883 # 0.680 vcov(fe)*100 vcov(be)*100 ##### twoways case ### fe2_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within", effect = "twoways") # be_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="between") # RE gives warning due to neg. variance estimation re2_grun <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random", effect = "twoways") phtest(fe2_grun, re2_grun) # 13.460, p = 0.00194496 [also given by EViews 9.5; # Baltagi (2013), p. 85 has other values due to older/wrong version of EViews?] phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "time") # test to see of phtest(, method = "aux") respects argument effect # formal test (statistic is about 13 for twoways case and well below in one-way cases) testobj <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways", method = "aux") #YC if (round(testobj$statistic, digits = 0) != 13) stop("argument effect seems to be not respected with method = \"aux\"") testobj2 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") # just to be sure: test for method="chisq" also... #YC if (round(testobj2$statistic, digits = 0) != 13) stop("argument effect seems to be not respected with method = \"chisq\"") # test for class of statistic [was matrix pre rev. 305] testobj1 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways", method = "aux") testobj2 <- phtest(fe2_grun, re2_grun) testobj3 <- phtest(inv ~ value + capital, data=Grunfeldpdata, effect = "twoways") if (class(testobj1$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj1$statistic))) if (class(testobj2$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj2$statistic))) if (class(testobj3$statistic) != "numeric") stop(paste0("class of statistic is not numeric, but ", class(testobj3$statistic))) # Two-ways case with beetween model should result in informative errors. # phtest(fe2_grun, be_grun) # phtest(re2_grun, be_grun) ################################## (3) ################################## ### comparison to Stata: # Hausman test with Stata example 2, pp. 5-6 in http://www.stata.com/manuals/xtxtregpostestimation.pdf # # Results of phtest differ, most likely because RE model differs slightly from Stata's RE model as the # default RE model in Stata uses a slightly different implementation of Swamy-Arora method # [see http://www.stata.com/manuals/xtxtreg.pdf] # # Stata: # chi2(8) = (b-B)'[(V_b-V_B)^(-1)](b-B) # = 149.43 # Prob>chi2 = 0.0000 # library(haven) # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file # nlswork$race <- factor(nlswork$race) # convert # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example # nlswork$grade <- as.numeric(nlswork$grade) # nlswork$age2 <- (nlswork$age)^2 # nlswork$tenure2 <- (nlswork$tenure)^2 # nlswork$ttl_exp2 <- (nlswork$ttl_exp)^2 # # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) # # form_nls_ex2 <- formula(ln_wage ~ grade + age + age2 + ttl_exp + ttl_exp2 + tenure + tenure2 + race2 + not_smsa + south) # # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") # plm_be_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "between") # plm_re_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "random") # # summary(plm_re_nlswork) # # ### Stata: chi2(8) = 149.43 # phtest(plm_fe_nlswork, plm_re_nlswork) # chisq = 176.39, df = 8, p-value < 2.2e-16 # phtest(plm_be_nlswork, plm_re_nlswork) # chisq = 141.97, df = 10, p-value < 2.2e-16 # phtest(form_nls_ex2, data = pnlswork, method="aux") # chisq = 627.46, df = 8, p-value < 2.2e-16 [this resulted in an error for SVN revisions 125 - 141] # phtest(form_nls_ex2, data = nlswork, method="aux") # same on data.frame # phtest(form_nls_ex2, data = pnlswork, method="aux", vcov = vcovHC) # chisq = 583.56, df = 8, p-value < 2.2e-16 # # phtest(form_nls_ex2, data = pnlswork, method="aux", vcov = function(x) vcovHC(x, method="white2", type="HC3")) # computationally too heavy! plm/inst/tests/test_pcdtest.Rout.save0000644000176200001440000001065414126044755017514 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## tests for pcdtest > > ## test pcdtest for NaN value in result > ## * due to non-intersecting pairs, fixed in rev. 339 > ## * due to only ony period in intersection, fixed in rev. 345 > > library(plm) > data("Grunfeld", package = "plm") > > ## just a run test without obstacles > mod_pool <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") > testres1 <- pcdtest(mod_pool, test = "cd") > if (is.nan(testres1$statistic)) stop("statistic is NaN") > if (is.na(testres1$statistic)) stop("statistic is NA") > if (is.na(testres1$p.value)) stop("p-value is NA") > > ## no intersection for firm 1 and 2: > # firm 1 years: 1935 to 1944 > # firm 2 years: 1945 to 1954 > Grunfeld_no_intersect <- Grunfeld[-c(11:20, 21:30), ] > mod_pool_no_intersect <- plm(inv ~ value + capital, data = Grunfeld_no_intersect, model = "pooling") > > testres2 <- pcdtest(mod_pool_no_intersect, test = "cd") Warning message: In pcdres(tres = tres, n = n, w = w, form = paste(deparse(x$formula)), : Some pairs of individuals (4.4 percent) do not have any or just one time period in common and have been omitted from calculation > if (is.nan(testres2$statistic)) stop("statistic is NaN") > if (is.na(testres2$statistic)) stop("statistic is NA") > if (is.na(testres2$p.value)) stop("p-value is NA") > > > ## fixed in rev. 345 > ## only 1 intersection for firm 1 and 2: > # firm 1 years: 1935 to 1945 > # firm 2 years: 1945 to 1954 > Grunfeld_one_intersect <- Grunfeld[-c(12:20, 20:30), ] > mod_pool_one_intersect <- plm(inv ~ value + capital, data = Grunfeld_one_intersect, model = "pooling") > testres3 <- pcdtest(mod_pool_one_intersect, test = "cd") Warning message: In pcdres(tres = tres, n = n, w = w, form = paste(deparse(x$formula)), : Some pairs of individuals (4.4 percent) do not have any or just one time period in common and have been omitted from calculation > > if (is.nan(testres3$statistic)) stop("statistic is NaN") > if (is.na(testres3$statistic)) stop("statistic is NA") > if (is.na(testres3$p.value)) stop("p-value is NA") > > > ## make it also unbalanced for other individuals > Grunfeld_no_intersect_unbal <- Grunfeld_no_intersect[-c(65:66, 71, 103:110), ] > mod_pool_no_intersect_unbal <- plm(inv ~ value + capital, data = Grunfeld_no_intersect_unbal, model = "pooling") > testres4 <- pcdtest(mod_pool_no_intersect_unbal, test = "cd") Warning message: In pcdres(tres = tres, n = n, w = w, form = paste(deparse(x$formula)), : Some pairs of individuals (4.4 percent) do not have any or just one time period in common and have been omitted from calculation > if (is.nan(testres4$statistic)) stop("statistic is NaN") > if (is.na(testres4$statistic)) stop("statistic is NA") > if (is.na(testres4$p.value)) stop("p-value is NA") > > > ## test case for regression of variable on constant > ## resulted in error pre rev. 342: > ## "Error in lm.fit(tX, ty) : 'x' must be a matrix" > pcdtest(value ~ 1, data = Grunfeld) Pesaran CD test for cross-sectional dependence in panels data: value ~ 1 z = 13.843, p-value < 2.2e-16 alternative hypothesis: cross-sectional dependence > > ## tests of local test (with arg w) > w <- diag(1, nrow = 10) > w[2,1] <- 1 > testres5 <- pcdtest(mod_pool, test = "cd", w = w) > if (is.nan(testres5$statistic)) stop("statistic is NaN") > if (is.na(testres5$statistic)) stop("statistic is NA") > if (is.na(testres5$p.value)) stop("p-value is NA") > > ### should result in meaningful errors > ## upper and lower triangular part define different neighbours > # w1 <- diag(1, nrow = 10) > # w1[1,3] <- 1 > # w1[2,1] <- 1 > # pcdtest(mod_pool, test = "cd", w = w1) > ## wrong dimension > # w2 <- diag(1, nrow = 10, ncol = 11) > # pcdtest(mod_pool, test = "cd", w = w2) > > proc.time() user system elapsed 4.06 0.67 4.81 plm/inst/tests/test_pbgtest.R0000644000176200001440000001344614124132276016025 0ustar liggesusers# Testfile for plm::bgtest() # # (1) check if inputs are passed correctly for formula and panelmodel interface # (2) compare results to lmtest::bgtest() # Estimate some models first library(plm) data("Grunfeld", package = "plm") g_re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") g_fe <- plm(inv ~ value + capital, data = Grunfeld, model = "within") g_pool <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") g_pool_lm <- lm(inv ~ value + capital, data = Grunfeld) g_fe_lm <- lm(inv ~ factor(firm) + value + capital, data = Grunfeld) # Results should all be the same for same model (statistics, df, p-value) # compare plm::bgtests panelmodel interface to formula interface plm::pbgtest(inv ~ value + capital, order=1, data=Grunfeld) # default is pooling model plm::pbgtest(inv ~ value + capital, order=1, data=Grunfeld, model="pooling") plm::pbgtest(g_pool, order=1) plm::pbgtest(inv ~ value + capital, order=1, model="within", data=Grunfeld) plm::pbgtest(g_fe, order=1) plm::pbgtest(inv ~ value + capital, order=1, model="random", data=Grunfeld) plm::pbgtest(g_re, order=1) # 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) # panelmodel interface plm::pbgtest(g_pool, order = 1) lmtest::bgtest(g_pool) lmtest::bgtest(g_pool_lm) plm::pbgtest(g_pool, order = 1, type="F") lmtest::bgtest(g_pool, type="F") lmtest::bgtest(g_pool_lm, type="F") ## formula interface plm:::pbgtest( inv ~ value + capital, data = Grunfeld, order=1) lmtest::bgtest(inv ~ value + capital, data = Grunfeld, order=1) plm::pbgtest( inv ~ value + capital, data = Grunfeld, order=1, type="F") lmtest::bgtest(inv ~ value + capital, data = Grunfeld, order=1, type="F") # Use of order.by: # order.by as vector plm::pbgtest(g_pool, order = 1, order.by=g_pool$model$capital) lmtest::bgtest(g_pool, order = 1, order.by=g_pool$model$capital) lmtest::bgtest(g_pool_lm, order = 1, order.by=g_pool_lm$model$capital) plm::pbgtest( inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool$model$capital) lmtest::bgtest(inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool$model$capital) lmtest::bgtest(inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool_lm$model$capital) plm::pbgtest(g_pool, order = 1, order.by=g_pool$model$capital, type="F") lmtest::bgtest(g_pool, order = 1, order.by=g_pool$model$capital, type="F") lmtest::bgtest(g_pool_lm, order = 1, order.by=g_pool_lm$model$capital, type="F") plm::pbgtest( inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool$model$capital, type="F") lmtest::bgtest(inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool$model$capital, type="F") lmtest::bgtest(inv ~ value + capital, data=Grunfeld, order = 1, order.by=g_pool_lm$model$capital, type="F") # order.by as formula # when order.by is given as formula, also supply data= [requirement of lmtest::bgtest()] plm::pbgtest(g_pool, order.by=~capital, order = 1, data=Grunfeld) lmtest::bgtest(g_pool, order.by=~capital, data=Grunfeld) lmtest::bgtest(g_pool_lm, order.by=~capital, data=Grunfeld) plm::pbgtest( inv ~ value + capital, order.by=~capital, order = 1, data=Grunfeld, model="pooling") plm::pbgtest( inv ~ value + capital, order.by=~capital, order = 1, data=Grunfeld) # default is pooling model lmtest::bgtest(inv ~ value + capital, order.by=~capital, data=Grunfeld) lmtest::bgtest(inv ~ value + capital, order.by=~capital, data=Grunfeld) plm::pbgtest(g_pool, order.by=~capital, order = 1, data=Grunfeld, type="F") lmtest::bgtest(g_pool, order.by=~capital, data=Grunfeld, type="F") lmtest::bgtest(g_pool_lm, order.by=~capital, data=Grunfeld, type="F") plm::pbgtest( inv ~ value + capital, order.by=~capital, order = 1, data=Grunfeld, type="F", model="pooling") plm::pbgtest( inv ~ value + capital, order.by=~capital, order = 1, data=Grunfeld, type="F") # default is pooling model lmtest::bgtest(inv ~ value + capital, order.by=~capital, data=Grunfeld, type="F") lmtest::bgtest(inv ~ value + capital, order.by=~capital, data=Grunfeld, type="F") plm::pbgtest(inv ~ value + capital, order=1, model="within", data=Grunfeld, order.by=~capital) plm::pbgtest(g_fe, order=1, data=Grunfeld, order.by=~capital) plm::pbgtest(inv ~ value + capital, order=1, model="within", data=Grunfeld, order.by=~g_fe$model$capital) plm::pbgtest(g_fe, order=1, data=Grunfeld, order.by=~g_fe$model$capital) plm::pbgtest(inv ~ value + capital, order=1, model="random", data=Grunfeld, order.by=~capital) plm::pbgtest(g_re, order=1, data=Grunfeld, order.by=~capital) plm::pbgtest(inv ~ value + capital, order=1, model="random", data=Grunfeld, order.by=g_re$model$capital) plm::pbgtest(g_re, order=1, data=Grunfeld, order.by=g_re$model$capital) g_re <- plm(inv ~ value, model = "random", data = Grunfeld) g_re <- plm(inv ~ value + capital, model = "random", data = Grunfeld) X <- model.matrix(g_re) y <- pmodel.response(g_re) df <- as.data.frame(cbind(y, X[,-1])) lm.mod <- lm(y ~ X - 1) lm.mod2 <- lm(df) all.equal(lm.mod$residuals, g_re$residuals) all.equal(lm.mod2$residuals, g_re$residuals) lmtest::bgtest(lm.mod) lmtest::bgtest(lm.mod2) pbgtest(g_re, order = 1) plm/inst/tests/test_pwaldtest.R0000644000176200001440000003247214124132276016364 0ustar liggesusers#### Testfile for pwaldtest() # # see also tests/test_pwaldtest_vcovG_attr_cluster.R for the attribute 'cluster' of the furnished vcovs options(scipen = 999) options(digits = 8) library(plm) data("Grunfeld", package="plm") gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") gi <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual", model = "within") gt <- plm(inv ~ value + capital, data = Grunfeld, effect = "time", model = "within") gd <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "within") gre<- plm(inv ~ value + capital, data = Grunfeld, effect = "individual", model = "random") # Chisq plm::pwaldtest(gp, test = "Chisq") plm::pwaldtest(gi, test = "Chisq") plm::pwaldtest(gt, test = "Chisq") plm::pwaldtest(gd, test = "Chisq") plm::pwaldtest(gre, test = "Chisq") # F plm::pwaldtest(gp, test = "F") plm::pwaldtest(gi, test = "F") plm::pwaldtest(gt, test = "F") plm::pwaldtest(gd, test = "F") plm::pwaldtest(gre, test = "F") # Gretl uses Stata's small sample adjustment g <- pdim(gi)$nT$n # no of individuals n <- pdim(gi)$nT$N # no of total obs k <- length(coefficients(gi)) adj_k1 <- (g/(g-1) * (n-1)/(n-k-1)) # k <- k + 1 because Stata and Gretl have the intercept in the FE model adj <- (g/(g-1) * (n-1)/(n-k)) adj_gd <- (g/(g-1) * (n-1)/(n-k-1-19)) # Gretl has time dummies, not demeaning by time (20 periods for Grunfeld data) # vcov with adjustment factors vcov_mat_adj_gp <- adj_k1 * plm::vcovHC(gp) vcov_mat_adj_gi <- adj_k1 * plm::vcovHC(gi) vcov_mat_adj_gd <- adj_gd * plm::vcovHC(gd) # NB: adj_gd to be used here vcov_mat_adj_gre <- adj_k1 * plm::vcovHC(gre) vcov_mat_adj_gt <- adj_k1 * plm::vcovHC(gt) # Chisq - robust - formula plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC) plm::pwaldtest(gre, test = "Chisq", vcov = vcovHC) # Chisq - robust - matrix plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC(gp)) plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC(gi)) plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC(gt)) plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC(gd)) plm::pwaldtest(gre, test = "Chisq", vcov = vcov_mat_adj_gre) # replicates Gretl: Chi-square(2) = 70.1267 # F - robust plm::pwaldtest(gp, test = "F", vcov = vcov_mat_adj_gp) # replicates Gretl: F(2, 9) = 51.59060 plm::pwaldtest(gi, test = "F", vcov = vcov_mat_adj_gi) # replicates Gretl: F(2, 9) = 28.3096 plm::pwaldtest(gi, test = "F", vcov = function(x) vcovHC(x, cluster = "time")) # cluster on time, df2 = 19 plm::pwaldtest(gt, test = "F", vcov = vcov_mat_adj_gt) plm::pwaldtest(gd, test = "F", vcov = vcov_mat_adj_gd) # replicates Gretl: F(2, 9) = 60.0821 plm::pwaldtest(gre, test = "F", vcov = vcov_mat_adj_gre) # F - robust - matrix plm::pwaldtest(gp, test = "F", vcov = vcovHC(gp)) plm::pwaldtest(gi, test = "F", vcov = vcovHC(gi)) plm::pwaldtest(gi, test = "F", vcov = function(x) vcovHC(x, cluster = "time")) # cluster on time, df2 = 19 plm::pwaldtest(gt, test = "F", vcov = vcovHC(gt)) plm::pwaldtest(gd, test = "F", vcov = vcovHC(gd)) plm::pwaldtest(gre, test = "F", vcov = vcovHC(gre)) ############### compare to other statistics packages: ## package 'lfe' # library(lfe) # data("Grunfeld", package = "plm") # gi_lfe <- felm(inv ~ value + capital | firm, data = Grunfeld) # gi_lfe_cluster <- felm(inv ~ value + capital | firm, data = Grunfeld, clustervar="firm") # summary(gi_lfe) # summary(gi_lfe_cluster) # lfe::waldtest(gi_lfe, R = names(coef(gi_lfe))) # df1 = 2, df2 = 188 # lfe::waldtest(gi_lfe_cluster, R = names(coef(gi_lfe_cluster))) # chi2: 54.03250, F. 27.01625, df1 = 2, df2 = 9 # gi_lfe_cluster$clustervcv # # this vcov is not identical to vcovHC, so results do not match ### Stata #### # See http://www.stata.com/manuals14/xtxtreg.pdf # example 2 vs. example 3 (p 14 and 16): # F(8, 23386) = 610.12 - normal # F(8, 4696) = 273.86 - robust # commented because it needs extra library 'foreign' # library(plm) # library(haven) # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file # nlswork$race <- factor(nlswork$race) # convert # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example # nlswork$grade <- as.numeric(nlswork$grade) # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) # # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") # # plm:::pwaldtest(plm_fe_nlswork, test = "F") # replicates Stata: F(8, 23386) = 610.12 - normal # plm:::pwaldtest(plm_fe_nlswork, test = "F", vcov = vcovHC) # replicates Stata: F(8, 4696) = 273.86 - robust ### replicate Gretl #### # library(foreign);library(plm) # wagepan<-read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/wagepan.dta") # pwagepan <- pdata.frame(wagepan, index = c("nr", "year")) # pdim(pwagepan) # # mod_fe_ind <- plm(lwage ~ exper + hours + married + expersq, data = pwagepan, model = "within", effect = "individual") # # plm:::pwaldtest(mod_fe_ind, test="F") # plm:::pwaldtest(mod_fe_ind, test="F", vcov = function(x) vcovHC(x)) # 121.4972 # # # Gretl uses Stata's small sample adjustment # g <- pdim(mod_fe_ind)$nT$n # no of individuals # n <- pdim(mod_fe_ind)$nT$N # no of total obs # k <- length(coefficients(mod_fe_ind)) # k <- k+1 # + 1 because Stata and Gretl have the intercept in the FE model # adj <- (g/(g-1) * (n-1)/(n-k)) # vcov_mat_adj <- adj * plm::vcovHC(mod_fe_ind) # print(plm:::pwaldtest(mod_fe_ind, test="F", vcov = vcov_mat_adj), digits = 12) # replicate Gretl: F(4, 544) = 121.163 # Reference: Gretl (2016b) # # Gretl, wagepan data, fixed effects (oneway, HAC SEs) # Model 1: Fixed-effects, using 4360 observations # Included 545 cross-sectional units # Time-series length = 8 # Dependent variable: lwage # Robust (HAC) standard errors # # coefficient std. error t-ratio p-value # ----------------------------------------------------------- # const 1.30069 0.0550817 23.61 2.15e-085 *** # exper 0.137331 0.0108430 12.67 2.12e-032 *** # hours −0.000136467 2.13715e-05 −6.385 3.67e-010 *** # married 0.0481248 0.0213232 2.257 0.0244 ** # expersq −0.00532076 0.000692182 −7.687 7.09e-014 *** # # Mean dependent var 1.649147 S.D. dependent var 0.532609 # Sum squared resid 459.8591 S.E. of regression 0.347371 # LSDV R-squared 0.628105 Within R-squared 0.196125 # Log-likelihood −1283.082 Akaike criterion 3664.165 # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 # rho 0.065436 Durbin-Watson 1.546260 # # Joint test on named regressors - # Test statistic: F(4, 544) = 121.163 # with p-value = P(F(4, 544) > 121.163) = 7.19472e-074 # # Robust test for differing group intercepts - # Null hypothesis: The groups have a common intercept # Test statistic: Welch F(544, 1276.3) = 26.9623 # with p-value = P(F(544, 1276.3) > 26.9623) = 0 # Model 1: Fixed-effects, using 200 observations # Included 10 cross-sectional units # Time-series length = 20 # Dependent variable: inv # Robust (HAC) standard errors # # coefficient std. error t-ratio p-value # -------------------------------------------------------- # const −58.7439 27.6029 −2.128 0.0622 * # value 0.110124 0.0151945 7.248 4.83e-05 *** # capital 0.310065 0.0527518 5.878 0.0002 *** # # Mean dependent var 145.9582 S.D. dependent var 216.8753 # Sum squared resid 523478.1 S.E. of regression 52.76797 # LSDV R-squared 0.944073 Within R-squared 0.766758 # Log-likelihood −1070.781 Akaike criterion 2165.562 # Schwarz criterion 2205.142 Hannan-Quinn 2181.579 # rho 0.663920 Durbin-Watson 0.684480 # # Joint test on named regressors - # Test statistic: F(2, 9) = 28.3096 # with p-value = P(F(2, 9) > 28.3096) = 0.000131055 # # Robust test for differing group intercepts - # Null hypothesis: The groups have a common intercept # Test statistic: Welch F(9, 70.6) = 85.9578 # with p-value = P(F(9, 70.6) > 85.9578) = 1.90087e-034 # Model 6: Fixed-effects, using 200 observations # Included 10 cross-sectional units # Time-series length = 20 # Dependent variable: inv # Robust (HAC) standard errors # # coefficient std. error t-ratio p-value # -------------------------------------------------------- # const −32.8363 19.7826 −1.660 0.1313 # value 0.117716 0.0108244 10.88 1.77e-06 *** # capital 0.357916 0.0478484 7.480 3.77e-05 *** # dt_2 −19.1974 20.6986 −0.9275 0.3779 # dt_3 −40.6900 33.2832 −1.223 0.2526 # dt_4 −39.2264 15.7365 −2.493 0.0343 ** # dt_5 −69.4703 26.9988 −2.573 0.0300 ** # dt_6 −44.2351 17.3723 −2.546 0.0314 ** # dt_7 −18.8045 17.8475 −1.054 0.3195 # dt_8 −21.1398 14.1648 −1.492 0.1698 # dt_9 −42.9776 12.5441 −3.426 0.0076 *** # dt_10 −43.0988 10.9959 −3.920 0.0035 *** # dt_11 −55.6830 15.2019 −3.663 0.0052 *** # dt_12 −31.1693 20.9169 −1.490 0.1704 # dt_13 −39.3922 26.4371 −1.490 0.1704 # dt_14 −43.7165 38.8786 −1.124 0.2899 # dt_15 −73.4951 38.2545 −1.921 0.0869 * # dt_16 −75.8961 36.7985 −2.062 0.0692 * # dt_17 −62.4809 49.4181 −1.264 0.2379 # dt_18 −64.6323 51.5621 −1.253 0.2416 # dt_19 −67.7180 43.7447 −1.548 0.1560 # dt_20 −93.5262 31.7263 −2.948 0.0163 ** # # Mean dependent var 145.9582 S.D. dependent var 216.8753 # Sum squared resid 452147.1 S.E. of regression 51.72452 # LSDV R-squared 0.951693 Within R-squared 0.798540 # Log-likelihood −1056.132 Akaike criterion 2174.264 # Schwarz criterion 2276.512 Hannan-Quinn 2215.643 # rho 0.658860 Durbin-Watson 0.686728 # # Joint test on named regressors - # Test statistic: F(2, 9) = 60.0821 # with p-value = P(F(2, 9) > 60.0821) = 6.22231e-006 # # Robust test for differing group intercepts - # Null hypothesis: The groups have a common intercept # Test statistic: Welch F(9, 76.7) = 53.1255 # with p-value = P(F(9, 76.7) > 53.1255) = 2.45306e-029 # Model 5: Pooled OLS, using 200 observations # Included 10 cross-sectional units # Time-series length = 20 # Dependent variable: inv # Robust (HAC) standard errors # # coefficient std. error t-ratio p-value # -------------------------------------------------------- # const −42.7144 20.4252 −2.091 0.0660 * # value 0.115562 0.0158943 7.271 4.71e-05 *** # capital 0.230678 0.0849671 2.715 0.0238 ** # # Mean dependent var 145.9582 S.D. dependent var 216.8753 # Sum squared resid 1755850 S.E. of regression 94.40840 # R-squared 0.812408 Adjusted R-squared 0.810504 # F(2, 9) 51.59060 P-value(F) 0.000012 # Log-likelihood −1191.802 Akaike criterion 2389.605 # Schwarz criterion 2399.500 Hannan-Quinn 2393.609 # rho 0.956242 Durbin-Watson 0.209717 # Model 2: Random-effects (GLS), using 200 observations # Included 10 cross-sectional units # Time-series length = 20 # Dependent variable: inv # Robust (HAC) standard errors # # coefficient std. error z p-value # -------------------------------------------------------- # const −57.8344 24.8432 −2.328 0.0199 ** # value 0.109781 0.0137557 7.981 1.45e-015 *** # capital 0.308113 0.0549728 5.605 2.08e-08 *** # # Mean dependent var 145.9582 S.D. dependent var 216.8753 # Sum squared resid 1841062 S.E. of regression 96.42765 # Log-likelihood −1196.541 Akaike criterion 2399.083 # Schwarz criterion 2408.978 Hannan-Quinn 2403.087 # # 'Between' variance = 7089.8 # 'Within' variance = 2784.46 # theta used for quasi-demeaning = 0.861224 # corr(y,yhat)^2 = 0.806104 # # Joint test on named regressors - # Asymptotic test statistic: Chi-square(2) = 70.1267 # with p-value = 5.91814e-016 # # Breusch-Pagan test - # Null hypothesis: Variance of the unit-specific error = 0 # Asymptotic test statistic: Chi-square(1) = 798.162 # with p-value = 1.35448e-175 # # Hausman test - # Null hypothesis: GLS estimates are consistent # Asymptotic test statistic: Chi-square(2) = 7.31971 # with p-value = 0.0257363 plm/inst/tests/test_pbnftest.Rout.save0000644000176200001440000000745314124132276017670 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Grunfeld", package = "plm") > > > # Baltagi/Wu (1999), p. 822, Table 1: test data construction > a <- Grunfeld[["year"]][c(9, 10)] > b <- Grunfeld[["year"]][c(17, 18)] > c <- Grunfeld[["year"]][c(3, 4, 5)] > d <- Grunfeld[["year"]][c(7, 8, 9)] > e <- Grunfeld[["year"]][c(13, 14, 15)] > f <- Grunfeld[["year"]][c(3, 4, 5, 6)] > g <- Grunfeld[["year"]][c(12, 13, 14, 15)] > h <- Grunfeld[["year"]][c(2, 4, 5, 14)] > i <- Grunfeld[["year"]][c(8, 9, 16, 17, 19)] > j <- Grunfeld[["year"]][c(2, 3, 15, 16, 17, 19)] > k <- Grunfeld[["year"]][c(2, 3, 15, 18, 19, 20)] > l <- Grunfeld[["year"]][c(2, 3, 5, 7, 15, 20)] > m <- Grunfeld[["year"]][c(3, 5, 8, 9, 16, 17, 19)] > n <- Grunfeld[["year"]][c(2, 4, 5, 14, 15, 16, 19)] > o <- Grunfeld[["year"]][c(2, 3, 4, 8, 9, 16, 17, 19)] > p <- Grunfeld[["year"]][c(2, 3, 5, 7, 15, 18, 19, 20)] > q <- Grunfeld[["year"]][c(2, 4, 5, 8, 14, 15, 16, 19)] > > models_fe <- lapply(letters[1:17], function(let) plm(inv ~ value + capital, data = Grunfeld[!Grunfeld[["year"]] %in% get(let), ], model = "within")) > > results_modbnf <- lapply(models_fe, pbnftest) > names(results_modbnf) <- letters[1:17] > print(unlist(lapply(results_modbnf, function(i) i$statistic))) a.DW b.DW c.DW d.DW e.DW f.DW g.DW h.DW 0.7057889 0.8065231 0.7375006 0.7014472 0.6742988 0.7332151 0.6122722 0.6938174 i.DW j.DW k.DW l.DW m.DW n.DW o.DW p.DW 0.9676265 0.9105938 0.8134087 0.6891568 1.0313051 0.9010460 1.0045470 0.8662283 q.DW 0.8734696 > > results_lbi <- lapply(models_fe, function(mod) pbnftest(mod, test = "lbi")) > names(results_lbi) <- letters[1:17] > print(unlist(lapply(results_lbi, function(i) i$statistic))) a.LBI b.LBI c.LBI d.LBI e.LBI f.LBI g.LBI h.LBI 1.0218979 1.1394027 1.1616861 1.0127364 0.9816259 1.1875789 0.9203234 1.2372585 i.LBI j.LBI k.LBI l.LBI m.LBI n.LBI o.LBI p.LBI 1.4988555 1.5799163 1.1743453 1.3301079 1.8065594 1.6413748 1.7091607 1.5889458 q.LBI 1.6558149 > > # formula interface > pbnftest(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "within") modified Bhargava/Franzini/Narendranathan Panel Durbin-Watson Test data: inv ~ value + capital DW = 0.70579 alternative hypothesis: serial correlation in idiosyncratic errors > pbnftest(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], test = "lbi", model = "within") Baltagi/Wu LBI Test for Serial Correlation in Panel Models data: inv ~ value + capital LBI = 1.0219 alternative hypothesis: serial correlation in idiosyncratic errors > > # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "within") > # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1951, 1952), ], model = "within") > # x <- plm(inv ~ value + capital, data = Grunfeld, model = "within") > # x <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") > # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "pooling") > > > > > proc.time() user system elapsed 0.859 0.023 0.866 plm/inst/tests/test_EstimatorsNested.Rout.save0000644000176200001440000002424314125776262021346 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Produc", package = "plm") > pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) > form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp > summary(plm(form, data = pProduc, model = "random", effect = "nested")) Nested effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = form, data = pProduc, effect = "nested", model = "random") Balanced Panel: n = 48, T = 17, N = 816 Effects: var std.dev share idiosyncratic 0.001352 0.036765 0.191 individual 0.004278 0.065410 0.604 group 0.001455 0.038148 0.205 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.86492676 0.8649268 0.86492676 0.86492676 0.86492676 0.86492676 group 0.03960556 0.0466931 0.05713605 0.05577645 0.06458029 0.06458029 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.106171 -0.024805 -0.001816 -0.000054 0.019795 0.182810 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.08921088 0.14570204 14.3389 < 2.2e-16 *** log(pc) 0.27412419 0.02054440 13.3430 < 2.2e-16 *** log(emp) 0.73983766 0.02575046 28.7311 < 2.2e-16 *** log(hwy) 0.07273624 0.02202509 3.3024 0.0009585 *** log(water) 0.07645327 0.01385767 5.5170 3.448e-08 *** log(util) -0.09437398 0.01677289 -5.6266 1.838e-08 *** unemp -0.00616304 0.00090331 -6.8227 8.933e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 43.035 Residual Sum of Squares: 1.1245 R-Squared: 0.97387 Adj. R-Squared: 0.97368 Chisq: 20213.5 on 6 DF, p-value: < 2.22e-16 > summary(plm(form, data = pProduc, model = "random", effect = "nested", random.method = "walhus")) Nested effects Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = form, data = pProduc, effect = "nested", model = "random", random.method = "walhus") Balanced Panel: n = 48, T = 17, N = 816 Effects: var std.dev share idiosyncratic 0.001415 0.037617 0.163 individual 0.004507 0.067131 0.520 group 0.002744 0.052387 0.317 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.86533240 0.86533240 0.86533240 0.86533240 0.86533240 0.86533240 group 0.05409908 0.06154491 0.07179372 0.07023704 0.07867007 0.07867007 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.105014 -0.024736 -0.001879 -0.000056 0.019944 0.182082 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.08165186 0.15034855 13.8455 < 2.2e-16 *** log(pc) 0.27256322 0.02093384 13.0202 < 2.2e-16 *** log(emp) 0.74164483 0.02607167 28.4464 < 2.2e-16 *** log(hwy) 0.07493204 0.02234932 3.3528 0.0008001 *** log(water) 0.07639159 0.01386702 5.5089 3.611e-08 *** log(util) -0.09523031 0.01677247 -5.6778 1.365e-08 *** unemp -0.00614840 0.00090786 -6.7724 1.267e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 40.423 Residual Sum of Squares: 1.1195 R-Squared: 0.97231 Adj. R-Squared: 0.9721 Chisq: 19579.7 on 6 DF, p-value: < 2.22e-16 > summary(plm(form, data = pProduc, model = "random", effect = "nested", random.method = "amemiya")) Nested effects Random Effect Model (Amemiya's transformation) Call: plm(formula = form, data = pProduc, effect = "nested", model = "random", random.method = "amemiya") Balanced Panel: n = 48, T = 17, N = 816 Effects: var std.dev share idiosyncratic 0.001352 0.036765 0.130 individual 0.006899 0.083058 0.662 group 0.002170 0.046589 0.208 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.89325689 0.89325689 0.89325689 0.89325689 0.89325689 0.89325689 group 0.02996995 0.03548869 0.04369353 0.04264991 0.04959127 0.04959127 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.104625 -0.024323 -0.002264 -0.000038 0.019351 0.178975 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.13133109 0.16013819 13.3093 < 2.2e-16 *** log(pc) 0.26447567 0.02176030 12.1540 < 2.2e-16 *** log(emp) 0.75811017 0.02660794 28.4919 < 2.2e-16 *** log(hwy) 0.07211418 0.02362627 3.0523 0.002271 ** log(water) 0.07616495 0.01401879 5.4331 5.539e-08 *** log(util) -0.10150953 0.01705158 -5.9531 2.631e-09 *** unemp -0.00583842 0.00091107 -6.4083 1.471e-10 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 34.089 Residual Sum of Squares: 1.0911 R-Squared: 0.96799 Adj. R-Squared: 0.96776 Chisq: 18055 on 6 DF, p-value: < 2.22e-16 > > pProduc_unbal <- pProduc[-c(2, 20:45, 75, 83:85, 500:510, 632:688, 700, 750), ] > summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested")) Nested effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = form, data = pProduc_unbal, effect = "nested", model = "random") Unbalanced Panel: n = 46, T = 2-17, N = 715 Effects: var std.dev share idiosyncratic 0.001419 0.037675 0.168 individual 0.004411 0.066412 0.522 group 0.002621 0.051199 0.310 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.6276977 0.86369441 0.86369441 0.85962816 0.8636944 0.8636944 group 0.0541083 0.06164602 0.06742969 0.07072604 0.0758478 0.2904928 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.106934 -0.024858 -0.002859 -0.000148 0.019879 0.181828 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.0321973 0.1577280 12.8842 < 2.2e-16 *** log(pc) 0.2853607 0.0228505 12.4881 < 2.2e-16 *** log(emp) 0.7218179 0.0286988 25.1515 < 2.2e-16 *** log(hwy) 0.0767983 0.0237052 3.2397 0.001196 ** log(water) 0.0757904 0.0164164 4.6168 3.898e-06 *** log(util) -0.0899237 0.0182257 -4.9339 8.061e-07 *** unemp -0.0070859 0.0010199 -6.9474 3.721e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 33.485 Residual Sum of Squares: 1.0325 R-Squared: 0.96917 Adj. R-Squared: 0.96891 Chisq: 16047.9 on 6 DF, p-value: < 2.22e-16 > summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested", random.method = "walhus")) Nested effects Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = form, data = pProduc_unbal, effect = "nested", model = "random", random.method = "walhus") Unbalanced Panel: n = 46, T = 2-17, N = 715 Effects: var std.dev share idiosyncratic 0.001507 0.038816 0.169 individual 0.004534 0.067336 0.508 group 0.002881 0.053677 0.323 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.62253879 0.8615362 0.86153617 0.85741272 0.86153617 0.8615362 group 0.05672819 0.0643782 0.07021705 0.07356107 0.07867239 0.2969478 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.107045 -0.024879 -0.002859 -0.000151 0.019814 0.181937 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.0281839 0.1571527 12.9058 < 2.2e-16 *** log(pc) 0.2858283 0.0228012 12.5357 < 2.2e-16 *** log(emp) 0.7206212 0.0286704 25.1347 < 2.2e-16 *** log(hwy) 0.0770974 0.0236227 3.2637 0.0011 ** log(water) 0.0758658 0.0164032 4.6251 3.745e-06 *** log(util) -0.0894263 0.0182002 -4.9135 8.947e-07 *** unemp -0.0071093 0.0010199 -6.9702 3.164e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 33.762 Residual Sum of Squares: 1.0348 R-Squared: 0.96936 Adj. R-Squared: 0.9691 Chisq: 16143.7 on 6 DF, p-value: < 2.22e-16 > summary(plm(form, data = pProduc_unbal, model = "random", effect = "nested", random.method = "amemiya")) Nested effects Random Effect Model (Amemiya's transformation) Call: plm(formula = form, data = pProduc_unbal, effect = "nested", model = "random", random.method = "amemiya") Unbalanced Panel: n = 46, T = 2-17, N = 715 Effects: var std.dev share idiosyncratic 0.001419 0.037675 0.139 individual 0.006713 0.081933 0.659 group 0.002056 0.045342 0.202 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.69078564 0.88916192 0.88916192 0.88579289 0.88916192 0.8891619 group 0.03058569 0.03628007 0.04091226 0.04361291 0.04806296 0.2186737 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.105106 -0.024277 -0.002881 -0.000097 0.019620 0.179820 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.0757687 0.1665550 12.4630 < 2.2e-16 *** log(pc) 0.2794706 0.0236526 11.8157 < 2.2e-16 *** log(emp) 0.7358457 0.0291822 25.2156 < 2.2e-16 *** log(hwy) 0.0739908 0.0248387 2.9789 0.002893 ** log(water) 0.0749155 0.0165758 4.5196 6.196e-06 *** log(util) -0.0956244 0.0185165 -5.1643 2.413e-07 *** unemp -0.0068164 0.0010224 -6.6674 2.604e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 28.79 Residual Sum of Squares: 1.0065 R-Squared: 0.96504 Adj. R-Squared: 0.96475 Chisq: 14790.8 on 6 DF, p-value: < 2.22e-16 > > proc.time() user system elapsed 1.23 0.26 1.39 plm/inst/tests/test_groupGenerics_pseries.Rout.save0000644000176200001440000006435014154734502022413 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## test of groupGernerics for 'pseries' objects work > ## test of propagation > ## > ## see further down below (5) for an example of R's behaviour for a wrapping class "myclass" without group Generics > ## see also (6) for a case which cannot be worked around (best to my knowledge) > library(plm) > data("Grunfeld", package = "plm") > Grunfeld[ , "integer"] <- rep(c(1L, 2L, 3L, 4L), 25) > Grunfeld[ , "logi"] <- rep(c(TRUE, FALSE, TRUE, FALSE), 25) > Grunfeld[ , "complex"] <- rep(c(1+0i, 2+1i), 100) > Grunfeld[ , "char"] <- rep(c("a1", "b2"), 100) > Grunfeld[ , "fac"] <- factor(rep(c("a", "b"), 100)) > pGrunfeld <- pdata.frame(Grunfeld, stringsAsFactors = FALSE) > > ############### (1) general checks if group generics and propagation works ########### > > # check Ops: integer -> numeric > stopifnot(all.equal(c("pseries", class(Grunfeld$integer / 33)), class(pGrunfeld$integer / 33))) > > # check Ops: logical -> numeric > stopifnot(all.equal(c("pseries", class(Grunfeld$logi + 1.1)), class(pGrunfeld$logi + 1.1))) > stopifnot(all.equal(c("pseries", class(-Grunfeld$logi)), class(-pGrunfeld$logi))) > > stopifnot(all(class(diff(pGrunfeld$logi)) == c("pseries", "integer"))) > > ## check Ops: non-vector result, result is matrix (may not be class c("pseries", "matrix")) > mdat <- matrix(c(1:200), nrow = 200, ncol = 1, byrow = TRUE) > stopifnot(inherits(pGrunfeld$integer * mdat, "matrix")) > stopifnot(inherits(pGrunfeld$logi * mdat, "matrix")) > stopifnot(inherits(mdat * pGrunfeld$integer, "matrix")) > stopifnot(inherits(mdat * pGrunfeld$logi, "matrix")) > > # check Math: also with optional second argument (check calculation and class) > stopifnot(all.equal(log(Grunfeld$integer), as.numeric(log(pGrunfeld$integer)))) > stopifnot(all.equal(c("pseries", class(log(Grunfeld$integer))), class(log(pGrunfeld$integer)))) > > stopifnot(all.equal(log(Grunfeld$integer, 20), as.numeric(log(pGrunfeld$integer, 20)))) > stopifnot(all.equal(c("pseries", class(log(Grunfeld$integer, 20))), class(log(pGrunfeld$integer, 20)))) > > > # check Complex > stopifnot(all(c("pseries", class(Re(Grunfeld$logi))) == class(Re(pGrunfeld$logi)))) > stopifnot(all(c("pseries", class(Im(Grunfeld$logi))) == class(Im(pGrunfeld$logi)))) > stopifnot(all(c("pseries", class(Conj(Grunfeld$logi))) == class(Re(pGrunfeld$logi)))) > stopifnot(all(c("pseries", class(Conj(Grunfeld$complex))) == class(Conj(pGrunfeld$complex)))) > # this is a downward propagation complex -> numeric > stopifnot(all(c("pseries", class(Re(Grunfeld$complex))) == class(Re(pGrunfeld$complex)))) > > ############# (2) check of model estimation with dependent variable as integer ######### > ## During testing phase of the implementation of groupGenerics, it became apparent that > ## non-correct implementation yields different results when an integer serves as dependent > ## variable -> use an integer as test case > data("Produc", package = "plm") > > ## gsp is an integer > form <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp > zz <- plm(form, data = Produc, index=c("state","year"), model = "within") > print(summary(zz)) Oneway (individual) effect Within Model Call: plm(formula = form, data = Produc, model = "within", index = c("state", "year")) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.120456 -0.023741 -0.002041 0.018144 0.174718 Coefficients: Estimate Std. Error t-value Pr(>|t|) log(pcap) -0.02614965 0.02900158 -0.9017 0.3675 log(pc) 0.29200693 0.02511967 11.6246 < 2.2e-16 *** log(emp) 0.76815947 0.03009174 25.5273 < 2.2e-16 *** unemp -0.00529774 0.00098873 -5.3582 1.114e-07 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 18.941 Residual Sum of Squares: 1.1112 R-Squared: 0.94134 Adj. R-Squared: 0.93742 F-statistic: 3064.81 on 4 and 764 DF, p-value: < 2.22e-16 > > pProduc <- pdata.frame(Produc) > pProduc$gsp2 <- as.numeric(pProduc$gsp) > > zz2 <- plm(update(form, log(gsp2) ~ . ), data = pProduc, index = c("state","year"), model = "within") > print(summary(zz2)) Oneway (individual) effect Within Model Call: plm(formula = update(form, log(gsp2) ~ .), data = pProduc, model = "within", index = c("state", "year")) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.120456 -0.023741 -0.002041 0.018144 0.174718 Coefficients: Estimate Std. Error t-value Pr(>|t|) log(pcap) -0.02614965 0.02900158 -0.9017 0.3675 log(pc) 0.29200693 0.02511967 11.6246 < 2.2e-16 *** log(emp) 0.76815947 0.03009174 25.5273 < 2.2e-16 *** unemp -0.00529774 0.00098873 -5.3582 1.114e-07 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 18.941 Residual Sum of Squares: 1.1112 R-Squared: 0.94134 Adj. R-Squared: 0.93742 F-statistic: 3064.81 on 4 and 764 DF, p-value: < 2.22e-16 > > if (!isTRUE(all.equal(zz$coefficients, zz2$coefficients))) stop("estimation results not equal") > > > ############# (3) assinging 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. > > Grunfeld[ , "integer"] <- rep(c(1L, 2L, 3L, 4L), 25) > Grunfeld[ , "logi"] <- rep(c(TRUE, FALSE, TRUE, FALSE), 25) > pGrunfeld <- pdata.frame(Grunfeld) > > class(pGrunfeld[ , "integer"]) [1] "pseries" "integer" > class(pGrunfeld[ , "integer"] / 3) [1] "pseries" "numeric" > > # assign: we don't (yet?) have methods for [<-.pdata.frame and [[<-.pdata.frame, so it dispatches to the respective data.frame methods > # This results in really assigning a pseries to the pdata.frame in case of [<- and [[<- as can be seen by lapply(pGrunfeld, class) > pGrunfeld[ , "int2double"] <- pGrunfeld$integer / 30 > pGrunfeld$int2double2 <- pGrunfeld$integer / 30 # this case by assigning with $<- is treated differently as we have "$<-.pdata.frame" defined > pGrunfeld[["int2double3"]] <- pGrunfeld$integer / 30 > > class(pGrunfeld[ , "int2double"]) [1] "pseries" "numeric" > class(pGrunfeld[ , "int2double2"]) [1] "pseries" "numeric" > class(pGrunfeld[ , "int2double3"]) [1] "pseries" "numeric" > > typeof(pGrunfeld[ , "int2double"]) [1] "double" > typeof(pGrunfeld[ , "int2double2"]) [1] "double" > typeof(pGrunfeld[ , "int2double3"]) [1] "double" > > # check values > if(isTRUE(all.equal(as.numeric(pGrunfeld[ , "int2double"]), rep(0, 200)))) stop("when assigning by [<-: double casted to integer (wrong result)") > if(isTRUE(all.equal(as.numeric(pGrunfeld$int2double2), rep(0, 200)))) stop("when assigning by $<-: double casted to integer (wrong result)") > if(isTRUE(all.equal(as.numeric(pGrunfeld[ , "int2double3"]), rep(0, 200)))) stop("when assigning by [[<-: double casted to integer (wrong result)") > > # check classes > if(!isTRUE(all.equal(class(pGrunfeld[ , "int2double"]), c("pseries", "numeric")))) stop("when assigning by [<-: double casted to logical (wrong class)") > if(!isTRUE(all.equal(class(pGrunfeld$int2double2), c("pseries", "numeric")))) stop("when assigning by $<-: double casted to logical (wrong class)") > if(!isTRUE(all.equal(class(pGrunfeld[ , "int2double3"]), c("pseries", "numeric")))) stop("when assigning by [[<-: double casted to logical (wrong class)") > > ## same with logicals: > pGrunfeld[ , "logi2double1"] <- pGrunfeld$logi / 10 > pGrunfeld$logi2double2 <- pGrunfeld$logi / 10 > pGrunfeld[["logi2double3"]] <- pGrunfeld$logi / 10 > > class(pGrunfeld[ , "logi2double1"]) [1] "pseries" "numeric" > class(pGrunfeld[ , "logi2double2"]) [1] "pseries" "numeric" > class(pGrunfeld[ , "logi2double3"]) [1] "pseries" "numeric" > > typeof(pGrunfeld[ , "logi2double1"]) [1] "double" > typeof(pGrunfeld[ , "logi2double2"]) [1] "double" > typeof(pGrunfeld[ , "logi2double3"]) [1] "double" > > # check values > if(!isTRUE(all.equal(as.numeric(pGrunfeld[ , "logi2double1"]), rep(c(0.1, 0.0), 100)))) stop("when assigning by [<-: double casted to logical (wrong result)") > if(!isTRUE(all.equal(as.numeric(pGrunfeld$logi2double2), rep(c(0.1, 0.0), 100)))) stop("when assigning by $<-: double casted to logical (wrong result)") > if(!isTRUE(all.equal(as.numeric(pGrunfeld[ , "logi2double3"]), rep(c(0.1, 0.0), 100)))) stop("when assigning by [[<-: double casted to logical (wrong result)") > > # check classes > if(!isTRUE(all.equal(class(pGrunfeld[ , "logi2double1"]), c("pseries", "numeric")))) stop("when assigning by [<-: double casted to logical (wrong class)") > if(!isTRUE(all.equal(class(pGrunfeld$logi2double2), c("pseries", "numeric")))) stop("when assigning by $<-: double casted to logical (wrong class)") > if(!isTRUE(all.equal(class(pGrunfeld[ , "logi2double3"]), c("pseries", "numeric")))) stop("when assigning by [[<-: double casted to logical (wrong class)") > > > ############## (4) test for various kinds of argument combinations in Ops.pseries ############## > > # e1: pseries, e2: not a pseries and vice versa > # -> result must be a pseries in both cases > e1e2_a <- `*`(pGrunfeld$integer, 4L) > e1e2_b <- `*`(4L, pGrunfeld$integer) > class(e1e2_a) [1] "pseries" "integer" > class(e1e2_b) [1] "pseries" "integer" > stopifnot(is.pseries(e1e2_a)) > stopifnot(is.pseries(e1e2_b)) > stopifnot(isTRUE(all.equal(e1e2_a, e1e2_b))) > > # e1, e2: pseries with varying length > # -> result must have index of longer pseries (as the shorter pseries is recycled) > pGrunfeld_short <- pGrunfeld[4:5, ] > e1e2_c <- `*`(pGrunfeld$integer, pGrunfeld_short$integer) > e1e2_d <- `*`(pGrunfeld_short$integer, pGrunfeld$integer) > length(e1e2_c) [1] 200 > length(e1e2_d) [1] 200 > index(e1e2_c) firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > index(e1e2_d) firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > nrow(index(e1e2_c)) [1] 200 > nrow(index(e1e2_d)) [1] 200 > stopifnot(is.pseries(e1e2_c)) > stopifnot(is.pseries(e1e2_d)) > stopifnot(isTRUE(all.equal(index(e1e2_c), index(pGrunfeld$integer)))) > stopifnot(isTRUE(all.equal(index(e1e2_d), index(pGrunfeld$integer)))) > > # e1, e2: pseries with index of same length but different content > # -> result is assigned index of first operand > Gr <- Grunfeld > Gr$firm <- sort(rep(LETTERS[1:10], 20)) # make individual index different > pGr <- pdata.frame(Gr, stringsAsFactors = FALSE) > e1e2_e <- `*`(pGr$integer, pGrunfeld$integer) > e1e2_f <- `*`(pGrunfeld$integer, pGr$integer) > index(e1e2_e) firm year 1 A 1935 2 A 1936 3 A 1937 4 A 1938 5 A 1939 6 A 1940 7 A 1941 8 A 1942 9 A 1943 10 A 1944 11 A 1945 12 A 1946 13 A 1947 14 A 1948 15 A 1949 16 A 1950 17 A 1951 18 A 1952 19 A 1953 20 A 1954 21 B 1935 22 B 1936 23 B 1937 24 B 1938 25 B 1939 26 B 1940 27 B 1941 28 B 1942 29 B 1943 30 B 1944 31 B 1945 32 B 1946 33 B 1947 34 B 1948 35 B 1949 36 B 1950 37 B 1951 38 B 1952 39 B 1953 40 B 1954 41 C 1935 42 C 1936 43 C 1937 44 C 1938 45 C 1939 46 C 1940 47 C 1941 48 C 1942 49 C 1943 50 C 1944 51 C 1945 52 C 1946 53 C 1947 54 C 1948 55 C 1949 56 C 1950 57 C 1951 58 C 1952 59 C 1953 60 C 1954 61 D 1935 62 D 1936 63 D 1937 64 D 1938 65 D 1939 66 D 1940 67 D 1941 68 D 1942 69 D 1943 70 D 1944 71 D 1945 72 D 1946 73 D 1947 74 D 1948 75 D 1949 76 D 1950 77 D 1951 78 D 1952 79 D 1953 80 D 1954 81 E 1935 82 E 1936 83 E 1937 84 E 1938 85 E 1939 86 E 1940 87 E 1941 88 E 1942 89 E 1943 90 E 1944 91 E 1945 92 E 1946 93 E 1947 94 E 1948 95 E 1949 96 E 1950 97 E 1951 98 E 1952 99 E 1953 100 E 1954 101 F 1935 102 F 1936 103 F 1937 104 F 1938 105 F 1939 106 F 1940 107 F 1941 108 F 1942 109 F 1943 110 F 1944 111 F 1945 112 F 1946 113 F 1947 114 F 1948 115 F 1949 116 F 1950 117 F 1951 118 F 1952 119 F 1953 120 F 1954 121 G 1935 122 G 1936 123 G 1937 124 G 1938 125 G 1939 126 G 1940 127 G 1941 128 G 1942 129 G 1943 130 G 1944 131 G 1945 132 G 1946 133 G 1947 134 G 1948 135 G 1949 136 G 1950 137 G 1951 138 G 1952 139 G 1953 140 G 1954 141 H 1935 142 H 1936 143 H 1937 144 H 1938 145 H 1939 146 H 1940 147 H 1941 148 H 1942 149 H 1943 150 H 1944 151 H 1945 152 H 1946 153 H 1947 154 H 1948 155 H 1949 156 H 1950 157 H 1951 158 H 1952 159 H 1953 160 H 1954 161 I 1935 162 I 1936 163 I 1937 164 I 1938 165 I 1939 166 I 1940 167 I 1941 168 I 1942 169 I 1943 170 I 1944 171 I 1945 172 I 1946 173 I 1947 174 I 1948 175 I 1949 176 I 1950 177 I 1951 178 I 1952 179 I 1953 180 I 1954 181 J 1935 182 J 1936 183 J 1937 184 J 1938 185 J 1939 186 J 1940 187 J 1941 188 J 1942 189 J 1943 190 J 1944 191 J 1945 192 J 1946 193 J 1947 194 J 1948 195 J 1949 196 J 1950 197 J 1951 198 J 1952 199 J 1953 200 J 1954 > index(e1e2_f) firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > stopifnot(is.pseries(e1e2_e)) > stopifnot(is.pseries(e1e2_f)) > > > > ############## (5) demonstration of R's behaviour for a wrapping class "myclass" without group generics ############## > > x <- c(1L, 2L, 3L) > class(x) # integer [1] "integer" > mode(x) [1] "numeric" > typeof(x) [1] "integer" > > y <- x > class(y) <- c("myclass", class(y)) > class(y) # c("myclass", "integer") [1] "myclass" "integer" > mode(y) [1] "numeric" > typeof(y) [1] "integer" > > x2 <- x / 10 > class(x2) # numeric - propagated to higher class numeric [1] "numeric" > mode(x2) [1] "numeric" > typeof(x2) [1] "double" > > y2 <- y / 10 > class(y2) # c("myclass", "interger") - not propagated to c("myclass", "numeric") [1] "myclass" "integer" > mode(y2) [1] "numeric" > typeof(y2) [1] "double" > y2 # 0.1 0.2 0.3 - class is c("myclass", "integer") but result is decimals! [1] 0.1 0.2 0.3 attr(,"class") [1] "myclass" "integer" > > y3 <- y2 > typeof(y3) # double [1] "double" > class(y3) <- setdiff(class(y3), "myclass") > class(y3) # integer [1] "integer" > mode(y3) [1] "numeric" > typeof(y3) # integer [1] "integer" > y3 # 0 0 0 - integers after class() <- "integer" [1] 0 0 0 > > y4 <- y2 > attr(y4, "class") [1] "myclass" "integer" > attr(y4, "class") <- NULL > class(y4) [1] "numeric" > mode(y4) [1] "numeric" > typeof(y4) [1] "double" > y4 # 0.1 0.2 0.3 numerics after attr(obj, "class") <- NULL [1] 0.1 0.2 0.3 > > fac <- factor(x) > class(fac) [1] "factor" > typeof(fac) [1] "integer" > mode(fac) [1] "numeric" > > logi <- c(TRUE, FALSE, TRUE) > class(logi) # logical [1] "logical" > typeof(logi) # logical [1] "logical" > class(logi) <- c("myclass", class(logi)) > class(logi) # myclass logical [1] "myclass" "logical" > loginum <- logi - 1.5 > class(loginum) # myclass logical [1] "myclass" "logical" > typeof(loginum) # double [1] "double" > > ############## (6) demonstrate case of R's behaviour which cannot be worked around even with without group generics ############## > # dpois() (also dnorm() and likely more) does not strip unnecessary classes and custom attributes > # before it performs its operations > ## see also ## see also: https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17516 > class(pGrunfeld$integer) # "pseries" "integer" [1] "pseries" "integer" > set.seed(42) > res_dpois <- dpois(pGrunfeld$integer, sample(1:10, 200, replace = TRUE)) > class(res_dpois) # "pseries" "integer" <-- can do nothing about his [1] "pseries" "integer" > typeof(res_dpois) # double [1] "double" > str(res_dpois) 'pseries' Named num [1:200] 0.367879 0.084224 0.061313 0.033737 0.000454 ... - attr(*, "names")= chr [1:200] "1-1935" "1-1936" "1-1937" "1-1938" ... - attr(*, "index")=Classes 'pindex' and 'data.frame': 200 obs. of 2 variables: ..$ firm: Factor w/ 10 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ... ..$ year: Factor w/ 20 levels "1935","1936",..: 1 2 3 4 5 6 7 8 9 10 ... > res_pmax <- pmax(res_dpois, .Machine[["double.eps"]]) > # this errored for a while when no correction in remove_pseries_features() was in place: > if(isTRUE(all.equal(as.numeric(res_pmax), rep(.Machine[["double.eps"]], 200)))) { + stop("pmax gives wrong result due wrong coercion (integer/numeric)") + } > > proc.time() user system elapsed 2.78 0.37 3.18 plm/inst/tests/test_pvcm.R0000644000176200001440000000306714126005632015315 0ustar liggesusers## Test of pvcm # # residuals should be of class c("pseries", "numeric) [since rev. 713] # library(plm) data("Produc", package = "plm") zw <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") zr <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") print(zw$residuals) class(zw$residuals) print(zw$coefficients) class(zw$coefficients) summary(zw) pwaldtest(zw) print(zr$residuals) class(zr$residuals) print(zr$coefficients) class(zr$coefficients) summary(zr) pwaldtest(zr) # run tests intercept-only models zwint <- pvcm(log(gsp) ~ 1, data = Produc, model = "within") zwint2 <- pvcm(log(gsp) ~ 1, data = Produc[1:17, ], model = "within") # test with only one individual summary(zwint) # gave multiple intercept summaries up until rev. 1199 stopifnot(dim(coef(zwint)) == c(48, 1)) # pwaldtest(zwint) # errors rightfully, and since rev. 1200 also informatively zrint <- pvcm(log(gsp) ~ 1, data = Produc, model = "random") # zrint2 <- pvcm(log(gsp) ~ 1, data = Produc[1:17, ], model = "random") # only one individual -> errors -> catch case? summary(zrint) # does not calculate Wald statistic (rightfully, as only intercept) # pwaldtest(zrint) # errors rightfully, and since rev. 1202 also informatively ## Stata example: ## http://www.stata.com/manuals/xtxtrc.pdf ## replicate Stata's example: # dat <- haven::read_dta("http://www.stata-press.com/data/r15/invest2.dta") # pvcm(invest ~ market + stock, data = dat, index = c("company", "time"), model = "random") plm/inst/tests/test_fixef_comp_lm_plm.Rout.save0000644000176200001440000004336514124132276021524 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Grunfeld", package = "plm") > Grunfeld_unbalanced <- Grunfeld[1:199, ] > > ## fixef() is related to within_intercept() > ## see also: > ## * test file tests/test_within_intercept.R > ## * test file tests/test_fixef.R > ## * test file tests/test_fixef2.R > > ### TODO: > ## * test vcov, once the standard errors have been modified to > ## accommodate the unbalanced case (see (3)) > > ## (1) tests of effects in balanced case > ## (2) tests of effects in unbalanced case > ## (3) tests of standard errors in balanced and unbalanced case > > ######### (1) balanced ############ > > # plm oneway individual balanced > plm_fe_oneway_ind <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "individual") > fixef_plm_oneway_ind_dfirst <- fixef(plm_fe_oneway_ind, type = "dfirst", effect = "individual") > > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_ind)), + (within_intercept(plm_fe_oneway_ind) + + fixef(plm_fe_oneway_ind, type = "dmean", effect = "individual")[as.character(index(plm_fe_oneway_ind)[[1]])] + + as.vector(tcrossprod(coef(plm_fe_oneway_ind), as.matrix(plm_fe_oneway_ind$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/id: effects not correct") > > # plm oneway time balanced > plm_fe_oneway_time <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") > fixef_plm_oneway_time_dfirst <- fixef(plm_fe_oneway_time, type = "dfirst", effect = "time") > > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_time)), + (within_intercept(plm_fe_oneway_time) + + fixef(plm_fe_oneway_time, type = "dmean", effect = "time")[as.character(index(plm_fe_oneway_time)[[2]])] + + as.vector(tcrossprod(coef(plm_fe_oneway_time), as.matrix(plm_fe_oneway_time$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/time: effects not correct") > > # plm twoways balanced > plm_fe_tw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") > fixef_plm_tw_ind_dfirst <- fixef(plm_fe_tw, type = "dfirst", effect = "individual") > fixef_plm_tw_time_dfirst <- fixef(plm_fe_tw, type = "dfirst", effect = "time") > > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_tw)), + (within_intercept(plm_fe_tw) + + fixef(plm_fe_tw, type = "dmean", effect = "individual")[as.character(index(plm_fe_tw)[[1]])] + + fixef(plm_fe_tw, type = "dmean", effect = "time")[as.character(index(plm_fe_tw)[[2]])] + + as.vector(tcrossprod(coef(plm_fe_tw), as.matrix(plm_fe_tw$model[ , 2:3])))), check.attributes = FALSE))) stop("2way bal: effects not correct") > > # lm oneway individual balanced > lm_fe_oneway_ind <- lm(inv ~ value + capital + factor(firm), data = Grunfeld) > fixef_lm_oneway_ind_dfirst <- lm_fe_oneway_ind$coefficients[4:12] > > # lm oneway time balanced > lm_fe_oneway_time <- lm(inv ~ value + capital + factor(year), data = Grunfeld) > fixef_lm_oneway_time_dfirst <- lm_fe_oneway_time$coefficients[4:22] > > # lm twoways balanced > lm_fe_tw <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld) > fixef_lm_tw_ind_dfirst <- lm_fe_tw$coefficients[4:12] > fixef_lm_tw_time_dfirst <- lm_fe_tw$coefficients[13:31] > > > # Test residuals oneway individual and time; twoway balanced > if(!isTRUE(all.equal(residuals(lm_fe_oneway_ind), as.numeric(residuals(plm_fe_oneway_ind)), check.attributes = FALSE))) + stop("one-way individual balanced model: residuals do not match (lm vs. plm)") > > if(!isTRUE(all.equal(residuals(lm_fe_oneway_time), as.numeric(residuals(lm_fe_oneway_time)), check.attributes = FALSE))) + stop("one-way time balanced model: residuals do not match (lm vs. plm)") > > if(!isTRUE(all.equal(residuals(lm_fe_tw), as.numeric(residuals(plm_fe_tw)), check.attributes = FALSE))) + stop("two-ways balanced model: residuals do not match (lm vs. plm)") > > > # Test balanced one-way and two-way dfirst fixefs: lm vs. plm > if(!isTRUE(all.equal(fixef_lm_oneway_ind_dfirst, as.numeric(fixef_plm_oneway_ind_dfirst), check.attributes = FALSE))) + stop("individual effects do not match") > > if(!isTRUE(all.equal(fixef_lm_oneway_time_dfirst, as.numeric(fixef_plm_oneway_time_dfirst), check.attributes = FALSE))) + stop("time effects do not match") > > if(!isTRUE(all.equal(fixef_lm_tw_ind_dfirst, as.numeric(fixef_plm_tw_ind_dfirst), check.attributes = FALSE))) + stop("individual effects do not match") > > if(!isTRUE(all.equal(fixef_lm_tw_time_dfirst, as.numeric(fixef_plm_tw_time_dfirst), check.attributes = FALSE))) + stop("time effects do not match") > > > > > ######### (2) unbalanced ############ > > # plm one-way individual unbalanced > plm_fe_oneway_ind_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "individual") > fixef_plm_oneway_ind_dfirst_u <- fixef(plm_fe_oneway_ind_u, type = "dfirst", effect = "individual") > > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_ind_u)), + (within_intercept(plm_fe_oneway_ind_u) + + fixef(plm_fe_oneway_ind_u, type = "dmean", effect = "individual")[as.character(index(plm_fe_oneway_ind_u)[[1]])] + + as.vector(tcrossprod(coef(plm_fe_oneway_ind_u), as.matrix(plm_fe_oneway_ind_u$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/id: effects not correct") > > # plm one-way time unbalanced > plm_fe_oneway_time_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "time") > fixef_plm_oneway_time_dfirst_u <- fixef(plm_fe_oneway_time_u, type = "dfirst", effect = "time") > > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_oneway_time_u)), + (within_intercept(plm_fe_oneway_time_u) + + fixef(plm_fe_oneway_time_u, type = "dmean", effect = "time")[as.character(index(plm_fe_oneway_time_u)[[2]])] + + as.vector(tcrossprod(coef(plm_fe_oneway_time_u), as.matrix(plm_fe_oneway_time_u$model[ , 2:3])))), check.attributes = FALSE))) stop("1way unbal/time: effects not correct") > > > # plm twoways unbalanced > plm_fe_tw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "twoways") > fixef_plm_tw_ind_dfirst_u <- fixef(plm_fe_tw_u, type = "dfirst", effect = "individual") > fixef_plm_tw_time_dfirst_u <- fixef(plm_fe_tw_u, type = "dfirst", effect = "time") > > ## the level effects in case of 2-way unbalanced are not correct?, hence the dmean specification is not correct? > if(!isTRUE(all.equal(as.numeric(plm:::fitted_exp.plm(plm_fe_tw_u)), + (within_intercept(plm_fe_tw_u) + + fixef(plm_fe_tw_u, type = "dmean", effect = "individual")[as.character(index(plm_fe_tw_u)[[1]])] + + fixef(plm_fe_tw_u, type = "dmean", effect = "time")[as.character(index(plm_fe_tw_u)[[2]])] + + as.vector(tcrossprod(coef(plm_fe_tw_u), as.matrix(plm_fe_tw_u$model[ , 2:3])))), check.attributes = FALSE))) stop("tw unbal: effects not correct") > > > # lm oneway individual unbalanced > lm_fe_oneway_ind_u <- lm(inv ~ value + capital + factor(firm), data = Grunfeld_unbalanced) > fixef_lm_oneway_ind_dfirst_u <- lm_fe_oneway_ind_u$coefficients[4:12] > > # lm oneway time unbalanced > lm_fe_oneway_time_u <- lm(inv ~ value + capital + factor(year), data = Grunfeld_unbalanced) > fixef_lm_oneway_time_dfirst_u <- lm_fe_oneway_time_u$coefficients[4:22] > > > # lm twoways unbalanced > lm_fe_tw_u <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) > fixef_lm_tw_ind_dfirst_u <- lm_fe_tw_u$coefficients[4:12] > fixef_lm_tw_time_dfirst_u <- lm_fe_tw_u$coefficients[13:31] > > # lm twoways unbalanced with contrast coding > Grunfeld_unbalanced_fac <- Grunfeld_unbalanced > Grunfeld_unbalanced_fac$firm <- factor(Grunfeld_unbalanced_fac$firm) > Grunfeld_unbalanced_fac$year <- factor(Grunfeld_unbalanced_fac$year) > lm_fe_tw_u_eff_cod <- lm(inv ~ value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.sum", year="contr.sum")) > lm_fe_tw_u_eff_cod_wo_int <- lm(inv ~ 0 + value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.sum", year="contr.sum")) > > # replicates SAS - 2-way unbalanced > lm_fe_tw_u_eff_cod_SAS_w_Int <- lm(inv ~ value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS", year="contr.SAS")) > lm_fe_tw_u_eff_cod_SAS <- lm(inv ~ 0 + value + capital + firm + year, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS", year="contr.SAS")) > lm_fe_tw_u_eff_cod_SAS$coefficients[3:12] ## correct level specification for individuals? firm1 firm2 firm3 firm4 firm5 firm6 firm7 -192.75787 17.29792 -325.30255 -92.83502 -194.44185 -85.03009 -136.91837 firm8 firm9 firm10 -120.56599 -158.25739 -63.30781 > lm_fe_tw_u_eff_cod_SAS$coefficients[3:12] - mean(lm_fe_tw_u_eff_cod_SAS$coefficients[3:12]) ## correct dmean specification for individuals (matches EViews) firm1 firm2 firm3 firm4 firm5 firm6 -57.545973 152.509825 -190.090649 42.376886 -59.229951 50.181808 firm7 firm8 firm9 firm10 -1.706466 14.645916 -23.045488 71.904093 > > > lm_fe_tw_u_eff_cod_SAS_time <- lm(inv ~ 0 + value + capital + year + firm, data = Grunfeld_unbalanced_fac, contrasts = list(year="contr.SAS", firm="contr.SAS")) > lm_fe_tw_u_eff_cod_SAS_time$coefficients[3:22] - mean(lm_fe_tw_u_eff_cod_SAS_time$coefficients[3:22]) ## time effect: does _NOT_ match EViews?! year1935 year1936 year1937 year1938 year1939 year1940 year1941 48.593186 29.064161 7.264162 9.008158 -21.471466 3.710778 29.119648 year1942 year1943 year1944 year1945 year1946 year1947 year1948 26.860543 4.901031 4.759426 -7.936753 16.480113 8.235932 3.803099 year1949 year1950 year1951 year1952 year1953 year1954 -26.105664 -28.618549 -15.456697 -17.835127 -21.352071 -53.023909 > > ## oneway unbalanced: SAS matches fixef() > lm_fe_tw_u_eff_cod_SAS_1way_unbal_ind <- lm(inv ~ 0 + value + capital + firm, data = Grunfeld_unbalanced_fac, contrasts = list(firm="contr.SAS")) > fixef(plm_fe_oneway_ind_u) 1 2 3 4 5 6 7 8 -70.2994 101.9046 -235.5729 -27.8097 -114.6164 -23.1615 -66.5532 -57.5461 9 10 -87.2222 -6.6123 > lm_fe_tw_u_eff_cod_SAS_1way_unbal_time <- lm(inv ~ 0 + value + capital + year, data = Grunfeld_unbalanced_fac, contrasts = list(year="contr.SAS")) > fixef(plm_fe_oneway_time_u) 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 -23.657 -40.872 -58.192 -52.237 -80.056 -54.321 -26.480 -25.337 -45.728 -46.040 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 -57.527 -30.982 -29.354 -28.107 -53.046 -52.642 -35.990 -30.040 -22.116 -40.609 > > > > # Test unbalanced residuals oneway individual and time; twoway > if(!isTRUE(all.equal(residuals(lm_fe_oneway_ind_u), as.numeric(residuals(plm_fe_oneway_ind_u)), check.attributes = FALSE))) + stop("one-way individual unbalanced model: residuals do not match (lm vs. plm)") > > if(!isTRUE(all.equal(residuals(lm_fe_oneway_time_u), as.numeric(residuals(lm_fe_oneway_time_u)), check.attributes = FALSE))) + stop("one-way time unbalanced model: residuals do not match (lm vs. plm)") > > if(!isTRUE(all.equal(residuals(lm_fe_tw_u), as.numeric(residuals(plm_fe_tw_u)), check.attributes = FALSE))) + stop("two-ways unbalanced model: residuals do not match (lm vs. plm)") > > > # Test unbalanced one-way and two-way dfirst fixefs: lm vs. plm > if(!isTRUE(all.equal(fixef_lm_oneway_ind_dfirst_u, as.numeric(fixef_plm_oneway_ind_dfirst_u), check.attributes = FALSE))) + stop("oneway individual unbalanced: dfirst fixefs do not match") > > if(!isTRUE(all.equal(fixef_lm_oneway_time_dfirst_u, as.numeric(fixef_plm_oneway_time_dfirst_u), check.attributes = FALSE))) + stop("oneway time unbalanced: dfirst fixefs do not match") > > if(!isTRUE(all.equal(fixef_lm_tw_ind_dfirst_u, as.numeric(fixef_plm_tw_ind_dfirst_u), check.attributes = FALSE))) + stop("two-ways individual unbalanced: dfirst fixefs do not match") > > if(!isTRUE(all.equal(fixef_lm_tw_time_dfirst_u, as.numeric(fixef_plm_tw_time_dfirst_u), check.attributes = FALSE))) + stop("two-ways time unbalanced: dfirst fixefs do not match") > > > #### test with levels: first component of individual and time effect _in levels_ equal? > # ## balanced > plm_fw_tw_ind_level <- fixef(plm_fe_tw, type = "level", effect = "individual") > plm_fw_tw_time_level <- fixef(plm_fe_tw, type = "level", effect = "time") > if(isTRUE(!all.equal(plm_fw_tw_ind_level[1], plm_fw_tw_time_level[1], check.attributes = FALSE))) { + stop("two-ways balanced levels: first components of individual and time effect in levels are not equal") + } > ## unbalanced > plm_fw_tw_ind_level_u <- fixef(plm_fe_tw_u, type = "level", effect = "individual") > plm_fw_tw_time_level_u <- fixef(plm_fe_tw_u, type = "level", effect = "time") > if(isTRUE(!all.equal(plm_fw_tw_ind_level_u[1], plm_fw_tw_time_level_u[1], check.attributes = FALSE))) { + stop("two-ways unbalanced levels: first components of individual and time effect in levels are not equal") + } > > > ######### (3) Test of standard errors, balanced and unbalanced ############ > > # oneway ind, time balanced > sum_lm_fe_oneway_ind <- summary(lm_fe_oneway_ind) > sum_lm_fe_oneway_time <- summary(lm_fe_oneway_time) > sum_plm_fixef_lm_oneway_ind_dfirst <- summary(fixef_plm_oneway_ind_dfirst) > sum_plm_fixef_lm_oneway_time_dfirst <- summary(fixef_plm_oneway_time_dfirst) > > # twoways ind, time balanced > sum_lm_fe_tw <- summary(lm_fe_tw) > sum_plm_fixef_lm_tw_ind_dfirst <- summary(fixef_plm_tw_ind_dfirst) > sum_plm_fixef_lm_tw_time_dfirst <- summary(fixef_plm_tw_time_dfirst) > > # oneway ind, time unbalanced > sum_lm_fe_oneway_ind_u <- summary(lm_fe_oneway_ind_u) > sum_lm_fe_oneway_time_u <- summary(lm_fe_oneway_time_u) > sum_plm_fixef_lm_oneway_ind_dfirst_u <- summary(fixef_plm_oneway_ind_dfirst_u) > sum_plm_fixef_lm_oneway_time_dfirst_u <- summary(fixef_plm_oneway_time_dfirst_u) > > # twoways ind, time unbalanced > sum_lm_fe_tw_u <- summary(lm_fe_tw_u) > sum_plm_fixef_lm_tw_ind_dfirst_u <- summary(fixef_plm_tw_ind_dfirst_u) > sum_plm_fixef_lm_tw_time_dfirst_u <- summary(fixef_plm_tw_time_dfirst_u) > > # one-way balanced > if(!isTRUE(all.equal(sum_lm_fe_oneway_ind[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_oneway_ind_dfirst[ , "Std. Error"], check.attributes = FALSE))) + stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > if(!isTRUE(all.equal(sum_lm_fe_oneway_time[["coefficients"]][c(4:22) , "Std. Error"], sum_plm_fixef_lm_oneway_time_dfirst[ , "Std. Error"], check.attributes = FALSE))) + stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > # one-way unbalanced > if(!isTRUE(all.equal(sum_lm_fe_oneway_ind_u[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_oneway_ind_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) + stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > if(!isTRUE(all.equal(sum_lm_fe_oneway_time_u[["coefficients"]][c(4:22) , "Std. Error"], sum_plm_fixef_lm_oneway_time_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) + stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > # two-ways balanced > ##### Tests deactivated as SEs are currently not computed for two-way FE > #if(!isTRUE(all.equal(sum_lm_fe_tw[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_tw_ind_dfirst[ , "Std. Error"], check.attributes = FALSE))) > # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > #if(!isTRUE(all.equal(sum_lm_fe_tw[["coefficients"]][c(13:31) , "Std. Error"], sum_plm_fixef_lm_tw_time_dfirst[ , "Std. Error"], check.attributes = FALSE))) > # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > # two-ways unbalanced - does not yet match > # if (!isTRUE(all.equal(sum_lm_fe_tw_u[["coefficients"]][c(4:12) , "Std. Error"], sum_plm_fixef_lm_tw_ind_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) > # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > # if (!isTRUE(all.equal(sum_lm_fe_tw_u[["coefficients"]][c(13:31) , "Std. Error"], sum_plm_fixef_lm_tw_time_dfirst_u[ , "Std. Error"], check.attributes = FALSE))) > # stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") > > > proc.time() user system elapsed 3.00 0.35 3.34 plm/inst/tests/test_Estimators.R0000644000176200001440000003647314154734502016517 0ustar liggesusers#### Replicate results of various sources and additional run tests, compared to the corresponding .Rout.save #### #### (1): Baltagi (2013) #### (2): Stata's FE estimator #### (3): test of unbalanced one-way RE Swamy/Arora on Hedonic data set #### (1) #### #### compare OLS, FE and RE estimators to Baltagi's results # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons # oneway: sec. 2.6, example 1 p. 27, table 2.1 # twoways: sec. 3.6, example 1 p. 51, table 3.1 # # = Baltagi (2005), p. 21 (oneway), p. 43 (twoways) # Table 2.1 Grunfeld's Data One-way Error Component Results # beta1 beta2 rho sigma_me sigma_nu #-------------------------------------------------- # [...] library(plm) data("Grunfeld", package = "plm") Grunfeld_unbal <- Grunfeld[1:199, ] #### oneway individual balanced plm_grunfeld_pooled <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") plm_grunfeld_be <- plm(inv ~ value + capital, data=Grunfeld, model="between") plm_grunfeld_fe <- plm(inv ~ value + capital, data=Grunfeld, model="within") plm_grunfeld_re_walhus <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus") plm_grunfeld_re_amemiya <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya") plm_grunfeld_re_swar <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar") plm_grunfeld_re_nerlove <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove") summary(plm_grunfeld_pooled ) summary(plm_grunfeld_be ) summary(plm_grunfeld_fe ) summary(plm_grunfeld_re_walhus ) summary(plm_grunfeld_re_swar ) summary(plm_grunfeld_re_amemiya) summary(plm_grunfeld_re_nerlove) #### oneway time balanced plm_grunfeld_be_time <- plm(inv ~ value + capital, data=Grunfeld, model="between", effect = "time") plm_grunfeld_fe_time <- plm(inv ~ value + capital, data=Grunfeld, model="within", effect = "time") plm_grunfeld_re_walhus_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus", effect = "time") plm_grunfeld_re_amemiya_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya", effect = "time") plm_grunfeld_re_swar_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar", effect = "time") plm_grunfeld_re_nerlove_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove", effect = "time") summary(plm_grunfeld_be_time ) summary(plm_grunfeld_fe_time ) summary(plm_grunfeld_re_walhus_time ) summary(plm_grunfeld_re_swar_time ) summary(plm_grunfeld_re_amemiya_time) summary(plm_grunfeld_re_nerlove_time) #### oneway individual unbalanced plm_grunfeld_be_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="between") plm_grunfeld_fe_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within") plm_grunfeld_re_walhus_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus") plm_grunfeld_re_amemiya_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya") plm_grunfeld_re_swar_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar") plm_grunfeld_re_nerlove_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove") summary(plm_grunfeld_be_unbal ) summary(plm_grunfeld_fe_unbal ) summary(plm_grunfeld_re_walhus_unbal ) summary(plm_grunfeld_re_swar_unbal ) summary(plm_grunfeld_re_amemiya_unbal) summary(plm_grunfeld_re_nerlove_unbal) #### oneway time unbalanced plm_grunfeld_be_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="between", effect = "time") plm_grunfeld_fe_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within", effect = "time") plm_grunfeld_re_walhus_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus", effect = "time") plm_grunfeld_re_amemiya_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya", effect = "time") plm_grunfeld_re_swar_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar", effect = "time") plm_grunfeld_re_nerlove_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove", effect = "time") summary(plm_grunfeld_be_time_unbal ) summary(plm_grunfeld_fe_time_unbal ) summary(plm_grunfeld_re_walhus_time_unbal ) summary(plm_grunfeld_re_swar_time_unbal ) summary(plm_grunfeld_re_amemiya_time_unbal) summary(plm_grunfeld_re_nerlove_time_unbal) # Table 3.1 Grunfeld's Data. Two-way Error Component Results # RE estimators: SWAR and WALHUS yield negative estimates of # sigma_lambda^2 and these are set to zero in the table. # # beta1 beta2 rho sigma_me sigma_nu #------------------------------------------------- # [...] #### twoways balanced plm_grunfeld_pooled_tw <- plm(inv ~ value + capital, data=Grunfeld, model="pooling", effect = "twoways") plm_grunfeld_fe_tw <- plm(inv ~ value + capital, data=Grunfeld, model="within", effect = "twoways") plm_grunfeld_re_walhus_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus", effect = "twoways") plm_grunfeld_re_amemiya_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya", effect = "twoways") plm_grunfeld_re_swar_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar", effect = "twoways") plm_grunfeld_re_nerlove_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove", effect = "twoways") summary(plm_grunfeld_pooled_tw ) summary(plm_grunfeld_fe_tw ) summary(plm_grunfeld_re_walhus_tw ) summary(plm_grunfeld_re_amemiya_tw) summary(plm_grunfeld_re_swar_tw ) summary(plm_grunfeld_re_nerlove_tw) ##### twoways unbalanced plm_grunfeld_pooled_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="pooling", effect = "twoways") plm_grunfeld_fe_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within", effect = "twoways") plm_grunfeld_re_walhus_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus", effect = "twoways") plm_grunfeld_re_amemiya_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya", effect = "twoways") plm_grunfeld_re_swar_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar", effect = "twoways") plm_grunfeld_re_nerlove_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove", effect = "twoways") summary(plm_grunfeld_pooled_tw_unbal ) summary(plm_grunfeld_fe_tw_unbal ) summary(plm_grunfeld_re_walhus_tw_unbal ) summary(plm_grunfeld_re_amemiya_tw_unbal) summary(plm_grunfeld_re_swar_tw_unbal ) summary(plm_grunfeld_re_nerlove_tw_unbal) ### "amemiya" and "swar" have the same idiosyncratic variance (both based on the within variance) # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") # # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_time)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_time)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") # # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_unbal)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") # # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_time_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_time_unbal)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") # # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_tw)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_tw)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") # # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_tw_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_tw_unbal)[["sigma2"]][["idios"]]))) # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") #### (2) #### ####### replicate Stata's fixed effects estimator, R-squared, F statistic ### ## http://www.stata.com/manuals/xtxtreg.pdf [example 2 on p. 14] # library(plm) # library(haven) # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file # nlswork$race <- factor(nlswork$race) # convert # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example # nlswork$grade <- as.numeric(nlswork$grade) # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=FALSE) # # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) # # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") # Stata's results: # # R-sq: # within = 0.1727 # between = 0.3505 # overall = 0.262 # F(8,23386) = 610.12 # Prob > F = 0.0000 # ln_wage Coef. Std. Err. #------------------------------------------------------- # grade 0 (omitted) # age .0359987 .0033864 # c.age#c.age -.000723 .0000533 # ttl_exp .0334668 .0029653 # c.ttl_exp#c.ttl_exp .0002163 .0001277 # tenure .0357539 .0018487 # c.tenure#c.tenure -.0019701 .000125 # race # black 0 (omitted) # not_smsa -.0890108 .0095316 # south -.0606309 .0109319 # _cons 1.03732 .0485546 # resambles Stata (ex. 2, p. 14) # => coefficients, std.errors, R^2 (=R-sq within), F => correct # (NB: Stata outputs an "artificial" constant for FE models, see below) #summary(plm_fe_nlswork) # Stata outputs a constant for the FE model which is computed as the weighted average of the individual constants # see http://www.stata.com/support/faqs/statistics/intercept-in-fixed-effects-model/ # However, Stata also outputs std.err, t-test and p-value for the artificial constant # gretl mimics Stata: see gretl user's guide example p. 160-161 (example 18.1) # http://gretl.sourceforge.net/gretl-help/gretl-guide.pdf # http://lists.wfu.edu/pipermail/gretl-devel/2013-May/004459.html #within.intercept(plm_fe_nlswork) #const_fe_Stata_gretl <- weighted.mean(fixef(plm_fe_nlswork) , as.numeric(table(index(plm_fe_nlswork)[[1]]))) # RE estimator # note Stata 14 uses by default a different method compared to plm's Swamy-Arora variance component estimator # This is why in comparison with web examples from Stata the random effects coefficients slightly differ #plm_re_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "random") #### (3) #### ## Test of unbalanced random effects estimator on Hedonic data of Harrison/Rubinfeld (1978) ## NB: Baltagi's text book, table 9.1 uses the Stata results, the original paper Baltagi/Chang (1994) what EViews and plm yields ## However, the standard error of plm do not match exactly EViews and the paper. We don't know what exactly ## EViews or Baltagi/Chang (1994) did (the paper mentions "approximate" standard errors). ## A detailed explanation what EViews does is here: http://forums.eviews.com/viewtopic.php?f=4&t=18629#p59506 # scaling of variables in dataset Hedonic is a little bit different to Baltagi/Chang (1994) and Baltagi's text book, table 9.1 # see below for scaling as in Baltagi/Chang (1994) data("Hedonic", package = "plm") pHedonic <- pdata.frame(Hedonic, index = "townid") form <- formula(mv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + blacks + lstat) summary(plm(form, data = pHedonic, model = "random")) ## do (weired) scaling of variables as in Baltagi/Chang (1994) Hedonic$mv2 <- Hedonic$mv Hedonic$crim2 <- Hedonic$crim / 100 Hedonic$zn2 <- Hedonic$zn / 1000 Hedonic$indus2 <- Hedonic$indus / 100 Hedonic$chas2 <- (as.numeric(Hedonic$chas)-1) / 10 Hedonic$nox2 <- Hedonic$nox / 100 Hedonic$rm2 <- Hedonic$rm / 100 Hedonic$age2 <- Hedonic$age / 1000 Hedonic$dis2 <- Hedonic$dis / 10 Hedonic$rad2 <- Hedonic$rad / 10 Hedonic$tax2 <- Hedonic$tax / 1000 Hedonic$ptratio2 <- Hedonic$ptratio / 100 Hedonic$lstat2 <- Hedonic$lstat / 10 pHedonic2 <- pdata.frame(Hedonic, index = "townid") form2 <- formula(mv2 ~ crim2 + zn2 + indus2 + chas2 + nox2 + rm2 + age2 + dis2 + rad2 + tax2 + ptratio2 + blacks + lstat2) summary(plm(form2, data = pHedonic2, model = "random")) # pcce(., model = "mg") and pmg(., model = "cmg") estimate the same model but # in a different way - coefficients need to match data("Produc", package = "plm") form <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp pccemgmod <- pcce(form, data = Produc, model = "mg") pmgccemgmod <- pmg (form, data = Produc, model = "cmg") common <- intersect(names(pccemgmod[["coefficients"]]), names(pmgccemgmod[["coefficients"]])) coef_pccemgmod <- round(pccemgmod[["coefficients"]][common], digits = 7) coef_pmgccemgmod <- round(pmgccemgmod[["coefficients"]][common], digits = 7) stopifnot(all.equal(coef_pccemgmod, coef_pmgccemgmod, tolerance = 1E-04)) print(summary(pccemgmod)) print(summary(pmgccemgmod)) # run and output tests for pcce/pmg with model = 'p'/'mg'/'dmg' print(summary(pcce(form, data = Produc, model = "p"))) print(summary(pmg (form, data = Produc, model = "mg"))) print(summary(pmg (form, data = Produc, model = "dmg"))) print(summary(pmg (form, data = Produc, model = "cmg", trend = TRUE))) print(summary(pmg (form, data = Produc, model = "mg", trend = TRUE))) print(summary(pmg (form, data = Produc, model = "dmg", trend = TRUE))) ## further run tests without intercept plm(inv ~ 0 + value + capital, data = Grunfeld, model = "between") plm(inv ~ 0 + value + capital, data = Grunfeld, model = "random") plm(inv ~ 0 + value + capital, data = Grunfeld, model = "within") plm(inv ~ 0 + value + capital, data = Grunfeld, model = "fd") ## run tests within intercept only intonly.pool <- plm(inv ~ 1, data = Grunfeld, model = "pooling") summary(intonly.pool) intonly.fd <- plm(inv ~ 1, data = Grunfeld, model = "fd") summary(intonly.fd) # errored up to and incl. rev. 1194 intonly.be <- plm(inv ~ 1, data = Grunfeld, model = "between") summary(intonly.be) ## errors rightfully with "empty model": # plm(inv ~ 1, data = pGrun, model = "within") ## errors rightfully due to the within model involved in "swar" RE estimator: # intonly.re <- plm(inv ~ 1, data = Grunfeld, model = "random") intonly.re2 <- plm(inv ~ 1, data = Grunfeld, model = "random", random.method = "walhus") summary(intonly.re2) plm/inst/tests/test_pdata.frame_extract_class_est_mod.R0000644000176200001440000001076614164667746023215 0ustar liggesusers### (1) Comparison of extraction of data.frame and pdata.frame and ### (2) class 'pseries' of estimated_model$model ### (1) Comparison of extraction of data.frame and pdata.frame ### # -> everything is ok in rev. 189+ # from ?pdata.frame: "The "[" method behaves as for data.frame, except that the extraction is also applied to the index attribute." library(plm) data("Grunfeld", package="plm") class(Grunfeld) pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = F) class(pGrunfeld) nrow(Grunfeld[Grunfeld$inv == 317.60, ]) # 1 row and ... class(Grunfeld[Grunfeld$inv == 317.60, ]) # ... it is a data.frame class(pGrunfeld[pGrunfeld$inv == 317.60, ]) # should be classes 'pdata.frame' and 'data.frame' if (!all(class(pGrunfeld[pGrunfeld$inv == 317.60, ]) == c("pdata.frame", "data.frame"))) stop("wrong classes") nrow(pGrunfeld[pGrunfeld$inv == 317.60, ]) # operation works on pdata.frame as well ### (2) class 'pseries' of estimated_model$model [fixed in rev. 242] ### mod <- plm(inv ~ value + capital, data=pGrunfeld, model = "pooling") class(mod$model) class(mod$model$inv) # 'pseries' appeared twice before rev. 242 if (!all(class(mod$model$inv) == c("pseries", "numeric"))) stop("wrong classes (or too few/many") if (!(length(class(mod$model$inv)) == 2 && identical(class(mod$model$inv), c("pseries", "numeric")))) warning("class(es) are wrong!") df <- as.data.frame(mod$model) class(df) class(df$inv) # 'pseries' appeared twice before rev. 242 if (!(length(class(df$inv)) == 2 && identical(class(df$inv), c("pseries", "numeric")))) warning("class(es) are wrong!") # pdata.frame extraction by [.pdata.frame uses data.frame's extraction ([.data.frame) which drops the "pindex" class for the index # test if it is still present class(attr(pGrunfeld, "index")) class(attr(pGrunfeld[1, ], "index")) if(!all(class(attr(pGrunfeld[1, ], "index")) == c("pindex", "data.frame"))) stop("class \"pindex\" missing for index after subsetting a pdata.frame") # for pseries class(attr(pGrunfeld$inv, "index")) class(attr(pGrunfeld[1, ]$inv, "index")) if(!all(class(attr(pGrunfeld[1, ]$inv, "index")) == c("pindex", "data.frame"))) stop("class \"pindex\" missing for index after subsetting a pseries") ## pdata.frame: Check order of attributes after subsetting [R's "[.data.frame" does not preserve order of attributes] attrib_names_before_subsetting_pdataframe <- names(attributes(pGrunfeld)) attrib_names_after_subsetting_pdataframe <- names(attributes(pGrunfeld[1:2, ])) if (!isTRUE(all.equal(attrib_names_before_subsetting_pdataframe, attrib_names_after_subsetting_pdataframe))) stop("order of attributes has changed after subsetting a pdata.frame") ## pseries: pdata.frame: Check order of attributes after subsetting [R's "[.data.frame" does not preserve order of attributes] attrib_names_before_subsetting_pseries <- names(attributes(pGrunfeld$inv)) attrib_names_after_subsetting_pseries <- names(attributes(pGrunfeld[1:2, ]$inv)) if (!isTRUE(all.equal(attrib_names_before_subsetting_pseries, attrib_names_after_subsetting_pseries))) stop("order of attributes has changed after subsetting a pseries") if (!(identical(pGrunfeld[["inv"]], pGrunfeld$"inv"))) stop("extraction of vector from pdata.frame yields different results for [[.pdata.frame and $.pdata.frame") # check names and order of attribute # generally, R does not currently garantuee preserving the order of attributes # (which is why identical(..., attrib.as.set = TRUE) is default attrib_names_after_subsetting_pdataframe <- names(attributes(pGrunfeld[1:2, ])) if (!isTRUE(all.equal(attrib_names_before_subsetting_pdataframe, attrib_names_after_subsetting_pdataframe))) stop("attributes names (or their order) have changed after subsetting") ### extract pseries from pdata.frame and add back # get fresh data data("Grunfeld", package="plm") pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = F) px <- pGrunfeld$inv if (!all(class(px) == c("pseries", "numeric"))) stop("wrong class(es) after extraction from pdata.frame") if (is.null(attr(px, "index"))) stop("no index attribute present after extraction from pdata.frame") pGrunfeld$px <- px if (!lapply(pGrunfeld, class)$px == "numeric") stop("should be only 'numeric'") if (inherits(lapply(pGrunfeld, class)$px, "pseries")) stop("should not inherit 'pseries'") if (!is.null(lapply(pGrunfeld, function(x) attr(x, "index"))$px)) stop("should not have attribute index present") plm/inst/tests/test_is.pconsecutive.Rout.save0000644000176200001440000004720114126043416021156 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests for is.pconsecutive > # > # in separate test file: tests for make.pconsecutive and make.pbalanced > > > > ############## test with consecutive and non-consecutive time periods #### > > library(plm) > data("Grunfeld", package = "plm") > Grunfeld_missing_period <- Grunfeld[-2, ] > > pGrunfeld <- pdata.frame(Grunfeld) > pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) # delete one time period of first individual (1-1936 is missing) > > # Expected results: > # Grunfeld: rep(TRUE, 10) > # Grunfeld_missing_period: c(FALSE, rep(TRUE, 9)) > > # test on data.frame > is.pconsecutive(Grunfeld) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > is.pconsecutive(Grunfeld, index=c("firm", "year")) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld_missing_period, index=c("firm", "year")) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > # should result in informative error message: is.pconsecutive(Grunfeld, index=c("firm") > # because we need both dimensions when index != NULL > ttC <- tryCatch(is.pconsecutive(Grunfeld, index=c("firm")), error=function(e) e, warning=function(w) w) > if(!is(ttC,"error")) stop("error for non supplied time dimension in index not working") > # print(ttC$message) > > # test with not ordered data.frame (ordered by id, time) > # [only necessary for data.frame as pdata.frames are always ordered this way] > Grun_not_ordered <- Grunfeld > Grun_not_ordered <- Grun_not_ordered[order(Grun_not_ordered$capital), ] > is.pconsecutive(Grun_not_ordered) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > if (!isTRUE(all.equal(is.pconsecutive(Grun_not_ordered), rep(TRUE, 10), check.attributes = FALSE))) + stop("wrong result for not ordered data.frame") > > > # test on pdata.frame > if (!all(is.pconsecutive(pGrunfeld))) + stop("is.pconsecutive on pdata.frame: wrong result") > if (!isTRUE(all.equal(is.pconsecutive(pGrunfeld_missing_period), c(FALSE, rep(TRUE, 9)), check.names = FALSE))) + stop("is.pconsecutive on pdata.frame: wrong result") > > > # test on panelmodel object > estimation_pGrunfeld <- plm(inv ~ value + capital, data = pGrunfeld) > estimation_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = pGrunfeld_missing_period) > nobs(estimation_pGrunfeld) # 200 [1] 200 > nobs(estimation_pGrunfeld_missing_period) # 199 [1] 199 > > is.pconsecutive(estimation_pGrunfeld) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(estimation_pGrunfeld_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > > # default method (by dispatching) > # test on "numeric" and "NULL" -> should execute is.pconsecutive.default > is.pconsecutive(Grunfeld$inv, id = Grunfeld$firm, time = Grunfeld$year) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld[["inv"]], id = Grunfeld$firm, time = Grunfeld$year) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > exp_res_arbitrary_vec <- rep(TRUE, 10) > # formal test > if (!isTRUE(all.equal(is.pconsecutive(Grunfeld$inv, id = Grunfeld$firm, time = Grunfeld$year), + exp_res_arbitrary_vec, check.attributes = FALSE))) + stop("not correct for arbitrary vector") > > > # test on pseries > pinv <- pGrunfeld$inv > pinv_missing_period <- pGrunfeld_missing_period$inv > > is.pconsecutive(pinv) 1 2 3 4 5 6 7 8 9 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(pinv_missing_period) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > > ## more missing periods > Grunfeld_missing_periods <- Grunfeld[-c(2,6,7), ] > pGrunfeld_missing_periods <- pdata.frame(Grunfeld_missing_periods) > pinv_missing_periods <- pGrunfeld_missing_periods$inv > > > > ######## with different data set "Hedonic" > data("Hedonic", package = "plm") > Hed <- Hedonic > pHed <- pdata.frame(Hedonic, index = "townid") > Hed_missing_period <- Hedonic[-c(5,11), ] # delete 3-2 and 4-5 > > pHed_missing_period <- pdata.frame(Hedonic, index = "townid") # make pdata.frame first to produce a time index > pHed_missing_period <- as.data.frame(pHed_missing_period) > pHed_missing_period <- pHed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 > pHed_missing_period <- pdata.frame(pHed_missing_period, index = c("townid", "time")) > > > # Expected results > # Hed: all TRUE (rep(TRUE, 92)) > # Hed_missing_period: 3rd and 4th individual FALSE, rest TRUE > expected_Hed <- rep(TRUE, 92) > expected_Hed_missing_period <- expected_Hed > expected_Hed_missing_period[c(3,4)] <- FALSE > > # test on data.frame > Hed_df <- as.data.frame(pHed) > Hed_df_missing_period <- as.data.frame(pHed_missing_period) > is.pconsecutive(Hed_df, index = c("townid", "time")) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 81 82 83 84 85 86 87 88 89 90 91 92 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Hed_df_missing_period, index = c("townid", "time")) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > # test on pdata.frame > if(!isTRUE(all.equal(is.pconsecutive(pHed), expected_Hed, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result") > if(!isTRUE(all.equal(is.pconsecutive(pHed_missing_period), expected_Hed_missing_period, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result") > > # test on panelmodel object > estimation_pHed <- plm(mv ~ crim + indus, data = pHed) > estimation_pHed_missing_period <- plm(mv ~ crim + indus, data = pHed_missing_period) > > is.pconsecutive(estimation_pHed) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 81 82 83 84 85 86 87 88 89 90 91 92 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(estimation_pHed_missing_period) 1 2 3 4 5 6 7 8 9 10 11 12 13 TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 14 15 16 17 18 19 20 21 22 23 24 25 26 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 27 28 29 30 31 32 33 34 35 36 37 38 39 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 40 41 42 43 44 45 46 47 48 49 50 51 52 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 53 54 55 56 57 58 59 60 61 62 63 64 65 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 66 67 68 69 70 71 72 73 74 75 76 77 78 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 79 80 81 82 83 84 85 86 87 88 89 90 91 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE 92 TRUE > > # test on pseries > pmv <- pHed$mv > pmv_missing_period <- pHed_missing_period$mv > > if(!isTRUE(all.equal(is.pconsecutive(pmv), expected_Hed, check.names = FALSE))) stop("is.pconsecutive on pseries: wrong result") > if(!isTRUE(all.equal(is.pconsecutive(pmv_missing_period), expected_Hed_missing_period, check.names = FALSE))) stop("is.pconsecutive on pseries: wrong result") > > ######## with different data set "Gasoline" (has "named" individuals, not just numbers) > data("Gasoline", package = "plm") > pGasoline <- pdata.frame(Gasoline) > > # test on data.frame > is.pconsecutive(Gasoline, index = c("country", "year")) AUSTRIA BELGIUM CANADA DENMARK FRANCE GERMANY GREECE IRELAND TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE ITALY JAPAN NETHERLA NORWAY SPAIN SWEDEN SWITZERL TURKEY TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE U.K. U.S.A. TRUE TRUE > > # test on pdata.frame > is.pconsecutive(pGasoline) AUSTRIA BELGIUM CANADA DENMARK FRANCE GERMANY GREECE IRELAND TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE ITALY JAPAN NETHERLA NORWAY SPAIN SWEDEN SWITZERL TURKEY TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE U.K. U.S.A. TRUE TRUE > > > > ######### test for case with a time period missing from whole data set > data("Grunfeld", package = "plm") > obs_3rd <- 3 + 20*c(0:9) > Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) > > expected_Grunfeld_wo_1937 <- rep(FALSE, 10) > > if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_wo_1937), expected_Grunfeld_wo_1937, check.names = FALSE))) + stop("is.pconsecutive on pdata.frame: wrong result for a missing time period in whole data set") > > if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_wo_1937$inv), expected_Grunfeld_wo_1937, check.names = FALSE))) + stop("is.pconsecutive on pdata.frame: wrong result for a missing time period in whole data set") > > > ########## Tests with NA in individual and time index ########### > > > ### test with NA in time index ### > data("Grunfeld", package = "plm") # get fresh Grunfeld (no NAs) > Grunfeld_NA_time <- Grunfeld > Grunfeld_NA_time[2, "year"] <- NA # firm 1, year 1936: year set to NA > > pGrunfeld_NA_time <- pdata.frame(Grunfeld_NA_time) Warning message: In pdata.frame(Grunfeld_NA_time) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > # time index with NA is in pdata.frame > # it gets sorted to end of firm 1 > head(pGrunfeld_NA_time, 21) firm year inv value capital 1-1935 1 1935 317.6 3078.5 2.8 1-1937 1 1937 410.6 5387.1 156.9 1-1938 1 1938 257.7 2792.2 209.2 1-1939 1 1939 330.8 4313.2 203.4 1-1940 1 1940 461.2 4643.9 207.2 1-1941 1 1941 512.0 4551.2 255.2 1-1942 1 1942 448.0 3244.1 303.7 1-1943 1 1943 499.6 4053.7 264.1 1-1944 1 1944 547.5 4379.3 201.6 1-1945 1 1945 561.2 4840.9 265.0 1-1946 1 1946 688.1 4900.9 402.2 1-1947 1 1947 568.9 3526.5 761.5 1-1948 1 1948 529.2 3254.7 922.4 1-1949 1 1949 555.1 3700.2 1020.1 1-1950 1 1950 642.9 3755.6 1099.0 1-1951 1 1951 755.9 4833.0 1207.7 1-1952 1 1952 891.2 4924.9 1430.5 1-1953 1 1953 1304.4 6241.7 1777.3 1-1954 1 1954 1486.7 5593.6 2226.3 1-NA 1 391.8 4661.7 52.6 2-1935 2 1935 209.9 1362.4 53.8 > > expected_NA_time <- c(NA, rep(TRUE, 9)) > expected_NA_time_na.rm.tindex <- c(FALSE, rep(TRUE, 9)) > > is.pconsecutive(Grunfeld_NA_time) 1 2 3 4 5 6 7 8 9 10 NA TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld_NA_time, na.rm.tindex = FALSE) 1 2 3 4 5 6 7 8 9 10 NA TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > is.pconsecutive(Grunfeld_NA_time, na.rm.tindex = TRUE) 1 2 3 4 5 6 7 8 9 10 FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_time), is.pconsecutive(pGrunfeld_NA_time)))) + stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in time index") > if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_time), expected_NA_time, check.names=FALSE))) + stop("is.pconsecutive: not expected result with 'NA' in time index") > if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_time, na.rm.tindex = TRUE), expected_NA_time_na.rm.tindex, check.names=FALSE))) + stop("is.pconsecutive(, na.rm.tindex = TRUE: not expected result with 'NA' in time index - there should be no NA values left") > > ### test with NA in individual index ### > # get fresh Grunfeld (no NAs) > Grunfeld_NA_ind <- Grunfeld > Grunfeld_NA_ind[3, "firm"] <- NA # firm 1, year 1937: firm set to NA > pGrunfeld_NA_ind <- pdata.frame(Grunfeld_NA_ind) Warning message: In pdata.frame(Grunfeld_NA_ind) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > > # individual index with NA is in pdata.frame > # it gets sorted to end of individuals > tail(pGrunfeld_NA_ind, 21) firm year inv value capital 10-1935 10 1935 2.54 70.91 4.50 10-1936 10 1936 2.00 87.94 4.71 10-1937 10 1937 2.19 82.20 4.57 10-1938 10 1938 1.99 58.72 4.56 10-1939 10 1939 2.03 80.54 4.38 10-1940 10 1940 1.81 86.47 4.21 10-1941 10 1941 2.14 77.68 4.12 10-1942 10 1942 1.86 62.16 3.83 10-1943 10 1943 0.93 62.24 3.58 10-1944 10 1944 1.18 61.82 3.41 10-1945 10 1945 1.36 65.85 3.31 10-1946 10 1946 2.24 69.54 3.23 10-1947 10 1947 3.81 64.97 3.90 10-1948 10 1948 5.66 68.00 5.38 10-1949 10 1949 4.21 71.24 7.39 10-1950 10 1950 3.42 69.05 8.74 10-1951 10 1951 4.67 83.04 9.07 10-1952 10 1952 6.00 74.42 9.93 10-1953 10 1953 6.53 63.51 11.68 10-1954 10 1954 5.12 58.12 14.33 NA-1937 1937 410.60 5387.10 156.90 > > expected_NA_ind <- c(FALSE, rep(TRUE, 9)) > > if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_ind), is.pconsecutive(pGrunfeld_NA_ind)))) + stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in individual index") > if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_ind), expected_NA_ind, check.names=FALSE))) + stop("is.pconsecutive: not expected result with 'NA' in individual index") > > > > ### test with NA in individual AND time index ### > # get fresh Grunfeld (no NAs) > Grunfeld_NA_id_time <- Grunfeld > Grunfeld_NA_id_time[4, c("firm", "year")] <- NA # firm 1, year 1938: firm and year set to NA > pGrunfeld_NA_id_time <- pdata.frame(Grunfeld_NA_id_time) Warning message: In pdata.frame(Grunfeld_NA_id_time) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > > # individual and time index with NA is in pdata.frame > # it gets sorted to end of individuals > tail(pGrunfeld_NA_id_time, 21) firm year inv value capital 10-1935 10 1935 2.54 70.91 4.50 10-1936 10 1936 2.00 87.94 4.71 10-1937 10 1937 2.19 82.20 4.57 10-1938 10 1938 1.99 58.72 4.56 10-1939 10 1939 2.03 80.54 4.38 10-1940 10 1940 1.81 86.47 4.21 10-1941 10 1941 2.14 77.68 4.12 10-1942 10 1942 1.86 62.16 3.83 10-1943 10 1943 0.93 62.24 3.58 10-1944 10 1944 1.18 61.82 3.41 10-1945 10 1945 1.36 65.85 3.31 10-1946 10 1946 2.24 69.54 3.23 10-1947 10 1947 3.81 64.97 3.90 10-1948 10 1948 5.66 68.00 5.38 10-1949 10 1949 4.21 71.24 7.39 10-1950 10 1950 3.42 69.05 8.74 10-1951 10 1951 4.67 83.04 9.07 10-1952 10 1952 6.00 74.42 9.93 10-1953 10 1953 6.53 63.51 11.68 10-1954 10 1954 5.12 58.12 14.33 NA-NA 257.70 2792.20 209.20 > > expected_NA_ind_time <- c(FALSE, rep(TRUE, 9)) > > if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_id_time), is.pconsecutive(pGrunfeld_NA_id_time)))) + stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in individual AND time index") > if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_id_time), expected_NA_ind_time, check.names=FALSE))) + stop("is.pconsecutive: not expected result with 'NA' in individual AND time index") > > > > > proc.time() user system elapsed 3.82 0.54 4.48 plm/inst/tests/test_Estimators.Rout.save0000644000176200001440000020147214154734502020175 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Replicate results of various sources and additional run tests, compared to the corresponding .Rout.save > #### > #### (1): Baltagi (2013) > #### (2): Stata's FE estimator > #### (3): test of unbalanced one-way RE Swamy/Arora on Hedonic data set > > #### (1) #### > #### compare OLS, FE and RE estimators to Baltagi's results > # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons > # oneway: sec. 2.6, example 1 p. 27, table 2.1 > # twoways: sec. 3.6, example 1 p. 51, table 3.1 > # > # = Baltagi (2005), p. 21 (oneway), p. 43 (twoways) > > # Table 2.1 Grunfeld's Data One-way Error Component Results > # beta1 beta2 rho sigma_me sigma_nu > #-------------------------------------------------- > # [...] > > library(plm) > data("Grunfeld", package = "plm") > Grunfeld_unbal <- Grunfeld[1:199, ] > > #### oneway individual balanced > plm_grunfeld_pooled <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") > plm_grunfeld_be <- plm(inv ~ value + capital, data=Grunfeld, model="between") > plm_grunfeld_fe <- plm(inv ~ value + capital, data=Grunfeld, model="within") > plm_grunfeld_re_walhus <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus") > plm_grunfeld_re_amemiya <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya") > plm_grunfeld_re_swar <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar") > plm_grunfeld_re_nerlove <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove") > > summary(plm_grunfeld_pooled ) Pooling Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "pooling") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.6757 -30.0137 5.3033 34.8293 369.4464 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -42.7143694 9.5116760 -4.4907 1.207e-05 *** value 0.1155622 0.0058357 19.8026 < 2.2e-16 *** capital 0.2306785 0.0254758 9.0548 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 1755900 R-Squared: 0.81241 Adj. R-Squared: 0.8105 F-statistic: 426.576 on 2 and 197 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_be ) Oneway (individual) effect Between Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "between") Balanced Panel: n = 10, T = 20, N = 200 Observations used in estimation: 10 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -163.3924 -3.6808 2.9683 20.7388 144.0590 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -8.527114 47.515308 -0.1795 0.86266 value 0.134646 0.028745 4.6841 0.00225 ** capital 0.032031 0.190938 0.1678 0.87152 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 355780 Residual Sum of Squares: 50603 R-Squared: 0.85777 Adj. R-Squared: 0.81713 F-statistic: 21.1077 on 2 and 7 DF, p-value: 0.0010851 > summary(plm_grunfeld_fe ) Oneway (individual) effect Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "within") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -184.00857 -17.64316 0.56337 19.19222 250.70974 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.110124 0.011857 9.2879 < 2.2e-16 *** capital 0.310065 0.017355 17.8666 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2244400 Residual Sum of Squares: 523480 R-Squared: 0.76676 Adj. R-Squared: 0.75311 F-statistic: 309.014 on 2 and 188 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus ) Oneway (individual) effect Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "random", random.method = "walhus") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 3089.07 55.58 0.352 individual 5690.18 75.43 0.648 theta: 0.8374 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -181.3556 -22.0352 5.7851 18.8320 253.9807 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.553864 25.335537 -2.2717 0.02311 * value 0.109710 0.010181 10.7756 < 2e-16 *** capital 0.307374 0.017272 17.7959 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2432400 Residual Sum of Squares: 558340 R-Squared: 0.77046 Adj. R-Squared: 0.76813 Chisq: 661.224 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar ) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "random", random.method = "swar") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2784.46 52.77 0.282 individual 7089.80 84.20 0.718 theta: 0.8612 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -177.6063 -19.7350 4.6851 19.5105 252.8743 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.834415 28.898935 -2.0013 0.04536 * value 0.109781 0.010493 10.4627 < 2e-16 *** capital 0.308113 0.017180 17.9339 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2381400 Residual Sum of Squares: 548900 R-Squared: 0.7695 Adj. R-Squared: 0.76716 Chisq: 657.674 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya) Oneway (individual) effect Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "random", random.method = "amemiya") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2755.15 52.49 0.298 individual 6477.30 80.48 0.702 theta: 0.8557 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -178.4834 -20.1692 4.9156 19.5200 253.1136 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.771054 27.961477 -2.0661 0.03882 * value 0.109764 0.010421 10.5328 < 2e-16 *** capital 0.307952 0.017200 17.9039 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2392500 Residual Sum of Squares: 550970 R-Squared: 0.76971 Adj. R-Squared: 0.76738 Chisq: 658.458 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove) Oneway (individual) effect Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, model = "random", random.method = "nerlove") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2617.39 51.16 0.263 individual 7350.06 85.73 0.737 theta: 0.8677 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -176.5695 -19.8094 4.5578 19.4083 252.6067 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.907362 30.106995 -1.9234 0.05443 . value 0.109802 0.010576 10.3824 < 2e-16 *** capital 0.308294 0.017158 17.9676 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2368800 Residual Sum of Squares: 546580 R-Squared: 0.76926 Adj. R-Squared: 0.76692 Chisq: 656.784 on 2 DF, p-value: < 2.22e-16 > > #### oneway time balanced > plm_grunfeld_be_time <- plm(inv ~ value + capital, data=Grunfeld, model="between", effect = "time") > plm_grunfeld_fe_time <- plm(inv ~ value + capital, data=Grunfeld, model="within", effect = "time") > plm_grunfeld_re_walhus_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus", effect = "time") > plm_grunfeld_re_amemiya_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya", effect = "time") > plm_grunfeld_re_swar_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar", effect = "time") > plm_grunfeld_re_nerlove_time <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove", effect = "time") > > summary(plm_grunfeld_be_time ) Oneway (time) effect Between Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "between") Balanced Panel: n = 10, T = 20, N = 200 Observations used in estimation: 20 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -33.94030 -7.93792 -0.56437 9.84984 19.53850 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -33.224601 19.412274 -1.7115 0.1051660 value 0.099252 0.020102 4.9374 0.0001249 *** capital 0.260214 0.024576 10.5879 6.659e-09 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 62870 Residual Sum of Squares: 3839.6 R-Squared: 0.93893 Adj. R-Squared: 0.93174 F-statistic: 130.682 on 2 and 17 DF, p-value: 4.7819e-11 > summary(plm_grunfeld_fe_time ) Oneway (time) effect Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "within") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -292.1576 -26.3717 8.3651 31.4250 380.1370 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.1167978 0.0063313 18.4477 < 2.2e-16 *** capital 0.2197066 0.0322961 6.8029 1.504e-10 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 8731200 Residual Sum of Squares: 1713000 R-Squared: 0.80381 Adj. R-Squared: 0.78067 F-statistic: 364.645 on 2 and 178 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus_time ) Oneway (time) effect Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "random", random.method = "walhus") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 9522.69 97.58 1 time 0.00 0.00 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.6757 -30.0137 5.3033 34.8293 369.4464 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -42.7143694 9.5116760 -4.4907 7.098e-06 *** value 0.1155622 0.0058357 19.8026 < 2.2e-16 *** capital 0.2306785 0.0254758 9.0548 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 1755900 R-Squared: 0.81241 Adj. R-Squared: 0.8105 Chisq: 853.151 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar_time ) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "random", random.method = "swar") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 9623.4 98.1 1 time 0.0 0.0 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.6757 -30.0137 5.3033 34.8293 369.4464 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -42.7143694 9.5116760 -4.4907 7.098e-06 *** value 0.1155622 0.0058357 19.8026 < 2.2e-16 *** capital 0.2306785 0.0254758 9.0548 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 1755900 R-Squared: 0.81241 Adj. R-Squared: 0.8105 Chisq: 853.151 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya_time) Oneway (time) effect Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "random", random.method = "amemiya") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 9516.51 97.55 1 time 0.00 0.00 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.6757 -30.0137 5.3033 34.8293 369.4464 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -42.7143694 9.5116760 -4.4907 7.098e-06 *** value 0.1155622 0.0058357 19.8026 < 2.2e-16 *** capital 0.2306785 0.0254758 9.0548 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 1755900 R-Squared: 0.81241 Adj. R-Squared: 0.8105 Chisq: 853.151 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove_time) Oneway (time) effect Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "time", model = "random", random.method = "nerlove") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 8564.86 92.55 0.973 time 234.38 15.31 0.027 theta: 0.1139 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.2135 -28.3774 5.6538 34.4465 371.6054 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -42.4667890 10.1886847 -4.1680 3.072e-05 *** value 0.1157687 0.0058638 19.7429 < 2.2e-16 *** capital 0.2289722 0.0263535 8.6885 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9224900 Residual Sum of Squares: 1746800 R-Squared: 0.81064 Adj. R-Squared: 0.80872 Chisq: 843.335 on 2 DF, p-value: < 2.22e-16 > > #### oneway individual unbalanced > plm_grunfeld_be_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="between") > plm_grunfeld_fe_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within") > plm_grunfeld_re_walhus_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus") > plm_grunfeld_re_amemiya_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya") > plm_grunfeld_re_swar_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar") > plm_grunfeld_re_nerlove_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove") > > summary(plm_grunfeld_be_unbal ) Oneway (individual) effect Between Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "between") Unbalanced Panel: n = 10, T = 19-20, N = 199 Observations used in estimation: 10 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -163.3896 -3.6615 2.9251 20.7200 144.0777 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -8.583114 47.497067 -0.1807 0.86172 value 0.134642 0.028744 4.6843 0.00225 ** capital 0.032182 0.190854 0.1686 0.87086 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 355810 Residual Sum of Squares: 50602 R-Squared: 0.85778 Adj. R-Squared: 0.81715 F-statistic: 21.1102 on 2 and 7 DF, p-value: 0.0010848 > summary(plm_grunfeld_fe_unbal ) Oneway (individual) effect Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "within") Unbalanced Panel: n = 10, T = 19-20, N = 199 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -184.00854 -17.86458 0.53588 19.33777 250.71052 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.110125 0.011888 9.2632 < 2.2e-16 *** capital 0.310064 0.017401 17.8188 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2244300 Residual Sum of Squares: 523480 R-Squared: 0.76676 Adj. R-Squared: 0.75304 F-statistic: 307.37 on 2 and 187 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus_unbal ) Oneway (individual) effect Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "random", random.method = "walhus") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2900.88 53.86 0.275 individual 7663.69 87.54 0.725 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.8602 0.8637 0.8637 0.8634 0.8637 0.8637 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -177.211 -19.802 4.641 -0.017 19.687 252.771 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.874183 29.422867 -1.967 0.04919 * value 0.109792 0.010552 10.405 < 2e-16 *** capital 0.308181 0.017216 17.901 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2376100 Residual Sum of Squares: 548000 R-Squared: 0.76937 Adj. R-Squared: 0.76702 Chisq: 653.998 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar_unbal ) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "random", random.method = "swar") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2799.34 52.91 0.282 individual 7124.82 84.41 0.718 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.8577 0.8612 0.8612 0.8609 0.8612 0.8612 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -177.611 -19.815 4.769 -0.018 19.686 252.876 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.846046 28.969526 -1.9968 0.04585 * value 0.109784 0.010519 10.4364 < 2e-16 *** capital 0.308110 0.017224 17.8880 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2381000 Residual Sum of Squares: 548910 R-Squared: 0.76947 Adj. R-Squared: 0.76711 Chisq: 654.345 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya_unbal) Oneway (individual) effect Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "random", random.method = "amemiya") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2799.34 52.91 0.286 individual 6994.34 83.63 0.714 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.8564 0.8599 0.8599 0.8596 0.8599 0.8599 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -177.811 -19.945 4.834 -0.018 19.678 252.929 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.831814 28.748169 -2.0117 0.04425 * value 0.109780 0.010503 10.4523 < 2e-16 *** capital 0.308074 0.017229 17.8813 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2383500 Residual Sum of Squares: 549370 R-Squared: 0.76951 Adj. R-Squared: 0.76716 Chisq: 654.521 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove_unbal) Oneway (individual) effect Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, model = "random", random.method = "nerlove") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2630.54 51.29 0.263 individual 7371.22 85.86 0.737 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.8642 0.8676 0.8676 0.8673 0.8676 0.8676 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -176.592 -19.821 4.568 -0.017 19.688 252.613 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.917118 30.158311 -1.9204 0.0548 . value 0.109804 0.010601 10.3577 <2e-16 *** capital 0.308288 0.017203 17.9211 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2368700 Residual Sum of Squares: 546620 R-Squared: 0.76923 Adj. R-Squared: 0.76688 Chisq: 653.474 on 2 DF, p-value: < 2.22e-16 > > #### oneway time unbalanced > plm_grunfeld_be_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="between", effect = "time") > plm_grunfeld_fe_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within", effect = "time") > plm_grunfeld_re_walhus_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus", effect = "time") > plm_grunfeld_re_amemiya_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya", effect = "time") > plm_grunfeld_re_swar_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar", effect = "time") > plm_grunfeld_re_nerlove_time_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove", effect = "time") > > summary(plm_grunfeld_be_time_unbal ) Oneway (time) effect Between Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "between") Unbalanced Panel: n = 10, T = 19-20, N = 199 Observations used in estimation: 20 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -34.0155 -8.0472 -0.2581 9.7594 18.9273 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -30.984895 18.541321 -1.6711 0.1130019 value 0.097527 0.019623 4.9700 0.0001167 *** capital 0.258281 0.024649 10.4782 7.774e-09 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 71348 Residual Sum of Squares: 3870 R-Squared: 0.94576 Adj. R-Squared: 0.93938 F-statistic: 148.209 on 2 and 17 DF, p-value: 1.7449e-11 > summary(plm_grunfeld_fe_time_unbal ) Oneway (time) effect Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "within") Unbalanced Panel: n = 10, T = 19-20, N = 199 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -288.9732 -27.3836 8.3436 31.6945 380.9448 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.1167471 0.0063489 18.3887 < 2.2e-16 *** capital 0.2215911 0.0328505 6.7454 2.088e-10 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 8651000 Residual Sum of Squares: 1711900 R-Squared: 0.80212 Adj. R-Squared: 0.77864 F-statistic: 358.743 on 2 and 177 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus_time_unbal ) Oneway (time) effect Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "random", random.method = "walhus") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 9666.19 98.32 1 time 0.00 0.00 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.8494 -29.8087 5.3955 34.7586 368.5334 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -43.0915664 9.5781503 -4.4989 6.829e-06 *** value 0.1156300 0.0058506 19.7637 < 2.2e-16 *** capital 0.2310875 0.0255505 9.0443 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1754400 R-Squared: 0.81216 Adj. R-Squared: 0.81025 Chisq: 847.453 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar_time_unbal ) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "random", random.method = "swar") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 9671.53 98.34 1 time 0.00 0.00 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.8494 -29.8087 5.3955 34.7586 368.5334 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -43.0915664 9.5781503 -4.4989 6.829e-06 *** value 0.1156300 0.0058506 19.7637 < 2.2e-16 *** capital 0.2310875 0.0255505 9.0443 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1754400 R-Squared: 0.81216 Adj. R-Squared: 0.81025 Chisq: 847.453 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya_time_unbal) Oneway (time) effect Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "random", random.method = "amemiya") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 9671.53 98.34 1 time 0.00 0.00 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.8494 -29.8087 5.3955 34.7586 368.5334 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -43.0915664 9.5781503 -4.4989 6.829e-06 *** value 0.1156300 0.0058506 19.7637 < 2.2e-16 *** capital 0.2310875 0.0255505 9.0443 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1754400 R-Squared: 0.81216 Adj. R-Squared: 0.81025 Chisq: 847.453 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove_time_unbal) Oneway (time) effect Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "time", model = "random", random.method = "nerlove") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 8602.31 92.75 0.974 time 231.60 15.22 0.026 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.1028 0.1124 0.1124 0.1119 0.1124 0.1124 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -291.08 -28.31 5.81 0.00 34.04 370.70 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -42.8982645 10.2559971 -4.1827 2.88e-05 *** value 0.1158167 0.0058773 19.7057 < 2.2e-16 *** capital 0.2296520 0.0264490 8.6828 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9201200 Residual Sum of Squares: 1745500 R-Squared: 0.81029 Adj. R-Squared: 0.80836 Chisq: 836.775 on 2 DF, p-value: < 2.22e-16 > > > > > # Table 3.1 Grunfeld's Data. Two-way Error Component Results > # RE estimators: SWAR and WALHUS yield negative estimates of > # sigma_lambda^2 and these are set to zero in the table. > # > # beta1 beta2 rho sigma_me sigma_nu > #------------------------------------------------- > # [...] > > #### twoways balanced > plm_grunfeld_pooled_tw <- plm(inv ~ value + capital, data=Grunfeld, model="pooling", effect = "twoways") > plm_grunfeld_fe_tw <- plm(inv ~ value + capital, data=Grunfeld, model="within", effect = "twoways") > plm_grunfeld_re_walhus_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="walhus", effect = "twoways") > plm_grunfeld_re_amemiya_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="amemiya", effect = "twoways") > plm_grunfeld_re_swar_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="swar", effect = "twoways") > plm_grunfeld_re_nerlove_tw <- plm(inv ~ value + capital, data=Grunfeld, model="random", random.method="nerlove", effect = "twoways") > > summary(plm_grunfeld_pooled_tw ) Pooling Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "pooling") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.6757 -30.0137 5.3033 34.8293 369.4464 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -42.7143694 9.5116760 -4.4907 1.207e-05 *** value 0.1155622 0.0058357 19.8026 < 2.2e-16 *** capital 0.2306785 0.0254758 9.0548 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 1755900 R-Squared: 0.81241 Adj. R-Squared: 0.8105 F-statistic: 426.576 on 2 and 197 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_fe_tw ) Twoways effects Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "within") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -162.6094 -19.4710 -1.2669 19.1277 211.8420 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.117716 0.013751 8.5604 6.653e-15 *** capital 0.357916 0.022719 15.7540 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1615600 Residual Sum of Squares: 452150 R-Squared: 0.72015 Adj. R-Squared: 0.67047 F-statistic: 217.442 on 2 and 169 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus_tw ) Twoways effects Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "walhus") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 3188.06 56.46 0.359 individual 5685.23 75.40 0.641 time 0.00 0.00 0.000 theta: 0.8349 (id) 0 (time) 0 (total) Residuals: Min. 1st Qu. Median 3rd Qu. Max. -181.7595 -22.3727 5.9119 18.7001 254.1129 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.522213 25.012301 -2.2998 0.02146 * value 0.109703 0.010147 10.8113 < 2e-16 *** capital 0.307286 0.017283 17.7795 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2438400 Residual Sum of Squares: 559450 R-Squared: 0.77057 Adj. R-Squared: 0.76824 Chisq: 661.637 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya_tw) Twoways effects Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "amemiya") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2644.13 51.42 0.256 individual 7452.02 86.33 0.721 time 243.78 15.61 0.024 theta: 0.868 (id) 0.2787 (time) 0.2776 (total) Residuals: Min. 1st Qu. Median 3rd Qu. Max. -176.9062 -18.0431 3.2697 17.1719 234.1735 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -63.767791 29.851537 -2.1362 0.03267 * value 0.111386 0.010909 10.2102 < 2e-16 *** capital 0.323321 0.018772 17.2232 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2066800 Residual Sum of Squares: 518200 R-Squared: 0.74927 Adj. R-Squared: 0.74673 Chisq: 588.717 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar_tw ) Twoways effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "swar") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2675.43 51.72 0.274 individual 7095.25 84.23 0.726 time 0.00 0.00 0.000 theta: 0.864 (id) 0 (time) 0 (total) Residuals: Min. 1st Qu. Median 3rd Qu. Max. -177.1700 -19.7576 4.6048 19.4676 252.7596 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -57.865377 29.393359 -1.9687 0.04899 * value 0.109790 0.010528 10.4285 < 2e-16 *** capital 0.308190 0.017171 17.9483 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2376000 Residual Sum of Squares: 547910 R-Squared: 0.7694 Adj. R-Squared: 0.76706 Chisq: 657.295 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove_tw) Twoways effects Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "random", random.method = "nerlove") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 2260.74 47.55 0.201 individual 8426.92 91.80 0.751 time 534.94 23.13 0.048 theta: 0.885 (id) 0.455 (time) 0.4532 (total) Residuals: Min. 1st Qu. Median 3rd Qu. Max. -173.1203 -16.4742 2.0885 18.8439 221.8104 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -68.304674 33.457520 -2.0415 0.0412 * value 0.112729 0.011330 9.9499 <2e-16 *** capital 0.334494 0.019686 16.9917 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1896600 Residual Sum of Squares: 496930 R-Squared: 0.73799 Adj. R-Squared: 0.73533 Chisq: 554.874 on 2 DF, p-value: < 2.22e-16 > > ##### twoways unbalanced > plm_grunfeld_pooled_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="pooling", effect = "twoways") > plm_grunfeld_fe_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="within", effect = "twoways") > plm_grunfeld_re_walhus_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="walhus", effect = "twoways") > plm_grunfeld_re_amemiya_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="amemiya", effect = "twoways") > plm_grunfeld_re_swar_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="swar", effect = "twoways") > plm_grunfeld_re_nerlove_tw_unbal <- plm(inv ~ value + capital, data=Grunfeld_unbal, model="random", random.method="nerlove", effect = "twoways") > > summary(plm_grunfeld_pooled_tw_unbal ) Pooling Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "pooling") Unbalanced Panel: n = 10, T = 19-20, N = 199 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -291.8494 -29.8087 5.3955 34.7586 368.5334 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -43.0915664 9.5781503 -4.4989 1.169e-05 *** value 0.1156300 0.0058506 19.7637 < 2.2e-16 *** capital 0.2310875 0.0255505 9.0443 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1754400 R-Squared: 0.81216 Adj. R-Squared: 0.81025 F-statistic: 423.727 on 2 and 196 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_fe_tw_unbal ) Twoways effects Within Model Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "within") Unbalanced Panel: n = 10, T = 19-20, N = 199 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -163.3268 -19.0378 -1.7054 20.7438 212.5877 Coefficients: Estimate Std. Error t-value Pr(>|t|) value 0.118504 0.013775 8.6029 5.299e-15 *** capital 0.361140 0.022951 15.7352 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1597100 Residual Sum of Squares: 449510 R-Squared: 0.71855 Adj. R-Squared: 0.66829 F-statistic: 214.457 on 2 and 168 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_walhus_tw_unbal ) Twoways effects Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "random", random.method = "walhus") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 3078.75 55.49 0.287 individual 7655.76 87.50 0.713 time 0.00 0.00 0.000 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.8560314 0.859604 0.859604 0.8592629 0.859604 0.859604 time 0.0000000 0.000000 0.000000 0.0000000 0.000000 0.000000 total 0.0000000 0.000000 0.000000 0.0000000 0.000000 0.000000 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -329.39 -41.02 10.57 -0.25 46.73 329.43 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -5.7828e+01 5.4187e-01 -106.72 < 2.2e-16 *** value 1.0978e-01 1.9828e-04 553.65 < 2.2e-16 *** capital 3.0806e-01 3.2541e-04 946.70 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1838200 R-Squared: 0.80588 Adj. R-Squared: 0.8039 Chisq: 1835110 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_amemiya_tw_unbal) Twoways effects Random Effect Model (Amemiya's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "random", random.method = "amemiya") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2675.67 51.73 0.241 individual 8088.44 89.94 0.729 time 326.08 18.06 0.029 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.8691846 0.8724423 0.8724423 0.8721313 0.8724423 0.8724423 time 0.3094100 0.3286443 0.3286443 0.3277744 0.3286443 0.3286443 total 0.3082868 0.3273981 0.3273981 0.3265245 0.3273981 0.3273981 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -344.32 -44.34 14.98 -0.19 51.14 324.13 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -6.5371e+01 6.0239e-01 -108.52 < 2.2e-16 *** value 1.1185e-01 2.1633e-04 517.04 < 2.2e-16 *** capital 3.2691e-01 3.7420e-04 873.62 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1896700 R-Squared: 0.80418 Adj. R-Squared: 0.80218 Chisq: 1497680 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_swar_tw_unbal ) Twoways effects Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "random", random.method = "swar") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2675.67 51.73 0.273 individual 7131.05 84.45 0.727 time 0.00 0.00 0.000 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.8608394 0.8642973 0.8642973 0.8639671 0.8642973 0.8642973 time 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 total 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -329.50 -41.03 10.61 -0.25 46.75 329.39 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -5.7881e+01 5.5860e-01 -103.62 < 2.2e-16 *** value 1.0979e-01 1.9973e-04 549.70 < 2.2e-16 *** capital 3.0820e-01 3.2561e-04 946.53 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1838600 R-Squared: 0.80587 Adj. R-Squared: 0.80389 Chisq: 1827600 on 2 DF, p-value: < 2.22e-16 > summary(plm_grunfeld_re_nerlove_tw_unbal) Twoways effects Random Effect Model (Nerlove's transformation) Call: plm(formula = inv ~ value + capital, data = Grunfeld_unbal, effect = "twoways", model = "random", random.method = "nerlove") Unbalanced Panel: n = 10, T = 19-20, N = 199 Effects: var std.dev share idiosyncratic 2258.86 47.53 0.199 individual 8507.69 92.24 0.750 time 576.05 24.00 0.051 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. id 0.8826053 0.8855384 0.8855384 0.8852583 0.8855384 0.8855384 time 0.4491128 0.4692672 0.4692672 0.4683557 0.4692672 0.4692672 total 0.4474297 0.4674017 0.4674017 0.4664846 0.4674017 0.4674017 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -352.09 -44.32 15.52 -0.16 51.19 321.29 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -6.9329e+01 6.7047e-01 -103.40 < 2.2e-16 *** value 1.1305e-01 2.2642e-04 499.27 < 2.2e-16 *** capital 3.3639e-01 3.9545e-04 850.66 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9340000 Residual Sum of Squares: 1935200 R-Squared: 0.80335 Adj. R-Squared: 0.80135 Chisq: 1381720 on 2 DF, p-value: < 2.22e-16 > > ### "amemiya" and "swar" have the same idiosyncratic variance (both based on the within variance) > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > # > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_time)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_time)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > # > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_unbal)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > # > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_time_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_time_unbal)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > # > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_tw)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_tw)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > # > # if (!isTRUE(all.equal(ercomp(plm_grunfeld_re_amemiya_tw_unbal)[["sigma2"]][["idios"]], ercomp(plm_grunfeld_re_swar_tw_unbal)[["sigma2"]][["idios"]]))) > # stop("idiosyncratic variance for 'amemiya' and 'swar' differ!") > > > > #### (2) #### > ####### replicate Stata's fixed effects estimator, R-squared, F statistic ### > ## http://www.stata.com/manuals/xtxtreg.pdf [example 2 on p. 14] > # library(plm) > # library(haven) > # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file > # nlswork$race <- factor(nlswork$race) # convert > # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example > # nlswork$grade <- as.numeric(nlswork$grade) > # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=FALSE) > # > # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) > # > # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within") > > # Stata's results: > # > # R-sq: > # within = 0.1727 > # between = 0.3505 > # overall = 0.262 > > # F(8,23386) = 610.12 > # Prob > F = 0.0000 > > # ln_wage Coef. Std. Err. > #------------------------------------------------------- > # grade 0 (omitted) > # age .0359987 .0033864 > # c.age#c.age -.000723 .0000533 > # ttl_exp .0334668 .0029653 > # c.ttl_exp#c.ttl_exp .0002163 .0001277 > # tenure .0357539 .0018487 > # c.tenure#c.tenure -.0019701 .000125 > # race > # black 0 (omitted) > # not_smsa -.0890108 .0095316 > # south -.0606309 .0109319 > # _cons 1.03732 .0485546 > > # resambles Stata (ex. 2, p. 14) > # => coefficients, std.errors, R^2 (=R-sq within), F => correct > # (NB: Stata outputs an "artificial" constant for FE models, see below) > #summary(plm_fe_nlswork) > > # Stata outputs a constant for the FE model which is computed as the weighted average of the individual constants > # see http://www.stata.com/support/faqs/statistics/intercept-in-fixed-effects-model/ > # However, Stata also outputs std.err, t-test and p-value for the artificial constant > # gretl mimics Stata: see gretl user's guide example p. 160-161 (example 18.1) > # http://gretl.sourceforge.net/gretl-help/gretl-guide.pdf > # http://lists.wfu.edu/pipermail/gretl-devel/2013-May/004459.html > #within.intercept(plm_fe_nlswork) > #const_fe_Stata_gretl <- weighted.mean(fixef(plm_fe_nlswork) , as.numeric(table(index(plm_fe_nlswork)[[1]]))) > > # RE estimator > # note Stata 14 uses by default a different method compared to plm's Swamy-Arora variance component estimator > # This is why in comparison with web examples from Stata the random effects coefficients slightly differ > #plm_re_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "random") > > #### (3) #### > ## Test of unbalanced random effects estimator on Hedonic data of Harrison/Rubinfeld (1978) > > ## NB: Baltagi's text book, table 9.1 uses the Stata results, the original paper Baltagi/Chang (1994) what EViews and plm yields > ## However, the standard error of plm do not match exactly EViews and the paper. We don't know what exactly > ## EViews or Baltagi/Chang (1994) did (the paper mentions "approximate" standard errors). > ## A detailed explanation what EViews does is here: http://forums.eviews.com/viewtopic.php?f=4&t=18629#p59506 > > # scaling of variables in dataset Hedonic is a little bit different to Baltagi/Chang (1994) and Baltagi's text book, table 9.1 > # see below for scaling as in Baltagi/Chang (1994) > data("Hedonic", package = "plm") > pHedonic <- pdata.frame(Hedonic, index = "townid") > form <- formula(mv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + blacks + lstat) > summary(plm(form, data = pHedonic, model = "random")) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = form, data = pHedonic, model = "random") Unbalanced Panel: n = 92, T = 1-30, N = 506 Effects: var std.dev share idiosyncratic 0.01696 0.13025 0.562 individual 0.01324 0.11505 0.438 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.2505 0.5483 0.6284 0.6141 0.7147 0.7976 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.62902 -0.06712 -0.00156 -0.00216 0.06858 0.54973 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 9.6859e+00 1.9751e-01 49.0398 < 2.2e-16 *** crim -7.4120e-03 1.0478e-03 -7.0738 1.508e-12 *** zn 7.8877e-05 6.5001e-04 0.1213 0.9034166 indus 1.5563e-03 4.0349e-03 0.3857 0.6997051 chasyes -4.4247e-03 2.9212e-02 -0.1515 0.8796041 nox -5.8425e-03 1.2452e-03 -4.6921 2.704e-06 *** rm 9.0552e-03 1.1886e-03 7.6182 2.573e-14 *** age -8.5787e-04 4.6793e-04 -1.8333 0.0667541 . dis -1.4442e-01 4.4094e-02 -3.2753 0.0010557 ** rad 9.5984e-02 2.6611e-02 3.6069 0.0003098 *** tax -3.7740e-04 1.7693e-04 -2.1331 0.0329190 * ptratio -2.9476e-02 9.0698e-03 -3.2499 0.0011546 ** blacks 5.6278e-01 1.0197e-01 5.5188 3.413e-08 *** lstat -2.9107e-01 2.3927e-02 -12.1650 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 987.94 Residual Sum of Squares: 8.9988 R-Squared: 0.99091 Adj. R-Squared: 0.99067 Chisq: 1199.5 on 13 DF, p-value: < 2.22e-16 > > ## do (weired) scaling of variables as in Baltagi/Chang (1994) > Hedonic$mv2 <- Hedonic$mv > Hedonic$crim2 <- Hedonic$crim / 100 > Hedonic$zn2 <- Hedonic$zn / 1000 > Hedonic$indus2 <- Hedonic$indus / 100 > Hedonic$chas2 <- (as.numeric(Hedonic$chas)-1) / 10 > Hedonic$nox2 <- Hedonic$nox / 100 > Hedonic$rm2 <- Hedonic$rm / 100 > Hedonic$age2 <- Hedonic$age / 1000 > Hedonic$dis2 <- Hedonic$dis / 10 > Hedonic$rad2 <- Hedonic$rad / 10 > Hedonic$tax2 <- Hedonic$tax / 1000 > Hedonic$ptratio2 <- Hedonic$ptratio / 100 > Hedonic$lstat2 <- Hedonic$lstat / 10 > > pHedonic2 <- pdata.frame(Hedonic, index = "townid") > form2 <- formula(mv2 ~ crim2 + zn2 + indus2 + chas2 + nox2 + rm2 + age2 + dis2 + rad2 + tax2 + ptratio2 + blacks + lstat2) > summary(plm(form2, data = pHedonic2, model = "random")) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = form2, data = pHedonic2, model = "random") Unbalanced Panel: n = 92, T = 1-30, N = 506 Effects: var std.dev share idiosyncratic 0.01696 0.13025 0.562 individual 0.01324 0.11505 0.438 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.2505 0.5483 0.6284 0.6141 0.7147 0.7976 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.62902 -0.06712 -0.00156 -0.00216 0.06858 0.54973 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 9.685867 0.197510 49.0398 < 2.2e-16 *** crim2 -0.741197 0.104781 -7.0738 1.508e-12 *** zn2 0.078877 0.650012 0.1213 0.9034166 indus2 0.155634 0.403491 0.3857 0.6997051 chas2 -0.044247 0.292118 -0.1515 0.8796041 nox2 -0.584251 0.124518 -4.6921 2.704e-06 *** rm2 0.905517 0.118863 7.6182 2.573e-14 *** age2 -0.857873 0.467933 -1.8333 0.0667541 . dis2 -1.444184 0.440937 -3.2753 0.0010557 ** rad2 0.959839 0.266109 3.6069 0.0003098 *** tax2 -0.377396 0.176926 -2.1331 0.0329190 * ptratio2 -2.947578 0.906984 -3.2499 0.0011546 ** blacks 0.562775 0.101974 5.5188 3.413e-08 *** lstat2 -2.910749 0.239273 -12.1650 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 987.94 Residual Sum of Squares: 8.9988 R-Squared: 0.99091 Adj. R-Squared: 0.99067 Chisq: 1199.5 on 13 DF, p-value: < 2.22e-16 > > > # pcce(., model = "mg") and pmg(., model = "cmg") estimate the same model but > # in a different way - coefficients need to match > data("Produc", package = "plm") > form <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp > pccemgmod <- pcce(form, data = Produc, model = "mg") > pmgccemgmod <- pmg (form, data = Produc, model = "cmg") > common <- intersect(names(pccemgmod[["coefficients"]]), names(pmgccemgmod[["coefficients"]])) > coef_pccemgmod <- round(pccemgmod[["coefficients"]][common], digits = 7) > coef_pmgccemgmod <- round(pmgccemgmod[["coefficients"]][common], digits = 7) > stopifnot(all.equal(coef_pccemgmod, coef_pmgccemgmod, tolerance = 1E-04)) > > print(summary(pccemgmod)) Common Correlated Effects Mean Groups model Call: pcce(formula = form, data = Produc, model = "mg") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0806338298 -0.0037117390 0.0003146508 0.0040206746 0.0438957373 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) 0.0899850 0.1176042 0.7652 0.44418 log(pc) 0.0335784 0.0423362 0.7931 0.42770 log(emp) 0.6258657 0.1071720 5.8398 5.226e-09 *** unemp -0.0031178 0.0014389 -2.1668 0.03025 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.056978 HPY R-squared: 0.99312 > print(summary(pmgccemgmod)) Common Correlated Effects Mean Groups model Call: pmg(formula = form, data = Produc, model = "cmg") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0806338274 -0.0037117404 0.0003146628 0.0040206767 0.0438957373 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.6741754 1.0445518 -0.6454 0.518655 log(pcap) 0.0899850 0.1176040 0.7652 0.444180 log(pc) 0.0335784 0.0423362 0.7931 0.427698 log(emp) 0.6258659 0.1071719 5.8398 5.225e-09 *** unemp -0.0031178 0.0014389 -2.1668 0.030249 * y.bar 1.0038005 0.1078874 9.3041 < 2.2e-16 *** log(pcap).bar -0.0491919 0.2396185 -0.2053 0.837344 log(pc).bar -0.0033198 0.1576547 -0.0211 0.983200 log(emp).bar -0.6978359 0.2432887 -2.8683 0.004126 ** unemp.bar 0.0025544 0.0031848 0.8021 0.422505 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.056978 Multiple R-squared: 0.99993 > > > # run and output tests for pcce/pmg with model = 'p'/'mg'/'dmg' > print(summary(pcce(form, data = Produc, model = "p"))) Common Correlated Effects Pooled model Call: pcce(formula = form, data = Produc, model = "p") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0918842484 -0.0060964487 0.0005035277 0.0059795726 0.0682325138 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) 0.0432375 0.1041125 0.4153 0.6779 log(pc) 0.0363922 0.0368432 0.9878 0.3233 log(emp) 0.8209631 0.1390202 5.9054 3.519e-09 *** unemp -0.0020925 0.0014973 -1.3976 0.1622 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.11927 HPY R-squared: 0.99077 > print(summary(pmg (form, data = Produc, model = "mg"))) Mean Groups model Call: pmg(formula = form, data = Produc, model = "mg") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0828078889 -0.0118150348 0.0004246566 0.0126479124 0.1189647497 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.6722392 0.4126515 6.4758 9.433e-11 *** log(pcap) -0.1048507 0.0799132 -1.3121 0.18950 log(pc) 0.2182539 0.0500862 4.3576 1.315e-05 *** log(emp) 0.9334776 0.0750072 12.4452 < 2.2e-16 *** unemp -0.0037216 0.0016427 -2.2655 0.02348 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.33009 Multiple R-squared: 0.99961 > print(summary(pmg (form, data = Produc, model = "dmg"))) Demeaned Mean Groups model Call: pmg(formula = form, data = Produc, model = "dmg") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0834415058 -0.0076164165 -0.0001225963 0.0078108813 0.1177008894 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 0.0580979 0.1042881 0.5571 0.577466 log(pcap) -0.0629002 0.1021706 -0.6156 0.538133 log(pc) 0.1607882 0.0591334 2.7191 0.006546 ** log(emp) 0.8425585 0.0704896 11.9529 < 2.2e-16 *** unemp -0.0050181 0.0020770 -2.4160 0.015693 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.23666 Multiple R-squared: 0.99972 > print(summary(pmg (form, data = Produc, model = "cmg", trend = TRUE))) Common Correlated Effects Mean Groups model Call: pmg(formula = form, data = Produc, model = "cmg", trend = TRUE) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0344687086 -0.0031627228 0.0002987933 0.0032868591 0.0376921540 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -1.5070998 2.3224783 -0.6489 0.5163909 log(pcap) 0.0158617 0.1630186 0.0973 0.9224881 log(pc) 0.0142806 0.0501462 0.2848 0.7758130 log(emp) 0.6437498 0.1028653 6.2582 3.895e-10 *** unemp -0.0026343 0.0016265 -1.6196 0.1053197 y.bar 1.0783238 0.1403259 7.6844 1.537e-14 *** log(pcap).bar -0.1257206 0.2293070 -0.5483 0.5835113 log(pc).bar 0.1368755 0.1655543 0.8268 0.4083669 log(emp).bar -0.7235769 0.2041846 -3.5437 0.0003945 *** unemp.bar 0.0027532 0.0041063 0.6705 0.5025474 trend -0.0024686 0.0075303 -0.3278 0.7430488 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.039344 Multiple R-squared: 0.99995 > print(summary(pmg (form, data = Produc, model = "mg", trend = TRUE))) Mean Groups model Call: pmg(formula = form, data = Produc, model = "mg", trend = TRUE) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -7.609341e-02 -8.279992e-03 -6.593009e-05 8.589863e-03 1.237588e-01 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 4.9053650 1.2456243 3.9381 8.214e-05 *** log(pcap) 0.1900332 0.1055302 1.8007 0.07174 . log(pc) -0.0613999 0.0535890 -1.1458 0.25190 log(emp) 0.6259588 0.1207121 5.1856 2.154e-07 *** unemp -0.0089830 0.0022760 -3.9468 7.921e-05 *** trend 0.0133940 0.0029888 4.4814 7.414e-06 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.19488 Multiple R-squared: 0.99977 > print(summary(pmg (form, data = Produc, model = "dmg", trend = TRUE))) Demeaned Mean Groups model Call: pmg(formula = form, data = Produc, model = "dmg", trend = TRUE) Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0850324288 -0.0058606596 -0.0002823731 0.0065328252 0.0613773162 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.0721421 0.1828551 -0.3945 0.69319 log(pcap) 0.0826555 0.1273591 0.6490 0.51634 log(pc) 0.0421269 0.0386986 1.0886 0.27633 log(emp) 0.9059747 0.0773599 11.7112 < 2e-16 *** unemp -0.0025406 0.0014973 -1.6968 0.08973 . trend 0.0024740 0.0016826 1.4704 0.14145 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.12972 Multiple R-squared: 0.99985 > > ## further run tests without intercept > plm(inv ~ 0 + value + capital, data = Grunfeld, model = "between") Model Formula: inv ~ 0 + value + capital Coefficients: value capital 0.1351278 0.0091422 > plm(inv ~ 0 + value + capital, data = Grunfeld, model = "random") Model Formula: inv ~ 0 + value + capital Coefficients: value capital 0.10282 0.30745 > plm(inv ~ 0 + value + capital, data = Grunfeld, model = "within") Model Formula: inv ~ 0 + value + capital Coefficients: value capital 0.11012 0.31007 > plm(inv ~ 0 + value + capital, data = Grunfeld, model = "fd") Model Formula: inv ~ 0 + value + capital Coefficients: value capital 0.089063 0.278694 > > ## run tests within intercept only > > intonly.pool <- plm(inv ~ 1, data = Grunfeld, model = "pooling") > summary(intonly.pool) Pooling Model Call: plm(formula = inv ~ 1, data = Grunfeld, model = "pooling") Balanced Panel: n = 10, T = 20, N = 200 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -145.0283 -112.4008 -88.4733 -7.9183 1340.7417 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) 145.958 15.335 9.5177 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 9359900 Residual Sum of Squares: 9359900 R-Squared: 5.5511e-16 Adj. R-Squared: 5.5511e-16 > > intonly.fd <- plm(inv ~ 1, data = Grunfeld, model = "fd") > summary(intonly.fd) Oneway (individual) effect First-Difference Model Call: plm(formula = inv ~ 1, data = Grunfeld, model = "fd") Balanced Panel: n = 10, T = 20, N = 200 Observations used in estimation: 190 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -218.1808 -15.0808 -8.9458 6.7192 402.6192 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) 10.5808 4.0341 2.6228 0.009432 ** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 584410 Residual Sum of Squares: 584410 R-Squared: -0.036398 Adj. R-Squared: -0.036398 > > # errored up to and incl. rev. 1194 > intonly.be <- plm(inv ~ 1, data = Grunfeld, model = "between") > summary(intonly.be) Oneway (individual) effect Between Model Call: plm(formula = inv ~ 1, data = Grunfeld, model = "between") Balanced Panel: n = 10, T = 20, N = 200 Observations used in estimation: 10 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -142.874 -101.891 -87.352 -47.710 462.062 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) 145.958 62.874 2.3215 0.04538 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 355780 Residual Sum of Squares: 355780 R-Squared: 0 Adj. R-Squared: 0 > > ## errors rightfully with "empty model": > # plm(inv ~ 1, data = pGrun, model = "within") > > ## errors rightfully due to the within model involved in "swar" RE estimator: > # intonly.re <- plm(inv ~ 1, data = Grunfeld, model = "random") > intonly.re2 <- plm(inv ~ 1, data = Grunfeld, model = "random", random.method = "walhus") > summary(intonly.re2) Oneway (individual) effect Random Effect Model (Wallace-Hussain's transformation) Call: plm(formula = inv ~ 1, data = Grunfeld, model = "random", random.method = "walhus") Balanced Panel: n = 10, T = 20, N = 200 Effects: var std.dev share idiosyncratic 11812.4 108.7 0.252 individual 34987.3 187.0 0.748 theta: 0.8712 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -290.7863 -28.4427 -16.8619 6.9135 938.2137 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 145.958 59.797 2.4409 0.01465 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 2362500 Residual Sum of Squares: 2362500 R-Squared: 4.4409e-16 Adj. R-Squared: 4.4409e-16 > > > proc.time() user system elapsed 4.09 0.42 4.68 plm/inst/tests/test_pdata.frame_const_allNA_nonfinite.R0000644000176200001440000000340114124132276023053 0ustar liggesuserslibrary("plm") data("Grunfeld", package = "plm") Grunfeld$const <- 5 Grunfeld$allNA <- NA Grunfeld$non_finite <- 6 Grunfeld$non_finite[1:50] <- -Inf Grunfeld$non_finite[51] <- 6.5 Grunfeld$non_finite2 <- 7 Grunfeld$non_finite2[1:40] <- NaN Grunfeld$non_finite2[41] <- 7.5 # # plm()'s behaviour # plm(inv ~ value + capital + const, data = Grunfeld) # works fine # plm(inv ~ value + capital + allNA, data = Grunfeld) # errors with informative msg: 0 (non-NA) cases # plm(inv ~ value + capital + non_finite, data = Grunfeld) # errors with informative msg: NA/NaN/Inf in 'x' # plm(inv ~ value + capital + non_finite2, data = Grunfeld) # works fine # plm(inv ~ value + capital, data = Grunfeld[-c(1:40), ]) # check: same result as above line # # # # compare to behaviour of lm() # lm(inv ~ value + capital + const, data = Grunfeld) # works fine # lm(inv ~ value + capital + allNA, data = Grunfeld) # errors with informative msg: 0 (non-NA) cases # lm(inv ~ value + capital + non_finite, data = Grunfeld) # errors with informative msg: NA/NaN/Inf in 'x' # lm(inv ~ value + capital + non_finite2, data = Grunfeld) # works fine # lm(inv ~ value + capital, data = Grunfeld[-c(1:40), ]) # check: same result as above line pGrun_const <- pdata.frame(Grunfeld) pGrun_const <- pdata.frame(Grunfeld, drop.const.series = TRUE) # allNA series is also constant pGrun_allNA <- pdata.frame(Grunfeld, drop.NA.series = TRUE) pGrun_const_allNA <- pdata.frame(Grunfeld, drop.const.series = TRUE, drop.NA.series = TRUE) pGrun_const_allNA_non_finiteFALSE <- pdata.frame(Grunfeld, drop.const.series = TRUE, drop.NA.series = TRUE, replace.non.finite = FALSE) pGrun_non_finite <- pdata.frame(Grunfeld, replace.non.finite = TRUE) plm/inst/tests/test_Errors.Rout.save0000644000176200001440000000327614125776262017330 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### Testing problematic and erroneous data > library(plm) > > ### NA in the individual index: should give an informative error > ind <- 1:100 > ind[4] <- NA > T <- 4 > # balanced panel of length 4 > alpha <- rnorm(length(ind)) > # fixed effects > eps <- rnorm(T*length(ind)) > # idiosyncratic effect > x <- runif(length(ind)) > y <- x + alpha + eps > dat <- data.frame(y, x, ind=rep(ind, T), t=rep(1:T, each=length(ind))) > data <- pdata.frame(dat, index=c("ind", "t")) Warning message: In pdata.frame(dat, index = c("ind", "t")) : at least one NA in at least one index dimension in resulting pdata.frame to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany") > a <- try(m <- plm(y ~ x, data=data, model="random")) Error in checkNA.index(index) : NA in the individual index variable > # should give an error: NA in the individual index > > proc.time() user system elapsed 1.34 0.17 1.50 plm/inst/tests/test_model.matrix_pmodel.response.Rout.save0000644000176200001440000003011114126044721023625 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Tests for model.matrix[.pFormula|.plm] and pmodel.response.[pFormula|.plm|.data.frame] > > # commented lines do not run in v1.5-15 > > # 1) model.matrix[.pFormula|.plm] > # 2) pmodel.response.[pFormula|.plm|.data.frame] > > > > library(plm) > data("Grunfeld", package="plm") > form <- formula(inv ~ value + capital) > plm_pool <- plm(form, data=Grunfeld, model="pooling") > plm_fe <- plm(form, data=Grunfeld, model="within") > plm_re <- plm(form, data=Grunfeld, model="random") > > ########### 1) model.matrix[.pFormula|.plm] ########### > > > > # pooling and within models work pdata.frame [albeit one should input a model.frame of class pdata.frame] > pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) > mf <- model.frame(pGrunfeld, form) > > #MM modmat_pFormula_pdf_pool <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="pooling") # works > #MM modmat_pFormula_pdf_fe <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="within") # works > > modmat_pFormula_pdf_pool <- plm:::model.matrix.pdata.frame(mf, model="pooling") # works > modmat_pFormula_pdf_fe <- plm:::model.matrix.pdata.frame(mf, model="within") # works > > > #modmat_pFormula_re2 <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="random") # still fails in v1.5-15 > > # Error: > # Error in plm:::model.matrix.pFormula(form, data = pGrunfeld, model = "random") : > # dims [product 600] do not match the length of object [0] > > > #### some sanity checks if various interfaces yield the same result ### > modmat_plm_pool <- model.matrix(plm_pool) > modmat_plm_fe <- model.matrix(plm_fe) > modmat_plm_re <- model.matrix(plm_re) > > > ##### interfaces: plm vs. pFormula with pdata.frame > if(!isTRUE(all.equal(modmat_plm_pool, modmat_pFormula_pdf_pool, check.attributes = FALSE))) stop("model.matrix's are not the same") > if(!isTRUE(all.equal(modmat_plm_fe, modmat_pFormula_pdf_fe, check.attributes = FALSE))) stop("model.matrix's are not the same") > #if(!isTRUE(all.equal(modmat_plm_re, modmat_pFormula_pdf_re, check.attributes = FALSE))) stop("model.matrix's are not the same") > > > > > ########### 2) pmodel.response.[pFormula|.plm|.data.frame] ########### > > # pooling and within models work on a pdata.frame [the plain pdata.frame is coerced to a model.frame > # internally in pmodel.response.pFormula] > #MM resp_pFormula_pool <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "pooling") > #MM resp_pFormula_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within") > > resp_pFormula_pool <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "pooling") > resp_pFormula_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within") > > # still fails > # resp_pFormula_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld, model = "random") > # > # Error in model.matrix.pFormula(pFormula(formula), data = data, model = model, : > # dims [product 200] do not match the length of object [0] > > > ### pmodel.response.data.frame on data.frame/pdata.frame > ## the 'data' data.frame for pmodel.response.data.frame must be a model.frame created by plm's model.frame > ## it needs to be a model.frame because then it is ensured we find the response variable in the fist column > #pGrunfeld_mf <- model.frame(pFormula(form), data = pGrunfeld) > pGrunfeld_mf <- model.frame(pGrunfeld, form) > > resp_pdf_mf_pool <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "pooling") # works > resp_pdf_mf_fe <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "within") # works > #resp_pdf_mf_re <- plm:::pmodel.response.data.frame(pGrunfeld_mf, model = "random") # error, likely due to missing arguments > > ## these errored pre rev. 601 due to missing 'match.arg()' to set default value: > #pmodel.response(pFormula(form), data = pGrunfeld) > pmodel.response(form, data = pGrunfeld) 1 2 3 4 5 6 7 8 9 10 317.60 391.80 410.60 257.70 330.80 461.20 512.00 448.00 499.60 547.50 11 12 13 14 15 16 17 18 19 20 561.20 688.10 568.90 529.20 555.10 642.90 755.90 891.20 1304.40 1486.70 21 22 23 24 25 26 27 28 29 30 209.90 355.30 469.90 262.30 230.40 361.60 472.80 445.60 361.60 288.20 31 32 33 34 35 36 37 38 39 40 258.70 420.30 420.50 494.50 405.10 418.80 588.20 645.50 641.00 459.30 41 42 43 44 45 46 47 48 49 50 33.10 45.00 77.20 44.60 48.10 74.40 113.00 91.90 61.30 56.80 51 52 53 54 55 56 57 58 59 60 93.60 159.90 147.20 146.30 98.30 93.50 135.20 157.30 179.50 189.60 61 62 63 64 65 66 67 68 69 70 40.29 72.76 66.26 51.60 52.41 69.41 68.35 46.80 47.40 59.57 71 72 73 74 75 76 77 78 79 80 88.78 74.12 62.68 89.36 78.98 100.66 160.62 145.00 174.93 172.49 81 82 83 84 85 86 87 88 89 90 39.68 50.73 74.24 53.51 42.65 46.48 61.40 39.67 62.24 52.32 91 92 93 94 95 96 97 98 99 100 63.21 59.37 58.02 70.34 67.42 55.74 80.30 85.40 91.90 81.43 101 102 103 104 105 106 107 108 109 110 20.36 25.98 25.94 27.53 24.60 28.54 43.41 42.81 27.84 32.60 111 112 113 114 115 116 117 118 119 120 39.03 50.17 51.85 64.03 68.16 77.34 95.30 99.49 127.52 135.72 121 122 123 124 125 126 127 128 129 130 24.43 23.21 32.78 32.54 26.65 33.71 43.50 34.46 44.28 70.80 131 132 133 134 135 136 137 138 139 140 44.12 48.98 48.51 50.00 50.59 42.53 64.77 72.68 73.86 89.51 141 142 143 144 145 146 147 148 149 150 12.93 25.90 35.05 22.89 18.84 28.57 48.51 43.34 37.02 37.81 151 152 153 154 155 156 157 158 159 160 39.27 53.46 55.56 49.56 32.04 32.24 54.38 71.78 90.08 68.60 161 162 163 164 165 166 167 168 169 170 26.63 23.39 30.65 20.89 28.78 26.93 32.08 32.21 35.69 62.47 171 172 173 174 175 176 177 178 179 180 52.32 56.95 54.32 40.53 32.54 43.48 56.49 65.98 66.11 49.34 181 182 183 184 185 186 187 188 189 190 2.54 2.00 2.19 1.99 2.03 1.81 2.14 1.86 0.93 1.18 191 192 193 194 195 196 197 198 199 200 1.36 2.24 3.81 5.66 4.21 3.42 4.67 6.00 6.53 5.12 > pmodel.response(pGrunfeld_mf) 1 2 3 4 5 6 7 8 9 10 317.60 391.80 410.60 257.70 330.80 461.20 512.00 448.00 499.60 547.50 11 12 13 14 15 16 17 18 19 20 561.20 688.10 568.90 529.20 555.10 642.90 755.90 891.20 1304.40 1486.70 21 22 23 24 25 26 27 28 29 30 209.90 355.30 469.90 262.30 230.40 361.60 472.80 445.60 361.60 288.20 31 32 33 34 35 36 37 38 39 40 258.70 420.30 420.50 494.50 405.10 418.80 588.20 645.50 641.00 459.30 41 42 43 44 45 46 47 48 49 50 33.10 45.00 77.20 44.60 48.10 74.40 113.00 91.90 61.30 56.80 51 52 53 54 55 56 57 58 59 60 93.60 159.90 147.20 146.30 98.30 93.50 135.20 157.30 179.50 189.60 61 62 63 64 65 66 67 68 69 70 40.29 72.76 66.26 51.60 52.41 69.41 68.35 46.80 47.40 59.57 71 72 73 74 75 76 77 78 79 80 88.78 74.12 62.68 89.36 78.98 100.66 160.62 145.00 174.93 172.49 81 82 83 84 85 86 87 88 89 90 39.68 50.73 74.24 53.51 42.65 46.48 61.40 39.67 62.24 52.32 91 92 93 94 95 96 97 98 99 100 63.21 59.37 58.02 70.34 67.42 55.74 80.30 85.40 91.90 81.43 101 102 103 104 105 106 107 108 109 110 20.36 25.98 25.94 27.53 24.60 28.54 43.41 42.81 27.84 32.60 111 112 113 114 115 116 117 118 119 120 39.03 50.17 51.85 64.03 68.16 77.34 95.30 99.49 127.52 135.72 121 122 123 124 125 126 127 128 129 130 24.43 23.21 32.78 32.54 26.65 33.71 43.50 34.46 44.28 70.80 131 132 133 134 135 136 137 138 139 140 44.12 48.98 48.51 50.00 50.59 42.53 64.77 72.68 73.86 89.51 141 142 143 144 145 146 147 148 149 150 12.93 25.90 35.05 22.89 18.84 28.57 48.51 43.34 37.02 37.81 151 152 153 154 155 156 157 158 159 160 39.27 53.46 55.56 49.56 32.04 32.24 54.38 71.78 90.08 68.60 161 162 163 164 165 166 167 168 169 170 26.63 23.39 30.65 20.89 28.78 26.93 32.08 32.21 35.69 62.47 171 172 173 174 175 176 177 178 179 180 52.32 56.95 54.32 40.53 32.54 43.48 56.49 65.98 66.11 49.34 181 182 183 184 185 186 187 188 189 190 2.54 2.00 2.19 1.99 2.03 1.81 2.14 1.86 0.93 1.18 191 192 193 194 195 196 197 198 199 200 1.36 2.24 3.81 5.66 4.21 3.42 4.67 6.00 6.53 5.12 > > > > #### some sanity checks if various interfaces yield the same result ### > resp_plm_pool <- pmodel.response(plm_pool) > resp_plm_fe <- pmodel.response(plm_fe) > resp_plm_re <- pmodel.response(plm_re) > > > # compare interface pFormula with plm > if(!isTRUE(all.equal(resp_pFormula_pool, resp_plm_pool, check.attributes = FALSE))) stop("responses not equal") > if(!isTRUE(all.equal(resp_pFormula_fe, resp_plm_fe, check.attributes = FALSE))) stop("responses not equal") > #if(!isTRUE(all.equal(resp_pFormula_re, resp_plm_re, check.attributes = FALSE))) stop("responses not equal") > > > # compare interface data.frame with model.frame with plm > if(!isTRUE(all.equal(resp_pdf_mf_pool, resp_plm_pool, check.attributes = FALSE))) stop("responses not equal") > if(!isTRUE(all.equal(resp_pdf_mf_fe, resp_plm_fe, check.attributes = FALSE))) stop("responses not equal") > #if(!isTRUE(all.equal(resp_pdf_mf_re, resp_plm_re, check.attributes = FALSE))) stop("responses not equal") > > > > > > proc.time() user system elapsed 3.31 0.68 3.98 plm/inst/tests/test_pwtest.R0000644000176200001440000000375214154734502015705 0ustar liggesusers### Testfile for pwtest() ### panelmodel interface did not respect the effect parameter in pre rev. 200, i. e., ### for a supplied panelmodel effect="individual" and effect="time" delivered the same ### result for CRAN version 1.4-0 / r-forge pre rev. 200 require(plm) data("Produc", package="plm") formula <- log(gsp)~log(pcap)+log(pc)+log(emp)+unemp ## formula interface default_pwtest_formula <- pwtest(formula, data = Produc) # == effect = "individual" ind_pwtest_formula <- pwtest(formula, data = Produc, effect = "individual") time_pwtest_formula <- pwtest(formula, data = Produc, effect = "time") ## panelmodel interface pool_prodc <- plm(formula, data=Produc, model="pooling") default_pwtest_panelmodel <- pwtest(pool_prodc) # == effect = "individual" ind_pwtest_panelmodel <- pwtest(pool_prodc, effect="individual") time_pwtest_panelmodel <- pwtest(pool_prodc, effect="time") if (!identical(default_pwtest_formula, ind_pwtest_formula)) stop("pwtest.formula default effect != effect = 'individual'!") if (!identical(default_pwtest_panelmodel, ind_pwtest_panelmodel)) stop("pwtest.panelmodel default effect != effect = 'individual'!") if (!identical(ind_pwtest_panelmodel, ind_pwtest_formula)) stop("pwtest with effect = 'individual': formula and panelmodel interface results differ!") if (!identical(time_pwtest_panelmodel, time_pwtest_formula)) stop("pwtest with effect = 'individual': formula and panelmodel interface results differ!") if (identical(ind_pwtest_panelmodel, time_pwtest_panelmodel)) stop("pwtest results for effect='individual' and effect='time' are identical!") ### test if the error messages points to the correct possible values of 'effect' argument (only 'individual' or 'time' are allowed) # pwtest(formula, data=Produc, effect = "individualXX") # pwtest(pool_prodc, data=Produc, effect = "individualXX") ### test if wrong input model is detected # fe_prodc <- plm(formula, data=Produc, model="within") # pwtest(fe_prodc)plm/inst/tests/test_pdata.frame_id_index_more.R0000644000176200001440000001464514124132276021426 0ustar liggesusers# Test of conversion to pdata.frame if only an individual index in supplied # bug fixed in rev. 204 library(plm) data("Hedonic", package = "plm") # insert test columns Hedonic$str <- c(rep(c(letters), nrow(Hedonic)%/%length(letters)), letters[1:(nrow(Hedonic)%%length(letters))]) Hedonic$str_const <- rep("const", nrow(Hedonic)) temp <- pdata.frame(Hedonic, index = "townid") Hedonic$fac <- factor(Hedonic$str) Hedonic$fac_const <- rep(factor("fac_const"), nrow(Hedonic)) Hedonic$na <- rep(NA, nrow(Hedonic)) temp <- pdata.frame(Hedonic, index = "townid") Hedonic$na2 <- rep(NA, nrow(Hedonic)) rm(temp) Hedonic2 <- Hedonic[order(Hedonic$mv), ] # sorted a different way Hedonic3 <- Hedonic[order(Hedonic$townid, decreasing = TRUE), ] # in descending order Hed1 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = FALSE) # works pdim(Hed1) head(Hed1) Hed1_2.1 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = TRUE) # works pdim(Hed1_2.1) head(Hed1_2.1) #str(Hed1_2.1) sapply(Hed1_2.1, function(x) class(x)) Hed1_2.2 <- pdata.frame(Hedonic, index = "townid", stringsAsFactors = FALSE) # works pdim(Hed1_2.2) head(Hed1_2.2) #str(Hed1_2.2) sapply(Hed1_2.2, function(x) class(x)) Hed2 <- pdata.frame(Hedonic2, index = "townid") pdim(Hed2) head(Hed2) Hed2_2 <- pdata.frame(Hedonic2, index = "townid") pdim(Hed2_2) head(Hed2_2) head(Hedonic2) Hed3 <- pdata.frame(Hedonic3, index = "townid") pdim(Hed3) head(Hed3) Hed3_2 <- pdata.frame(Hedonic3, index = "townid") pdim(Hed3_2) head(Hed3_2) head(Hedonic3) # test for warning of duplicated couples data("Grunfeld", package = "plm") Grunfeld_dup <- rbind(Grunfeld, Grunfeld[200, ]) ttC <- tryCatch(pdata.frame(Grunfeld_dup), error=function(e) e, warning=function(w) w) if(!is(ttC,"warning") | ttC$message != "duplicate couples (id-time) in resulting pdata.frame\n to find out which, use, e.g., table(index(your_pdataframe), useNA = \"ifany\")") stop("warning of duplicated couples not successful") # test: character as individual index Grunfeld.p <- pdata.frame(Grunfeld) Grunfeld_charac <- Grunfeld Grunfeld_charac$firm <- as.character(Grunfeld_charac$firm) Grunfeld_charac.p <- pdata.frame(Grunfeld_charac) Grunfeld_charac.p2 <- pdata.frame(Grunfeld_charac, stringsAsFactors = FALSE) if(!identical(Grunfeld_charac.p, Grunfeld_charac.p2)) stop("pdata.frames not identical)") pdim(Grunfeld_charac.p) pdim(Grunfeld_charac.p2) # test: character as individual index Grunfeld_charac2 <- Grunfeld Grunfeld_charac2$firm <- as.character(Grunfeld_charac2$firm) Grunfeld_charac2$year <- as.character(Grunfeld_charac2$year) Grunfeld_charac2.p <- pdata.frame(Grunfeld_charac2) Grunfeld_charac2.p2 <- pdata.frame(Grunfeld_charac2, stringsAsFactors = FALSE) if(!identical(Grunfeld_charac2.p, Grunfeld_charac2.p2)) stop("pdata.frames not identical)") pdim(Grunfeld_charac2.p) pdim(Grunfeld_charac2.p2) # index with two variables Grunfeld.p3 <- pdata.frame(Grunfeld, index = c("firm", "year")) pdim(Grunfeld.p3) # index is numeric data("Wages", package = "plm") Wag <- pdata.frame(Wages, 595) pdim(Wag) # test for warning about time index ttC2 <- tryCatch(pdata.frame(Wages, index=c(595, 3)), error=function(e) e, warning = function(w) w) if(!is(ttC2,"warning") | ttC2$message != "The time index (second element of 'index' argument) will be ignored\n") stop("warning about unused time index not sent") # test of index() when individual index is called "group" (fixed in revision 904) data("Produc", package = "plm") Produc$group <- Produc$region pProduc <- pdata.frame(Produc, index = "group") index(pProduc) # test of 'appropriate' (="non-confusing") index names -> should issue warning data("Produc", package = "plm") Produc_confuse <- transform(Produc, id = year) Produc_confuse <- transform(Produc_confuse, time = state) p2 <- pdata.frame(Produc_confuse, index=c("state", "id")) p3 <- pdata.frame(Produc_confuse, index=c("time", "id")) index(p2) # gives wrong index (2x individual variable) with warning index(p2, which = "individual") # with warning index(p2, which = "id") # with warning index(p2, which = "time") # with warning index(p3) # gives wrong index (2x individual variable) index(p3, which = "individual") # with warning index(p3, which = "id") # with warning index(p3, which = "time") # with warning # test for error about length(index)>2 # Should result in error with informative message #ttC3 <- tryCatch(pdata.frame(Wages, index=c(595, 3, 5)), error=function(e) e, warning = function(w) w) #if(!is(ttC3,"error") | ttC3$message != "'index' can be of length 2 at the most (one individual and one time index)") stop("error about length(index)>2 not sent") #YC deprecated, the index can be now of length 3 #### larger data set ### ## commented because needs other package # require(plm) # library(ggplot2) # data("diamonds", package = "ggplot2") # # class(diamonds$cut) # ordered factor # # diamonds.p <- pdata.frame(diamonds, index = "cut") # wrong indexes created # pdim(diamonds.p) # # # order data set # diamonds3_asc <- diamonds[order(diamonds$cut), ] # diamonds3_asc.p <- pdata.frame(diamonds3_asc, index = "cut") # pdim(diamonds3_asc.p) # works # # diamonds3_desc <- diamonds[order(diamonds$cut, decreasing = T), ] # diamonds3_desc.p <- pdata.frame(diamonds3_desc, index = "cut") # pdim(diamonds3_desc.p) # # # # try numeric index # diamonds2 <- diamonds # diamonds2$cut_num <- as.numeric(diamonds2$cut) # make index numeric # # diamonds2_asc <- diamonds2[order(diamonds2$cut_num), ] # ascending order of index # diamonds2_desc <- diamonds2[order(diamonds2$cut_num, decreasing = T), ] # descending order of index # # head(diamonds2_asc) # head(diamonds2_desc) # # diamonds2_asc.p <- pdata.frame(diamonds2_asc, index = "cut_num") # pdim(diamonds2_asc.p) # # diamonds2_desc.p <- pdata.frame(diamonds2_desc, index = "cut_num") # wrong index created # pdim(diamonds2_desc.p) # # # # Some further tests about the blocks of individuals # # - does it depend on asc. block length? # # -> no, works fine # diamonds2_asc_short <- diamonds2_asc[-c(33940:nrow(diamonds2_asc)), ] # diamonds2_asc_short.p <- pdata.frame(diamonds2_asc_short, index = "cut_num") # pdim(diamonds2_asc_short.p) # # diamonds2_asc_short2 <- diamonds2_asc[-c(6517:18517), ] # diamonds2_asc_short2.p <- pdata.frame(diamonds2_asc_short2, index = "cut_num") # pdim(diamonds2_asc_short2.p) plm/inst/tests/test_pdwtest.R0000644000176200001440000000523114124132276016040 0ustar liggesusers## Test if pdwtest gives the same values for statistic and p-value for pooling and FE model ## as lmtest::dwtest ## ## bug fixed in rev. 127 / 2015-08-14 library(plm) library(lmtest) data("Grunfeld", package = "plm") # Use lm() for pooled OLS and fixed effects lm_pool <- lm(inv ~ value + capital, data = Grunfeld) lm_fe <- lm(inv ~ value + capital + factor(firm), data = Grunfeld) # Use plm() for pooled OLS and fixed effects plm_pool <- plm(inv ~ value + capital, data=Grunfeld, model = "pooling") plm_fe <- plm(inv ~ value + capital, data=Grunfeld, model = "within") # pre-check: Are the residuals for the pooled OLS and fixed effects model by plm() and lm() the same? if (!isTRUE(all.equal(as.numeric(residuals(plm_pool)), residuals(lm_pool), check.attributes = FALSE))) stop("pooling residuals not equal") if (!isTRUE(all.equal(as.numeric(residuals(plm_fe)), residuals(lm_fe), check.attributes = FALSE))) stop("FE residuals not equal") # check if statistics and p-values match res_dwtest_pool <- lmtest::dwtest(lm_pool) res_dwtest_fe <- lmtest::dwtest(lm_fe) res_pdwtest_pool <- pdwtest(plm_pool) res_pdwtest_fe <- pdwtest(plm_fe) if (!isTRUE(all.equal(res_dwtest_pool$statistic, res_pdwtest_pool$statistic))) stop("statistics do not match!") if (!isTRUE(all.equal(res_dwtest_pool$p.value, res_pdwtest_pool$p.value))) stop("p-values do not match!") if (!isTRUE(all.equal(res_dwtest_fe$statistic, res_pdwtest_fe$statistic))) stop("statistics do not match!") if (!isTRUE(all.equal(res_dwtest_fe$p.value, res_pdwtest_fe$p.value))) stop("p-values do not match!") # test for passing of arguments in ellipsis (...) res_dwtest_pool_alt2 <- lmtest::dwtest(lm_pool, alternative = "two.sided") res_pdwtest_pool_alt2 <- pdwtest(plm_pool, alternative = "two.sided") if (!isTRUE(all.equal(res_dwtest_pool_alt2$statistic, res_pdwtest_pool_alt2$statistic))) stop("statistics do not match! Arg 'alternative' likely not respected") # simple run tests pdwtest(inv ~ value + capital, data = Grunfeld) pdwtest(inv ~ value + capital, data = Grunfeld, model = "random", effect = "twoways") pdwtest(inv ~ value + capital, data = Grunfeld, model = "random", effect = "twoways", alternative = "two.sided") # exact = T (but not exact = TRUE) fails up to at least rev. 408 pdwtest(inv ~ value + capital, data = Grunfeld, model = "pooling", effect = "individual", alternative = "two.sided", exact = TRUE) # pdwtest(inv ~ value + capital, data = Grunfeld, model = "pooling", effect = "individual", alternative = "two.sided", exact = T) # pdwtest(plm_pool, alternative = "two.sided", exact = T) ## Error in if (exact) { : argument is not interpretable as logical plm/inst/tests/test_FD_models.R0000644000176200001440000000143714124132276016206 0ustar liggesusers## Test of various models involving first-differences library(plm) data("Produc", package = "plm") # plm with intercept fd_plm <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") # plm without intercept fd_plm2 <- plm(log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") # pggls with intercept fd_pggls <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") # pggls without intercept fd_pggls2 <- pggls(log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") summary(fd_plm) summary(fd_plm2) summary(fd_pggls) summary(fd_pggls2) vcovHC(fd_plm) vcovHC(fd_plm2) ## vcovHC does not run pggls models # vcovHC(fd_pggls) # vcovHC(fd_pggls2) plm/inst/tests/test_Chow.Rout.save0000644000176200001440000000376314125776262016755 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ############## Poolability: Chow test > # Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, Wiley & Sons > # Sec 4.1.3, example 2, p. 68 => results are replicated > > library(plm) > data("Gasoline", package = "plm") > form <- lgaspcar ~ lincomep + lrpmg + lcarpcap > > # poolability across countries > pooltest(form, data = Gasoline, effect = "individual", model = "pooling") # matches: F=129.38 [F(68,270)] F statistic data: form F = 129.32, df1 = 68, df2 = 270, p-value < 2.2e-16 alternative hypothesis: unstability > > # poolability across countries [slope coefficients only, allowing for different intercepts] > pooltest(form, data = Gasoline, effect = "individual", model = "within") # matches: F= 27.33 [F(51,270)] F statistic data: form F = 27.335, df1 = 51, df2 = 270, p-value < 2.2e-16 alternative hypothesis: unstability > > # poolability across time > pooltest(form, data = Gasoline, effect = "time", model = "pooling") # matches: F= 0.276 [F(72,266)] F statistic data: form F = 0.27625, df1 = 72, df2 = 266, p-value = 1 alternative hypothesis: unstability > pooltest(form, data = Gasoline, effect = "time", model = "within") # no value stated in Baltagi (2013) for within F statistic data: form F = 0.29465, df1 = 54, df2 = 266, p-value = 1 alternative hypothesis: unstability > > proc.time() user system elapsed 0.865 0.034 0.887 plm/inst/tests/test_pFtest.Rout.save0000644000176200001440000000531114124132276017277 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Testfile for pFtest() > > # SAS 9.4 Output for F Test [fixed one-way estimates, individual effect] > # > # F Test for No Fixed Effects > # > # Num DF Den DF F statistic Pr > F > # 9 188 49.18 < .0001 > > library(plm) > data("Grunfeld", package="plm") > gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") > > gi <- plm(inv ~ value + capital, data = Grunfeld, + effect = "individual", model = "within") > > gt <- plm(inv ~ value + capital, data = Grunfeld, + effect = "time", model = "within") > > gd <- plm(inv ~ value + capital, data = Grunfeld, + effect = "twoways", model = "within") > > > pFtest(gi, gp) # test for individual effects matches SAS's Output F test for individual effects data: inv ~ value + capital F = 49.177, df1 = 9, df2 = 188, p-value < 2.2e-16 alternative hypothesis: significant effects > pFtest(gt, gp) F test for time effects data: inv ~ value + capital F = 0.23451, df1 = 19, df2 = 178, p-value = 0.9997 alternative hypothesis: significant effects > pFtest(gd, gp) F test for twoways effects data: inv ~ value + capital F = 17.403, df1 = 28, df2 = 169, p-value < 2.2e-16 alternative hypothesis: significant effects > > > print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "individual")) F test for individual effects data: inv ~ value + capital F = 49.177, df1 = 9, df2 = 188, p-value < 2.2e-16 alternative hypothesis: significant effects > print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "time")) F test for time effects data: inv ~ value + capital F = 0.23451, df1 = 19, df2 = 178, p-value = 0.9997 alternative hypothesis: significant effects > print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "twoways")) F test for twoways effects data: inv ~ value + capital F = 17.403, df1 = 28, df2 = 169, p-value < 2.2e-16 alternative hypothesis: significant effects > > # test for wrong order of arguments, this is supposed to give a meaningful error message > # pFtest(gi, gd) > > proc.time() user system elapsed 0.809 0.033 0.848 plm/inst/tests/test_pgrangertest.R0000644000176200001440000000243214124132276017053 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") pgrangertest(inv ~ value, data = Grunfeld) pgrangertest(inv ~ value, data = Grunfeld, order = 2L) pgrangertest(inv ~ value, data = Grunfeld, order = 2L, test = "Zbar") # unbalanced unbal <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = 2L) unbal$indgranger # varying lag order bal_varorder <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = c(rep(2L, 9), 3L)) bal_varorder$indgranger unbal_varorder <- pgrangertest(inv ~ value, data = Grunfeld[1:199, ], order = c(rep(2L, 9), 3L)) unbal_varorder$indgranger ## Demo data from Dumitrescu/Hurlin (2012) supplement: ## http://www.runmycode.org/companion/view/42 ## The data are in the following format: 20 x 20 ## First 20 columns are the x series for the 10 individual ## next 20 columns are the y series for the 10 individuals ## -> need to convert to 'long' format first # demodat <- readxl::read_excel("data/Granger_Data_demo_long.xls") # demodat <- data.frame(demodat) # pdemodat <- pdata.frame(demodat) # pgrangertest(y ~ x, data = pdemodat, order = 1L) # pgrangertest(y ~ x, data = pdemodat, order = 1L, test = "Zbar") # # pgrangertest(y ~ x, data = pdemodat, order = 2L) # pgrangertest(y ~ x, data = pdemodat, order = 2L, test = "Zbar")plm/inst/tests/test_fitted.plm.R0000644000176200001440000001266214124132276016422 0ustar liggesusers# Test of fitted.plm # # 1) Does fitted.plm run with various inputs? # 2) Does fitted.plm run / issue a warning if a coefficients gets (silently) dropped in estimated model # 3) Sundry # # NB: Correctness of calculation in fitted.plm is not checked currently in this file # # NB: there is also a non-exported function fitted_exp.plm and an associated test file # which calculates the fitted values by subtracting the "overall" residuals # (of the respective "overall"/"outer" model). library(plm) data("Grunfeld", package = "plm") form <- inv ~ value + capital mod_pool <- plm(form, data = Grunfeld, model = "pooling") mod_fe <- plm(form, data = Grunfeld, model = "within") mod_re <- plm(form, data = Grunfeld, model = "random") mod_be <- plm(form, data = Grunfeld, model = "between") ######## 1) General tests with various inputs ######## plm:::fitted.plm(mod_pool) plm:::fitted.plm(mod_fe) plm:::fitted.plm(mod_re) plm:::fitted.plm(mod_be) plm:::fitted.plm(mod_pool, model = "pooling") plm:::fitted.plm(mod_fe, model = "pooling") plm:::fitted.plm(mod_re, model = "pooling") plm:::fitted.plm(mod_be, model = "pooling") plm:::fitted.plm(mod_pool, model = "within") plm:::fitted.plm(mod_fe, model = "within") plm:::fitted.plm(mod_re, model = "within") plm:::fitted.plm(mod_be, model = "within") # some fail in v1.4-0 and v1.5-14: # "Error in ercomp.plm(object) : ercomp only relevant for random models" # plm:::fitted.plm(mod_pool, model = "random") # plm:::fitted.plm(mod_fe, model = "random") plm:::fitted.plm(mod_re, model = "random") # plm:::fitted.plm(mod_be, model = "random") plm:::fitted.plm(mod_pool, model = "between") plm:::fitted.plm(mod_fe, model = "between") plm:::fitted.plm(mod_re, model = "between") plm:::fitted.plm(mod_be, model = "between") ######## 2) Testcase with dropped coefficient in estimated model ###### # add linear dependent columns to dataset. Those columns get dropped in estimation Grunfeld$lin_dep_col <- Grunfeld$capital Grunfeld$lin_dep_col2 <- 2 * Grunfeld$lin_dep_col form2 <- update.formula(form, . ~ . + lin_dep_col) form3 <- update.formula(form, . ~ . + lin_dep_col + lin_dep_col2) mod_pool_droppedCoef <- plm(form2, data = Grunfeld, model = "pooling") mod_fe_droppedCoef <- plm(form2, data = Grunfeld, model = "within") mod_re_droppedCoef <- plm(form2, data = Grunfeld, model = "random") mod_be_droppedCoef <- plm(form2, data = Grunfeld, model = "between") mod_pool_dropped2Coef <- plm(form3, data = Grunfeld, model = "pooling") mod_pool_droppedCoef$aliased mod_fe_droppedCoef$aliased mod_re_droppedCoef$aliased mod_be_droppedCoef$aliased mod_pool_dropped2Coef$aliased # Below: # Some of these failed due to dropped coefficients, was fixed in rev. 184 # [and some due to an additional error with ercomp.plm] fitval_mod_pool_droppedCoef <- plm:::fitted.plm(mod_pool_droppedCoef) fitval_mod_fe_droppedCoef <- plm:::fitted.plm(mod_fe_droppedCoef) fitval_mod_re_droppedCoef <- plm:::fitted.plm(mod_re_droppedCoef) fitval_mod_be_droppedCoef <- plm:::fitted.plm(mod_be_droppedCoef) # formal test of same results if (!identical(fitval_mod_pool_droppedCoef, plm:::fitted.plm(mod_pool))) stop("not identical") if (!identical(fitval_mod_fe_droppedCoef, plm:::fitted.plm(mod_fe))) stop("not identical") if (!identical(fitval_mod_re_droppedCoef, plm:::fitted.plm(mod_re))) stop("not identical") if (!identical(fitval_mod_be_droppedCoef, plm:::fitted.plm(mod_be))) stop("not identical") plm:::fitted.plm(mod_pool_droppedCoef, model = "pooling") plm:::fitted.plm(mod_fe_droppedCoef, model = "pooling") plm:::fitted.plm(mod_re_droppedCoef, model = "pooling") plm:::fitted.plm(mod_be_droppedCoef, model = "pooling") # some of these were all NA before rev. 605: plm:::fitted.plm(mod_pool_droppedCoef, model = "within") plm:::fitted.plm(mod_fe_droppedCoef, model = "within") plm:::fitted.plm(mod_re_droppedCoef, model = "within") plm:::fitted.plm(mod_be_droppedCoef, model = "within") # formal test if (all(is.na(plm:::fitted.plm(mod_pool_droppedCoef, model = "within")))) stop("all values are NA") # plm:::fitted.plm(mod_pool_droppedCoef, model = "random") # "Error in ercomp.plm(object) : ercomp only relevant for random models" # plm:::fitted.plm(mod_fe_droppedCoef, model = "random") # "Error in ercomp.plm(object) : ercomp only relevant for random models" # plm:::fitted.plm(mod_re_droppedCoef, model = "random") # plm:::fitted.plm(mod_be_droppedCoef, model = "random") # "Error in ercomp.plm(object) : ercomp only relevant for random models" ### test with data that becomes linear dependent due to within transformation data("Cigar", package = "plm") Cigar.p <- pdata.frame(Cigar) Cigar.p[ , "fact1"] <- c(0,1) Cigar.p[ , "fact2"] <- c(1,0) # linear dependent columns are silently dropped in these functions, thus they work mod_pool_cigar <- plm(price ~ cpi + fact1 + fact2, data = Cigar.p, model = "pooling") mod_fe_cigar <- plm(price ~ cpi + fact1 + fact2, data = Cigar.p, model = "within") mod_pool_cigar$aliased mod_fe_cigar$aliased plm:::fitted.plm(mod_pool_cigar) plm:::fitted.plm(mod_pool_cigar, model = "within") plm:::fitted.plm(mod_fe_cigar) plm:::fitted.plm(mod_fe_cigar, model = "within") ######## 3) Sundry # this gave an error pre rev. 522 (drop = FALSE was missing): wi <- plm(inv ~ value, data = Grunfeld, model = "within") plm:::fitted.plm(wi, model = "between") plm/inst/tests/test_pbnftest.R0000644000176200001440000000405314124132276016174 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") # Baltagi/Wu (1999), p. 822, Table 1: test data construction a <- Grunfeld[["year"]][c(9, 10)] b <- Grunfeld[["year"]][c(17, 18)] c <- Grunfeld[["year"]][c(3, 4, 5)] d <- Grunfeld[["year"]][c(7, 8, 9)] e <- Grunfeld[["year"]][c(13, 14, 15)] f <- Grunfeld[["year"]][c(3, 4, 5, 6)] g <- Grunfeld[["year"]][c(12, 13, 14, 15)] h <- Grunfeld[["year"]][c(2, 4, 5, 14)] i <- Grunfeld[["year"]][c(8, 9, 16, 17, 19)] j <- Grunfeld[["year"]][c(2, 3, 15, 16, 17, 19)] k <- Grunfeld[["year"]][c(2, 3, 15, 18, 19, 20)] l <- Grunfeld[["year"]][c(2, 3, 5, 7, 15, 20)] m <- Grunfeld[["year"]][c(3, 5, 8, 9, 16, 17, 19)] n <- Grunfeld[["year"]][c(2, 4, 5, 14, 15, 16, 19)] o <- Grunfeld[["year"]][c(2, 3, 4, 8, 9, 16, 17, 19)] p <- Grunfeld[["year"]][c(2, 3, 5, 7, 15, 18, 19, 20)] q <- Grunfeld[["year"]][c(2, 4, 5, 8, 14, 15, 16, 19)] models_fe <- lapply(letters[1:17], function(let) plm(inv ~ value + capital, data = Grunfeld[!Grunfeld[["year"]] %in% get(let), ], model = "within")) results_modbnf <- lapply(models_fe, pbnftest) names(results_modbnf) <- letters[1:17] print(unlist(lapply(results_modbnf, function(i) i$statistic))) results_lbi <- lapply(models_fe, function(mod) pbnftest(mod, test = "lbi")) names(results_lbi) <- letters[1:17] print(unlist(lapply(results_lbi, function(i) i$statistic))) # formula interface pbnftest(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "within") pbnftest(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], test = "lbi", model = "within") # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "within") # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1951, 1952), ], model = "within") # x <- plm(inv ~ value + capital, data = Grunfeld, model = "within") # x <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") # x <- plm(inv ~ value + capital, data = Grunfeld[!Grunfeld$year %in% c(1943, 1944), ], model = "pooling") plm/inst/tests/test_pggls.R0000644000176200001440000000425714155651544015501 0ustar liggesuserslibrary(plm) data("Produc", package = "plm") zz_default <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) summary(zz_default) # is within, check if correctly identified in print output zz_wi <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") summary(zz_wi) zz_pool <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "pooling") summary(zz_pool) zz_fd <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") summary(zz_fd) zz_wi_t <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within", effect = "time") summary(zz_wi_t) zz_pool_t <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "pooling", effect = "time") summary(zz_pool_t) ## effect = "time" for FD model not supported as senseless (individ. dimension ## does not have a natural order) ## do not run as additional package is needed # library(wooldridge) # data("jtrain", package = "wooldridge") # pjtrain <- pdata.frame(jtrain, index = c("fcode", "year")) # # ## no examples in Wooldridge (2002/2010), Ch. 10 for the RE GLS, FE GLS, FD GLS models # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "pooling") # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "within") # pggls(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "fd") # errored in 1.6-5, run in 1.6-6 (but gives nointercept), with intercept in 1.7-0 (rev. 746) # # # summary(plm(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "random")) # W (2010), p. 297 # summary(plm(lscrap ~ d88 + d89 + union + grant + grant_1, data = pjtrain, model = "within")) # W (2010), p. 307 # summary(plm(lscrap ~ d89 + union + grant + grant_1, data = pjtrain, model = "fd")) # W (2010), p. 319 ## Results in Wooldridge, Ch. 10 for plm random, p. 297 ## 0.415 intercept ## -0.093 d88 ## -0.270 d89 ## +0.548 union ## -0.215 grant ## -0.377 grant_t-1plm/inst/tests/test_summary.plm_vcov.R0000644000176200001440000000277214124132276017676 0ustar liggesusers### Test of summary.plm with user specified vcov (arg 'vcov' as matrix and as function) options(scipen = 999) library(plm) data("Grunfeld", package = "plm") gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") sum_obj <- summary(gi) sum_obj_mat <- summary(gi, vcov = vcovHC(gi)) # arg 'vcov' is matrix mat <- vcovHC(gi) sum_obj_mat2 <- summary(gi, vcov = mat) # arg 'vcov' is matrix sum_obj_fun <- summary(gi, vcov = vcovHC) # arg 'vcov' is function sum_obj_fun2 <- summary(gi, vcov = function(x) vcovHC(x, method="white2")) # arg 'vcov' is function with args if (identical(sum_obj, sum_obj_mat)) stop("summary.plm objects with and without robust vcov must be non-identical") if (!identical(sum_obj_mat$coefficients, sum_obj_fun$coefficients)) stop("summary.plm object's coefs, SE, t stat and p-values for vcov = matrix and for vcov = function not identical") # Note: objects with vcov = matrix and vcov = function are non-identical, because attr(object$rvcov, "name") differs # Visualise output with various rvcov names print(sum_obj) # without furnished vcov print(sum_obj_mat) # vcov = matrix prints short info that a furnished vcov is used print(sum_obj_mat2) # vcov = matrix prints short info that a furnished vcov is used print(sum_obj_fun) # vcov = function prints additional info about the vcov function used print(sum_obj_fun2) # vcov = function with args prints additional info about the vcov function used plm/inst/tests/test_model.frame.Rout.save0000644000176200001440000001656614126044711020237 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests if model is re-producable from plm_object$model (model.frame in plm_object) > # => reproduction works > > library(plm) > data("Grunfeld", package="plm") # requires package plm > > > # generate dataset with NA in dependent and independent variable > Grunfeld_NA_dep_var <- Grunfeld > Grunfeld_NA_dep_var[1, ]$inv <- NA > pGrunfeld_NA_dep_var <- pdata.frame(Grunfeld_NA_dep_var) > > Grunfeld_NA_indep_var <- Grunfeld > Grunfeld_NA_indep_var[1, ]$value <- NA > pGrunfeld_NA_indep_var <- pdata.frame(Grunfeld_NA_indep_var) > > #### input more NAs in dep var > pGrunfeld_NA_dep_var_more <- pGrunfeld_NA_dep_var > pGrunfeld_NA_dep_var_more[c(1:10, 21:30), ]$inv <- NA > > > > # generate dataset with NA row > Grunfeld_NA_row <- Grunfeld > Grunfeld_NA_row[1, c("inv", "value", "capital")] <- NA > pGrunfeld_NA_row <- pdata.frame(Grunfeld_NA_row) > > > form <- formula(inv ~ value + capital) > > # 200 rows > nrow(Grunfeld) [1] 200 > nrow(Grunfeld_NA_dep_var) [1] 200 > nrow(Grunfeld_NA_row) [1] 200 > > > plm_fe <- plm(form, data=Grunfeld, model="within") > plm_fe_NA_dep_var <- plm(form, data=pGrunfeld_NA_dep_var, model="within") > plm_fe_NA_dep_var_more <- plm(form, data=pGrunfeld_NA_dep_var_more, model="within") > plm_fe_NA_dep_var_tw <- plm(form, data=pGrunfeld_NA_dep_var, model="within", effect = "twoways") > > plm_re <- plm(form, data=Grunfeld, model="random") > plm_re_NA_dep_var <- plm(form, data=pGrunfeld_NA_dep_var, model="random") > plm_re_NA_dep_var_more <- plm(form, data=pGrunfeld_NA_dep_var_more, model="random") > # plm_re_NA_dep_var_tw <- plm(form, data=pGrunfeld_NA_dep_var, model="random", effect = "twoways") # not implemented > # plm_re_NA_tw <- plm(form, data=Grunfeld, model="random", effect = "twoways") # est. variance of time effect < 0 > > > if (nrow(plm_fe$model) != 200) stop("should be 200 rows") # 200 (correct) > if (nrow(plm_fe_NA_dep_var$model) != 199) stop("should be 199 rows") # 199 (correct) > if (nrow(plm_fe_NA_dep_var_more$model) != 180) stop("should be 180 rows") # 180 (correct) > if (nrow(plm_fe_NA_dep_var_tw$model) != 199) stop("should be 199 rows") # 199 (correct) > > if (nrow(plm_re$model) != 200) stop("should be 200 rows") # 200 (correct) > if (nrow(plm_re_NA_dep_var$model) != 199) stop("should be 199 rows") # 199 (correct) > if (nrow(plm_re_NA_dep_var_more$model) != 180) stop("should be 180 rows") # 180 (correct) > #nrow(plm_fe_NA_dep_var_tw$model) # not implemented > > > > ###### re-produce FE model > plm_fe_NA_dep_var2 <- plm(form, data=plm_fe_NA_dep_var$model, model="within") > > # coefficients are the same > if(!all(plm_fe_NA_dep_var$coefficients == plm_fe_NA_dep_var2$coefficients)) stop("coefficients diverge") > > # model.frames in plm_objects are the same > if(!all(plm_fe_NA_dep_var$model == plm_fe_NA_dep_var2$model)) stop("model.frames diverge") > if(!all.equal(plm_fe_NA_dep_var$model, plm_fe_NA_dep_var2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_fe_NA_dep_var$model), as.data.frame(plm_fe_NA_dep_var2$model), ignoreAttrs = TRUE) # TRUE > > > > > ###### re-produce FE model with more NAs > plm_fe_NA_dep_var_more2 <- plm(form, data=plm_fe_NA_dep_var_more$model, model="within") > > # coefficients are the same > if (!all(plm_fe_NA_dep_var_more$coefficients == plm_fe_NA_dep_var_more2$coefficients)) stop("coefficients diverge") > > # model.frame in plm_object is same > if (!all(plm_fe_NA_dep_var_more$model == plm_fe_NA_dep_var_more2$model)) stop("model.frames diverge") > if (!all.equal(plm_fe_NA_dep_var_more$model, plm_fe_NA_dep_var_more2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_fe_NA_dep_var_more$model), as.data.frame(plm_fe_NA_dep_var_more2$model), ignoreAttrs = TRUE) # TRUE > > > > ###### re-produce for twoway FE model > plm_fe_NA_dep_var_tw2 <- plm(form, data=plm_fe_NA_dep_var_tw$model, model="within", effect = "twoways") > > # coefficients are the same > if (!all(plm_fe_NA_dep_var_tw$coefficients == plm_fe_NA_dep_var_tw2$coefficients)) stop("coefficients diverge") > > # model.frame in plm_object is same > if (!all(plm_fe_NA_dep_var_tw$model == plm_fe_NA_dep_var_tw$model)) stop("model.frames diverge") > if (!all.equal(plm_fe_NA_dep_var_tw$model, plm_fe_NA_dep_var_tw2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_fe_NA_dep_var_tw$model), as.data.frame(plm_fe_NA_dep_var_tw2$model), ignoreAttrs = TRUE) # TRUE > > > > > > > ###### re-produce RE model > plm_re_NA_dep_var2 <- plm(form, data=plm_re_NA_dep_var$model, model="random") > > # coefficients are the same > if (!all(plm_re_NA_dep_var$coefficients == plm_re_NA_dep_var2$coefficients)) stop("coefficients diverge") > > # model.frames in plm_objects are the same > if (!all(plm_re_NA_dep_var$model == plm_re_NA_dep_var2$model)) stop("model.frames diverge") > if (!all.equal(plm_re_NA_dep_var$model, plm_re_NA_dep_var2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_re_NA_dep_var$model), as.data.frame(plm_re_NA_dep_var2$model), ignoreAttrs = TRUE) # TRUE > > > > > ###### re-produce RE model with more NAs > plm_re_NA_dep_var_more2 <- plm(form, data=plm_re_NA_dep_var_more$model, model="random") > > # coefficients are the same > if (!all(plm_re_NA_dep_var_more$coefficients == plm_re_NA_dep_var_more2$coefficients)) stop("coefficients diverge") > > # model.frame in plm_object is same > if (!all(plm_re_NA_dep_var_more$model == plm_re_NA_dep_var_more2$model)) stop("model.frames diverge") > if (!all.equal(plm_re_NA_dep_var_more$model, plm_re_NA_dep_var_more2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_re_NA_dep_var_more$model), as.data.frame(plm_re_NA_dep_var_more2$model), ignoreAttrs = TRUE) # TRUE > > > > ###### re-produce for twoway RE model - not implemented > # plm_re_NA_dep_var_tw2 <- plm(form, data=plm_re_NA_dep_var_tw$model, model="within", effect = "twoways") > # > # # coefficients are the same > # if(!all(plm_re_NA_dep_var_tw$coefficients == plm_re_NA_dep_var_tw2$coefficients)) stop("coefficients diverge") > # > # # model.frame in plm_object is same > # if(!all(plm_re_NA_dep_var_tw$model == plm_re_NA_dep_var_tw$model)) stop("model.frames diverge") > # if(!all.equal(plm_re_NA_dep_var_tw$model, plm_re_NA_dep_var_tw2$model, check.attributes = FALSE)) stop("model.frames diverge") > #compare::compare(as.data.frame(plm_re_NA_dep_var_tw$model), as.data.frame(plm_re_NA_dep_var_tw2$model), ignoreAttrs = TRUE) # TRUE > > > proc.time() user system elapsed 3.32 0.45 3.82 plm/inst/tests/test_is.pconsecutive.R0000644000176200001440000002155514124132276017476 0ustar liggesusers# tests for is.pconsecutive # # in separate test file: tests for make.pconsecutive and make.pbalanced ############## test with consecutive and non-consecutive time periods #### library(plm) data("Grunfeld", package = "plm") Grunfeld_missing_period <- Grunfeld[-2, ] pGrunfeld <- pdata.frame(Grunfeld) pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) # delete one time period of first individual (1-1936 is missing) # Expected results: # Grunfeld: rep(TRUE, 10) # Grunfeld_missing_period: c(FALSE, rep(TRUE, 9)) # test on data.frame is.pconsecutive(Grunfeld) is.pconsecutive(Grunfeld_missing_period) is.pconsecutive(Grunfeld, index=c("firm", "year")) is.pconsecutive(Grunfeld_missing_period, index=c("firm", "year")) # should result in informative error message: is.pconsecutive(Grunfeld, index=c("firm") # because we need both dimensions when index != NULL ttC <- tryCatch(is.pconsecutive(Grunfeld, index=c("firm")), error=function(e) e, warning=function(w) w) if(!is(ttC,"error")) stop("error for non supplied time dimension in index not working") # print(ttC$message) # test with not ordered data.frame (ordered by id, time) # [only necessary for data.frame as pdata.frames are always ordered this way] Grun_not_ordered <- Grunfeld Grun_not_ordered <- Grun_not_ordered[order(Grun_not_ordered$capital), ] is.pconsecutive(Grun_not_ordered) if (!isTRUE(all.equal(is.pconsecutive(Grun_not_ordered), rep(TRUE, 10), check.attributes = FALSE))) stop("wrong result for not ordered data.frame") # test on pdata.frame if (!all(is.pconsecutive(pGrunfeld))) stop("is.pconsecutive on pdata.frame: wrong result") if (!isTRUE(all.equal(is.pconsecutive(pGrunfeld_missing_period), c(FALSE, rep(TRUE, 9)), check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result") # test on panelmodel object estimation_pGrunfeld <- plm(inv ~ value + capital, data = pGrunfeld) estimation_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = pGrunfeld_missing_period) nobs(estimation_pGrunfeld) # 200 nobs(estimation_pGrunfeld_missing_period) # 199 is.pconsecutive(estimation_pGrunfeld) is.pconsecutive(estimation_pGrunfeld_missing_period) # default method (by dispatching) # test on "numeric" and "NULL" -> should execute is.pconsecutive.default is.pconsecutive(Grunfeld$inv, id = Grunfeld$firm, time = Grunfeld$year) is.pconsecutive(Grunfeld[["inv"]], id = Grunfeld$firm, time = Grunfeld$year) is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) exp_res_arbitrary_vec <- rep(TRUE, 10) # formal test if (!isTRUE(all.equal(is.pconsecutive(Grunfeld$inv, id = Grunfeld$firm, time = Grunfeld$year), exp_res_arbitrary_vec, check.attributes = FALSE))) stop("not correct for arbitrary vector") # test on pseries pinv <- pGrunfeld$inv pinv_missing_period <- pGrunfeld_missing_period$inv is.pconsecutive(pinv) is.pconsecutive(pinv_missing_period) ## more missing periods Grunfeld_missing_periods <- Grunfeld[-c(2,6,7), ] pGrunfeld_missing_periods <- pdata.frame(Grunfeld_missing_periods) pinv_missing_periods <- pGrunfeld_missing_periods$inv ######## with different data set "Hedonic" data("Hedonic", package = "plm") Hed <- Hedonic pHed <- pdata.frame(Hedonic, index = "townid") Hed_missing_period <- Hedonic[-c(5,11), ] # delete 3-2 and 4-5 pHed_missing_period <- pdata.frame(Hedonic, index = "townid") # make pdata.frame first to produce a time index pHed_missing_period <- as.data.frame(pHed_missing_period) pHed_missing_period <- pHed_missing_period[-c(5,11), ] # delete 3-2 and 4-5 pHed_missing_period <- pdata.frame(pHed_missing_period, index = c("townid", "time")) # Expected results # Hed: all TRUE (rep(TRUE, 92)) # Hed_missing_period: 3rd and 4th individual FALSE, rest TRUE expected_Hed <- rep(TRUE, 92) expected_Hed_missing_period <- expected_Hed expected_Hed_missing_period[c(3,4)] <- FALSE # test on data.frame Hed_df <- as.data.frame(pHed) Hed_df_missing_period <- as.data.frame(pHed_missing_period) is.pconsecutive(Hed_df, index = c("townid", "time")) is.pconsecutive(Hed_df_missing_period, index = c("townid", "time")) # test on pdata.frame if(!isTRUE(all.equal(is.pconsecutive(pHed), expected_Hed, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result") if(!isTRUE(all.equal(is.pconsecutive(pHed_missing_period), expected_Hed_missing_period, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result") # test on panelmodel object estimation_pHed <- plm(mv ~ crim + indus, data = pHed) estimation_pHed_missing_period <- plm(mv ~ crim + indus, data = pHed_missing_period) is.pconsecutive(estimation_pHed) is.pconsecutive(estimation_pHed_missing_period) # test on pseries pmv <- pHed$mv pmv_missing_period <- pHed_missing_period$mv if(!isTRUE(all.equal(is.pconsecutive(pmv), expected_Hed, check.names = FALSE))) stop("is.pconsecutive on pseries: wrong result") if(!isTRUE(all.equal(is.pconsecutive(pmv_missing_period), expected_Hed_missing_period, check.names = FALSE))) stop("is.pconsecutive on pseries: wrong result") ######## with different data set "Gasoline" (has "named" individuals, not just numbers) data("Gasoline", package = "plm") pGasoline <- pdata.frame(Gasoline) # test on data.frame is.pconsecutive(Gasoline, index = c("country", "year")) # test on pdata.frame is.pconsecutive(pGasoline) ######### test for case with a time period missing from whole data set data("Grunfeld", package = "plm") obs_3rd <- 3 + 20*c(0:9) Grunfeld_wo_1937 <- pdata.frame(Grunfeld[-obs_3rd, ]) expected_Grunfeld_wo_1937 <- rep(FALSE, 10) if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_wo_1937), expected_Grunfeld_wo_1937, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result for a missing time period in whole data set") if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_wo_1937$inv), expected_Grunfeld_wo_1937, check.names = FALSE))) stop("is.pconsecutive on pdata.frame: wrong result for a missing time period in whole data set") ########## Tests with NA in individual and time index ########### ### test with NA in time index ### data("Grunfeld", package = "plm") # get fresh Grunfeld (no NAs) Grunfeld_NA_time <- Grunfeld Grunfeld_NA_time[2, "year"] <- NA # firm 1, year 1936: year set to NA pGrunfeld_NA_time <- pdata.frame(Grunfeld_NA_time) # time index with NA is in pdata.frame # it gets sorted to end of firm 1 head(pGrunfeld_NA_time, 21) expected_NA_time <- c(NA, rep(TRUE, 9)) expected_NA_time_na.rm.tindex <- c(FALSE, rep(TRUE, 9)) is.pconsecutive(Grunfeld_NA_time) is.pconsecutive(Grunfeld_NA_time, na.rm.tindex = FALSE) is.pconsecutive(Grunfeld_NA_time, na.rm.tindex = TRUE) if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_time), is.pconsecutive(pGrunfeld_NA_time)))) stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in time index") if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_time), expected_NA_time, check.names=FALSE))) stop("is.pconsecutive: not expected result with 'NA' in time index") if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_time, na.rm.tindex = TRUE), expected_NA_time_na.rm.tindex, check.names=FALSE))) stop("is.pconsecutive(, na.rm.tindex = TRUE: not expected result with 'NA' in time index - there should be no NA values left") ### test with NA in individual index ### # get fresh Grunfeld (no NAs) Grunfeld_NA_ind <- Grunfeld Grunfeld_NA_ind[3, "firm"] <- NA # firm 1, year 1937: firm set to NA pGrunfeld_NA_ind <- pdata.frame(Grunfeld_NA_ind) # individual index with NA is in pdata.frame # it gets sorted to end of individuals tail(pGrunfeld_NA_ind, 21) expected_NA_ind <- c(FALSE, rep(TRUE, 9)) if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_ind), is.pconsecutive(pGrunfeld_NA_ind)))) stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in individual index") if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_ind), expected_NA_ind, check.names=FALSE))) stop("is.pconsecutive: not expected result with 'NA' in individual index") ### test with NA in individual AND time index ### # get fresh Grunfeld (no NAs) Grunfeld_NA_id_time <- Grunfeld Grunfeld_NA_id_time[4, c("firm", "year")] <- NA # firm 1, year 1938: firm and year set to NA pGrunfeld_NA_id_time <- pdata.frame(Grunfeld_NA_id_time) # individual and time index with NA is in pdata.frame # it gets sorted to end of individuals tail(pGrunfeld_NA_id_time, 21) expected_NA_ind_time <- c(FALSE, rep(TRUE, 9)) if(!isTRUE(all.equal(is.pconsecutive(Grunfeld_NA_id_time), is.pconsecutive(pGrunfeld_NA_id_time)))) stop("is.pconsecutive not equal for data.frame and pdata.frame with 'NA' in individual AND time index") if(!isTRUE(all.equal(is.pconsecutive(pGrunfeld_NA_id_time), expected_NA_ind_time, check.names=FALSE))) stop("is.pconsecutive: not expected result with 'NA' in individual AND time index") plm/inst/tests/test_detect_lin_dep_alias.R0000644000176200001440000001030114164704704020460 0ustar liggesusers# Tests for functions: # * detect.lindep # * alias # YC 2017/10/09 : RE model par defaut pb because the between model is empty library(plm) data("Cigar", package = "plm") Cigar[ , "fact1"] <- c(0,1) Cigar[ , "fact2"] <- c(1,0) Cigar.p <- pdata.frame(Cigar) #pform <- pFormula(price ~ 0 + cpi + fact1 + fact2) form <- price ~ 0 + cpi + fact1 + fact2 mf <- model.frame(Cigar.p, form) # for the pooling model.matrix, there is no linear dependence # (because the intercept is left out in this case in the formula) #MM detect.lindep(model.matrix(pform, data = Cigar.p, model = "pooling")) detect.lindep(model.matrix(mf, model = "pooling")) # linear dependence occury after FE transformation # [after transformation fact1 == -1 * fact2] #MM detect.lindep(model.matrix(pform, data = Cigar.p, model = "within")) detect.lindep(model.matrix(mf, model = "within")) #MM mod_fe <- plm(pform, data = Cigar.p, model = "within") mod_fe <- plm(form, data = Cigar.p, model = "within") detect.lindep(mod_fe) # test with NA matrix and empty matrix detect.lindep(matrix(NA)) # NA matrix detect.lindep(matrix(NA, nrow = 0, ncol = 0)) # empty matrix # linear dependent column(s) are silently dropped in plm estimation, thus this works #mod_fe <- plm(pform, data = Cigar.p, model = "within") mod_fe <- plm(form, data = Cigar.p, model = "within") detect.lindep(model.matrix(mod_fe)) # tests with suppressed printing detect.lindep(matrix(NA), suppressPrint = TRUE) # NA matrix detect.lindep(matrix(NA, nrow = 0, ncol = 0), suppressPrint = TRUE) # empty matrix #MM detect.lindep(model.matrix(pform, data = Cigar.p, model = "pooling"), suppressPrint = TRUE) #MM detect.lindep(model.matrix(pform, data = Cigar.p, model = "within"), suppressPrint = TRUE) detect.lindep(model.matrix(mf, model = "pooling"), suppressPrint = TRUE) detect.lindep(model.matrix(mf, model = "within"), suppressPrint = TRUE) detect.lindep(model.matrix(mod_fe), suppressPrint = TRUE) detect.lindep(model.matrix(mod_fe), suppressPrint = FALSE) # test for (p)data.frame interface df <- as.data.frame(model.matrix(mod_fe)) detect.lindep(df) detect.lindep(Cigar) Cigar.p$price2 <- 2*Cigar.p$price detect.lindep(Cigar.p) detect.lindep(Cigar.p, suppressPrint = TRUE) ######## alias.plm, alias.pFormula ###### lmmod1 <- lm(form, data = Cigar.p) alias(lmmod1) #MM plm_fe <- plm(pform, data = Cigar.p, model = "within") plm_fe <- plm(form, data = Cigar.p, model = "within") #YC plm_re <- plm(pform, data = Cigar.p, model = "random") # The between model is very special, as there is no intercept and cpi is constant plm_re_wal <- plm(form, data = Cigar.p, model = "random", random.method = "walhus") plm_fd <- plm(form, data = Cigar.p, model = "fd") plm_pool <- plm(form, data = Cigar.p, model = "pooling") names(plm_fe$model) summary(plm_fe) alias(plm_fe) #YC alias(plm_re) alias(plm_re_wal) alias(plm_fd) alias(plm_pool) # Test variation of parameters # alias.lm(object, complete = TRUE, partial = FALSE, partial.pattern = FALSE, ...) alias(plm_fe, complete = FALSE) alias(plm_fe, partial = TRUE) alias(plm_fe, partial.pattern = TRUE) #MM alias(pform, Cigar.p, model = "within") alias(mf, model = "within") #YC alias(pform, Cigar.p, model = "random") #MM alias(pform, Cigar.p, model = "random", random.method = "walhus") alias(mf, model = "random", random.method = "walhus") # alias(pform, Cigar.p, model = "within", inst.method = "bvk") # should give informative error #MM alias(pform, Cigar.p, model = "fd") #MM alias(pform, Cigar.p, model = "pooling") alias(mf, model = "fd") alias(mf, model = "pooling") #MM alias(pform, Cigar.p, model = "within", complete = FALSE) #MM alias(pform, Cigar.p, model = "within", partial = TRUE) #MM alias(pform, Cigar.p, model = "within", partial.pattern = TRUE) alias(mf, model = "within", complete = FALSE) alias(mf, model = "within", partial = TRUE) alias(mf, model = "within", partial.pattern = TRUE) # Tests for names of plm_object$aliased if (!isTRUE(all.equal(names(mod_fe$aliased), colnames(model.matrix(mod_fe))))) stop("Names not correct (not like colnames of model.matrix: ", paste0(names(mod_fe$aliased), collapse = ", ")) plm/inst/tests/test_EstimatorsIV.Rout.save0000644000176200001440000016474014126006241020431 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Replicate some IV regression results > ## Replicate Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, ch. 7.2 (p. 133) > ## (same as Baltagi (2006), Estimating an econometric model of crime using panel data from North Carolina, > ## Journal of Applied Econometrics 21(4), pp. 543-547. > ## > ## NB: Crime data set: results can diverge slightly form the values printed in Baltagi > ## if logarithm computation is performed on the original variable. For the paper, > ## a data set with pre-computed logarithms (variables l*) was used and those > ## logarithmic values diverge from what R's log() function gives. > ## -> see the two FE2SLS example which is computed in both ways > > > library(plm) > data("Crime", package = "plm") > > # replicates Table 7.1, column "Between" > form <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa > be <- plm(form, data = Crime, model = "between") > summary(be) Oneway (individual) effect Between Model Call: plm(formula = form, data = Crime, model = "between") Balanced Panel: n = 90, T = 7, N = 630 Observations used in estimation: 90 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.510397 -0.098495 -0.021638 0.131446 0.598675 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -2.096704 2.821910 -0.7430 0.459999 log(prbarr) -0.647509 0.087766 -7.3777 2.738e-10 *** log(prbconv) -0.528202 0.066741 -7.9143 2.868e-11 *** log(prbpris) 0.296505 0.230668 1.2854 0.202943 log(avgsen) -0.235885 0.173534 -1.3593 0.178477 log(polpc) 0.364217 0.060091 6.0611 6.370e-08 *** log(density) 0.168390 0.077380 2.1761 0.032971 * log(wcon) 0.195005 0.210406 0.9268 0.357259 log(wtuc) -0.195747 0.170486 -1.1482 0.254864 log(wtrd) 0.128619 0.278350 0.4621 0.645479 log(wfir) 0.113239 0.220473 0.5136 0.609159 log(wser) -0.105834 0.162825 -0.6500 0.517861 log(wmfg) -0.024885 0.133876 -0.1859 0.853082 log(wfed) 0.156213 0.287071 0.5442 0.588083 log(wsta) -0.283780 0.256342 -1.1070 0.272123 log(wloc) 0.010325 0.463487 0.0223 0.982292 log(pctymle) -0.095049 0.157683 -0.6028 0.548626 log(pctmin) 0.148195 0.048543 3.0529 0.003218 ** regionwest -0.229630 0.108468 -2.1170 0.037865 * regioncentral -0.163672 0.064453 -2.5394 0.013362 * smsayes -0.034592 0.132374 -0.2613 0.794624 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 26.913 Residual Sum of Squares: 3.2171 R-Squared: 0.88046 Adj. R-Squared: 0.84582 F-statistic: 25.4115 on 20 and 69 DF, p-value: < 2.22e-16 > > # replicates Table 7.1, column "Fixed Effects" > fe <- plm(form, data = Crime, model = "within", effect = "twoways") > summary(fe) Twoways effects Within Model Call: plm(formula = form, data = Crime, effect = "twoways", model = "within") Balanced Panel: n = 90, T = 7, N = 630 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.5581590 -0.0650155 -0.0018256 0.0698165 0.5247036 Coefficients: Estimate Std. Error t-value Pr(>|t|) log(prbarr) -0.3548257 0.0322048 -11.0178 < 2.2e-16 *** log(prbconv) -0.2815673 0.0211376 -13.3207 < 2.2e-16 *** log(prbpris) -0.1731044 0.0323027 -5.3588 1.263e-07 *** log(avgsen) -0.0024524 0.0261190 -0.0939 0.925232 log(polpc) 0.4131576 0.0266231 15.5188 < 2.2e-16 *** log(density) 0.4143782 0.2825417 1.4666 0.143089 log(wcon) -0.0377894 0.0390757 -0.9671 0.333954 log(wtuc) 0.0455237 0.0190116 2.3945 0.016996 * log(wtrd) -0.0205048 0.0404790 -0.5066 0.612682 log(wfir) -0.0038988 0.0282572 -0.1380 0.890312 log(wser) 0.0088773 0.0191314 0.4640 0.642833 log(wmfg) -0.3598306 0.1118355 -3.2175 0.001374 ** log(wfed) -0.3093206 0.1761644 -1.7559 0.079703 . log(wsta) 0.0528862 0.1135307 0.4658 0.641532 log(wloc) 0.1815859 0.1176542 1.5434 0.123348 log(pctymle) 0.6267986 0.3636065 1.7238 0.085334 . --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 16.123 Residual Sum of Squares: 9.6545 R-Squared: 0.40121 Adj. R-Squared: 0.2729 F-statistic: 21.6923 on 16 and 518 DF, p-value: < 2.22e-16 > > # replicates Table 7.1, column "FE2SLS" > form_iv <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa | . -log(prbarr) - log(polpc) + log(taxpc) + log(mix) > form_iv2 <- lcrmrte ~ lprbarr + lprbconv + lprbpris + lavgsen + lpolpc + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa | . -lprbarr - lpolpc + ltaxpc + lmix > fe_iv <- plm(form_iv, data = Crime, model = "within", effect = "twoways", inst.method = "baltagi") > fe_iv2 <- plm(form_iv2, data = Crime, model = "within", effect = "twoways", inst.method = "baltagi") > summary(fe_iv) # logs computed by R Twoways effects Within Model Instrumental variable estimation Call: plm(formula = form_iv, data = Crime, effect = "twoways", model = "within", inst.method = "baltagi") Balanced Panel: n = 90, T = 7, N = 630 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.7207996 -0.0682050 -0.0041004 0.0759313 0.5661408 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(prbarr) -0.5753943 0.8019932 -0.7175 0.4731 log(prbconv) -0.4230764 0.5018196 -0.8431 0.3992 log(prbpris) -0.2502194 0.2793986 -0.8956 0.3705 log(avgsen) 0.0090948 0.0489808 0.1857 0.8527 log(polpc) 0.6574104 0.8466656 0.7765 0.4375 log(density) 0.1395236 1.0210334 0.1366 0.8913 log(wcon) -0.0287310 0.0535109 -0.5369 0.5913 log(wtuc) 0.0391296 0.0308542 1.2682 0.2047 log(wtrd) -0.0177599 0.0453090 -0.3920 0.6951 log(wfir) -0.0093412 0.0365471 -0.2556 0.7983 log(wser) 0.0185815 0.0388087 0.4788 0.6321 log(wmfg) -0.2431858 0.4194999 -0.5797 0.5621 log(wfed) -0.4512812 0.5270259 -0.8563 0.3918 log(wsta) -0.0187117 0.2807606 -0.0666 0.9469 log(wloc) 0.2631882 0.3122909 0.8428 0.3994 log(pctymle) 0.3512984 1.0107677 0.3476 0.7282 Total Sum of Squares: 16.123 Residual Sum of Squares: 11.535 R-Squared: 0.39131 Adj. R-Squared: 0.26087 Chisq: 56.2016 on 16 DF, p-value: 2.2539e-06 > summary(fe_iv2) # logs as in data set by Baltagi -> results match exactly Twoways effects Within Model Instrumental variable estimation Call: plm(formula = form_iv2, data = Crime, effect = "twoways", model = "within", inst.method = "baltagi") Balanced Panel: n = 90, T = 7, N = 630 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.7209110 -0.0682207 -0.0041115 0.0759381 0.5661659 Coefficients: Estimate Std. Error z-value Pr(>|z|) lprbarr -0.5755058 0.8021842 -0.7174 0.4731 lprbconv -0.4231446 0.5019375 -0.8430 0.3992 lprbpris -0.2502550 0.2794602 -0.8955 0.3705 lavgsen 0.0090987 0.0489879 0.1857 0.8527 lpolpc 0.6575270 0.8468673 0.7764 0.4375 ldensity 0.1394120 1.0212391 0.1365 0.8914 lwcon -0.0287308 0.0535145 -0.5369 0.5914 lwtuc 0.0391292 0.0308568 1.2681 0.2048 lwtrd -0.0177536 0.0453142 -0.3918 0.6952 lwfir -0.0093443 0.0365519 -0.2556 0.7982 lwser 0.0185854 0.0388155 0.4788 0.6321 lwmfg -0.2431684 0.4195485 -0.5796 0.5622 lwfed -0.4513372 0.5271232 -0.8562 0.3919 lwsta -0.0187458 0.2808182 -0.0668 0.9468 lwloc 0.2632585 0.3123945 0.8427 0.3994 lpctymle 0.3511166 1.0110334 0.3473 0.7284 Total Sum of Squares: 16.123 Residual Sum of Squares: 11.537 R-Squared: 0.3913 Adj. R-Squared: 0.26087 Chisq: 56.1934 on 16 DF, p-value: 2.2609e-06 > > # ## felm example > # library(lfe) > # form_felm <- log(crmrte) ~ log(prbconv) + log(prbpris) + log(avgsen) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) | > # county + year | > # (log(prbarr) + log(polpc) ~ log(prbpris) + log(avgsen) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(taxpc) + log(mix)) > # summary(felm(form_felm, data = Crime)) > > # replicates Table 7.1, column "BE2SLS" > be_iv <- plm(form_iv, data = Crime, model = "between") > summary(be_iv) Oneway (individual) effect Between Model Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_iv, data = Crime, model = "between") Balanced Panel: n = 90, T = 7, N = 630 Observations used in estimation: 90 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.5499406 -0.1041014 0.0029817 0.0986084 0.6020580 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -1.977222 4.000782 -0.4942 0.621159 log(prbarr) -0.502946 0.240623 -2.0902 0.036601 * log(prbconv) -0.524770 0.099948 -5.2504 1.517e-07 *** log(prbpris) 0.187177 0.318292 0.5881 0.556487 log(avgsen) -0.227225 0.178509 -1.2729 0.203052 log(polpc) 0.408439 0.192998 2.1163 0.034321 * log(density) 0.225624 0.102474 2.2018 0.027681 * log(wcon) 0.314005 0.259103 1.2119 0.225553 log(wtuc) -0.198943 0.197119 -1.0093 0.312854 log(wtrd) 0.053559 0.296005 0.1809 0.856415 log(wfir) 0.041707 0.305622 0.1365 0.891453 log(wser) -0.135428 0.173646 -0.7799 0.435446 log(wmfg) -0.042002 0.156266 -0.2688 0.788097 log(wfed) 0.148024 0.325648 0.4546 0.649431 log(wsta) -0.203080 0.298153 -0.6811 0.495792 log(wloc) 0.044440 0.494358 0.0899 0.928372 log(pctymle) -0.094720 0.191805 -0.4938 0.621423 log(pctmin) 0.168902 0.052700 3.2049 0.001351 ** regionwest -0.204816 0.113836 -1.7992 0.071982 . regioncentral -0.172932 0.066706 -2.5924 0.009530 ** smsayes -0.080500 0.144232 -0.5581 0.576758 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 26.913 Residual Sum of Squares: 3.396 R-Squared: 0.87385 Adj. R-Squared: 0.83729 Chisq: 413.647 on 20 DF, p-value: < 2.22e-16 > > # not in table > fd_iv <- plm(form_iv, data = Crime, model = "fd", effect = "individual") > summary(fd_iv) Oneway (individual) effect First-Difference Model Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_iv, data = Crime, effect = "individual", model = "fd") Balanced Panel: n = 90, T = 7, N = 630 Observations used in estimation: 540 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.0255104 -0.0799101 0.0053594 0.0800347 0.9355716 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 0.0069945 0.1200615 0.0583 0.9535 log(prbarr) -0.3657462 1.5603992 -0.2344 0.8147 log(prbconv) -0.2303887 0.9292399 -0.2479 0.8042 log(prbpris) -0.1751528 0.4564269 -0.3837 0.7012 log(avgsen) -0.0109961 0.1067622 -0.1030 0.9180 log(polpc) 0.2537245 2.1624236 0.1173 0.9066 log(density) -0.1466853 2.4584727 -0.0597 0.9524 log(wcon) -0.0368105 0.0605415 -0.6080 0.5432 log(wtuc) 0.0122918 0.0411881 0.2984 0.7654 log(wtrd) -0.0388990 0.0501528 -0.7756 0.4380 log(wfir) 0.0013050 0.0373671 0.0349 0.9721 log(wser) 0.0164254 0.0152130 1.0797 0.2803 log(wmfg) -0.2568435 0.3419870 -0.7510 0.4526 log(wfed) -0.1409253 0.5886135 -0.2394 0.8108 log(wsta) 0.1249133 0.0970830 1.2867 0.1982 log(wloc) 0.0553071 0.6247338 0.0885 0.9295 log(pctymle) -0.0054946 1.3734037 -0.0040 0.9968 Total Sum of Squares: 22.197 Residual Sum of Squares: 14.057 R-Squared: 0.37134 Adj. R-Squared: 0.3521 Chisq: 46.0102 on 16 DF, p-value: 9.7009e-05 > > # replicates Table 7.1, column "EC2SLS" > ## need to include time dummies! > form_re_iv <- log(crmrte) ~ log(prbarr) + log(prbconv) + log(prbpris) + log(avgsen) + log(polpc) + log(density) + log(wcon) + log(wtuc) + log(wtrd) + log(wfir) + log(wser) + log(wmfg) + log(wfed) + log(wsta) + log(wloc) + log(pctymle) + log(pctmin) + region + smsa + factor(year) | . -log(prbarr) - log(polpc) + log(taxpc) + log(mix) > form_re_iv2 <- lcrmrte ~ lprbarr + lprbconv + lprbpris + lavgsen + lpolpc + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle + lpctmin + region + smsa + factor(year) | . -lprbarr - lpolpc + ltaxpc + lmix > re_iv <- plm(form_re_iv, data = Crime, model = "random", inst.method = "baltagi") > re_iv2 <- plm(form_re_iv2, data = Crime, model = "random", inst.method = "baltagi") > summary(re_iv) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_re_iv, data = Crime, model = "random", inst.method = "baltagi") Balanced Panel: n = 90, T = 7, N = 630 Effects: var std.dev share idiosyncratic 0.02227 0.14923 0.326 individual 0.04604 0.21456 0.674 theta: 0.7458 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -4.997164 -0.465637 0.027153 0.512779 3.917220 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.9536145 1.2839853 -0.7427 0.457664 log(prbarr) -0.4129201 0.0974056 -4.2392 2.243e-05 *** log(prbconv) -0.3228859 0.0535539 -6.0292 1.648e-09 *** log(prbpris) -0.1863204 0.0419391 -4.4426 8.886e-06 *** log(avgsen) -0.0101739 0.0270229 -0.3765 0.706551 log(polpc) 0.4347568 0.0896981 4.8469 1.254e-06 *** log(density) 0.4290337 0.0548511 7.8218 5.208e-15 *** log(wcon) -0.0074746 0.0395773 -0.1889 0.850202 log(wtuc) 0.0454430 0.0197925 2.2960 0.021678 * log(wtrd) -0.0081453 0.0413823 -0.1968 0.843960 log(wfir) -0.0036394 0.0289236 -0.1258 0.899867 log(wser) 0.0056112 0.0201257 0.2788 0.780393 log(wmfg) -0.2041324 0.0804418 -2.5376 0.011160 * log(wfed) -0.1635333 0.1594522 -1.0256 0.305083 log(wsta) -0.0540400 0.1056774 -0.5114 0.609094 log(wloc) 0.1630405 0.1196368 1.3628 0.172947 log(pctymle) -0.1080968 0.1397015 -0.7738 0.439067 log(pctmin) 0.1890388 0.0415013 4.5550 5.238e-06 *** regionwest -0.2268401 0.0995975 -2.2776 0.022752 * regioncentral -0.1940408 0.0598277 -3.2433 0.001181 ** smsayes -0.2251624 0.1156369 -1.9471 0.051517 . factor(year)82 0.0107457 0.0257968 0.4166 0.677006 factor(year)83 -0.0837924 0.0307088 -2.7286 0.006360 ** factor(year)84 -0.1034973 0.0370886 -2.7905 0.005262 ** factor(year)85 -0.0956959 0.0494505 -1.9352 0.052968 . factor(year)86 -0.0688930 0.0595961 -1.1560 0.247681 factor(year)87 -0.0314024 0.0705204 -0.4453 0.656106 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 30.168 Residual Sum of Squares: 544.47 R-Squared: 0.59845 Adj. R-Squared: 0.58114 Chisq: 575.685 on 26 DF, p-value: < 2.22e-16 > summary(re_iv2) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_re_iv2, data = Crime, model = "random", inst.method = "baltagi") Balanced Panel: n = 90, T = 7, N = 630 Effects: var std.dev share idiosyncratic 0.02227 0.14924 0.326 individual 0.04604 0.21456 0.674 theta: 0.7457 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -4.996927 -0.465655 0.027205 0.512780 3.917085 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.9538032 1.2839664 -0.7429 0.457568 lprbarr -0.4129261 0.0974020 -4.2394 2.241e-05 *** lprbconv -0.3228872 0.0535517 -6.0295 1.645e-09 *** lprbpris -0.1863195 0.0419382 -4.4427 8.883e-06 *** lavgsen -0.0101765 0.0270231 -0.3766 0.706481 lpolpc 0.4347492 0.0896950 4.8470 1.254e-06 *** ldensity 0.4290282 0.0548483 7.8221 5.196e-15 *** lwcon -0.0074751 0.0395775 -0.1889 0.850194 lwtuc 0.0454450 0.0197926 2.2961 0.021673 * lwtrd -0.0081412 0.0413828 -0.1967 0.844040 lwfir -0.0036395 0.0289238 -0.1258 0.899865 lwser 0.0056098 0.0201259 0.2787 0.780447 lwmfg -0.2041398 0.0804393 -2.5378 0.011155 * lwfed -0.1635108 0.1594496 -1.0255 0.305142 lwsta -0.0540503 0.1056769 -0.5115 0.609024 lwloc 0.1630523 0.1196380 1.3629 0.172920 lpctymle -0.1081057 0.1396949 -0.7739 0.439007 lpctmin 0.1890370 0.0414988 4.5552 5.233e-06 *** regionwest -0.2268433 0.0995913 -2.2777 0.022742 * regioncentral -0.1940428 0.0598241 -3.2436 0.001180 ** smsayes -0.2251539 0.1156302 -1.9472 0.051512 . factor(year)82 0.0107452 0.0257969 0.4165 0.677023 factor(year)83 -0.0837944 0.0307088 -2.7287 0.006359 ** factor(year)84 -0.1034997 0.0370885 -2.7906 0.005261 ** factor(year)85 -0.0957017 0.0494502 -1.9353 0.052952 . factor(year)86 -0.0688982 0.0595956 -1.1561 0.247642 factor(year)87 -0.0314071 0.0705197 -0.4454 0.656055 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 30.169 Residual Sum of Squares: 544.4 R-Squared: 0.59847 Adj. R-Squared: 0.58115 Chisq: 575.735 on 26 DF, p-value: < 2.22e-16 > > # replicates Baltagi (2013), p. 137/Baltagi (2021), p. 165 ("G2SLS"), table 7.3 (not in Table 7.1) > re_iv_bvk <- plm(form_re_iv, data = Crime, model = "random", inst.method = "bvk") > re_iv_bvk2 <- plm(form_re_iv2, data = Crime, model = "random", inst.method = "bvk") > summary(re_iv_bvk) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_re_iv, data = Crime, model = "random", inst.method = "bvk") Balanced Panel: n = 90, T = 7, N = 630 Effects: var std.dev share idiosyncratic 0.02227 0.14923 0.326 individual 0.04604 0.21456 0.674 theta: 0.7458 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.7485123 -0.0710015 0.0040742 0.0784401 0.4756493 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.4538241 1.7029840 -0.2665 0.789864 log(prbarr) -0.4141200 0.2210540 -1.8734 0.061015 . log(prbconv) -0.3432383 0.1324679 -2.5911 0.009567 ** log(prbpris) -0.1900437 0.0733420 -2.5912 0.009564 ** log(avgsen) -0.0064374 0.0289406 -0.2224 0.823977 log(polpc) 0.5049285 0.2277811 2.2167 0.026642 * log(density) 0.4343519 0.0711528 6.1045 1.031e-09 *** log(wcon) -0.0042963 0.0414225 -0.1037 0.917392 log(wtuc) 0.0444572 0.0215449 2.0635 0.039068 * log(wtrd) -0.0085626 0.0419822 -0.2040 0.838387 log(wfir) -0.0040302 0.0294565 -0.1368 0.891175 log(wser) 0.0105604 0.0215822 0.4893 0.624620 log(wmfg) -0.2017917 0.0839423 -2.4039 0.016220 * log(wfed) -0.2134634 0.2151074 -0.9924 0.321023 log(wsta) -0.0601083 0.1203146 -0.4996 0.617362 log(wloc) 0.1835137 0.1396721 1.3139 0.188884 log(pctymle) -0.1458448 0.2268137 -0.6430 0.520214 log(pctmin) 0.1948760 0.0459409 4.2419 2.217e-05 *** regionwest -0.2281780 0.1010317 -2.2585 0.023916 * regioncentral -0.1987675 0.0607510 -3.2718 0.001068 ** smsayes -0.2595423 0.1499780 -1.7305 0.083535 . factor(year)82 0.0132140 0.0299923 0.4406 0.659518 factor(year)83 -0.0847676 0.0320008 -2.6489 0.008075 ** factor(year)84 -0.1062004 0.0387893 -2.7379 0.006184 ** factor(year)85 -0.0977398 0.0511685 -1.9102 0.056113 . factor(year)86 -0.0719390 0.0605821 -1.1875 0.235045 factor(year)87 -0.0396520 0.0758537 -0.5227 0.601153 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 30.168 Residual Sum of Squares: 12.418 R-Squared: 0.59228 Adj. R-Squared: 0.5747 Chisq: 542.435 on 26 DF, p-value: < 2.22e-16 > summary(re_iv_bvk2) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_re_iv2, data = Crime, model = "random", inst.method = "bvk") Balanced Panel: n = 90, T = 7, N = 630 Effects: var std.dev share idiosyncratic 0.02227 0.14924 0.326 individual 0.04604 0.21456 0.674 theta: 0.7457 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.7485357 -0.0709883 0.0040648 0.0784455 0.4756273 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) -0.4538501 1.7029831 -0.2665 0.789852 lprbarr -0.4141383 0.2210496 -1.8735 0.060998 . lprbconv -0.3432506 0.1324648 -2.5913 0.009563 ** lprbpris -0.1900467 0.0733392 -2.5913 0.009560 ** lavgsen -0.0064389 0.0289407 -0.2225 0.823935 lpolpc 0.5049461 0.2277778 2.2168 0.026634 * ldensity 0.4343449 0.0711496 6.1047 1.030e-09 *** lwcon -0.0042958 0.0414226 -0.1037 0.917403 lwtuc 0.0444589 0.0215448 2.0636 0.039060 * lwtrd -0.0085579 0.0419829 -0.2038 0.838476 lwfir -0.0040305 0.0294569 -0.1368 0.891166 lwser 0.0105602 0.0215823 0.4893 0.624630 lwmfg -0.2018020 0.0839373 -2.4042 0.016208 * lwfed -0.2134579 0.2151046 -0.9923 0.321029 lwsta -0.0601232 0.1203149 -0.4997 0.617275 lwloc 0.1835363 0.1396775 1.3140 0.188846 lpctymle -0.1458703 0.2268086 -0.6431 0.520131 lpctmin 0.1948763 0.0459385 4.2421 2.214e-05 *** regionwest -0.2281821 0.1010260 -2.2586 0.023905 * regioncentral -0.1987703 0.0607475 -3.2721 0.001068 ** smsayes -0.2595451 0.1499718 -1.7306 0.083518 . factor(year)82 0.0132147 0.0299924 0.4406 0.659500 factor(year)83 -0.0847693 0.0320010 -2.6490 0.008074 ** factor(year)84 -0.1062027 0.0387893 -2.7379 0.006183 ** factor(year)85 -0.0977457 0.0511681 -1.9103 0.056097 . factor(year)86 -0.0719451 0.0605819 -1.1876 0.235004 factor(year)87 -0.0396595 0.0758531 -0.5228 0.601081 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 30.169 Residual Sum of Squares: 12.419 R-Squared: 0.5923 Adj. R-Squared: 0.57472 Chisq: 542.478 on 26 DF, p-value: < 2.22e-16 > cor(plm:::fitted_exp.plm(re_iv_bvk2), re_iv_bvk2$model[ , 1])^2 # overall R^2 as per Stata [1] 0.7724889 > > > > ## Hausman-Taylor estimator: > ## replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 > # (chisq values in Baltagi (2021) are not those of the models but of Hausman test > # between the models! plm's summary replicates chisq values of the models as > # given by Stata and printed in Baltagi (2021), tables 7.6, 7.7) > # > # Table 7.5 claims to replicate Baltagi/Khanti-Akom (1990), table II, but values > # for all models but within are largely different (even the GLS case!), making > # the book reproducible but not the paper (likely the paper is in error!). > data("Wages", package = "plm") > pWages <- pdata.frame(Wages, index = 595) > > form_wage <- lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + + bluecol + ind + union + sex + black + ed > > form_wage_iv <- lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + + bluecol + ind + union + sex + black + ed | + bluecol + south + smsa + ind + sex + black | + wks + married + union + exp + I(exp ^ 2) > > gls <- plm(form_wage, data = pWages, model = "random") > summary(gls) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Call: plm(formula = form_wage, data = pWages, model = "random") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02310 0.15199 0.251 individual 0.06899 0.26266 0.749 theta: 0.7863 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -2.0612918 -0.1146344 0.0073351 0.1227697 2.0972144 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 4.2637e+00 9.7716e-02 43.6332 < 2.2e-16 *** wks 1.0347e-03 7.7337e-04 1.3379 0.1809396 southyes -1.6618e-02 2.6527e-02 -0.6265 0.5310184 smsayes -1.3823e-02 1.9993e-02 -0.6914 0.4893108 marriedyes -7.4628e-02 2.3005e-02 -3.2440 0.0011788 ** exp 8.2054e-02 2.8478e-03 28.8138 < 2.2e-16 *** I(exp^2) -8.0845e-04 6.2823e-05 -12.8686 < 2.2e-16 *** bluecolyes -5.0066e-02 1.6647e-02 -3.0076 0.0026336 ** ind 3.7441e-03 1.7262e-02 0.2169 0.8282830 unionyes 6.3223e-02 1.7070e-02 3.7038 0.0002124 *** sexfemale -3.3921e-01 5.1303e-02 -6.6119 3.795e-11 *** blackyes -2.1028e-01 5.7989e-02 -3.6262 0.0002876 *** ed 9.9659e-02 5.7475e-03 17.3395 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 270.16 Residual Sum of Squares: 164.79 R-Squared: 0.39002 Adj. R-Squared: 0.38825 Chisq: 2654.74 on 12 DF, p-value: < 2.22e-16 > > within <- plm(form_wage, data = pWages, model = "within") > summary(within) Oneway (individual) effect Within Model Call: plm(formula = form_wage, data = pWages, model = "within") Balanced Panel: n = 595, T = 7, N = 4165 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.8122282 -0.0519417 0.0038855 0.0614706 1.9434306 Coefficients: Estimate Std. Error t-value Pr(>|t|) wks 8.3595e-04 5.9967e-04 1.3940 0.16340 southyes -1.8612e-03 3.4299e-02 -0.0543 0.95673 smsayes -4.2469e-02 1.9428e-02 -2.1859 0.02889 * marriedyes -2.9726e-02 1.8984e-02 -1.5659 0.11747 exp 1.1321e-01 2.4710e-03 45.8141 < 2.2e-16 *** I(exp^2) -4.1835e-04 5.4595e-05 -7.6629 2.329e-14 *** bluecolyes -2.1476e-02 1.3784e-02 -1.5581 0.11930 ind 1.9210e-02 1.5446e-02 1.2437 0.21370 unionyes 3.2785e-02 1.4923e-02 2.1970 0.02809 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 240.65 Residual Sum of Squares: 82.267 R-Squared: 0.65815 Adj. R-Squared: 0.60026 F-statistic: 761.751 on 9 and 3561 DF, p-value: < 2.22e-16 > > ht <- plm(form_wage_iv, + data = pWages, + random.method = "ht", model = "random", inst.method = "baltagi") > summary(ht) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_wage_iv, data = pWages, model = "random", random.method = "ht", inst.method = "baltagi") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.643736 -0.466002 0.043285 0.524739 13.340263 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9127e+00 2.8365e-01 10.2687 < 2.2e-16 *** wks 8.3740e-04 5.9973e-04 1.3963 0.16263 southyes 7.4398e-03 3.1955e-02 0.2328 0.81590 smsayes -4.1833e-02 1.8958e-02 -2.2066 0.02734 * marriedyes -2.9851e-02 1.8980e-02 -1.5728 0.11578 exp 1.1313e-01 2.4710e-03 45.7851 < 2.2e-16 *** I(exp^2) -4.1886e-04 5.4598e-05 -7.6718 1.696e-14 *** bluecolyes -2.0705e-02 1.3781e-02 -1.5024 0.13299 ind 1.3604e-02 1.5237e-02 0.8928 0.37196 unionyes 3.2771e-02 1.4908e-02 2.1982 0.02794 * sexfemale -1.3092e-01 1.2666e-01 -1.0337 0.30129 blackyes -2.8575e-01 1.5570e-01 -1.8352 0.06647 . ed 1.3794e-01 2.1248e-02 6.4919 8.474e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4163.6 R-Squared: 0.60945 Adj. R-Squared: 0.60833 Chisq: 6891.87 on 12 DF, p-value: < 2.22e-16 > > am <- plm(form_wage_iv, + data = pWages, + random.method = "ht", model = "random", inst.method = "am") > summary(am) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = form_wage_iv, data = pWages, model = "random", random.method = "ht", inst.method = "am") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.643192 -0.464811 0.043216 0.523598 13.338789 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9273e+00 2.7513e-01 10.6399 < 2.2e-16 *** wks 8.3806e-04 5.9945e-04 1.3980 0.16210 southyes 7.2818e-03 3.1936e-02 0.2280 0.81964 smsayes -4.1951e-02 1.8947e-02 -2.2141 0.02682 * marriedyes -3.0089e-02 1.8967e-02 -1.5864 0.11266 exp 1.1297e-01 2.4688e-03 45.7584 < 2.2e-16 *** I(exp^2) -4.2140e-04 5.4554e-05 -7.7244 1.124e-14 *** bluecolyes -2.0850e-02 1.3765e-02 -1.5147 0.12986 ind 1.3629e-02 1.5229e-02 0.8949 0.37082 unionyes 3.2475e-02 1.4894e-02 2.1804 0.02922 * sexfemale -1.3201e-01 1.2660e-01 -1.0427 0.29709 blackyes -2.8590e-01 1.5549e-01 -1.8388 0.06595 . ed 1.3720e-01 2.0570e-02 6.6703 2.553e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4160.3 R-Squared: 0.60948 Adj. R-Squared: 0.60835 Chisq: 6879.2 on 12 DF, p-value: < 2.22e-16 > > bms <- plm(form_wage_iv, + data = pWages, + random.method = "ht", model = "random", inst.method = "bms") > summary(bms) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = form_wage_iv, data = pWages, model = "random", random.method = "ht", inst.method = "bms") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.790365 -0.448022 0.042648 0.506978 13.292638 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.9794e+00 2.6724e-01 7.4071 1.291e-13 *** wks 7.9537e-04 5.9850e-04 1.3289 0.183869 southyes 1.4668e-02 3.1883e-02 0.4601 0.645478 smsayes -5.2042e-02 1.8911e-02 -2.7520 0.005923 ** marriedyes -3.9262e-02 1.8925e-02 -2.0747 0.038017 * exp 1.0867e-01 2.4557e-03 44.2513 < 2.2e-16 *** I(exp^2) -4.9060e-04 5.4352e-05 -9.0265 < 2.2e-16 *** bluecolyes -1.5389e-02 1.3737e-02 -1.1203 0.262596 ind 1.9024e-02 1.5202e-02 1.2514 0.210795 unionyes 3.7855e-02 1.4864e-02 2.5467 0.010873 * sexfemale -1.8027e-01 1.2639e-01 -1.4263 0.153769 blackyes -1.5636e-01 1.5506e-01 -1.0084 0.313276 ed 2.2066e-01 1.9850e-02 11.1162 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4147.6 R-Squared: 0.60686 Adj. R-Squared: 0.60572 Chisq: 6467.37 on 12 DF, p-value: < 2.22e-16 > > # texreg::screenreg(list(ht, am, bms)) > > phtest(within, ht) # 5.2577 -> match Baltagi (2021), p. 175 for statistic but Hausman Test data: form_wage chisq = 5.2577, df = 9, p-value = 0.8113 alternative hypothesis: one model is inconsistent > # df are different (9 vs. 3), Baltagi explains why df = 3. > > phtest(ht, am) # 14.66 -> close to Baltagi's 17.74 (df = 12 vs. 13) Hausman Test data: form_wage_iv chisq = 14.666, df = 12, p-value = 0.2602 alternative hypothesis: one model is inconsistent > > > > > ### IV estimators ## > form_wage_iv2 <- lwage ~ wks + married + exp + I(exp ^ 2) + bluecol | + wks + exp + bluecol | + wks + married + exp + I(exp ^ 2) > > ## balanced one-way individual > IVbvk <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "bvk") > summary(IVbvk) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_wage_iv2, data = pWages, model = "random", inst.method = "bvk") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02315 0.15215 0.189 individual 0.09928 0.31509 0.811 theta: 0.8205 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9670577 -0.1180355 0.0091769 0.1192050 2.0936461 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.3917e+00 5.2313e-02 103.0662 < 2.2e-16 *** wks 1.1115e-03 7.7209e-04 1.4397 0.1500 marriedyes -1.3964e-02 2.1789e-02 -0.6409 0.5216 exp 8.6050e-02 2.9196e-03 29.4729 < 2.2e-16 *** I(exp^2) -7.9169e-04 6.4523e-05 -12.2700 < 2.2e-16 *** bluecolyes -1.1180e-01 1.5963e-02 -7.0034 2.498e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 261.48 Residual Sum of Squares: 163.12 R-Squared: 0.37618 Adj. R-Squared: 0.37543 Chisq: 2507.95 on 5 DF, p-value: < 2.22e-16 > > IVbalt <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "baltagi") > summary(IVbalt) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_wage_iv2, data = pWages, model = "random", inst.method = "baltagi") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02315 0.15215 0.189 individual 0.09928 0.31509 0.811 theta: 0.8205 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.909745 -0.785178 0.047664 0.784261 13.789006 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.4619e+00 5.3852e-02 101.4244 < 2.2e-16 *** wks 1.1434e-03 7.7454e-04 1.4763 0.1399 marriedyes -1.1791e-01 2.4588e-02 -4.7954 1.623e-06 *** exp 8.7309e-02 3.1570e-03 27.6556 < 2.2e-16 *** I(exp^2) -8.1720e-04 7.0594e-05 -11.5761 < 2.2e-16 *** bluecolyes -1.0980e-01 1.6010e-02 -6.8583 6.968e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 261.48 Residual Sum of Squares: 7085.3 R-Squared: 0.3728 Adj. R-Squared: 0.37204 Chisq: 2502.88 on 5 DF, p-value: < 2.22e-16 > > IVam <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "am") > summary(IVam) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = form_wage_iv2, data = pWages, model = "random", inst.method = "am") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02315 0.15215 0.189 individual 0.09928 0.31509 0.811 theta: 0.8205 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.910190 -0.782406 0.048668 0.783272 13.787161 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.4599e+00 5.3794e-02 101.4955 < 2.2e-16 *** wks 1.1451e-03 7.7434e-04 1.4788 0.1392 marriedyes -1.1314e-01 2.4486e-02 -4.6206 3.826e-06 *** exp 8.7077e-02 3.1494e-03 27.6490 < 2.2e-16 *** I(exp^2) -8.1187e-04 7.0401e-05 -11.5320 < 2.2e-16 *** bluecolyes -1.0993e-01 1.6006e-02 -6.8681 6.504e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 261.48 Residual Sum of Squares: 7081.8 R-Squared: 0.3731 Adj. R-Squared: 0.37235 Chisq: 2501.31 on 5 DF, p-value: < 2.22e-16 > > IVbms <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "bms") > summary(IVbms) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = form_wage_iv2, data = pWages, model = "random", inst.method = "bms") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02315 0.15215 0.189 individual 0.09928 0.31509 0.811 theta: 0.8205 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.910637 -0.781238 0.049022 0.783769 13.787656 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.4586e+00 5.3775e-02 101.5077 < 2.2e-16 *** wks 1.1419e-03 7.7433e-04 1.4747 0.1403 marriedyes -1.1298e-01 2.4431e-02 -4.6244 3.757e-06 *** exp 8.7249e-02 3.1468e-03 27.7266 < 2.2e-16 *** I(exp^2) -8.1597e-04 7.0335e-05 -11.6012 < 2.2e-16 *** bluecolyes -1.0990e-01 1.6006e-02 -6.8660 6.600e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 261.48 Residual Sum of Squares: 7081.8 R-Squared: 0.37311 Adj. R-Squared: 0.37235 Chisq: 2503.01 on 5 DF, p-value: < 2.22e-16 > > # texreg::screenreg(list("BVK" = IVbvk, "Baltagi" = IVbalt, "AM" = IVam, "BMS" = IVbms), > # digits = 5) > > ## unbalanced one-way individual > > pWages_ubal <- pWages[-c(2:7, 79:82, 500:505), ] > pdim(pWages_ubal) Unbalanced Panel: n = 595, T = 1-7, N = 4149 > IVbvk_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "bvk") > summary(IVbvk_ubal) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bvk") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.02323 0.15243 0.19 individual 0.09893 0.31453 0.81 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5639 0.8198 0.8198 0.8196 0.8198 0.8198 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -1.96701 -0.11847 0.00915 -0.00001 0.11963 2.09363 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.3954e+00 5.2425e-02 102.9162 < 2.2e-16 *** wks 1.1191e-03 7.7476e-04 1.4445 0.1486 marriedyes -1.3685e-02 2.1830e-02 -0.6269 0.5308 exp 8.5760e-02 2.9316e-03 29.2539 < 2.2e-16 *** I(exp^2) -7.8934e-04 6.4755e-05 -12.1898 < 2.2e-16 *** bluecolyes -1.1174e-01 1.6014e-02 -6.9771 3.012e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 265.29 Residual Sum of Squares: 163.35 R-Squared: 0.38425 Adj. R-Squared: 0.38351 Chisq: 2477.34 on 5 DF, p-value: < 2.22e-16 > > IVbalt_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "baltagi") > summary(IVbalt_ubal) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "baltagi") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.02323 0.15243 0.19 individual 0.09893 0.31453 0.81 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5639 0.8198 0.8198 0.8196 0.8198 0.8198 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -12.8856 -0.7915 0.0470 -0.0004 0.7861 13.7637 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.4676e+00 5.4011e-02 101.2297 < 2.2e-16 *** wks 1.1427e-03 7.7735e-04 1.4700 0.1416 marriedyes -1.1874e-01 2.4650e-02 -4.8172 1.456e-06 *** exp 8.6999e-02 3.1742e-03 27.4081 < 2.2e-16 *** I(exp^2) -8.1476e-04 7.0926e-05 -11.4874 < 2.2e-16 *** bluecolyes -1.0986e-01 1.6064e-02 -6.8389 7.982e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 265.29 Residual Sum of Squares: 7070.4 R-Squared: 0.38083 Adj. R-Squared: 0.38008 Chisq: 2468.11 on 5 DF, p-value: < 2.22e-16 > > IVam_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "am") > summary(IVam_ubal) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "am") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.02323 0.15243 0.19 individual 0.09893 0.31453 0.81 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5639 0.8198 0.8198 0.8196 0.8198 0.8198 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -12.8863 -0.7867 0.0495 -0.0001 0.7861 13.7627 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.4638e+00 5.3915e-02 101.3399 < 2.2e-16 *** wks 1.1511e-03 7.7708e-04 1.4813 0.1385 marriedyes -1.1403e-01 2.4534e-02 -4.6479 3.354e-06 *** exp 8.6894e-02 3.1630e-03 27.4723 < 2.2e-16 *** I(exp^2) -8.1196e-04 7.0668e-05 -11.4898 < 2.2e-16 *** bluecolyes -1.0982e-01 1.6058e-02 -6.8391 7.968e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 265.29 Residual Sum of Squares: 7066.9 R-Squared: 0.38113 Adj. R-Squared: 0.38038 Chisq: 2471.83 on 5 DF, p-value: < 2.22e-16 > > IVbms_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "bms") > > > summary(IVbms_ubal) Oneway (individual) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, model = "random", inst.method = "bms") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.02323 0.15243 0.19 individual 0.09893 0.31453 0.81 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0.5639 0.8198 0.8198 0.8196 0.8198 0.8198 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -12.8867 -0.7873 0.0499 -0.0001 0.7873 13.7632 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 5.46240311 0.05389528 101.3522 < 2.2e-16 *** wks 0.00114787 0.00077707 1.4772 0.1396 marriedyes -0.11376538 0.02447722 -4.6478 3.355e-06 *** exp 0.08706288 0.00316031 27.5488 < 2.2e-16 *** I(exp^2) -0.00081599 0.00007060 -11.5579 < 2.2e-16 *** bluecolyes -0.10979302 0.01605806 -6.8373 8.072e-12 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 265.29 Residual Sum of Squares: 7066.8 R-Squared: 0.38114 Adj. R-Squared: 0.3804 Chisq: 2473.49 on 5 DF, p-value: < 2.22e-16 > > # texreg::screenreg(list("BVK ui" = IVbvk_ubal, "Baltagi ui" = IVbalt_ubal, "AM ui" = IVam_ubal, "BMS ui" = IVbms_ubal), > # digits = 5) > > > ## balanced one-way time > # gives identical results for "am" and "bms" results are identical to "baltagi", > # likely because function StarX is not symmetric in effect > IVbvk_t <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "bvk", effect = "time") > summary(IVbvk_t) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_wage_iv2, data = pWages, effect = "time", model = "random", inst.method = "bvk") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.1271 0.3565 1 time 0.0000 0.0000 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9957868 -0.2573738 -0.0061258 0.2677200 2.1611993 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.0131e+00 6.0968e-02 98.629 < 2.2e-16 *** wks 3.6313e-03 1.2032e-03 3.018 0.002545 ** marriedyes 3.1837e-01 1.6118e-02 19.753 < 2.2e-16 *** exp 3.6882e-02 2.4393e-03 15.120 < 2.2e-16 *** I(exp^2) -6.4913e-04 5.3708e-05 -12.086 < 2.2e-16 *** bluecolyes -3.2165e-01 1.2368e-02 -26.007 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 654.8 R-Squared: 0.2617 Adj. R-Squared: 0.26081 Chisq: 1474.21 on 5 DF, p-value: < 2.22e-16 > > IVbalt_t <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "baltagi", effect = "time") > summary(IVbalt_t) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_wage_iv2, data = pWages, effect = "time", model = "random", inst.method = "baltagi") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.1271 0.3565 1 time 0.0000 0.0000 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.598694 -0.721869 -0.017043 0.751016 6.062259 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.01329823 0.06096780 98.6307 < 2.2e-16 *** wks 0.00363128 0.00120324 3.0179 0.002545 ** marriedyes 0.31849295 0.01611823 19.7598 < 2.2e-16 *** exp 0.03685389 0.00243934 15.1081 < 2.2e-16 *** I(exp^2) -0.00064850 0.00005371 -12.0740 < 2.2e-16 *** bluecolyes -0.32165802 0.01236790 -26.0075 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 5152.8 R-Squared: 0.2617 Adj. R-Squared: 0.26081 Chisq: 1474.19 on 5 DF, p-value: < 2.22e-16 > > IVam_t <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "am", effect = "time") > summary(IVam_t) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = form_wage_iv2, data = pWages, effect = "time", model = "random", inst.method = "am") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.1271 0.3565 1 time 0.0000 0.0000 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.598694 -0.721869 -0.017043 0.751016 6.062259 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.01329823 0.06096780 98.6307 < 2.2e-16 *** wks 0.00363128 0.00120324 3.0179 0.002545 ** marriedyes 0.31849295 0.01611823 19.7598 < 2.2e-16 *** exp 0.03685389 0.00243934 15.1081 < 2.2e-16 *** I(exp^2) -0.00064850 0.00005371 -12.0740 < 2.2e-16 *** bluecolyes -0.32165802 0.01236790 -26.0075 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 5152.8 R-Squared: 0.2617 Adj. R-Squared: 0.26081 Chisq: 1474.19 on 5 DF, p-value: < 2.22e-16 > > IVbms_t <- plm(form_wage_iv2, + data = pWages, + model = "random", inst.method = "bms", effect = "time") > summary(IVbms_t) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = form_wage_iv2, data = pWages, effect = "time", model = "random", inst.method = "bms") Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.1271 0.3565 1 time 0.0000 0.0000 0 theta: 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.598694 -0.721869 -0.017043 0.751016 6.062259 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.01329823 0.06096780 98.6307 < 2.2e-16 *** wks 0.00363128 0.00120324 3.0179 0.002545 ** marriedyes 0.31849295 0.01611823 19.7598 < 2.2e-16 *** exp 0.03685389 0.00243934 15.1081 < 2.2e-16 *** I(exp^2) -0.00064850 0.00005371 -12.0740 < 2.2e-16 *** bluecolyes -0.32165802 0.01236790 -26.0075 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 5152.8 R-Squared: 0.2617 Adj. R-Squared: 0.26081 Chisq: 1474.19 on 5 DF, p-value: < 2.22e-16 > > # texreg::screenreg(list("BVK t" = IVbvk_t, "Baltagi t" = IVbalt_t, "AM t" = IVam_t, "BMS t" = IVbms_t), > # digits = 5) > > ## unbalanced one-way time > IVbvk_t_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "bvk", effect = "time") > summary(IVbvk_t_ubal) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Balestra-Varadharajan-Krishnakumar's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, effect = "time", model = "random", inst.method = "bvk") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.1267 0.3559 1 time 0.0000 0.0000 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9960628 -0.2575742 -0.0060508 0.2675715 2.1579866 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.0335e+00 6.1226e-02 98.5444 <2e-16 *** wks 3.3238e-03 1.2072e-03 2.7533 0.0059 ** marriedyes 3.2084e-01 1.6130e-02 19.8905 <2e-16 *** exp 3.6349e-02 2.4441e-03 14.8720 <2e-16 *** I(exp^2) -6.3990e-04 5.3793e-05 -11.8954 <2e-16 *** bluecolyes -3.2373e-01 1.2389e-02 -26.1299 <2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 883.99 Residual Sum of Squares: 652.02 R-Squared: 0.26241 Adj. R-Squared: 0.26152 Chisq: 1473.97 on 5 DF, p-value: < 2.22e-16 > > IVbalt_t_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "baltagi", effect = "time") > summary(IVbalt_t_ubal) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, effect = "time", model = "random", inst.method = "baltagi") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.1267 0.3559 1 time 0.0000 0.0000 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.608286 -0.723549 -0.016968 0.751478 6.062804 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.0336e+00 6.1226e-02 98.5463 < 2.2e-16 *** wks 3.3236e-03 1.2072e-03 2.7532 0.005902 ** marriedyes 3.2096e-01 1.6130e-02 19.8980 < 2.2e-16 *** exp 3.6323e-02 2.4442e-03 14.8609 < 2.2e-16 *** I(exp^2) -6.3932e-04 5.3795e-05 -11.8844 < 2.2e-16 *** bluecolyes -3.2374e-01 1.2389e-02 -26.1307 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 883.99 Residual Sum of Squares: 5147.1 R-Squared: 0.26241 Adj. R-Squared: 0.26152 Chisq: 1473.99 on 5 DF, p-value: < 2.22e-16 > > IVam_t_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "am", effect = "time") > summary(IVam_t_ubal) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, effect = "time", model = "random", inst.method = "am") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.1267 0.3559 1 time 0.0000 0.0000 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.608287 -0.723547 -0.016967 0.751478 6.062799 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.0336e+00 6.1226e-02 98.5463 < 2.2e-16 *** wks 3.3236e-03 1.2072e-03 2.7532 0.005902 ** marriedyes 3.2096e-01 1.6130e-02 19.8980 < 2.2e-16 *** exp 3.6323e-02 2.4442e-03 14.8607 < 2.2e-16 *** I(exp^2) -6.3931e-04 5.3795e-05 -11.8842 < 2.2e-16 *** bluecolyes -3.2374e-01 1.2389e-02 -26.1307 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 883.99 Residual Sum of Squares: 5147.1 R-Squared: 0.26241 Adj. R-Squared: 0.26152 Chisq: 1473.99 on 5 DF, p-value: < 2.22e-16 > > IVbms_t_ubal <- plm(form_wage_iv2, + data = pWages_ubal, + model = "random", inst.method = "bms", effect = "time") > summary(IVbms_t_ubal) Oneway (time) effect Random Effect Model (Swamy-Arora's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = form_wage_iv2, data = pWages_ubal, effect = "time", model = "random", inst.method = "bms") Unbalanced Panel: n = 595, T = 1-7, N = 4149 Effects: var std.dev share idiosyncratic 0.1267 0.3559 1 time 0.0000 0.0000 0 theta: Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -5.608281 -0.723591 -0.017027 0.751556 6.062881 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 6.0335e+00 6.1226e-02 98.5452 < 2.2e-16 *** wks 3.3233e-03 1.2072e-03 2.7529 0.005907 ** marriedyes 3.2099e-01 1.6130e-02 19.8997 < 2.2e-16 *** exp 3.6332e-02 2.4442e-03 14.8648 < 2.2e-16 *** I(exp^2) -6.3952e-04 5.3794e-05 -11.8884 < 2.2e-16 *** bluecolyes -3.2374e-01 1.2389e-02 -26.1307 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 883.99 Residual Sum of Squares: 5147.1 R-Squared: 0.26241 Adj. R-Squared: 0.26152 Chisq: 1474.18 on 5 DF, p-value: < 2.22e-16 > > # texreg::screenreg(list("BVK tu" = IVbvk_t_ubal, "Baltagi tu" = IVbalt_t_ubal, "AM tu" = IVam_t_ubal, "BMS tu" = IVbms_t_ubal), > # digits = 5) > > > ### twoway RE estimation: currently prevented (error informatively) > # IVbvktw <- plm(form_wage_iv2, > # data = pWages, > # model = "random", inst.method = "bvk", effect = "twoways") > # summary(IVbvktw) > # > # IVbalttw <- plm(form_wage_iv2, > # data = pWages, > # model = "random", inst.method = "baltagi", effect = "twoways") > # summary(IVbalttw) > # > # IVamtw <- plm(form_wage_iv2, > # data = pWages, > # model = "random", inst.method = "am", effect = "twoways") > # summary(IVamtw) > # > # IVbmstw <- plm(form_wage_iv2, > # data = pWages, > # model = "random", inst.method = "bms", effect = "twoways") > # summary(IVbmstw) > # > # texreg::screenreg(list("BVK tw" = IVbvktw, "Baltagi tw" = IVbalttw, "AM tw" = IVamtw, "BMS tw" = IVbmstw), > # digits = 5) > > > > proc.time() user system elapsed 9.32 0.18 9.54 plm/inst/tests/test_pdata.frame_print_duplicated_rownames.R0000644000176200001440000000146314124132276024060 0ustar liggesusers# 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 # # This is a testfile to check if the workaround works library(plm) df <- data.frame(id=c(1,2,11,11), time=c(8,9,NA,NA), a=c(1,2,3.1,3.2), b=c(1,2,3.1,3.2)) # has duplicated row names, current workaround is to not print # the original row names pdf_w_duprownames <- pdata.frame(df, row.names = TRUE) any(duplicated(rownames(pdf_w_duprownames))) print(pdf_w_duprownames) # should work in any case (no duplicated row names) pdf_wo_duprownames <- pdata.frame(df, row.names = FALSE) any(duplicated(rownames(pdf_wo_duprownames))) print(pdf_wo_duprownames) plm/inst/tests/test_ranef.R0000644000176200001440000000350614124132276015444 0ustar liggesusers## test of ranef() library(plm) data("Cigar", package = "plm") # note: the formulae used in estimation are different obj_bal_ind <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "individual") # gives positive estimate for theta obj_bal_time <- plm(price ~ pop + sales, data = Cigar, model = "random", effect = "time") # gives positive estimate for theta summary(obj_bal_ind) summary(obj_bal_time) ranef(obj_bal_ind) ranef(obj_bal_time) ### unbalanced one-way tests data("Grunfeld", package = "plm") Grunfeld199 <- Grunfeld[1:199, ] mod_unbal_id <- plm(inv ~ value + capital, data = Grunfeld199, model = "random", effect = "individual") mod_unbal_time <- plm(inv ~ value + capital, data = Grunfeld199, model = "random", effect = "time") ranef(mod_unbal_id) ranef(mod_unbal_time) Cigar_unbal <- Cigar[1:(nrow(Cigar)-1), ] ## same formula this time obj_unbal_ind <- plm(sales ~ pop, data = Cigar_unbal, model = "random", effect = "individual") # gives positive estimate for theta obj_unbal_time <- plm(sales ~ pop, data = Cigar_unbal, model = "random", effect = "time") # gives positive estimate for theta summary(obj_unbal_ind) summary(obj_unbal_time) ranef(obj_unbal_ind) ranef(obj_unbal_time) ## two-way balanced obj_bal_tw <- plm(sales ~ pop + price, data = Cigar, model = "random", effect = "twoways") # gives positive estimate for theta summary(obj_bal_tw) ranef(obj_bal_tw) ranef(obj_bal_tw, effect = "individual") # same as line before ranef(obj_bal_tw, effect = "time") ## two-way unbalanced obj_unbal_tw <- plm(sales ~ pop + price, data = Cigar_unbal, model = "random", effect = "twoways") # gives positive estimate for theta summary(obj_unbal_tw) ranef(obj_unbal_tw) ranef(obj_unbal_tw, effect = "individual") # same as line before ranef(obj_unbal_tw, effect = "time") plm/inst/tests/test_model.matrix_effects.R0000644000176200001440000000241214164704035020450 0ustar liggesusers# TODO: add all cases: all model objects with all combinations of available model and effect values # request all combinations from all model objects library(plm) data("Grunfeld", package = "plm") fe2_bal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld) fe2_unbal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld[1:199, ]) model.matrix(fe2_bal, model = "pooling", effect = "individual") model.matrix(fe2_bal, model = "pooling", effect = "time") model.matrix(fe2_bal, model = "pooling", effect = "twoways") model.matrix(fe2_unbal, model = "pooling", effect = "individual") model.matrix(fe2_unbal, model = "pooling", effect = "time") model.matrix(fe2_unbal, model = "pooling", effect = "twoways") # this resulted pre rev. 298 in an error due to the effect argument saved in # plm_object$args$effect = "twoways" which gets interpreted by model.matrix # and "applied" to model = "pooling" model.matrix(fe2_unbal, model = "pooling") pmodel.response(fe2_unbal, model = "pooling") #### "mean" model.matrix(fe2_unbal, model = "mean") model.matrix(fe2_bal, model = "mean") #### "random" results in error # model.matrix(fe2_unbal, model = "random")plm/inst/tests/test_make.pconsecutive_pbalanced.R0000644000176200001440000005422414124132276021770 0ustar liggesusers##### Testing of make.pconsecutive.* ##### ##### and of make.pbalanced.* ##### ##### ## in separate file test_is.pconsecutive.R: test of is.pconsecutive.* library(plm) ##################### test of make.pconsecutive.indexes ##################### # (non-exported function) # make.pconsecutive.indexes: for data.frames data("Grunfeld", package = "plm") drop_for_unbalanced <- c(2,42,56,78) unbalanced_Grunfeld <- Grunfeld[-drop_for_unbalanced, ] gindex <- plm:::make.pconsecutive.indexes(unbalanced_Grunfeld, index = c("firm", "year"))[[1L]] nrow(gindex) all.equal(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ]) #compare::compare(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ], allowAll = TRUE) if (!identical(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ])) stop("failure data.frame") if (!isTRUE(all.equal(unbalanced_Grunfeld[, 1:2], gindex[-drop_for_unbalanced, ]))) stop("failure data.frame") # class(unbalanced_Grunfeld[, 2]) # class(gindex[-drop_for_unbalanced, 2]) # # typeof(unbalanced_Grunfeld[, 2]) # typeof(gindex[-drop_for_unbalanced, 2]) # # attr(unbalanced_Grunfeld, "row.names") # attr(gindex, "row.names") # make.pconsecutive.indexes: for pdata.frames punbalanced_Grunfeld <- pdata.frame(unbalanced_Grunfeld) pgindex <- plm:::make.pconsecutive.indexes(punbalanced_Grunfeld, index = c("firm", "year"))[[1L]] nrow(pgindex) if (!identical(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ])) stop("failure index of pdata.frame") if (!isTRUE(all.equal(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ]))) stop("failure index of pdata.frame") #compare::compare(attr(punbalanced_Grunfeld, "index")[, 1:2], pgindex[-drop_for_unbalanced, ], allowAll = TRUE) # class(pgindex[-drop_for_unbalanced, ]) # mode(attr(unbalanced_Grunfeld[, 1:2], "row.names")) # mode(attr(gindex[-drop_for_unbalanced, ], "row.names")) # class(row.names(gindex[-drop_for_unbalanced, ])) # make.pconsecutive.indexes: pseries interface pgindex <- plm:::make.pconsecutive.indexes(punbalanced_Grunfeld$inv, index = c("firm", "year"))[[1L]] if (!identical(attr(punbalanced_Grunfeld$inv, "index")[, 1:2], pgindex[-drop_for_unbalanced, ])) stop("failure index of pdata.frame") if (!isTRUE(all.equal(attr(punbalanced_Grunfeld$inv, "index")[, 1:2], pgindex[-drop_for_unbalanced, ]))) stop("failure index of pdata.frame") ##################### END test of make.pconsecutive.indexes ##################### ##################### test of make.pconsecutive methods (various interfaces) ##################### ### create some easy test data with some leading and trailing NAs ### df_consec <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), time = c(1, 2, 3, 1, 2, 1, 2, 3), value = c("a", "b", "c", "d", "e", "f", "g", "h")) df_first_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), time = c(NA, 2, 3, 1, 2, 1, 2, 3), value = c("a", "b", "c", "d", "e", "f", "g", "h")) df_first_t_NA2 <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), time = c(1, 2, 3, NA, 2, 1, 2, 3), value = c("a", "b", "c", "d", "e", "f", "g", "h")) df_last_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), time = c(1, 2, NA, 1, 2, 1, 2, 3), value = c("a", "b", "c", "d", "e", "f", "g", "h")) df_first_last_t_NA <- data.frame(id = c(1, 1, 1, 2, 2, 3, 3, 3), time = c(NA, 2, NA, 1, 2, 1, 2, NA), value = c("a", "b", "c", "d", "e", "f", "g", "h")) pdf_consec <- pdata.frame(df_consec) pdf_first_t_NA <- pdata.frame(df_first_t_NA) pdf_first_t_NA2 <- pdata.frame(df_first_t_NA2) pdf_last_t_NA <- pdata.frame(df_last_t_NA) pdf_first_last_t_NA <- pdata.frame(df_first_last_t_NA) if (!identical(make.pconsecutive(pdf_consec$value), pdf_consec$value)) stop("failure for already consecutive pseries: result is not identical to input") if (!all(names(make.pconsecutive(pdf_first_t_NA$value)) == c("1-2", "1-3", "2-1", "2-2", "3-1", "3-2", "3-3"))) stop("failure for leading NA") if (!all(names(make.pconsecutive(pdf_first_t_NA2$value)) == c("1-1", "1-2", "1-3", "2-2", "3-1", "3-2", "3-3"))) stop("failure for leading NA") if (!all(names(make.pconsecutive(pdf_last_t_NA$value)) == c("1-1", "1-2", "2-1", "2-2", "3-1", "3-2", "3-3"))) stop("failure for last NA") if (!all(names(make.pconsecutive(pdf_first_last_t_NA$value)) == c("1-2", "2-1" , "2-2", "3-1", "3-2"))) stop("failure for first/last NA pattern") ## some missing periods data("Grunfeld", package = "plm") Grunfeld_missing_periods_one_id <- Grunfeld[-c(2,6,7), ] pGrunfeld_missing_periods_one_id <- pdata.frame(Grunfeld_missing_periods_one_id) pinv_missing_periods <- pGrunfeld_missing_periods_one_id$inv multi_periods <- c(2,6,7,22,23,56) # may not be at the first or last pos for an id, otherwise this line cannot be restored Grunfeld_missing_periods_multi_id <- Grunfeld[-multi_periods, ] pGrunfeld_missing_periods_multi_id <- pdata.frame(Grunfeld_missing_periods_multi_id) pinv_missing_periods_multi_id <- pGrunfeld_missing_periods_multi_id$inv #### test of pseries interface #### if (!all(is.pconsecutive(make.pconsecutive(pinv_missing_periods)))) stop("failure") if (!nrow(attr(make.pconsecutive(pinv_missing_periods), "index")) == 200) stop("wrong index") if (!all(class(make.pconsecutive(pinv_missing_periods)) == class(pinv_missing_periods))) stop("wrong class") # test for fancy_rownames names(make.pconsecutive(pinv_missing_periods)) # names should be "fancy" pGrunfeld_missing_periods_one_id_wo_fancy_rownames <- pdata.frame(Grunfeld_missing_periods_one_id, row.names = FALSE) pinv_missing_periods_wo_fancy_rownames <- pGrunfeld_missing_periods_one_id_wo_fancy_rownames$inv # should not be "fancy" but sequence of numbers if (!all(as.numeric(names(make.pconsecutive(pinv_missing_periods_wo_fancy_rownames))) == c(1:200))) stop("fancy rownames test failed") ### test of data.frame interface #### # index vars automatically taken from columns 1,2, as no index arg specified a <- make.pconsecutive(Grunfeld_missing_periods_one_id) all.equal(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ]) identical(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ]) if (!identical(a[-c(2,6,7), ], Grunfeld[-c(2,6,7), ])) stop("data.frame interface: non identical results") b <- make.pconsecutive(Grunfeld_missing_periods_multi_id) all.equal(b[-multi_periods, ], Grunfeld[-multi_periods, ]) identical(b[-multi_periods, ], Grunfeld[-multi_periods, ]) if (!identical(b[-multi_periods, ], Grunfeld[-multi_periods, ])) stop("data.frame interface: non identical results") # place index vars at other positions, specify index arg permutate_cols <- c(3, 1, 4, 5, 2) Grunfeld_missing_periods_multi_id_other_pos_index <- Grunfeld_missing_periods_multi_id[ , permutate_cols] d <- make.pconsecutive(Grunfeld_missing_periods_multi_id_other_pos_index, index = c("firm", "year")) all.equal(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index) identical(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index) if (!identical(d[-multi_periods, ], Grunfeld_missing_periods_multi_id_other_pos_index)) stop("data.frame interface: non identical results") ### test of pdata.frame interface f <- pdata.frame(Grunfeld_missing_periods_multi_id, index = c("firm", "year"), drop.index = FALSE) f_without_indexvars <- pdata.frame(Grunfeld_missing_periods_multi_id, index = c("firm", "year"), drop.index = TRUE) f_consec <- make.pconsecutive(f) f_without_indexvars_consec <- make.pconsecutive(f_without_indexvars) ## it seems like it is not possible here to check for equality of subsetted pdata.frames because ## the subsetting functions for pdata.frame alters the pdata.frame ## (this seems due to the fact that, currently, pdata.frames when created do not have ## "pseries" in columns and carry no index attribute. Only after extracting a column, that column ## will be of class c(“pseries”, “original_class”) and carry an index attribute. ## # To see this, use lapply (to avoid extraction): # df <- data.frame(id = c(1,1,2), time = c(1,2,1), f = factor(c("a", "a", "b")), n = c(1:3)) # pdf <- pdata.frame(df) # lapply(df, class) # lapply(pdf, class) # # lapply(df, attributes) # lapply(pdf, attributes) all.equal(f, f_consec[-multi_periods, ]) all.equal(f, f_consec[-multi_periods, ], check.attributes = FALSE) identical(f, f_consec[-multi_periods, ]) if (!identical(f, f_consec[-multi_periods, ])) stop("make.pconsecutive pdata.frame interface: non identical results") all.equal(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ]) identical(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ]) if (!identical(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ])) stop("pdata.frame interface: non identical results") if (!isTRUE(all.equal(f, f_consec[-multi_periods, ], check.attributes = FALSE))) stop("pdata.frame interface: non all.equal results") if (!isTRUE(all.equal(f_without_indexvars, f_without_indexvars_consec[-multi_periods, ], check.attributes = FALSE))) stop("pdata.frame interface: non all.equal results") ##### test for consecutive and at the same time balanced: unbalanced_Grunfeld2 <- Grunfeld[-c(1, 41, 42, 79), ] # due to missing first time periods for some individuals, # simply making it consecutive is not possible, because the # periods cannot be infered punbalanced_Grunfeld2 <- pdata.frame(unbalanced_Grunfeld2) if (!nrow(make.pconsecutive(unbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE)) == 200) stop("not balanced") if (!pdim(make.pconsecutive(unbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE))$balanced) stop("not balanced") if (!nrow(make.pconsecutive(punbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE)) == 200) stop("not balanced") if (!pdim(make.pconsecutive(punbalanced_Grunfeld2, index = c("firm", "year"), balanced = TRUE))$balanced) stop("not balanced") # for pseries if (length(make.pconsecutive(punbalanced_Grunfeld2$inv, balanced = TRUE)) != 200) stop("not balanced") # pseries is consecutive but not balanced and balancedness requested psun <- pdata.frame(Grunfeld[1:199 , ])$inv if (!length(make.pconsecutive(psun, balanced = TRUE)) == 200) stop("faile make.pconsecutive pseries") if (!nrow(attr(make.pconsecutive(psun, balanced = TRUE), "index")) == 200) stop("failure make.pconsecutive pseries' index") ######## test make.pbalanced ######### delte_2nd_period_and_3rd_for_id1 <- c(c(2, 2 + 20*c(1:9)), 3) Grunfeld_wo_2nd_period_and_3rd_for_id1 <- Grunfeld[-delte_2nd_period_and_3rd_for_id1, ] pGrunfeld_wo_2nd_period_and_3rd_for_id1 <- pdata.frame(Grunfeld_wo_2nd_period_and_3rd_for_id1) nrow(Grunfeld_wo_2nd_period_and_3rd_for_id1) # data.frame if (!nrow(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)) == 190) stop("failure make.pbalanced data.frame") # pdata.frame and its index if (!nrow(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1)) == 190) stop("failure make.pbalanced pdata.frame") if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1), "index")) == 190) stop("failure make.pbalanced pdata.frame's index") # pseries and its index if (!length(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv)) == 190) stop("failure make.pbalanced pseries") if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv), "index")) == 190) stop("failure make.pbalanced pseries' index") # pseries is consecutive but not balanced and balancedness requested psun <- pdata.frame(Grunfeld[1:199 , ])$inv if (!length(make.pbalanced(psun, balance.type = "fill")) == 200) stop("faile make.pbalanced pseries") if (!nrow(attr(make.pbalanced(psun, balance.type = "fill"), "index")) == 200) stop("failure make.pbalanced pseries' index") ## make.pbalanced with balance.type = "shared.times": # 2 periods deleted -> 180 rows/entries left in (p)data.frame/pseries # data.frame if (!nrow(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times") == 180)) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") # pdata.frame if (!nrow(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times") == 180)) stop("failure make.pbalanced, balance.type = \"shared.times\") pdata.frame") if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1, balance.type = "shared.times"), "index")) == 180) stop("failure make.pbalanced, balance.type = \"shared.times\") pdata.frame's index") # pseries if (!length(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv, balance.type = "shared.times")) == 180) stop("failure make.pbalanced(, balance.type = \"shared.times\") pseries") if (!nrow(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1$inv, balance.type = "shared.times"), "index")) == 180) stop("failure make.pbalanced pseries' index") # delete one (but different) period per id -> upper half of years (1945 to 1953) should be left delete_1_per_id_half <- c(1, 22, 43, 64, 85, 106, 127, 148, 169, 190) #split(Grunfeld[-delete_1_per_id_half, ]$year, Grunfeld[-delete_1_per_id_half, ]$firm) # inspect structure if (!nrow(make.pbalanced(Grunfeld[-delete_1_per_id_half, ], balance.type = "shared.times") == 100)) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") if (!all(unique(make.pbalanced(Grunfeld[-delete_1_per_id_half, ], balance.type = "shared.times")$year) == c(1945:1954))) stop("wrong years") # delete two (but different) periods per id -> none should be left -> data frame with 0 rows delete_2_per_id_all <- c(1, 20, 22, 39, 43, 58, 64, 77, 85, 96, 106, 115, 127, 134, 148, 153, 169, 172, 190, 191) #split(Grunfeld[-delete_2_per_id_all, ]$year, Grunfeld[-delete_2_per_id_all, ]$firm) # inspect structure if (!nrow(make.pbalanced(Grunfeld[-delete_2_per_id_all, ], balance.type = "shared.times")) == 0) stop("failure make.pbalanced, balance.type = \"shared.times\") data.frame") ############## check that no additional individuals or times were introduced # (because making it balanced does not introduce time periods # which are not present for at least one individual) # # pdata.frame and pseries: this is checking for new factor levels # data.frame: check for unique values #### pdata.frame if (!all(levels(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1)$year) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1$year))) stop("failure pdata.frame: factor levels for time periods do not match") # test: no new levels in index: if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1$year))) stop("failure pdata.frame: factor levels for time periods in index do not match") # for pdata.frame without index vars as columns pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index <- pdata.frame(Grunfeld_wo_2nd_period_and_3rd_for_id1, drop.index = TRUE) if (!all(levels(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index)$year) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) stop("failure pdata.frame: factor levels for time periods do not match") # test: no new levels in index: if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) stop("failure pdata.frame: factor levels for time periods in index do not match") #### pseries # (only need to test index for pseries): no new levels in index if (!all(levels(attr(make.pbalanced(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$value), "index")[[2]]) == levels(pGrunfeld_wo_2nd_period_and_3rd_for_id1_no_index$year))) stop("failure for pseries: factor levels for time periods in index do not match") #### data.frame # check that no additional values for individuals were introduced if (!all(sort(unique(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)$firm)) == sort(unique(Grunfeld_wo_2nd_period_and_3rd_for_id1$firm)))) stop("failure for data.frame: unique individuals in index do not match") # check that no additional values for time were introduced if (!all(sort(unique(make.pbalanced(Grunfeld_wo_2nd_period_and_3rd_for_id1)$year)) == sort(unique(Grunfeld_wo_2nd_period_and_3rd_for_id1$year)))) stop("failure for data.frame: unique time periods in index do not match") ######## END test make.pbalanced ######### ### messy data with various NA patterns ### # ## commented because needs package 'haven' and data need to be loaded from web # library(haven) # nlswork_r8 <- haven::read_dta("http://www.stata-press.com/data/r8/nlswork.dta") # # remove attributes added by haven # nlswork_r8 <- as.data.frame(lapply(nlswork_r8, function(x) {attr(x, "label") <- NULL; x})) # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) # nlswork_r8$here_before <- TRUE # # # length(unique(pnlswork_r8$year)) # == 15 # unique(pnlswork_r8$year) # years missing: 74, 76, 79, 81, 84, 86 (# = 6) # # => 15 + 6 = 21 # # ### test of pseries interface # # age_consec <- make.pconsecutive(pnlswork_r8$age) # if (!(all(is.pconsecutive(age_consec)))) stop("failure") # # # length(age_consec) # length(index(age_consec)[[1L]]) # length(index(age_consec)[[2L]]) # # ### test of data.frame interface # df_nlswork_r8_consec <- make.pconsecutive(nlswork_r8) # # if (!all(is.pconsecutive(df_nlswork_r8_consec))) stop("failure") # if (!nrow(df_nlswork_r8_consec) == 52365) stop("failure") # # # make temp original data with row.names so that identical can return TRUE # # otherwise it cannot be TRUE because new row.names were introduced and row.names # # are a consecutive series (rownames == row numbers) in the original data # # see how the output of all.equal diverges # rows_there_before <- df_nlswork_r8_consec$here_before & !is.na(df_nlswork_r8_consec$here_before) # all.equal(df_nlswork_r8_consec[rows_there_before, ], nlswork_r8) # # nlswork_r8_comparison <- nlswork_r8 # attr(nlswork_r8_comparison, "row.names") <- attr(df_nlswork_r8_consec[rows_there_before, ], "row.names") # # if (!identical(df_nlswork_r8_consec[rows_there_before, ],nlswork_r8_comparison)) stop("data.frame: not identical") # # if (!identical(typeof(attr(nlswork_r8, "row.names")), typeof(attr(df_nlswork_r8_consec, "row.names")))) # stop("wrong typeof of attribute 'row.names'") # # ### test of pdata.frame interface # pdf_pnlswork_r8_consec <- make.pconsecutive(pnlswork_r8) # # if (!all(is.pconsecutive(pdf_pnlswork_r8_consec))) stop("failure") # if (!nrow(pdf_pnlswork_r8_consec) == 52365) stop("failure") # # # same row.names adoption necessary as for data.frame # pnlswork_r8_comparison <- pnlswork_r8 # pdf_pnlswork_r8_consec_rows_there_before <- pdf_pnlswork_r8_consec[rows_there_before, ] # attr(attr(pnlswork_r8_comparison, "index"), "row.names") <- attr(attr(pdf_pnlswork_r8_consec_rows_there_before, "index"), "row.names") # # as the index vars are in the pdata.frame: added levels are not to be dropped; thus: adapt here to enable comparison # pdf_pnlswork_r8_consec_rows_there_before$idcode <- droplevels(pdf_pnlswork_r8_consec_rows_there_before$idcode) # pdf_pnlswork_r8_consec_rows_there_before$year <- droplevels(pdf_pnlswork_r8_consec_rows_there_before$year) # # length(levels(pdf_pnlswork_r8_consec_rows_there_before$year)) # # all.equal(pdf_pnlswork_r8_consec_rows_there_before, pnlswork_r8_comparison) # if (!identical(pdf_pnlswork_r8_consec_rows_there_before, pnlswork_r8_comparison)) stop("pdata.frame: not identical") # # # # dims_consec <- pdim(pdf_pnlswork_r8_consec) # min(dims_consec$Tint$Ti) # 1 # max(dims_consec$Tint$Ti) # 21 = 15 + 6 # dims_consec$Tint$nt # => ok! (not all the same years for each individual, because just consecutive, not balanced) # # # 15 + 6 == 21 # if (!length(unique(index(pdf_pnlswork_r8_consec)[[2]])) == 21) stop("failure") # # years 68 to 88 need to be present (each year needs to be present) # if (!all(levels(attr(pdf_pnlswork_r8_consec, "index")[[2]]) == factor(68:88))) stop("failure") # # # # test argument balanced on this data set # pdf_pnlswork_r8_consec_bal <- make.pconsecutive(pnlswork_r8, balanced = TRUE) # dims_consec_bal <- pdim(pdf_pnlswork_r8_consec_bal) # # need to have same numer of obs per year (because balanced) # if (!all(dims_consec_bal$Tint$nt[1] == dims_consec_bal$Tint$nt)) stop("failure for argument balanced") # if (!nrow(pdf_pnlswork_r8_consec_bal) == 98931) stop("failure: nrow not correct") # if (!dims_consec_bal$balanced) stop("failure: not balanced") # # ## test of only making it balanced, but not consecutive # nlswork_r8_bal <- make.pbalanced(nlswork_r8) # data.frame # pnlswork_r8_bal <- make.pbalanced(pnlswork_r8) # pdata.frame # # if (!all(sort(unique(nlswork_r8$year)) == sort(unique(nlswork_r8_bal$year)))) stop("data.frame: times do not match") # if (!all(levels(pnlswork_r8$year) == levels(pnlswork_r8_bal$year))) stop("pdata.frame: times do not match") ########### compare results to statar ######################## # devtools::install_github("matthieugomez/statar") # library(tidyr) # library(dplyr) ########### compare to tidyr ########## ## commented because it requires a separate package # ## make panel balanced by inserting NAs ## note: this is a good bit faster than make.psconsective(, balanced = TRUE) # nlswork_r8_no_NA <- tidyr::complete(nlswork_r8, idcode, year = as.integer(tidyr::full_seq(year, 1))) # # tidyr::full_seq(c(1, 2, 4, 5, 10), 1) # tidyr::full_seq(c(1, 2, 4, 5, 10), 2) # error: not a regular sequence # tidyr::full_seq(c( 2, 4, 6, 10), 2) # pnlswork_r8_no_NA <- pdata.frame(nlswork_r8_no_NA, index=c("idcode", "year"), drop.index=F) # # # all(is.pconsecutive(pnlswork_r8_no_NA)) # # pdim_tidyr <- pdim(pnlswork_r8_no_NA) # # min(dims$Tint$Ti) # max(dims$Tint$Ti) # # pdim(pnlswork_r8_no_NA) # anyNA(pnlswork_r8_no_NA$year) plm/inst/tests/test_misc.R0000644000176200001440000003625614126043771015317 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") Grunfeld_unbal <- Grunfeld[1:199, ] # ercomp(plm(inv ~ value, Grunfeld, model = "random")) # ercomp(plm(inv ~ value, Grunfeld, model = "random", random.method = "amemiya")) # ercomp(plm(inv ~ value + capital, Grunfeld_unbal, model = "random")) # these resulted in errors pre rev. 523 due to missing drop = FALSE plm(inv ~ value, Grunfeld_unbal, model = "random", random.method = "amemiya") plm(inv ~ value, Grunfeld_unbal, model = "random", random.method = "amemiya", effect = "time") # test case for illegal pseries in pmerge's return value: # up to rev. 675, pmerge produced a data.frame with a column declared to be a pseries but with lacking index, # and there should be no 'pseries' in the resulting data.frame in first place pGrunfeld <- pdata.frame(Grunfeld) df_after_pmerge <- plm:::pmerge(pGrunfeld$inv, pGrunfeld$value) if (inherits(df_after_pmerge$ind, "pseries") && is.null(attr(df_after_pmerge$ind, "index"))) stop("illegal pseries (no index) produced by pmerge") if ("pseries" %in% unlist(lapply(df_after_pmerge, class))) stop("pmerge returned a column with pseries") if (!"data.frame" == class(df_after_pmerge)) stop("pmerge did not return a pure data.frame according to class()") # pmodel.response: test case for illegal pseries form <- formula(inv ~ value + capital) if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "pooling"))) stop("pmodel.response's return value is not a valid pseries") if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "within"))) stop("pmodel.response's return value is not a valid pseries") if (!is.pseries(pmodel.response(form, data = pGrunfeld, model = "Between"))) stop("pmodel.response's return value is not a valid pseries") if (!is.pseries(pmodel.response(plm(form, data = pGrunfeld, model = "random")))) stop("pmodel.response's return value is not a valid pseries") # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression if (inherits(pmodel.response(form, data = pGrunfeld, model = "fd"), "pseries")) stop("pmodel.response's return value shall not be a pseries for fd models") if (inherits(pmodel.response(form, data = pGrunfeld, model = "between"), "pseries")) stop("pmodel.response's return value shall not be a pseries for between models") if (plm:::has.index(pmodel.response(plm(form, data = pGrunfeld, model = "fd")))) stop("pmodel.response's return value shall not have an index for fd models") if (plm:::has.index(pmodel.response(plm(form, data = pGrunfeld, model = "between")))) stop("pmodel.response's return value shall not have an index for between models") # residuals.plm: test case for illegal pseries if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "pooling")))) stop("residuals.plm's return value is not a valid pseries") if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "within")))) stop("residuals.plm's return value is not a valid pseries") if (!is.pseries(residuals(plm(form, data = pGrunfeld, model = "random")))) stop("residuals.plm's return value is not a valid pseries") # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression if (inherits(residuals(plm(form, data = pGrunfeld, model = "fd")), "pseries")) stop("residuals.plm's return value shall not be a pseries for fd models") if (inherits(residuals(plm(form, data = pGrunfeld, model = "between")), "pseries")) stop("residuals.plm's return value shall not be a pseries for between models") if (plm:::has.index(residuals(plm(form, data = pGrunfeld, model = "fd")))) stop("residuals.plm's return value shall not have an index for fd models") if (plm:::has.index(residuals(plm(form, data = pGrunfeld, model = "between")))) stop("residuals.plm's return value shall not have an index for between models") # fitted.plm: test case for illegal pseries if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "pooling")))) stop("fitted.plm's return value is not a valid pseries") if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "within")))) stop("fitted.plm's return value is not a valid pseries") if (!is.pseries(fitted(plm(form, data = pGrunfeld, model = "random")))) stop("fitted.plm's return value is not a valid pseries") # for FD and between models, it should be a numeric as a pseries does not make sense due to the data compression if (inherits(fitted(plm(form, data = pGrunfeld, model = "fd")), "pseries")) stop("fitted.plm's return value shall not be a pseries for fd models") if (inherits(fitted(plm(form, data = pGrunfeld, model = "between")), "pseries")) stop("fitted.plm's return value shall not be a pseries for between models") if (plm:::has.index(fitted(plm(form, data = pGrunfeld, model = "fd")))) stop("fitted.plm's return value shall not have an index for fd models") if (plm:::has.index(fitted(plm(form, data = pGrunfeld, model = "between")))) stop("fitted.plm's return value shall not have an index for between models") ## WLS p <- plm(inv ~ value, Grunfeld, model = "pooling") pwls <- plm(inv ~ value + capital, data = Grunfeld, weights = Grunfeld$capital, model = "pooling") if (!is.null(p$weights)) stop("element 'weights' in plm object albeit it should not be there") if (is.null(pwls$weights)) stop("element 'weights' missing in plm object") ## aneweytest data("RiceFarms", package = "plm") aneweytest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") ## piest pirice <- piest(log(goutput) ~ log(seed) + log(totlabor) + log(size), RiceFarms, index = "id") summary(pirice) ## mtest data("EmplUK", package = "plm") ar <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + lag(log(capital), 0:2) + lag(log(output), 0:2) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") mtest(ar, order = 1) mtest(ar, order = 2, vcov = vcovHC) ## pcdtest pcdtest(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) ## test on two-way fixed effects homogeneous model pcdtest(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways", index = c("firm", "year")) ## test on panelmodel object g <- plm(inv ~ value + capital, data = Grunfeld, index = c("firm", "year")) pcdtest(g) ## scaled LM test pcdtest(g, test = "sclm") ## test on pseries pGrunfeld <- pdata.frame(Grunfeld) pcdtest(pGrunfeld$value) ## local test ## define neighbours for individual 2: 1, 3, 4, 5 in lower triangular matrix w <- matrix(0, ncol= 10, nrow=10) w[2,1] <- w[3,2] <- w[4,2] <- w[5,2] <- 1 pcdtest(g, w = w) ## cortab pGrunfeld <- pdata.frame(Grunfeld) grp <- c(rep(1, 100), rep(2, 50), rep(3, 50)) # make 3 groups cortab(pGrunfeld$value, grouping = grp, groupnames = c("A", "B", "C")) ## ercomp data("Produc", package = "plm") ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, method = "walhus", effect = "time") z <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, random.method = "walhus", effect = "time", model = "random") ercomp(z) ercomp(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, method = "amemiya", effect = "twoways") ## index data("Grunfeld", package = "plm") Gr <- pdata.frame(Grunfeld, index = c("firm", "year")) m <- plm(inv ~ value + capital, data = Gr) index(Gr, "firm") index(Gr, "time") index(Gr$inv, c(2, 1)) index(m, "id") # with additional group index data("Produc", package = "plm") pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) index(pProduc, 3) index(pProduc, "region") index(pProduc, "group") ## is.pbalanced Grunfeld_missing_period <- Grunfeld[-2, ] is.pbalanced(Grunfeld_missing_period) # check if balanced: FALSE pdim(Grunfeld_missing_period)$balanced # same pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) is.pbalanced(Grunfeld_missing_period) is.pbalanced(pGrunfeld_missing_period$inv) ## is.pconsecutive is.pconsecutive(Grunfeld) is.pconsecutive(Grunfeld, index=c("firm", "year")) # delete 2nd row (2nd time period for first individual) # -> non consecutive Grunfeld_missing_period <- Grunfeld[-2, ] is.pconsecutive(Grunfeld_missing_period) all(is.pconsecutive(Grunfeld_missing_period)) # FALSE # delete rows 1 and 2 (1st and 2nd time period for first individual) # -> consecutive Grunfeld_missing_period_other <- Grunfeld[-c(1,2), ] is.pconsecutive(Grunfeld_missing_period_other) # all TRUE # delete year 1937 (3rd period) for _all_ individuals Grunfeld_wo_1937 <- Grunfeld[Grunfeld$year != 1937, ] is.pconsecutive(Grunfeld_wo_1937) # all FALSE # pdata.frame interface pGrunfeld <- pdata.frame(Grunfeld) pGrunfeld_missing_period <- pdata.frame(Grunfeld_missing_period) is.pconsecutive(pGrunfeld) # all TRUE is.pconsecutive(pGrunfeld_missing_period) # first FALSE, others TRUE # panelmodel interface (first, estimate some models) mod_pGrunfeld <- plm(inv ~ value + capital, data = Grunfeld) mod_pGrunfeld_missing_period <- plm(inv ~ value + capital, data = Grunfeld_missing_period) is.pconsecutive(mod_pGrunfeld) is.pconsecutive(mod_pGrunfeld_missing_period) nobs(mod_pGrunfeld) # 200 nobs(mod_pGrunfeld_missing_period) # 199 # pseries interface pinv <- pGrunfeld$inv pinv_missing_period <- pGrunfeld_missing_period$inv is.pconsecutive(pinv) is.pconsecutive(pinv_missing_period) # default method for arbitrary vectors or NULL inv <- Grunfeld$inv inv_missing_period <- Grunfeld_missing_period$inv is.pconsecutive(inv, id = Grunfeld$firm, time = Grunfeld$year) is.pconsecutive(inv_missing_period, id = Grunfeld_missing_period$firm, time = Grunfeld_missing_period$year) # only id and time are needed for evaluation is.pconsecutive(NULL, id = Grunfeld$firm, time = Grunfeld$year) ## is.pseries Em <- pdata.frame(EmplUK) z <- Em$output class(z) # pseries as indicated by class is.pseries(z) # and confirmed by check # destroy index of pseries and re-check attr(z, "index") <- NA is.pseries(z) # now FALSE ## model.frame, model.matrix pGrunfeld <- pdata.frame(Grunfeld) # then make a model frame from a formula and a pdata.frame form <- inv ~ value mf <- model.frame(pGrunfeld, form) # then construct the (transformed) model matrix (design matrix) # from model frame modmat <- model.matrix(mf, model = "within") ## retrieve model frame and model matrix from an estimated plm object fe_model <- plm(form, data = pGrunfeld, model = "within") model.frame(fe_model) model.matrix(fe_model) # same as constructed before all.equal(mf, model.frame(fe_model), check.attributes = FALSE) # TRUE all.equal(modmat, model.matrix(fe_model), check.attributes = FALSE) # TRUE ## pmodel.response form <- inv ~ value + capital mf <- model.frame(pGrunfeld, form) # construct (transformed) response of the within model resp <- pmodel.response(form, data = mf, model = "within", effect = "individual") # retrieve (transformed) response directly from model frame resp_mf <- pmodel.response(mf, model = "within", effect = "individual") # retrieve (transformed) response from a plm object, i.e., an estimated model fe_model <- plm(form, data = pGrunfeld, model = "within") pmodel.response(fe_model) # same as constructed before all.equal(resp, pmodel.response(fe_model), check.attributes = FALSE) # TRUE ## nobs z <- plm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp,data=Produc, model="random", subset = gsp > 5000) nobs(z) # total observations used in estimation pdim(z)$nT$N # same information pdim(z) # more information about the dimensions (no. of individuals and time periods) # illustrate difference between nobs and pdim for first-difference model data("Grunfeld", package = "plm") fdmod <- plm(inv ~ value + capital, data = Grunfeld, model = "fd") nobs(fdmod) # 190 pdim(fdmod)$nT$N # 200 ## pgmm ## Arellano and Bond (1991), table 4 col. b z1 <- pgmm(log(emp) ~ lag(log(emp), 1:2) + lag(log(wage), 0:1) + log(capital) + lag(log(output), 0:1) | lag(log(emp), 2:99), data = EmplUK, effect = "twoways", model = "twosteps") summary(z1, robust = FALSE) ## Blundell and Bond (1998) table 4 (cf. DPD for OX p. 12 col. 4) z2 <- pgmm(log(emp) ~ lag(log(emp), 1)+ lag(log(wage), 0:1) + lag(log(capital), 0:1) | lag(log(emp), 2:99) + lag(log(wage), 2:99) + lag(log(capital), 2:99), data = EmplUK, effect = "twoways", model = "onestep", transformation = "ld") summary(z2, robust = TRUE) # Same with the old formula or dynformula interface # Arellano and Bond (1991), table 4, col. b z1 <- pgmm(log(emp) ~ log(wage) + log(capital) + log(output), lag.form = list(2,1,0,1), data = EmplUK, effect = "twoways", model = "twosteps", gmm.inst = ~log(emp), lag.gmm = list(c(2,99))) summary(z1, robust = FALSE) ## Blundell and Bond (1998) table 4 (cf DPD for OX p. 12 col. 4) z2 <- pgmm(dynformula(log(emp) ~ log(wage) + log(capital), list(1,1,1)), data = EmplUK, effect = "twoways", model = "onestep", gmm.inst = ~log(emp) + log(wage) + log(capital), lag.gmm = c(2,99), transformation = "ld") summary(z2, robust = TRUE) ## pht (deprecated) # deprecated way with pht() for HT data("Wages", package = "plm") ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "ht", index = 595) summary(ht) am <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "am", index = 595) summary(am) ## pldv pder.avail <- if (!requireNamespace("pder", quietly = TRUE)) FALSE else TRUE if(pder.avail) { data("Donors", package = "pder") pDonors <- pdata.frame(Donors, index = "id") modA <- pldv(donation ~ treatment + prcontr, data = pDonors, model = "random", method = "bfgs") summary(modA) modB <- pldv(donation ~ treatment * prcontr - prcontr, data = pDonors, model = "random", method = "bfgs") summary(modB) invisible(NULL) } ## pwartest pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK) pwartest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3") ## pwfdtest pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK) pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, h0 = "fe") pwfdtest(log(emp) ~ log(wage) + log(capital), data = EmplUK, type = "HC3", h0 = "fe") mod <- plm(log(emp) ~ log(wage) + log(capital), data = EmplUK, model = "fd") pwfdtest(mod) pwfdtest(mod, h0 = "fe") pwfdtest(mod, type = "HC3", h0 = "fe") # pwtest pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc) pwtest(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, effect = "time") ## panelmodel interface # first, estimate a pooling model, than compute test statistics form <- formula(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp) pool_prodc <- plm(form, data = Produc, model = "pooling") pwtest(pool_prodc) # == effect="individual" pwtest(pool_prodc, effect="time") plm/inst/tests/test_pdata.frame_subsetting.Rout.save0000644000176200001440000005371414154734502022500 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # various test of subsetting ("indexing") a pdata.frame and a pseries (the latter currently commented), > # e.g., that subsetting by rownames preserves the index > # (pre rev. 187/189 all entries were set to NA) > # (pre rev. 251 subsetting a pdata.frame added extra information due to coercing rules of "[.data.frame") > # (pre rev. 668 subsetting a pdata.frame with [.pdata.frame such that a single column (pseries) is returned was lacking names) > > library(plm) > data("Grunfeld", package = "plm") > > pGrunfeld <- pdata.frame(Grunfeld) > > # subsetting with [] with rownames - works > attr(pGrunfeld[c("1-1935"), ], which = "index") firm year 1 1 1935 > attr(pGrunfeld[c("1-1935", "1-1936"), ], which = "index") firm year 1 1 1935 2 1 1936 > > if (anyNA(attr(pGrunfeld[c("1-1935"), ], which = "index"))) stop("FAIL: NA in index") > if (anyNA(attr(pGrunfeld[c("1-1935", "1-1936"), ], which = "index"))) stop("FAIL: NA in index") > > > # subsetting with [] by line number works (indexes preserved) > if (!all(attr(pGrunfeld[c(1), ], which = "index") == c(1, 1935))) stop("wrong index!") > if (!all(attr(pGrunfeld[c(1,2), ], which = "index") == data.frame(firm = c(1,1), year = c(1935, 1936)))) stop("wrong index!") > > if (anyNA(attr(pGrunfeld[c(1), ], which = "index"))) stop("FAIL: NA in index") > if (anyNA(attr(pGrunfeld[c(1,2), ], which = "index"))) stop("FAIL: NA in index") > > # subsetting with [[]] works (indexes preserved) > attr(pGrunfeld[["inv"]], which = "index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > attr(pGrunfeld[[3]], which = "index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > > if (anyNA(attr(pGrunfeld[["inv"]], which = "index"))) stop("FAIL: NA in index") > if (anyNA(attr(pGrunfeld[[3]], which = "index"))) stop("FAIL: NA in index") > > > # check that extracting a single column (which becomes a pseries) yield the same > # result for the three extraction methods $.pdata.freme, [[.pdata.frame, and [.pdata.frame > extr1 <- pGrunfeld$inv > extr2 <- pGrunfeld[["inv"]] > extr3 <- pGrunfeld[ , "inv"] > if (!isTRUE(all.equal(extr1, extr2))) stop("extraction of single column (pseries) does not yield same results for $.pdata.frame and [[.pdata.frame") > if (!isTRUE(all.equal(extr1, extr3))) stop("extraction of single column (pseries) does not yield same results for $.pdata.frame and [.pdata.frame") > > # check that row names are kept and subsetted by [.pdata.frame when a single column (pseries) is returned > if (!isTRUE(all.equal(names(pGrunfeld[1:5 , "inv"]), row.names(pGrunfeld)[1:5]))) stop("row names not correctly subsetted by [.pdata.frame") > > > ############ subsetting used to change the pdata.frame > ########## since rev.252 this is fully fixed (rev. 251 already fixed large parts of this), > ########## pre rev 251 a lot of unnecessary information was added to the pdata.frame by subsetting > > # this should yield a structurally identical pdata.frame as all rows are extracted: > Grunfeld2 <- Grunfeld[1:nrow(Grunfeld), ] > pGrunfeld2 <- pGrunfeld[1:nrow(pGrunfeld), ] > > identical(Grunfeld, Grunfeld2) # TRUE for data.frame [1] TRUE > identical(pGrunfeld, pGrunfeld2) # TRUE for pdata.frame (was FALSE pre rev. 252) [1] TRUE > if (!identical(pGrunfeld, pGrunfeld2)) + stop("pdata.frame not identical after \"subsetting\" with all rows (which should actually not do any subsetting))") > > ### compare object sizes > # object.size(pGrunfeld) # 37392 bytes > # object.size(pGrunfeld2) # 37392 bytes since rev. 252 # (was: 83072 bytes in pre rev.251, considerably larger!) > # (was: 26200 bytes in rev. 251) > # if (!object.size(pGrunfeld) == object.size(pGrunfeld2)) > # print("pdata.frame not same object size after \"subsetting\" with all rows (which should actually not do any subsetting))") > > # this is likely to be unnecessarily pedantic, because by default attrib.as.set is TRUE > # and from ?attributes "Attributes are not stored internally as a list and should be > # thought of as a set and not a vector." > identical(Grunfeld, Grunfeld2, attrib.as.set = FALSE) # TRUE for data.frame [1] TRUE > identical(pGrunfeld, pGrunfeld2, attrib.as.set = FALSE) # TRUE for pdata.frame [but was false prior to rev. 1271] [1] TRUE > > # display differences (if any) [with rev. 252 there should be no differences left] > all.equal(pGrunfeld, pGrunfeld2) [1] TRUE > all.equal(pGrunfeld, pGrunfeld2, check.attributes = FALSE) [1] TRUE > # compare::compare(pGrunfeld, pGrunfeld2, allowAll = TRUE) > > > # Unused levels from the index attribute of a pdata.frame shall be dropped > # (NB: unused levels are not dropped from the variables of the pdata.frame as this is standard R behaviour) > pGrunfeld_sub_id <- pGrunfeld[-c(1:20), ] # drop first individual (1st ind. is in first 20 rows) > if (!isTRUE(all.equal(levels(attr(pGrunfeld_sub_id, "index")[[1]]), levels(factor(2:10))))) + stop("unused levels from index (individual) not dropped") > > pGrunfeld_sub_year <- pGrunfeld[!pGrunfeld$year %in% "1936", ] # drop year 1936 > if (!isTRUE(all.equal(levels(attr(pGrunfeld_sub_year, "index")[[2]]), levels(factor(c(1935, 1937:1954)))))) + stop("unused levels from index (time) not dropped") > > > > > > > > > > #### test estimation by plm on a subsetted pdata.frame (failed pre rev. 251) > pGrunfeld_sub <- pGrunfeld[c(23:99), ] > plm(inv ~ value + capital, data = pGrunfeld[c(23:99), ]) # failed pre rev.251 Model Formula: inv ~ value + capital Coefficients: value capital 0.066117 0.173627 > > # classes of index of pdata.frame and subsetted pdata.frame are the same 'pindex' and 'data.frame') > class(attr(pGrunfeld, which="index")) [1] "pindex" "data.frame" > class(attr(pGrunfeld$inv, which="index")) [1] "pindex" "data.frame" > if (!all(class(attr(pGrunfeld, which="index")) == class(attr(pGrunfeld$inv, which="index")))) stop("classes differ!") > > # classes of index of columns of pdata.frame and subsetted pdata.frame must be the same 'pindex' and 'data.frame') > class(attr(pGrunfeld$inv, which="index")) [1] "pindex" "data.frame" > class(attr(pGrunfeld_sub$inv, which="index")) [1] "pindex" "data.frame" > if (!all(class(attr(pGrunfeld$inv, which="index")) == class(attr(pGrunfeld_sub$inv, which="index")))) stop("classes differ!") > > > ############ further testing subsetting of pdata.frame and its index > # up to rev.254 subsetting by [i] (with missing j) did not mimic data.frame behavior in case of missing j (j as in [i, j]) > # fixed in rev.255 > data("Grunfeld", package = "plm") > X <- Grunfeld > pX <- pdata.frame(X) > > ###### test dimensions of subsetted pdata.frame > if (!isTRUE(all.equal(dim(X[]), dim(pX[])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , ]), dim(pX[ ,])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , , ]), dim(pX[ , , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , , drop = TRUE]), dim(pX[ , , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , , drop = FALSE]), dim(pX[ , , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > > if (!isTRUE(all.equal(dim(X[1:10, 2:4]), dim(pX[1:10, 2:4])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1:10, 2:4, drop = TRUE]), dim(pX[1:10, 2:4, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1:10, 2:4, drop = FALSE]), dim(pX[1:10, 2:4, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > if (!isTRUE(all.equal(dim(X[1:10, , ]), dim(pX[1:10, , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1:10, , drop = TRUE]), dim(pX[1:10, , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1:10, , drop = FALSE]), dim(pX[1:10, , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > > if (!isTRUE(all.equal(dim(X[1:10, ]), dim(pX[1:10, ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1, ]), dim(pX[1, ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > if (!isTRUE(all.equal(dim(X[1]), dim(pX[1])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1, drop = TRUE]), dim(pX[1, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") Warning messages: 1: In `[.data.frame`(X, 1, drop = TRUE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1, drop = TRUE) : 'drop' argument will be ignored > if (!isTRUE(all.equal(dim(X[1, drop = FALSE]), dim(pX[1, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") Warning messages: 1: In `[.data.frame`(X, 1, drop = FALSE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1, drop = FALSE) : 'drop' argument will be ignored > > if (!isTRUE(all.equal(dim(X[1:2]), dim(pX[1:2])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1:2, drop = TRUE]), dim(pX[1:2, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") Warning messages: 1: In `[.data.frame`(X, 1:2, drop = TRUE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1:2, drop = TRUE) : 'drop' argument will be ignored > if (!isTRUE(all.equal(dim(X[1:2, drop = FALSE]), dim(pX[1:2, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") Warning messages: 1: In `[.data.frame`(X, 1:2, drop = FALSE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1:2, drop = FALSE) : 'drop' argument will be ignored > > if (!isTRUE(all.equal(dim(X[ , 2:4]), dim(pX[ , 2:4])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , 2:4, drop = TRUE]), dim(pX[ , 2:4, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , 2:4 ,drop = FALSE]), dim(pX[ , 2:4, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > if (!isTRUE(all.equal(dim(X[ , 3]), dim(pX[ , 3])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , 3, drop = TRUE]), dim(pX[ , 3, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[ , 3, drop = FALSE]), dim(pX[ , 3, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > if (!isTRUE(all.equal(dim(X[1, , ]), dim(pX[1, , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1, , drop = TRUE]), dim(pX[1, , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > if (!isTRUE(all.equal(dim(X[1, , drop = FALSE]), dim(pX[1, , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") > > > ###### test dimensions of index of subsetted pdata.frame > if (!all(c(dim(pX[1:10, 2:4])[1], 2L) == dim(attr(pX[1:10, 2:4], "index")))) stop("index has wrong dimension after subsetting") > if (!all(c(dim(pX[1:10, ])[1], 2L) == dim(attr(pX[1:10, ], "index")))) stop("index has wrong dimension after subsetting") > if (!all(c(dim(pX[ , 2:4])[1], 2L) == dim(attr(pX[ , 2:4], "index")))) stop("index has wrong dimension after subsetting") > > # NB: this is class c("pseries", "numeric), need length here > if (!all(c(length(pX[ , 3]), 2L) == dim(attr(pX[ , 3], "index")))) stop("index has wrong dimension after subsetting") > > # NB: this is class c("pseries", "numeric), need length here > if (!all(c(length(pX[ , 3, drop = TRUE]), 2L) == dim(attr(pX[ , 3, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") > > # need dim again here, because drop = FALSE > if (!all(c(dim(pX[ , 3, drop = FALSE])[1], 2L) == dim(attr(pX[ , 3, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") > > # NB: this is a list! has no index anymore > length(pX[1, , drop = TRUE]) [1] 5 > # NB: this a a pdata.frame (drop = FALSE) > if (!all(c(dim(pX[1, , drop = FALSE])[1], 2L) == dim(attr(pX[1, , drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") > > > # case of [i]-indexing with missing j: index must be have full rows > # dim of pdata.frame: 25, 3 > if (!all(c(dim(pX[2:4])[1], 2L) == dim(attr(pX[2:4], "index")))) stop("index has wrong dimension after subsetting") > if (!all(c(dim(pX[2:4, drop = TRUE])[1], 2L) == dim(attr(pX[2:4, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") Warning messages: 1: In `[.data.frame`(x, 2:4, drop = TRUE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 2:4, drop = TRUE) : 'drop' argument will be ignored > if (!all(c(dim(pX[2:4, drop = FALSE])[1], 2L) == dim(attr(pX[2:4, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") Warning messages: 1: In `[.data.frame`(x, 2:4, drop = FALSE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 2:4, drop = FALSE) : 'drop' argument will be ignored > > if (!all(c(dim(pX[1])[1], 2L) == dim(attr(pX[1], "index")))) stop("index has wrong dimension after subsetting") > if (!all(c(dim(pX[1, drop = TRUE])[1], 2L) == dim(attr(pX[1, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") Warning messages: 1: In `[.data.frame`(x, 1, drop = TRUE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1, drop = TRUE) : 'drop' argument will be ignored > if (!all(c(dim(pX[1, drop = FALSE])[1], 2L) == dim(attr(pX[1, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") Warning messages: 1: In `[.data.frame`(x, 1, drop = FALSE) : 'drop' argument will be ignored 2: In `[.data.frame`(x, 1, drop = FALSE) : 'drop' argument will be ignored > > > ####### test return values (named) numeric(0) etc and especially NULL > > ## compare pdata.frame() to data.frame() in case of subsetting with non-existent return values > # firm 31 is non-existent > # valueNonExistent is non-existent > > pGrunfeld[pGrunfeld$firm == "31"] data frame with 0 columns and 200 rows > > Grunfeld[Grunfeld$firm == "31"] data frame with 0 columns and 200 rows > > > pGrunfeld[pGrunfeld$firm == "31", "value"] named numeric(0) > > Grunfeld[Grunfeld$firm == "31", "value"] numeric(0) > > #### since R 3.4.0 the following two cases gave a warning which was pacified in rev. 626 > pGrunfeld[pGrunfeld$firm == "31", "valueNonExistent"] NULL > > Grunfeld[Grunfeld$firm == "31", "valueNonExistent"] NULL > > > # with existent firm 19 > pGrunfeld[pGrunfeld$firm == "19", "valueNonExistent"] NULL > > Grunfeld[Grunfeld$firm == "19", "valueNonExistent"] NULL > > > > > proc.time() user system elapsed 2.68 0.42 3.20 plm/inst/tests/test_fixef.R0000644000176200001440000000761014124132276015452 0ustar liggesusers### Test of fixef ### ### (1): general tests ### (2): consistency with summary.plm ### ### see also: ### * test file test_within_intercept.R for consistency checks ### between functions fixef and within_intercept ### * test file test_fixef_comp_lm_plm.R for a comparison of the fixed effects to LSDV models via lm() ############# (1): general run tests ############# library(plm) data("Grunfeld", package = "plm") # balanced models gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") gt <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") gtw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") f_level <- fixef(gi, type = "level") f_level_robust_mat <- fixef(gi, type = "level", vcov = vcovHC(gi)) # vcov is matrix f_level_robust_func <- fixef(gi, type = "level", vcov = vcovHC) # vcov is function print(attr(f_level, "se")) print(attr(f_level_robust_func, "se")) print(summary(f_level), digits = 8) print(summary(f_level_robust_func), digits = 8) f_level_t <- fixef(gt, type = "level") f_level_t_robust_func <- fixef(gt, type = "level", vcov = vcovHC) # vcov is function print(attr(f_level_t, "se")) print(attr(f_level_t_robust_func, "se")) print(summary(f_level_t), digits = 8) print(summary(f_level_t_robust_func), digits = 8) f_level_d <- fixef(gtw, type = "level") f_level_d_robust_func <- fixef(gtw, type = "level", vcov = vcovHC) # vcov is function print(attr(f_level_d, "se")) print(attr(f_level_d_robust_func, "se")) print(summary(f_level_d), digits = 8) print(summary(f_level_d_robust_func), digits = 8) # just run tests for type = "dmean" and type = "dfirst" fixef(gi, type = "dmean") fixef(gt, type = "dmean") fixef(gtw, effect = "individual", type = "dmean") fixef(gtw, effect = "time", type = "dmean") fixef(gtw, effect = "twoways", type = "dmean") fixef(gi, type = "dfirst") fixef(gt, type = "dfirst") fixef(gtw, effect = "individual", type = "dfirst") fixef(gtw, effect = "time", type = "dfirst") fixef(gtw, effect = "twoways", type = "dfirst") fixef(gtw, effect = "twoways", type = "level") ############# (2): consistency with summary.plm ############# # compare summary.plm to summary.fixef( , type = "dfirst") mod_pool <- plm(inv ~ value + capital + factor(firm), data = Grunfeld, model = "pooling") sum_mod_pool <- summary(mod_pool) f_dfirst <- fixef(gi, type = "dfirst") sum_f_dfirst <- summary(f_dfirst) if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Estimate"], sum_f_dfirst[ , "Estimate"], check.attributes = FALSE))) stop("estimates diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Std. Error"], sum_f_dfirst[ , "Std. Error"], check.attributes = FALSE))) stop("standard errors diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "t-value"], sum_f_dfirst[ , "t-value"], check.attributes = FALSE))) stop("t-values diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") if(!isTRUE(all.equal(sum_mod_pool[["coefficients"]][-c(1:3) , "Pr(>|t|)"], sum_f_dfirst[ , "Pr(>|t|)"], check.attributes = FALSE))) stop("p-values diverge: summary.plm vs. summary.fixef(..., type = \"dfirst\")") ###### compare to package lfe: ## Standard errors are bootstrapped in lfe ## -> different SE results compared to plm ## -> different SE results for every new call # # library(lfe) # data("Grunfeld", package = "plm") # mod_felm <- felm(inv ~ value + capital | firm, data = Grunfeld) # summary(mod_felm) # # fe_lfe <- getfe(mod_felm, se = TRUE, bN = 50) # print(fe_lfe) # sum_f_level <- summary(f_level) # print(sum_f_level) plm/inst/tests/test_pvcm.Rout.save0000644000176200001440000036362514126007076017017 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Test of pvcm > # > # residuals should be of class c("pseries", "numeric) [since rev. 713] > # > > library(plm) > data("Produc", package = "plm") > zw <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") > zr <- pvcm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") > > print(zw$residuals) ALABAMA.1 ALABAMA.2 ALABAMA.3 ALABAMA.4 -2.784630e-02 1.383510e-02 2.577634e-02 2.092742e-02 ALABAMA.5 ALABAMA.6 ALABAMA.7 ALABAMA.8 -1.838635e-02 1.829207e-02 4.174781e-03 -2.029554e-02 ALABAMA.9 ALABAMA.10 ALABAMA.11 ALABAMA.12 -2.158995e-02 -1.608098e-02 -3.575963e-02 -1.404029e-02 ALABAMA.13 ALABAMA.14 ALABAMA.15 ALABAMA.16 -1.429039e-02 5.610193e-03 2.144429e-02 3.049732e-02 ALABAMA.17 ARIZONA.18 ARIZONA.19 ARIZONA.20 2.773194e-02 -1.167610e-02 1.830009e-02 1.071088e-02 ARIZONA.21 ARIZONA.22 ARIZONA.23 ARIZONA.24 -7.780213e-03 -2.331784e-02 4.445025e-03 5.914372e-03 ARIZONA.25 ARIZONA.26 ARIZONA.27 ARIZONA.28 1.387280e-02 4.613659e-03 7.245242e-04 4.199142e-04 ARIZONA.29 ARIZONA.30 ARIZONA.31 ARIZONA.32 -6.887961e-03 -2.383551e-02 -3.664123e-03 -5.115862e-03 ARIZONA.33 ARIZONA.34 ARKANSAS.35 ARKANSAS.36 1.370727e-03 2.190562e-02 -2.480017e-02 5.533086e-04 ARKANSAS.37 ARKANSAS.38 ARKANSAS.39 ARKANSAS.40 3.630756e-02 2.981028e-02 -6.032021e-03 2.115390e-03 ARKANSAS.41 ARKANSAS.42 ARKANSAS.43 ARKANSAS.44 -1.871883e-02 -1.778363e-02 -8.087211e-03 -1.827031e-02 ARKANSAS.45 ARKANSAS.46 ARKANSAS.47 ARKANSAS.48 -2.519145e-02 5.305858e-03 4.351819e-03 1.358953e-03 ARKANSAS.49 ARKANSAS.50 ARKANSAS.51 CALIFORNIA.52 1.438849e-02 2.344727e-03 2.234723e-02 -3.720384e-03 CALIFORNIA.53 CALIFORNIA.54 CALIFORNIA.55 CALIFORNIA.56 3.845621e-03 5.487535e-03 -6.807072e-03 -1.753898e-02 CALIFORNIA.57 CALIFORNIA.58 CALIFORNIA.59 CALIFORNIA.60 1.117601e-02 1.498366e-02 1.556449e-02 1.139312e-02 CALIFORNIA.61 CALIFORNIA.62 CALIFORNIA.63 CALIFORNIA.64 -2.763856e-03 -6.146694e-03 -4.236254e-02 -2.775454e-02 CALIFORNIA.65 CALIFORNIA.66 CALIFORNIA.67 CALIFORNIA.68 1.509588e-03 9.038197e-03 2.106124e-02 1.303461e-02 COLORADO.69 COLORADO.70 COLORADO.71 COLORADO.72 -1.516181e-02 4.697943e-03 -4.765959e-03 1.250179e-02 COLORADO.73 COLORADO.74 COLORADO.75 COLORADO.76 -3.549464e-03 2.168866e-03 1.387069e-02 5.895767e-03 COLORADO.77 COLORADO.78 COLORADO.79 COLORADO.80 2.458483e-03 -2.451444e-04 -1.009144e-02 -6.822043e-03 COLORADO.81 COLORADO.82 COLORADO.83 COLORADO.84 -6.319155e-03 -1.218252e-03 -1.420828e-03 4.917400e-03 COLORADO.85 CONNECTICUT.86 CONNECTICUT.87 CONNECTICUT.88 3.083159e-03 -2.643478e-02 1.360983e-03 2.168305e-02 CONNECTICUT.89 CONNECTICUT.90 CONNECTICUT.91 CONNECTICUT.92 2.305605e-02 -1.154249e-02 -3.172177e-02 4.275466e-02 CONNECTICUT.93 CONNECTICUT.94 CONNECTICUT.95 CONNECTICUT.96 3.165183e-02 9.307457e-03 -1.457874e-02 -4.914892e-02 CONNECTICUT.97 CONNECTICUT.98 CONNECTICUT.99 CONNECTICUT.100 -2.602057e-02 -4.170906e-02 -3.024500e-03 2.224411e-02 CONNECTICUT.101 CONNECTICUT.102 DELAWARE.103 DELAWARE.104 3.734511e-02 1.477758e-02 -1.588738e-02 1.425444e-03 DELAWARE.105 DELAWARE.106 DELAWARE.107 DELAWARE.108 -1.999020e-03 4.159452e-02 -2.569928e-02 -3.964339e-03 DELAWARE.109 DELAWARE.110 DELAWARE.111 DELAWARE.112 1.426597e-02 3.651801e-02 6.140999e-04 -3.597826e-02 DELAWARE.113 DELAWARE.114 DELAWARE.115 DELAWARE.116 -4.766308e-02 -1.550997e-02 1.239372e-02 3.314620e-02 DELAWARE.117 DELAWARE.118 DELAWARE.119 FLORIDA.120 1.264274e-02 -8.967390e-03 3.068004e-03 -1.091538e-03 FLORIDA.121 FLORIDA.122 FLORIDA.123 FLORIDA.124 -4.839938e-03 -1.191272e-04 1.384049e-02 -1.094641e-04 FLORIDA.125 FLORIDA.126 FLORIDA.127 FLORIDA.128 3.033621e-03 1.861103e-02 3.792548e-03 -4.688881e-03 FLORIDA.129 FLORIDA.130 FLORIDA.131 FLORIDA.132 -8.724000e-03 -1.862728e-02 -1.025231e-02 -1.974326e-02 FLORIDA.133 FLORIDA.134 FLORIDA.135 FLORIDA.136 -9.449469e-04 -1.592931e-03 6.386656e-03 2.506932e-02 GEORGIA.137 GEORGIA.138 GEORGIA.139 GEORGIA.140 -1.587016e-02 1.132871e-02 2.119717e-02 6.690145e-03 GEORGIA.141 GEORGIA.142 GEORGIA.143 GEORGIA.144 -1.892810e-02 2.326513e-04 7.692612e-03 1.689957e-02 GEORGIA.145 GEORGIA.146 GEORGIA.147 GEORGIA.148 -7.034004e-03 -1.180972e-02 -2.529726e-02 -1.301519e-02 GEORGIA.149 GEORGIA.150 GEORGIA.151 GEORGIA.152 -1.159810e-02 1.439403e-02 1.901063e-02 -7.565688e-04 GEORGIA.153 IDAHO.154 IDAHO.155 IDAHO.156 6.863585e-03 1.959912e-02 -2.542472e-02 -1.076719e-02 IDAHO.157 IDAHO.158 IDAHO.159 IDAHO.160 -1.876944e-03 2.442251e-02 6.495507e-03 1.439773e-02 IDAHO.161 IDAHO.162 IDAHO.163 IDAHO.164 -1.717405e-02 -3.060920e-03 -2.177473e-02 -1.787043e-03 IDAHO.165 IDAHO.166 IDAHO.167 IDAHO.168 -1.083341e-02 -2.597953e-02 2.655308e-03 -2.054770e-03 IDAHO.169 IDAHO.170 ILLINOIS.171 ILLINOIS.172 3.206565e-02 2.109748e-02 -1.333784e-03 2.856468e-03 ILLINOIS.173 ILLINOIS.174 ILLINOIS.175 ILLINOIS.176 1.295623e-02 1.927578e-02 -1.828254e-02 -3.058082e-02 ILLINOIS.177 ILLINOIS.178 ILLINOIS.179 ILLINOIS.180 -1.936555e-03 3.475024e-04 6.414427e-03 -2.558462e-02 ILLINOIS.181 ILLINOIS.182 ILLINOIS.183 ILLINOIS.184 -4.837295e-02 -4.476182e-04 -1.243160e-02 -1.304067e-02 ILLINOIS.185 ILLINOIS.186 ILLINOIS.187 INDIANA.188 2.327708e-02 3.085146e-02 5.603221e-02 -9.835585e-03 INDIANA.189 INDIANA.190 INDIANA.191 INDIANA.192 1.622850e-02 4.057175e-03 1.886850e-02 -1.673771e-02 INDIANA.193 INDIANA.194 INDIANA.195 INDIANA.196 -2.080075e-02 -3.466260e-03 -6.823615e-03 -9.814636e-03 INDIANA.197 INDIANA.198 INDIANA.199 INDIANA.200 -2.302129e-02 -2.381779e-02 1.792367e-02 -1.095133e-04 INDIANA.201 INDIANA.202 INDIANA.203 INDIANA.204 4.716922e-04 2.061579e-02 1.981031e-02 1.645151e-02 IOWA.205 IOWA.206 IOWA.207 IOWA.208 -2.921646e-03 -9.102124e-03 1.106896e-02 3.026834e-02 IOWA.209 IOWA.210 IOWA.211 IOWA.212 -2.338372e-02 -3.527714e-03 2.197806e-04 -4.152423e-03 IOWA.213 IOWA.214 IOWA.215 IOWA.216 -8.873614e-03 8.380588e-04 1.702764e-04 2.699055e-02 IOWA.217 IOWA.218 IOWA.219 IOWA.220 7.456707e-03 -3.253337e-02 2.803530e-03 1.506421e-02 IOWA.221 KANSAS.222 KANSAS.223 KANSAS.224 -1.038579e-02 -1.549354e-02 1.957049e-02 2.313640e-02 KANSAS.225 KANSAS.226 KANSAS.227 KANSAS.228 1.316554e-02 -8.656662e-03 -3.502461e-03 -3.112552e-02 KANSAS.229 KANSAS.230 KANSAS.231 KANSAS.232 -9.952810e-03 -1.050510e-02 2.094366e-02 -5.398649e-03 KANSAS.233 KANSAS.234 KANSAS.235 KANSAS.236 -2.718945e-02 -2.097860e-02 -1.761376e-02 1.170965e-02 KANSAS.237 KANSAS.238 KENTUCKY.239 KENTUCKY.240 1.344772e-02 4.844309e-02 -7.497095e-03 5.576079e-03 KENTUCKY.241 KENTUCKY.242 KENTUCKY.243 KENTUCKY.244 1.257227e-02 2.265419e-02 1.760319e-03 -2.921331e-02 KENTUCKY.245 KENTUCKY.246 KENTUCKY.247 KENTUCKY.248 -1.001315e-02 4.766151e-03 -6.597084e-03 -1.393529e-02 KENTUCKY.249 KENTUCKY.250 KENTUCKY.251 KENTUCKY.252 -3.122085e-02 8.726779e-03 -8.641607e-03 -2.957107e-03 KENTUCKY.253 KENTUCKY.254 KENTUCKY.255 LOUISIANA.256 3.273277e-02 1.382077e-02 7.466168e-03 -7.526357e-03 LOUISIANA.257 LOUISIANA.258 LOUISIANA.259 LOUISIANA.260 2.594283e-02 3.660483e-02 1.666357e-02 -3.068202e-02 LOUISIANA.261 LOUISIANA.262 LOUISIANA.263 LOUISIANA.264 -6.440261e-02 -1.423655e-02 3.022714e-03 2.060340e-02 LOUISIANA.265 LOUISIANA.266 LOUISIANA.267 LOUISIANA.268 6.118172e-03 -1.742925e-02 9.896352e-03 3.498407e-03 LOUISIANA.269 LOUISIANA.270 LOUISIANA.271 LOUISIANA.272 -2.917173e-03 7.619249e-03 1.905540e-02 -1.183097e-02 MAINE.273 MAINE.274 MAINE.275 MAINE.276 -2.540597e-02 -6.795338e-03 1.335807e-02 2.970486e-02 MAINE.277 MAINE.278 MAINE.279 MAINE.280 9.927548e-03 -2.296865e-03 7.136648e-03 -7.087680e-03 MAINE.281 MAINE.282 MAINE.283 MAINE.284 -8.466031e-03 -1.844592e-02 -2.779265e-02 -3.924306e-03 MAINE.285 MAINE.286 MAINE.287 MAINE.288 6.871866e-03 1.729564e-02 1.305114e-02 9.291594e-03 MAINE.289 MARYLAND.290 MARYLAND.291 MARYLAND.292 -6.422598e-03 -8.085625e-03 1.988118e-03 1.832082e-02 MARYLAND.293 MARYLAND.294 MARYLAND.295 MARYLAND.296 6.014388e-03 -3.199599e-02 -4.863238e-03 3.042477e-02 MARYLAND.297 MARYLAND.298 MARYLAND.299 MARYLAND.300 1.341414e-02 4.061395e-03 -1.382740e-02 -3.383973e-02 MARYLAND.301 MARYLAND.302 MARYLAND.303 MARYLAND.304 -7.398166e-03 -1.902691e-03 -2.408771e-03 3.555209e-03 MARYLAND.305 MARYLAND.306 MASSACHUSETTS.307 MASSACHUSETTS.308 1.166296e-02 1.487981e-02 -2.379499e-02 2.781885e-03 MASSACHUSETTS.309 MASSACHUSETTS.310 MASSACHUSETTS.311 MASSACHUSETTS.312 1.549368e-02 3.212097e-02 -2.091898e-02 -1.134036e-02 MASSACHUSETTS.313 MASSACHUSETTS.314 MASSACHUSETTS.315 MASSACHUSETTS.316 3.876338e-02 3.365015e-02 2.918541e-04 -2.083442e-02 MASSACHUSETTS.317 MASSACHUSETTS.318 MASSACHUSETTS.319 MASSACHUSETTS.320 -4.926144e-02 -3.573653e-02 -3.385728e-02 -3.867327e-03 MASSACHUSETTS.321 MASSACHUSETTS.322 MASSACHUSETTS.323 MICHIGAN.324 2.775298e-02 4.323947e-02 5.516959e-03 -2.876377e-02 MICHIGAN.325 MICHIGAN.326 MICHIGAN.327 MICHIGAN.328 3.200065e-03 1.309492e-02 1.732426e-02 -2.970527e-03 MICHIGAN.329 MICHIGAN.330 MICHIGAN.331 MICHIGAN.332 2.019914e-02 -4.393522e-03 1.365610e-02 2.863445e-04 MICHIGAN.333 MICHIGAN.334 MICHIGAN.335 MICHIGAN.336 -1.825329e-02 -1.592364e-02 -1.038121e-02 4.418515e-03 MICHIGAN.337 MICHIGAN.338 MICHIGAN.339 MICHIGAN.340 -2.426791e-03 -7.145938e-03 6.972265e-03 1.110708e-02 MINNESOTA.341 MINNESOTA.342 MINNESOTA.343 MINNESOTA.344 -1.608595e-02 1.712794e-02 2.088196e-02 3.360899e-02 MINNESOTA.345 MINNESOTA.346 MINNESOTA.347 MINNESOTA.348 -1.408910e-02 -2.347343e-02 9.725807e-03 6.016706e-03 MINNESOTA.349 MINNESOTA.350 MINNESOTA.351 MINNESOTA.352 -1.706010e-02 -3.949246e-02 -5.814078e-02 -2.923871e-02 MINNESOTA.353 MINNESOTA.354 MINNESOTA.355 MINNESOTA.356 -1.260110e-02 4.293990e-04 2.315789e-02 3.287636e-02 MINNESOTA.357 MISSISSIPPI.358 MISSISSIPPI.359 MISSISSIPPI.360 6.635659e-02 -4.397914e-03 7.095488e-03 1.259341e-02 MISSISSIPPI.361 MISSISSIPPI.362 MISSISSIPPI.363 MISSISSIPPI.364 2.156677e-02 -3.712315e-02 -2.454944e-02 4.901769e-03 MISSISSIPPI.365 MISSISSIPPI.366 MISSISSIPPI.367 MISSISSIPPI.368 2.299973e-02 1.370377e-02 -1.072032e-03 -3.371248e-02 MISSISSIPPI.369 MISSISSIPPI.370 MISSISSIPPI.371 MISSISSIPPI.372 5.067184e-03 8.718913e-04 -9.348648e-03 1.737495e-02 MISSISSIPPI.373 MISSISSIPPI.374 MISSOURI.375 MISSOURI.376 -2.946131e-03 6.974838e-03 -2.650674e-02 1.454276e-02 MISSOURI.377 MISSOURI.378 MISSOURI.379 MISSOURI.380 2.647845e-02 2.196990e-02 -2.555746e-02 -1.390241e-02 MISSOURI.381 MISSOURI.382 MISSOURI.383 MISSOURI.384 8.443044e-03 1.895892e-02 3.991070e-03 -2.167280e-02 MISSOURI.385 MISSOURI.386 MISSOURI.387 MISSOURI.388 -3.948942e-02 -1.414610e-02 -1.376554e-02 1.563457e-02 MISSOURI.389 MISSOURI.390 MISSOURI.391 MONTANA.392 2.238929e-02 1.378153e-02 8.850948e-03 2.781074e-02 MONTANA.393 MONTANA.394 MONTANA.395 MONTANA.396 -2.461481e-02 9.106641e-03 1.514286e-02 -8.193485e-03 MONTANA.397 MONTANA.398 MONTANA.399 MONTANA.400 -1.424893e-02 -1.420288e-02 -4.191108e-02 -2.986629e-03 MONTANA.401 MONTANA.402 MONTANA.403 MONTANA.404 6.895739e-03 2.594081e-02 3.739503e-02 2.626124e-02 MONTANA.405 MONTANA.406 MONTANA.407 MONTANA.408 2.363969e-02 4.357338e-04 -4.901818e-02 -1.745249e-02 NEBRASKA.409 NEBRASKA.410 NEBRASKA.411 NEBRASKA.412 -7.224605e-03 2.255937e-02 2.139327e-02 1.153225e-02 NEBRASKA.413 NEBRASKA.414 NEBRASKA.415 NEBRASKA.416 -4.688112e-02 -2.799607e-03 -2.517715e-03 -2.258671e-02 NEBRASKA.417 NEBRASKA.418 NEBRASKA.419 NEBRASKA.420 1.021460e-03 -1.544706e-03 -2.308474e-02 2.043308e-02 NEBRASKA.421 NEBRASKA.422 NEBRASKA.423 NEBRASKA.424 -1.480806e-03 -2.503995e-02 7.020996e-03 -4.080630e-04 NEBRASKA.425 NEVADA.426 NEVADA.427 NEVADA.428 4.960759e-02 5.654215e-03 9.802668e-03 1.063117e-02 NEVADA.429 NEVADA.430 NEVADA.431 NEVADA.432 3.234228e-03 -2.445343e-02 -1.537698e-02 4.261622e-03 NEVADA.433 NEVADA.434 NEVADA.435 NEVADA.436 -5.636553e-03 -4.915593e-03 -4.482037e-03 4.765187e-03 NEVADA.437 NEVADA.438 NEVADA.439 NEVADA.440 8.767232e-03 1.117708e-04 1.462960e-02 -4.444933e-03 NEVADA.441 NEVADA.442 NEW_HAMPSHIRE.443 NEW_HAMPSHIRE.444 -2.311545e-03 -2.366291e-04 -1.871464e-02 1.816736e-02 NEW_HAMPSHIRE.445 NEW_HAMPSHIRE.446 NEW_HAMPSHIRE.447 NEW_HAMPSHIRE.448 6.035153e-03 -1.474427e-03 -6.828326e-03 -2.215374e-03 NEW_HAMPSHIRE.449 NEW_HAMPSHIRE.450 NEW_HAMPSHIRE.451 NEW_HAMPSHIRE.452 9.797515e-03 -5.623412e-03 1.619459e-02 3.752014e-03 NEW_HAMPSHIRE.453 NEW_HAMPSHIRE.454 NEW_HAMPSHIRE.455 NEW_HAMPSHIRE.456 -2.154266e-02 -1.651873e-02 -1.054802e-02 2.366872e-02 NEW_HAMPSHIRE.457 NEW_HAMPSHIRE.458 NEW_HAMPSHIRE.459 NEW_JERSEY.460 3.634272e-03 8.221642e-03 -6.005683e-03 -2.471505e-02 NEW_JERSEY.461 NEW_JERSEY.462 NEW_JERSEY.463 NEW_JERSEY.464 7.736547e-03 2.235296e-02 2.600601e-02 -1.332577e-02 NEW_JERSEY.465 NEW_JERSEY.466 NEW_JERSEY.467 NEW_JERSEY.468 -1.106436e-02 2.746862e-02 2.286481e-02 -4.271583e-03 NEW_JERSEY.469 NEW_JERSEY.470 NEW_JERSEY.471 NEW_JERSEY.472 -2.016519e-02 -4.549796e-02 -2.965721e-02 -1.076374e-02 NEW_JERSEY.473 NEW_JERSEY.474 NEW_JERSEY.475 NEW_JERSEY.476 1.152712e-02 1.005670e-02 1.233475e-02 1.911334e-02 NEW_MEXICO.477 NEW_MEXICO.478 NEW_MEXICO.479 NEW_MEXICO.480 8.042003e-03 4.488232e-03 -4.931393e-03 -3.310492e-03 NEW_MEXICO.481 NEW_MEXICO.482 NEW_MEXICO.483 NEW_MEXICO.484 6.032721e-03 1.355010e-02 -2.945636e-02 -2.330855e-02 NEW_MEXICO.485 NEW_MEXICO.486 NEW_MEXICO.487 NEW_MEXICO.488 -1.953674e-02 -1.624744e-03 1.025325e-02 2.858730e-02 NEW_MEXICO.489 NEW_MEXICO.490 NEW_MEXICO.491 NEW_MEXICO.492 1.329949e-02 1.177302e-02 1.452997e-02 7.117398e-03 NEW_MEXICO.493 NEW_YORK.494 NEW_YORK.495 NEW_YORK.496 -3.550520e-02 -2.586331e-02 3.008814e-04 1.616690e-02 NEW_YORK.497 NEW_YORK.498 NEW_YORK.499 NEW_YORK.500 3.098270e-02 3.972129e-03 7.047485e-03 1.470258e-02 NEW_YORK.501 NEW_YORK.502 NEW_YORK.503 NEW_YORK.504 2.956127e-02 8.403077e-03 -1.712243e-02 -4.233509e-02 NEW_YORK.505 NEW_YORK.506 NEW_YORK.507 NEW_YORK.508 -3.797252e-02 -3.800929e-02 -3.905444e-03 1.123304e-02 NEW_YORK.509 NEW_YORK.510 NORTH_CAROLINA.511 NORTH_CAROLINA.512 1.722282e-02 2.561520e-02 -2.457323e-02 2.977531e-03 NORTH_CAROLINA.513 NORTH_CAROLINA.514 NORTH_CAROLINA.515 NORTH_CAROLINA.516 2.529918e-02 1.467512e-02 -1.384586e-02 -7.549222e-06 NORTH_CAROLINA.517 NORTH_CAROLINA.518 NORTH_CAROLINA.519 NORTH_CAROLINA.520 1.144399e-03 9.376815e-03 1.117094e-02 -2.447057e-02 NORTH_CAROLINA.521 NORTH_CAROLINA.522 NORTH_CAROLINA.523 NORTH_CAROLINA.524 -2.816447e-02 4.350759e-03 -2.219808e-03 1.034018e-02 NORTH_CAROLINA.525 NORTH_CAROLINA.526 NORTH_CAROLINA.527 NORTH_DAKOTA.528 1.398175e-02 6.896910e-03 -6.932100e-03 -7.621332e-02 NORTH_DAKOTA.529 NORTH_DAKOTA.530 NORTH_DAKOTA.531 NORTH_DAKOTA.532 -7.841914e-03 3.772906e-03 1.189647e-01 2.252290e-02 NORTH_DAKOTA.533 NORTH_DAKOTA.534 NORTH_DAKOTA.535 NORTH_DAKOTA.536 2.144934e-02 -3.423648e-02 -6.258538e-02 9.768093e-04 NORTH_DAKOTA.537 NORTH_DAKOTA.538 NORTH_DAKOTA.539 NORTH_DAKOTA.540 -6.591251e-04 -8.649252e-03 5.622750e-02 4.444511e-02 NORTH_DAKOTA.541 NORTH_DAKOTA.542 NORTH_DAKOTA.543 NORTH_DAKOTA.544 -2.942149e-02 -6.772085e-03 -1.804289e-02 -2.393739e-02 OHIO.545 OHIO.546 OHIO.547 OHIO.548 -5.299663e-03 7.966681e-03 1.366271e-02 2.206536e-02 OHIO.549 OHIO.550 OHIO.551 OHIO.552 -1.715014e-02 -3.079426e-02 -4.586659e-03 -1.041588e-03 OHIO.553 OHIO.554 OHIO.555 OHIO.556 -5.414135e-03 -2.718136e-02 -4.466624e-02 -1.726336e-02 OHIO.557 OHIO.558 OHIO.559 OHIO.560 -1.481648e-02 1.355154e-02 3.658924e-02 3.682096e-02 OHIO.561 OKLAHOMA.562 OKLAHOMA.563 OKLAHOMA.564 3.755739e-02 6.084112e-03 9.879466e-03 1.662073e-02 OKLAHOMA.565 OKLAHOMA.566 OKLAHOMA.567 OKLAHOMA.568 1.784361e-02 -1.537302e-02 -1.317798e-02 -3.351283e-02 OKLAHOMA.569 OKLAHOMA.570 OKLAHOMA.571 OKLAHOMA.572 -1.483466e-02 -5.114080e-03 2.860454e-03 1.341257e-02 OKLAHOMA.573 OKLAHOMA.574 OKLAHOMA.575 OKLAHOMA.576 -1.150295e-02 1.831630e-02 8.163643e-03 2.914906e-03 OKLAHOMA.577 OKLAHOMA.578 OREGON.579 OREGON.580 -8.708918e-03 6.128645e-03 -1.872889e-02 -8.097574e-03 OREGON.581 OREGON.582 OREGON.583 OREGON.584 5.279235e-03 8.559307e-03 2.765980e-03 8.396921e-03 OREGON.585 OREGON.586 OREGON.587 OREGON.588 2.866662e-02 8.927369e-03 -5.380834e-03 -8.970038e-03 OREGON.589 OREGON.590 OREGON.591 OREGON.592 -7.181992e-03 -9.084292e-03 -1.864087e-02 -5.032937e-03 OREGON.593 OREGON.594 OREGON.595 PENNSYLVANIA.596 4.585749e-03 1.151243e-02 2.423815e-03 -1.189953e-02 PENNSYLVANIA.597 PENNSYLVANIA.598 PENNSYLVANIA.599 PENNSYLVANIA.600 -5.408371e-03 1.026538e-02 2.402653e-02 -1.119198e-02 PENNSYLVANIA.601 PENNSYLVANIA.602 PENNSYLVANIA.603 PENNSYLVANIA.604 -2.836665e-02 1.101472e-02 2.027020e-02 4.988519e-03 PENNSYLVANIA.605 PENNSYLVANIA.606 PENNSYLVANIA.607 PENNSYLVANIA.608 -1.736759e-02 -4.833131e-02 -3.651688e-03 -1.200734e-02 PENNSYLVANIA.609 PENNSYLVANIA.610 PENNSYLVANIA.611 PENNSYLVANIA.612 1.417608e-02 1.679898e-02 1.178139e-02 2.490266e-02 RHODE_ISLAND.613 RHODE_ISLAND.614 RHODE_ISLAND.615 RHODE_ISLAND.616 -2.708466e-02 1.866191e-02 2.773626e-02 2.582029e-02 RHODE_ISLAND.617 RHODE_ISLAND.618 RHODE_ISLAND.619 RHODE_ISLAND.620 -2.930238e-02 1.575003e-03 1.141857e-03 2.151035e-02 RHODE_ISLAND.621 RHODE_ISLAND.622 RHODE_ISLAND.623 RHODE_ISLAND.624 -1.434565e-02 -2.044935e-02 -4.215650e-02 -5.855269e-03 RHODE_ISLAND.625 RHODE_ISLAND.626 RHODE_ISLAND.627 RHODE_ISLAND.628 1.266342e-02 1.809076e-03 -5.144278e-03 6.134847e-03 RHODE_ISLAND.629 SOUTH_CAROLINA.630 SOUTH_CAROLINA.631 SOUTH_CAROLINA.632 2.728508e-02 3.890581e-03 1.495545e-02 1.856852e-02 SOUTH_CAROLINA.633 SOUTH_CAROLINA.634 SOUTH_CAROLINA.635 SOUTH_CAROLINA.636 9.412705e-03 -2.313247e-02 -1.175550e-02 -1.064155e-02 SOUTH_CAROLINA.637 SOUTH_CAROLINA.638 SOUTH_CAROLINA.639 SOUTH_CAROLINA.640 -9.038632e-03 -1.318140e-02 -7.050567e-03 -3.794354e-02 SOUTH_CAROLINA.641 SOUTH_CAROLINA.642 SOUTH_CAROLINA.643 SOUTH_CAROLINA.644 -2.411764e-02 -8.540698e-03 3.378751e-02 5.309876e-02 SOUTH_CAROLINA.645 SOUTH_CAROLINA.646 SOUTH_DAKOTA.647 SOUTH_DAKOTA.648 2.455087e-02 -1.286239e-02 -1.685987e-02 -3.450122e-03 SOUTH_DAKOTA.649 SOUTH_DAKOTA.650 SOUTH_DAKOTA.651 SOUTH_DAKOTA.652 -6.715654e-03 4.109882e-02 -5.572250e-03 3.061755e-02 SOUTH_DAKOTA.653 SOUTH_DAKOTA.654 SOUTH_DAKOTA.655 SOUTH_DAKOTA.656 -3.538357e-02 -1.384869e-02 -2.925910e-03 2.302824e-02 SOUTH_DAKOTA.657 SOUTH_DAKOTA.658 SOUTH_DAKOTA.659 SOUTH_DAKOTA.660 -1.242471e-02 1.347537e-02 2.825773e-02 -2.827767e-02 SOUTH_DAKOTA.661 SOUTH_DAKOTA.662 SOUTH_DAKOTA.663 TENNESSE.664 -4.837484e-03 -6.698440e-03 5.166702e-04 -2.272058e-02 TENNESSE.665 TENNESSE.666 TENNESSE.667 TENNESSE.668 8.035851e-03 2.625440e-02 2.513314e-02 -2.624214e-02 TENNESSE.669 TENNESSE.670 TENNESSE.671 TENNESSE.672 -6.517993e-03 1.488415e-03 4.886255e-03 3.250159e-03 TENNESSE.673 TENNESSE.674 TENNESSE.675 TENNESSE.676 -1.361826e-02 -2.737387e-02 -1.170707e-02 -2.311890e-03 TENNESSE.677 TENNESSE.678 TENNESSE.679 TENNESSE.680 1.647003e-02 2.084426e-02 5.955214e-03 -1.825931e-03 TEXAS.681 TEXAS.682 TEXAS.683 TEXAS.684 8.941530e-04 -3.745829e-03 -5.693630e-03 -6.924342e-03 TEXAS.685 TEXAS.686 TEXAS.687 TEXAS.688 -1.854557e-02 -5.868618e-03 1.219069e-02 2.969866e-02 TEXAS.689 TEXAS.690 TEXAS.691 TEXAS.692 3.153451e-02 7.472839e-03 -7.436183e-03 -1.682041e-02 TEXAS.693 TEXAS.694 TEXAS.695 TEXAS.696 -1.995150e-02 -2.339647e-03 -8.506010e-03 1.082326e-02 TEXAS.697 UTAH.698 UTAH.699 UTAH.700 3.217622e-03 2.013414e-03 5.593255e-03 7.028402e-03 UTAH.701 UTAH.702 UTAH.703 UTAH.704 7.326269e-03 -1.335056e-02 -1.585052e-02 -3.127349e-03 UTAH.705 UTAH.706 UTAH.707 UTAH.708 2.411241e-03 3.258599e-03 -7.554744e-03 1.891177e-03 UTAH.709 UTAH.710 UTAH.711 UTAH.712 8.262571e-03 -1.419713e-02 3.354434e-03 1.909191e-02 UTAH.713 UTAH.714 VERMONT.715 VERMONT.716 3.543436e-03 -9.694400e-03 -3.218815e-02 1.270522e-02 VERMONT.717 VERMONT.718 VERMONT.719 VERMONT.720 3.224440e-02 2.166727e-02 -1.466462e-02 -1.832062e-02 VERMONT.721 VERMONT.722 VERMONT.723 VERMONT.724 2.384841e-02 -9.625144e-03 5.167637e-04 -1.686073e-02 VERMONT.725 VERMONT.726 VERMONT.727 VERMONT.728 -1.429762e-02 -2.016448e-02 -2.272562e-02 1.595901e-02 VERMONT.729 VERMONT.730 VERMONT.731 VIRGINIA.732 1.831161e-02 3.654830e-02 -1.295399e-02 -4.307948e-03 VIRGINIA.733 VIRGINIA.734 VIRGINIA.735 VIRGINIA.736 4.781660e-04 2.191150e-03 9.937808e-03 -1.093166e-02 VIRGINIA.737 VIRGINIA.738 VIRGINIA.739 VIRGINIA.740 -8.553580e-04 2.540669e-03 1.099453e-02 6.982861e-03 VIRGINIA.741 VIRGINIA.742 VIRGINIA.743 VIRGINIA.744 -1.045294e-02 -2.450568e-02 -3.478990e-03 -9.527830e-03 VIRGINIA.745 VIRGINIA.746 VIRGINIA.747 VIRGINIA.748 1.643792e-02 1.997751e-02 1.632388e-03 -7.112596e-03 WASHINGTON.749 WASHINGTON.750 WASHINGTON.751 WASHINGTON.752 -4.357003e-03 -6.139003e-04 -5.276426e-04 1.819691e-03 WASHINGTON.753 WASHINGTON.754 WASHINGTON.755 WASHINGTON.756 -5.764001e-03 1.473219e-02 -4.927791e-03 -2.584610e-04 WASHINGTON.757 WASHINGTON.758 WASHINGTON.759 WASHINGTON.760 6.091760e-03 7.101852e-03 -5.186472e-03 -1.394926e-02 WASHINGTON.761 WASHINGTON.762 WASHINGTON.763 WASHINGTON.764 -3.931647e-03 1.122468e-02 7.369093e-04 -1.318386e-02 WASHINGTON.765 WEST_VIRGINIA.766 WEST_VIRGINIA.767 WEST_VIRGINIA.768 1.099296e-02 -1.050506e-02 4.761551e-03 2.967615e-02 WEST_VIRGINIA.769 WEST_VIRGINIA.770 WEST_VIRGINIA.771 WEST_VIRGINIA.772 2.872011e-02 -2.594033e-02 -4.020839e-02 -2.410764e-02 WEST_VIRGINIA.773 WEST_VIRGINIA.774 WEST_VIRGINIA.775 WEST_VIRGINIA.776 -5.446329e-04 8.992151e-03 1.281983e-03 -1.029131e-02 WEST_VIRGINIA.777 WEST_VIRGINIA.778 WEST_VIRGINIA.779 WEST_VIRGINIA.780 1.994241e-02 -4.145154e-03 -1.593895e-02 1.049819e-02 WEST_VIRGINIA.781 WEST_VIRGINIA.782 WISCONSIN.783 WISCONSIN.784 7.372210e-03 2.043670e-02 -6.924132e-03 2.837128e-04 WISCONSIN.785 WISCONSIN.786 WISCONSIN.787 WISCONSIN.788 1.379002e-02 4.108974e-02 -6.906662e-03 -2.758799e-02 WISCONSIN.789 WISCONSIN.790 WISCONSIN.791 WISCONSIN.792 -1.977495e-02 -4.735693e-03 1.025076e-02 -1.764233e-02 WISCONSIN.793 WISCONSIN.794 WISCONSIN.795 WISCONSIN.796 -3.809215e-02 -2.045588e-03 9.323202e-03 7.252596e-03 WISCONSIN.797 WISCONSIN.798 WISCONSIN.799 WYOMING.800 1.188596e-02 1.030624e-02 1.952726e-02 8.034937e-02 WYOMING.801 WYOMING.802 WYOMING.803 WYOMING.804 7.885823e-03 3.116807e-03 -2.216514e-02 1.295030e-02 WYOMING.805 WYOMING.806 WYOMING.807 WYOMING.808 -1.530456e-02 -8.280789e-02 -7.268214e-02 -2.412972e-02 WYOMING.809 WYOMING.810 WYOMING.811 WYOMING.812 5.426246e-04 6.077214e-02 5.074829e-02 3.223871e-02 WYOMING.813 WYOMING.814 WYOMING.815 WYOMING.816 1.714261e-02 -2.256130e-03 -7.721989e-03 -3.867911e-02 ALABAMA.1 ALABAMA.2 ALABAMA.3 ALABAMA.4 -2.784630e-02 1.383510e-02 2.577634e-02 2.092742e-02 ALABAMA.5 ALABAMA.6 ALABAMA.7 ALABAMA.8 -1.838635e-02 1.829207e-02 4.174781e-03 -2.029554e-02 ALABAMA.9 ALABAMA.10 ALABAMA.11 ALABAMA.12 -2.158995e-02 -1.608098e-02 -3.575963e-02 -1.404029e-02 ALABAMA.13 ALABAMA.14 ALABAMA.15 ALABAMA.16 -1.429039e-02 5.610193e-03 2.144429e-02 3.049732e-02 ALABAMA.17 ARIZONA.18 ARIZONA.19 ARIZONA.20 2.773194e-02 -1.167610e-02 1.830009e-02 1.071088e-02 ARIZONA.21 ARIZONA.22 ARIZONA.23 ARIZONA.24 -7.780213e-03 -2.331784e-02 4.445025e-03 5.914372e-03 ARIZONA.25 ARIZONA.26 ARIZONA.27 ARIZONA.28 1.387280e-02 4.613659e-03 7.245242e-04 4.199142e-04 ARIZONA.29 ARIZONA.30 ARIZONA.31 ARIZONA.32 -6.887961e-03 -2.383551e-02 -3.664123e-03 -5.115862e-03 ARIZONA.33 ARIZONA.34 ARKANSAS.35 ARKANSAS.36 1.370727e-03 2.190562e-02 -2.480017e-02 5.533086e-04 ARKANSAS.37 ARKANSAS.38 ARKANSAS.39 ARKANSAS.40 3.630756e-02 2.981028e-02 -6.032021e-03 2.115390e-03 ARKANSAS.41 ARKANSAS.42 ARKANSAS.43 ARKANSAS.44 -1.871883e-02 -1.778363e-02 -8.087211e-03 -1.827031e-02 ARKANSAS.45 ARKANSAS.46 ARKANSAS.47 ARKANSAS.48 -2.519145e-02 5.305858e-03 4.351819e-03 1.358953e-03 ARKANSAS.49 ARKANSAS.50 ARKANSAS.51 CALIFORNIA.52 1.438849e-02 2.344727e-03 2.234723e-02 -3.720384e-03 CALIFORNIA.53 CALIFORNIA.54 CALIFORNIA.55 CALIFORNIA.56 3.845621e-03 5.487535e-03 -6.807072e-03 -1.753898e-02 CALIFORNIA.57 CALIFORNIA.58 CALIFORNIA.59 CALIFORNIA.60 1.117601e-02 1.498366e-02 1.556449e-02 1.139312e-02 CALIFORNIA.61 CALIFORNIA.62 CALIFORNIA.63 CALIFORNIA.64 -2.763856e-03 -6.146694e-03 -4.236254e-02 -2.775454e-02 CALIFORNIA.65 CALIFORNIA.66 CALIFORNIA.67 CALIFORNIA.68 1.509588e-03 9.038197e-03 2.106124e-02 1.303461e-02 COLORADO.69 COLORADO.70 COLORADO.71 COLORADO.72 -1.516181e-02 4.697943e-03 -4.765959e-03 1.250179e-02 COLORADO.73 COLORADO.74 COLORADO.75 COLORADO.76 -3.549464e-03 2.168866e-03 1.387069e-02 5.895767e-03 COLORADO.77 COLORADO.78 COLORADO.79 COLORADO.80 2.458483e-03 -2.451444e-04 -1.009144e-02 -6.822043e-03 COLORADO.81 COLORADO.82 COLORADO.83 COLORADO.84 -6.319155e-03 -1.218252e-03 -1.420828e-03 4.917400e-03 COLORADO.85 CONNECTICUT.86 CONNECTICUT.87 CONNECTICUT.88 3.083159e-03 -2.643478e-02 1.360983e-03 2.168305e-02 CONNECTICUT.89 CONNECTICUT.90 CONNECTICUT.91 CONNECTICUT.92 2.305605e-02 -1.154249e-02 -3.172177e-02 4.275466e-02 CONNECTICUT.93 CONNECTICUT.94 CONNECTICUT.95 CONNECTICUT.96 3.165183e-02 9.307457e-03 -1.457874e-02 -4.914892e-02 CONNECTICUT.97 CONNECTICUT.98 CONNECTICUT.99 CONNECTICUT.100 -2.602057e-02 -4.170906e-02 -3.024500e-03 2.224411e-02 CONNECTICUT.101 CONNECTICUT.102 DELAWARE.103 DELAWARE.104 3.734511e-02 1.477758e-02 -1.588738e-02 1.425444e-03 DELAWARE.105 DELAWARE.106 DELAWARE.107 DELAWARE.108 -1.999020e-03 4.159452e-02 -2.569928e-02 -3.964339e-03 DELAWARE.109 DELAWARE.110 DELAWARE.111 DELAWARE.112 1.426597e-02 3.651801e-02 6.140999e-04 -3.597826e-02 DELAWARE.113 DELAWARE.114 DELAWARE.115 DELAWARE.116 -4.766308e-02 -1.550997e-02 1.239372e-02 3.314620e-02 DELAWARE.117 DELAWARE.118 DELAWARE.119 FLORIDA.120 1.264274e-02 -8.967390e-03 3.068004e-03 -1.091538e-03 FLORIDA.121 FLORIDA.122 FLORIDA.123 FLORIDA.124 -4.839938e-03 -1.191272e-04 1.384049e-02 -1.094641e-04 FLORIDA.125 FLORIDA.126 FLORIDA.127 FLORIDA.128 3.033621e-03 1.861103e-02 3.792548e-03 -4.688881e-03 FLORIDA.129 FLORIDA.130 FLORIDA.131 FLORIDA.132 -8.724000e-03 -1.862728e-02 -1.025231e-02 -1.974326e-02 FLORIDA.133 FLORIDA.134 FLORIDA.135 FLORIDA.136 -9.449469e-04 -1.592931e-03 6.386656e-03 2.506932e-02 GEORGIA.137 GEORGIA.138 GEORGIA.139 GEORGIA.140 -1.587016e-02 1.132871e-02 2.119717e-02 6.690145e-03 GEORGIA.141 GEORGIA.142 GEORGIA.143 GEORGIA.144 -1.892810e-02 2.326513e-04 7.692612e-03 1.689957e-02 GEORGIA.145 GEORGIA.146 GEORGIA.147 GEORGIA.148 -7.034004e-03 -1.180972e-02 -2.529726e-02 -1.301519e-02 GEORGIA.149 GEORGIA.150 GEORGIA.151 GEORGIA.152 -1.159810e-02 1.439403e-02 1.901063e-02 -7.565688e-04 GEORGIA.153 IDAHO.154 IDAHO.155 IDAHO.156 6.863585e-03 1.959912e-02 -2.542472e-02 -1.076719e-02 IDAHO.157 IDAHO.158 IDAHO.159 IDAHO.160 -1.876944e-03 2.442251e-02 6.495507e-03 1.439773e-02 IDAHO.161 IDAHO.162 IDAHO.163 IDAHO.164 -1.717405e-02 -3.060920e-03 -2.177473e-02 -1.787043e-03 IDAHO.165 IDAHO.166 IDAHO.167 IDAHO.168 -1.083341e-02 -2.597953e-02 2.655308e-03 -2.054770e-03 IDAHO.169 IDAHO.170 ILLINOIS.171 ILLINOIS.172 3.206565e-02 2.109748e-02 -1.333784e-03 2.856468e-03 ILLINOIS.173 ILLINOIS.174 ILLINOIS.175 ILLINOIS.176 1.295623e-02 1.927578e-02 -1.828254e-02 -3.058082e-02 ILLINOIS.177 ILLINOIS.178 ILLINOIS.179 ILLINOIS.180 -1.936555e-03 3.475024e-04 6.414427e-03 -2.558462e-02 ILLINOIS.181 ILLINOIS.182 ILLINOIS.183 ILLINOIS.184 -4.837295e-02 -4.476182e-04 -1.243160e-02 -1.304067e-02 ILLINOIS.185 ILLINOIS.186 ILLINOIS.187 INDIANA.188 2.327708e-02 3.085146e-02 5.603221e-02 -9.835585e-03 INDIANA.189 INDIANA.190 INDIANA.191 INDIANA.192 1.622850e-02 4.057175e-03 1.886850e-02 -1.673771e-02 INDIANA.193 INDIANA.194 INDIANA.195 INDIANA.196 -2.080075e-02 -3.466260e-03 -6.823615e-03 -9.814636e-03 INDIANA.197 INDIANA.198 INDIANA.199 INDIANA.200 -2.302129e-02 -2.381779e-02 1.792367e-02 -1.095133e-04 INDIANA.201 INDIANA.202 INDIANA.203 INDIANA.204 4.716922e-04 2.061579e-02 1.981031e-02 1.645151e-02 IOWA.205 IOWA.206 IOWA.207 IOWA.208 -2.921646e-03 -9.102124e-03 1.106896e-02 3.026834e-02 IOWA.209 IOWA.210 IOWA.211 IOWA.212 -2.338372e-02 -3.527714e-03 2.197806e-04 -4.152423e-03 IOWA.213 IOWA.214 IOWA.215 IOWA.216 -8.873614e-03 8.380588e-04 1.702764e-04 2.699055e-02 IOWA.217 IOWA.218 IOWA.219 IOWA.220 7.456707e-03 -3.253337e-02 2.803530e-03 1.506421e-02 IOWA.221 KANSAS.222 KANSAS.223 KANSAS.224 -1.038579e-02 -1.549354e-02 1.957049e-02 2.313640e-02 KANSAS.225 KANSAS.226 KANSAS.227 KANSAS.228 1.316554e-02 -8.656662e-03 -3.502461e-03 -3.112552e-02 KANSAS.229 KANSAS.230 KANSAS.231 KANSAS.232 -9.952810e-03 -1.050510e-02 2.094366e-02 -5.398649e-03 KANSAS.233 KANSAS.234 KANSAS.235 KANSAS.236 -2.718945e-02 -2.097860e-02 -1.761376e-02 1.170965e-02 KANSAS.237 KANSAS.238 KENTUCKY.239 KENTUCKY.240 1.344772e-02 4.844309e-02 -7.497095e-03 5.576079e-03 KENTUCKY.241 KENTUCKY.242 KENTUCKY.243 KENTUCKY.244 1.257227e-02 2.265419e-02 1.760319e-03 -2.921331e-02 KENTUCKY.245 KENTUCKY.246 KENTUCKY.247 KENTUCKY.248 -1.001315e-02 4.766151e-03 -6.597084e-03 -1.393529e-02 KENTUCKY.249 KENTUCKY.250 KENTUCKY.251 KENTUCKY.252 -3.122085e-02 8.726779e-03 -8.641607e-03 -2.957107e-03 KENTUCKY.253 KENTUCKY.254 KENTUCKY.255 LOUISIANA.256 3.273277e-02 1.382077e-02 7.466168e-03 -7.526357e-03 LOUISIANA.257 LOUISIANA.258 LOUISIANA.259 LOUISIANA.260 2.594283e-02 3.660483e-02 1.666357e-02 -3.068202e-02 LOUISIANA.261 LOUISIANA.262 LOUISIANA.263 LOUISIANA.264 -6.440261e-02 -1.423655e-02 3.022714e-03 2.060340e-02 LOUISIANA.265 LOUISIANA.266 LOUISIANA.267 LOUISIANA.268 6.118172e-03 -1.742925e-02 9.896352e-03 3.498407e-03 LOUISIANA.269 LOUISIANA.270 LOUISIANA.271 LOUISIANA.272 -2.917173e-03 7.619249e-03 1.905540e-02 -1.183097e-02 MAINE.273 MAINE.274 MAINE.275 MAINE.276 -2.540597e-02 -6.795338e-03 1.335807e-02 2.970486e-02 MAINE.277 MAINE.278 MAINE.279 MAINE.280 9.927548e-03 -2.296865e-03 7.136648e-03 -7.087680e-03 MAINE.281 MAINE.282 MAINE.283 MAINE.284 -8.466031e-03 -1.844592e-02 -2.779265e-02 -3.924306e-03 MAINE.285 MAINE.286 MAINE.287 MAINE.288 6.871866e-03 1.729564e-02 1.305114e-02 9.291594e-03 MAINE.289 MARYLAND.290 MARYLAND.291 MARYLAND.292 -6.422598e-03 -8.085625e-03 1.988118e-03 1.832082e-02 MARYLAND.293 MARYLAND.294 MARYLAND.295 MARYLAND.296 6.014388e-03 -3.199599e-02 -4.863238e-03 3.042477e-02 MARYLAND.297 MARYLAND.298 MARYLAND.299 MARYLAND.300 1.341414e-02 4.061395e-03 -1.382740e-02 -3.383973e-02 MARYLAND.301 MARYLAND.302 MARYLAND.303 MARYLAND.304 -7.398166e-03 -1.902691e-03 -2.408771e-03 3.555209e-03 MARYLAND.305 MARYLAND.306 MASSACHUSETTS.307 MASSACHUSETTS.308 1.166296e-02 1.487981e-02 -2.379499e-02 2.781885e-03 MASSACHUSETTS.309 MASSACHUSETTS.310 MASSACHUSETTS.311 MASSACHUSETTS.312 1.549368e-02 3.212097e-02 -2.091898e-02 -1.134036e-02 MASSACHUSETTS.313 MASSACHUSETTS.314 MASSACHUSETTS.315 MASSACHUSETTS.316 3.876338e-02 3.365015e-02 2.918541e-04 -2.083442e-02 MASSACHUSETTS.317 MASSACHUSETTS.318 MASSACHUSETTS.319 MASSACHUSETTS.320 -4.926144e-02 -3.573653e-02 -3.385728e-02 -3.867327e-03 MASSACHUSETTS.321 MASSACHUSETTS.322 MASSACHUSETTS.323 MICHIGAN.324 2.775298e-02 4.323947e-02 5.516959e-03 -2.876377e-02 MICHIGAN.325 MICHIGAN.326 MICHIGAN.327 MICHIGAN.328 3.200065e-03 1.309492e-02 1.732426e-02 -2.970527e-03 MICHIGAN.329 MICHIGAN.330 MICHIGAN.331 MICHIGAN.332 2.019914e-02 -4.393522e-03 1.365610e-02 2.863445e-04 MICHIGAN.333 MICHIGAN.334 MICHIGAN.335 MICHIGAN.336 -1.825329e-02 -1.592364e-02 -1.038121e-02 4.418515e-03 MICHIGAN.337 MICHIGAN.338 MICHIGAN.339 MICHIGAN.340 -2.426791e-03 -7.145938e-03 6.972265e-03 1.110708e-02 MINNESOTA.341 MINNESOTA.342 MINNESOTA.343 MINNESOTA.344 -1.608595e-02 1.712794e-02 2.088196e-02 3.360899e-02 MINNESOTA.345 MINNESOTA.346 MINNESOTA.347 MINNESOTA.348 -1.408910e-02 -2.347343e-02 9.725807e-03 6.016706e-03 MINNESOTA.349 MINNESOTA.350 MINNESOTA.351 MINNESOTA.352 -1.706010e-02 -3.949246e-02 -5.814078e-02 -2.923871e-02 MINNESOTA.353 MINNESOTA.354 MINNESOTA.355 MINNESOTA.356 -1.260110e-02 4.293990e-04 2.315789e-02 3.287636e-02 MINNESOTA.357 MISSISSIPPI.358 MISSISSIPPI.359 MISSISSIPPI.360 6.635659e-02 -4.397914e-03 7.095488e-03 1.259341e-02 MISSISSIPPI.361 MISSISSIPPI.362 MISSISSIPPI.363 MISSISSIPPI.364 2.156677e-02 -3.712315e-02 -2.454944e-02 4.901769e-03 MISSISSIPPI.365 MISSISSIPPI.366 MISSISSIPPI.367 MISSISSIPPI.368 2.299973e-02 1.370377e-02 -1.072032e-03 -3.371248e-02 MISSISSIPPI.369 MISSISSIPPI.370 MISSISSIPPI.371 MISSISSIPPI.372 5.067184e-03 8.718913e-04 -9.348648e-03 1.737495e-02 MISSISSIPPI.373 MISSISSIPPI.374 MISSOURI.375 MISSOURI.376 -2.946131e-03 6.974838e-03 -2.650674e-02 1.454276e-02 MISSOURI.377 MISSOURI.378 MISSOURI.379 MISSOURI.380 2.647845e-02 2.196990e-02 -2.555746e-02 -1.390241e-02 MISSOURI.381 MISSOURI.382 MISSOURI.383 MISSOURI.384 8.443044e-03 1.895892e-02 3.991070e-03 -2.167280e-02 MISSOURI.385 MISSOURI.386 MISSOURI.387 MISSOURI.388 -3.948942e-02 -1.414610e-02 -1.376554e-02 1.563457e-02 MISSOURI.389 MISSOURI.390 MISSOURI.391 MONTANA.392 2.238929e-02 1.378153e-02 8.850948e-03 2.781074e-02 MONTANA.393 MONTANA.394 MONTANA.395 MONTANA.396 -2.461481e-02 9.106641e-03 1.514286e-02 -8.193485e-03 MONTANA.397 MONTANA.398 MONTANA.399 MONTANA.400 -1.424893e-02 -1.420288e-02 -4.191108e-02 -2.986629e-03 MONTANA.401 MONTANA.402 MONTANA.403 MONTANA.404 6.895739e-03 2.594081e-02 3.739503e-02 2.626124e-02 MONTANA.405 MONTANA.406 MONTANA.407 MONTANA.408 2.363969e-02 4.357338e-04 -4.901818e-02 -1.745249e-02 NEBRASKA.409 NEBRASKA.410 NEBRASKA.411 NEBRASKA.412 -7.224605e-03 2.255937e-02 2.139327e-02 1.153225e-02 NEBRASKA.413 NEBRASKA.414 NEBRASKA.415 NEBRASKA.416 -4.688112e-02 -2.799607e-03 -2.517715e-03 -2.258671e-02 NEBRASKA.417 NEBRASKA.418 NEBRASKA.419 NEBRASKA.420 1.021460e-03 -1.544706e-03 -2.308474e-02 2.043308e-02 NEBRASKA.421 NEBRASKA.422 NEBRASKA.423 NEBRASKA.424 -1.480806e-03 -2.503995e-02 7.020996e-03 -4.080630e-04 NEBRASKA.425 NEVADA.426 NEVADA.427 NEVADA.428 4.960759e-02 5.654215e-03 9.802668e-03 1.063117e-02 NEVADA.429 NEVADA.430 NEVADA.431 NEVADA.432 3.234228e-03 -2.445343e-02 -1.537698e-02 4.261622e-03 NEVADA.433 NEVADA.434 NEVADA.435 NEVADA.436 -5.636553e-03 -4.915593e-03 -4.482037e-03 4.765187e-03 NEVADA.437 NEVADA.438 NEVADA.439 NEVADA.440 8.767232e-03 1.117708e-04 1.462960e-02 -4.444933e-03 NEVADA.441 NEVADA.442 NEW_HAMPSHIRE.443 NEW_HAMPSHIRE.444 -2.311545e-03 -2.366291e-04 -1.871464e-02 1.816736e-02 NEW_HAMPSHIRE.445 NEW_HAMPSHIRE.446 NEW_HAMPSHIRE.447 NEW_HAMPSHIRE.448 6.035153e-03 -1.474427e-03 -6.828326e-03 -2.215374e-03 NEW_HAMPSHIRE.449 NEW_HAMPSHIRE.450 NEW_HAMPSHIRE.451 NEW_HAMPSHIRE.452 9.797515e-03 -5.623412e-03 1.619459e-02 3.752014e-03 NEW_HAMPSHIRE.453 NEW_HAMPSHIRE.454 NEW_HAMPSHIRE.455 NEW_HAMPSHIRE.456 -2.154266e-02 -1.651873e-02 -1.054802e-02 2.366872e-02 NEW_HAMPSHIRE.457 NEW_HAMPSHIRE.458 NEW_HAMPSHIRE.459 NEW_JERSEY.460 3.634272e-03 8.221642e-03 -6.005683e-03 -2.471505e-02 NEW_JERSEY.461 NEW_JERSEY.462 NEW_JERSEY.463 NEW_JERSEY.464 7.736547e-03 2.235296e-02 2.600601e-02 -1.332577e-02 NEW_JERSEY.465 NEW_JERSEY.466 NEW_JERSEY.467 NEW_JERSEY.468 -1.106436e-02 2.746862e-02 2.286481e-02 -4.271583e-03 NEW_JERSEY.469 NEW_JERSEY.470 NEW_JERSEY.471 NEW_JERSEY.472 -2.016519e-02 -4.549796e-02 -2.965721e-02 -1.076374e-02 NEW_JERSEY.473 NEW_JERSEY.474 NEW_JERSEY.475 NEW_JERSEY.476 1.152712e-02 1.005670e-02 1.233475e-02 1.911334e-02 NEW_MEXICO.477 NEW_MEXICO.478 NEW_MEXICO.479 NEW_MEXICO.480 8.042003e-03 4.488232e-03 -4.931393e-03 -3.310492e-03 NEW_MEXICO.481 NEW_MEXICO.482 NEW_MEXICO.483 NEW_MEXICO.484 6.032721e-03 1.355010e-02 -2.945636e-02 -2.330855e-02 NEW_MEXICO.485 NEW_MEXICO.486 NEW_MEXICO.487 NEW_MEXICO.488 -1.953674e-02 -1.624744e-03 1.025325e-02 2.858730e-02 NEW_MEXICO.489 NEW_MEXICO.490 NEW_MEXICO.491 NEW_MEXICO.492 1.329949e-02 1.177302e-02 1.452997e-02 7.117398e-03 NEW_MEXICO.493 NEW_YORK.494 NEW_YORK.495 NEW_YORK.496 -3.550520e-02 -2.586331e-02 3.008814e-04 1.616690e-02 NEW_YORK.497 NEW_YORK.498 NEW_YORK.499 NEW_YORK.500 3.098270e-02 3.972129e-03 7.047485e-03 1.470258e-02 NEW_YORK.501 NEW_YORK.502 NEW_YORK.503 NEW_YORK.504 2.956127e-02 8.403077e-03 -1.712243e-02 -4.233509e-02 NEW_YORK.505 NEW_YORK.506 NEW_YORK.507 NEW_YORK.508 -3.797252e-02 -3.800929e-02 -3.905444e-03 1.123304e-02 NEW_YORK.509 NEW_YORK.510 NORTH_CAROLINA.511 NORTH_CAROLINA.512 1.722282e-02 2.561520e-02 -2.457323e-02 2.977531e-03 NORTH_CAROLINA.513 NORTH_CAROLINA.514 NORTH_CAROLINA.515 NORTH_CAROLINA.516 2.529918e-02 1.467512e-02 -1.384586e-02 -7.549222e-06 NORTH_CAROLINA.517 NORTH_CAROLINA.518 NORTH_CAROLINA.519 NORTH_CAROLINA.520 1.144399e-03 9.376815e-03 1.117094e-02 -2.447057e-02 NORTH_CAROLINA.521 NORTH_CAROLINA.522 NORTH_CAROLINA.523 NORTH_CAROLINA.524 -2.816447e-02 4.350759e-03 -2.219808e-03 1.034018e-02 NORTH_CAROLINA.525 NORTH_CAROLINA.526 NORTH_CAROLINA.527 NORTH_DAKOTA.528 1.398175e-02 6.896910e-03 -6.932100e-03 -7.621332e-02 NORTH_DAKOTA.529 NORTH_DAKOTA.530 NORTH_DAKOTA.531 NORTH_DAKOTA.532 -7.841914e-03 3.772906e-03 1.189647e-01 2.252290e-02 NORTH_DAKOTA.533 NORTH_DAKOTA.534 NORTH_DAKOTA.535 NORTH_DAKOTA.536 2.144934e-02 -3.423648e-02 -6.258538e-02 9.768093e-04 NORTH_DAKOTA.537 NORTH_DAKOTA.538 NORTH_DAKOTA.539 NORTH_DAKOTA.540 -6.591251e-04 -8.649252e-03 5.622750e-02 4.444511e-02 NORTH_DAKOTA.541 NORTH_DAKOTA.542 NORTH_DAKOTA.543 NORTH_DAKOTA.544 -2.942149e-02 -6.772085e-03 -1.804289e-02 -2.393739e-02 OHIO.545 OHIO.546 OHIO.547 OHIO.548 -5.299663e-03 7.966681e-03 1.366271e-02 2.206536e-02 OHIO.549 OHIO.550 OHIO.551 OHIO.552 -1.715014e-02 -3.079426e-02 -4.586659e-03 -1.041588e-03 OHIO.553 OHIO.554 OHIO.555 OHIO.556 -5.414135e-03 -2.718136e-02 -4.466624e-02 -1.726336e-02 OHIO.557 OHIO.558 OHIO.559 OHIO.560 -1.481648e-02 1.355154e-02 3.658924e-02 3.682096e-02 OHIO.561 OKLAHOMA.562 OKLAHOMA.563 OKLAHOMA.564 3.755739e-02 6.084112e-03 9.879466e-03 1.662073e-02 OKLAHOMA.565 OKLAHOMA.566 OKLAHOMA.567 OKLAHOMA.568 1.784361e-02 -1.537302e-02 -1.317798e-02 -3.351283e-02 OKLAHOMA.569 OKLAHOMA.570 OKLAHOMA.571 OKLAHOMA.572 -1.483466e-02 -5.114080e-03 2.860454e-03 1.341257e-02 OKLAHOMA.573 OKLAHOMA.574 OKLAHOMA.575 OKLAHOMA.576 -1.150295e-02 1.831630e-02 8.163643e-03 2.914906e-03 OKLAHOMA.577 OKLAHOMA.578 OREGON.579 OREGON.580 -8.708918e-03 6.128645e-03 -1.872889e-02 -8.097574e-03 OREGON.581 OREGON.582 OREGON.583 OREGON.584 5.279235e-03 8.559307e-03 2.765980e-03 8.396921e-03 OREGON.585 OREGON.586 OREGON.587 OREGON.588 2.866662e-02 8.927369e-03 -5.380834e-03 -8.970038e-03 OREGON.589 OREGON.590 OREGON.591 OREGON.592 -7.181992e-03 -9.084292e-03 -1.864087e-02 -5.032937e-03 OREGON.593 OREGON.594 OREGON.595 PENNSYLVANIA.596 4.585749e-03 1.151243e-02 2.423815e-03 -1.189953e-02 PENNSYLVANIA.597 PENNSYLVANIA.598 PENNSYLVANIA.599 PENNSYLVANIA.600 -5.408371e-03 1.026538e-02 2.402653e-02 -1.119198e-02 PENNSYLVANIA.601 PENNSYLVANIA.602 PENNSYLVANIA.603 PENNSYLVANIA.604 -2.836665e-02 1.101472e-02 2.027020e-02 4.988519e-03 PENNSYLVANIA.605 PENNSYLVANIA.606 PENNSYLVANIA.607 PENNSYLVANIA.608 -1.736759e-02 -4.833131e-02 -3.651688e-03 -1.200734e-02 PENNSYLVANIA.609 PENNSYLVANIA.610 PENNSYLVANIA.611 PENNSYLVANIA.612 1.417608e-02 1.679898e-02 1.178139e-02 2.490266e-02 RHODE_ISLAND.613 RHODE_ISLAND.614 RHODE_ISLAND.615 RHODE_ISLAND.616 -2.708466e-02 1.866191e-02 2.773626e-02 2.582029e-02 RHODE_ISLAND.617 RHODE_ISLAND.618 RHODE_ISLAND.619 RHODE_ISLAND.620 -2.930238e-02 1.575003e-03 1.141857e-03 2.151035e-02 RHODE_ISLAND.621 RHODE_ISLAND.622 RHODE_ISLAND.623 RHODE_ISLAND.624 -1.434565e-02 -2.044935e-02 -4.215650e-02 -5.855269e-03 RHODE_ISLAND.625 RHODE_ISLAND.626 RHODE_ISLAND.627 RHODE_ISLAND.628 1.266342e-02 1.809076e-03 -5.144278e-03 6.134847e-03 RHODE_ISLAND.629 SOUTH_CAROLINA.630 SOUTH_CAROLINA.631 SOUTH_CAROLINA.632 2.728508e-02 3.890581e-03 1.495545e-02 1.856852e-02 SOUTH_CAROLINA.633 SOUTH_CAROLINA.634 SOUTH_CAROLINA.635 SOUTH_CAROLINA.636 9.412705e-03 -2.313247e-02 -1.175550e-02 -1.064155e-02 SOUTH_CAROLINA.637 SOUTH_CAROLINA.638 SOUTH_CAROLINA.639 SOUTH_CAROLINA.640 -9.038632e-03 -1.318140e-02 -7.050567e-03 -3.794354e-02 SOUTH_CAROLINA.641 SOUTH_CAROLINA.642 SOUTH_CAROLINA.643 SOUTH_CAROLINA.644 -2.411764e-02 -8.540698e-03 3.378751e-02 5.309876e-02 SOUTH_CAROLINA.645 SOUTH_CAROLINA.646 SOUTH_DAKOTA.647 SOUTH_DAKOTA.648 2.455087e-02 -1.286239e-02 -1.685987e-02 -3.450122e-03 SOUTH_DAKOTA.649 SOUTH_DAKOTA.650 SOUTH_DAKOTA.651 SOUTH_DAKOTA.652 -6.715654e-03 4.109882e-02 -5.572250e-03 3.061755e-02 SOUTH_DAKOTA.653 SOUTH_DAKOTA.654 SOUTH_DAKOTA.655 SOUTH_DAKOTA.656 -3.538357e-02 -1.384869e-02 -2.925910e-03 2.302824e-02 SOUTH_DAKOTA.657 SOUTH_DAKOTA.658 SOUTH_DAKOTA.659 SOUTH_DAKOTA.660 -1.242471e-02 1.347537e-02 2.825773e-02 -2.827767e-02 SOUTH_DAKOTA.661 SOUTH_DAKOTA.662 SOUTH_DAKOTA.663 TENNESSE.664 -4.837484e-03 -6.698440e-03 5.166702e-04 -2.272058e-02 TENNESSE.665 TENNESSE.666 TENNESSE.667 TENNESSE.668 8.035851e-03 2.625440e-02 2.513314e-02 -2.624214e-02 TENNESSE.669 TENNESSE.670 TENNESSE.671 TENNESSE.672 -6.517993e-03 1.488415e-03 4.886255e-03 3.250159e-03 TENNESSE.673 TENNESSE.674 TENNESSE.675 TENNESSE.676 -1.361826e-02 -2.737387e-02 -1.170707e-02 -2.311890e-03 TENNESSE.677 TENNESSE.678 TENNESSE.679 TENNESSE.680 1.647003e-02 2.084426e-02 5.955214e-03 -1.825931e-03 TEXAS.681 TEXAS.682 TEXAS.683 TEXAS.684 8.941530e-04 -3.745829e-03 -5.693630e-03 -6.924342e-03 TEXAS.685 TEXAS.686 TEXAS.687 TEXAS.688 -1.854557e-02 -5.868618e-03 1.219069e-02 2.969866e-02 TEXAS.689 TEXAS.690 TEXAS.691 TEXAS.692 3.153451e-02 7.472839e-03 -7.436183e-03 -1.682041e-02 TEXAS.693 TEXAS.694 TEXAS.695 TEXAS.696 -1.995150e-02 -2.339647e-03 -8.506010e-03 1.082326e-02 TEXAS.697 UTAH.698 UTAH.699 UTAH.700 3.217622e-03 2.013414e-03 5.593255e-03 7.028402e-03 UTAH.701 UTAH.702 UTAH.703 UTAH.704 7.326269e-03 -1.335056e-02 -1.585052e-02 -3.127349e-03 UTAH.705 UTAH.706 UTAH.707 UTAH.708 2.411241e-03 3.258599e-03 -7.554744e-03 1.891177e-03 UTAH.709 UTAH.710 UTAH.711 UTAH.712 8.262571e-03 -1.419713e-02 3.354434e-03 1.909191e-02 UTAH.713 UTAH.714 VERMONT.715 VERMONT.716 3.543436e-03 -9.694400e-03 -3.218815e-02 1.270522e-02 VERMONT.717 VERMONT.718 VERMONT.719 VERMONT.720 3.224440e-02 2.166727e-02 -1.466462e-02 -1.832062e-02 VERMONT.721 VERMONT.722 VERMONT.723 VERMONT.724 2.384841e-02 -9.625144e-03 5.167637e-04 -1.686073e-02 VERMONT.725 VERMONT.726 VERMONT.727 VERMONT.728 -1.429762e-02 -2.016448e-02 -2.272562e-02 1.595901e-02 VERMONT.729 VERMONT.730 VERMONT.731 VIRGINIA.732 1.831161e-02 3.654830e-02 -1.295399e-02 -4.307948e-03 VIRGINIA.733 VIRGINIA.734 VIRGINIA.735 VIRGINIA.736 4.781660e-04 2.191150e-03 9.937808e-03 -1.093166e-02 VIRGINIA.737 VIRGINIA.738 VIRGINIA.739 VIRGINIA.740 -8.553580e-04 2.540669e-03 1.099453e-02 6.982861e-03 VIRGINIA.741 VIRGINIA.742 VIRGINIA.743 VIRGINIA.744 -1.045294e-02 -2.450568e-02 -3.478990e-03 -9.527830e-03 VIRGINIA.745 VIRGINIA.746 VIRGINIA.747 VIRGINIA.748 1.643792e-02 1.997751e-02 1.632388e-03 -7.112596e-03 WASHINGTON.749 WASHINGTON.750 WASHINGTON.751 WASHINGTON.752 -4.357003e-03 -6.139003e-04 -5.276426e-04 1.819691e-03 WASHINGTON.753 WASHINGTON.754 WASHINGTON.755 WASHINGTON.756 -5.764001e-03 1.473219e-02 -4.927791e-03 -2.584610e-04 WASHINGTON.757 WASHINGTON.758 WASHINGTON.759 WASHINGTON.760 6.091760e-03 7.101852e-03 -5.186472e-03 -1.394926e-02 WASHINGTON.761 WASHINGTON.762 WASHINGTON.763 WASHINGTON.764 -3.931647e-03 1.122468e-02 7.369093e-04 -1.318386e-02 WASHINGTON.765 WEST_VIRGINIA.766 WEST_VIRGINIA.767 WEST_VIRGINIA.768 1.099296e-02 -1.050506e-02 4.761551e-03 2.967615e-02 WEST_VIRGINIA.769 WEST_VIRGINIA.770 WEST_VIRGINIA.771 WEST_VIRGINIA.772 2.872011e-02 -2.594033e-02 -4.020839e-02 -2.410764e-02 WEST_VIRGINIA.773 WEST_VIRGINIA.774 WEST_VIRGINIA.775 WEST_VIRGINIA.776 -5.446329e-04 8.992151e-03 1.281983e-03 -1.029131e-02 WEST_VIRGINIA.777 WEST_VIRGINIA.778 WEST_VIRGINIA.779 WEST_VIRGINIA.780 1.994241e-02 -4.145154e-03 -1.593895e-02 1.049819e-02 WEST_VIRGINIA.781 WEST_VIRGINIA.782 WISCONSIN.783 WISCONSIN.784 7.372210e-03 2.043670e-02 -6.924132e-03 2.837128e-04 WISCONSIN.785 WISCONSIN.786 WISCONSIN.787 WISCONSIN.788 1.379002e-02 4.108974e-02 -6.906662e-03 -2.758799e-02 WISCONSIN.789 WISCONSIN.790 WISCONSIN.791 WISCONSIN.792 -1.977495e-02 -4.735693e-03 1.025076e-02 -1.764233e-02 WISCONSIN.793 WISCONSIN.794 WISCONSIN.795 WISCONSIN.796 -3.809215e-02 -2.045588e-03 9.323202e-03 7.252596e-03 WISCONSIN.797 WISCONSIN.798 WISCONSIN.799 WYOMING.800 1.188596e-02 1.030624e-02 1.952726e-02 8.034937e-02 WYOMING.801 WYOMING.802 WYOMING.803 WYOMING.804 7.885823e-03 3.116807e-03 -2.216514e-02 1.295030e-02 WYOMING.805 WYOMING.806 WYOMING.807 WYOMING.808 -1.530456e-02 -8.280789e-02 -7.268214e-02 -2.412972e-02 WYOMING.809 WYOMING.810 WYOMING.811 WYOMING.812 5.426246e-04 6.077214e-02 5.074829e-02 3.223871e-02 WYOMING.813 WYOMING.814 WYOMING.815 WYOMING.816 1.714261e-02 -2.256130e-03 -7.721989e-03 -3.867911e-02 > class(zw$residuals) [1] "pseries" "numeric" > print(zw$coefficients) (Intercept) log(pcap) log(pc) log(emp) unemp ALABAMA 8.4960384 -1.442643991 0.279501016 1.83524980 0.0073545006 ARIZONA 4.6652825 -0.162708442 -0.005220745 1.07582801 -0.0036579767 ARKANSAS 3.2456536 -0.505650280 0.321247275 1.23401732 0.0014922130 CALIFORNIA 0.2793476 0.263937746 0.248403298 0.69913460 -0.0107451010 COLORADO 0.5143180 0.731379856 -0.209834096 0.74826795 -0.0039961705 CONNECTICUT 5.0302333 -0.431134765 0.453161751 0.73256902 -0.0053864641 DELAWARE -1.1751222 0.622117695 -0.318462279 1.41693168 -0.0038134886 FLORIDA 1.5253424 0.552803128 -0.250663389 0.87120938 -0.0014626098 GEORGIA 2.3034759 -0.419174405 0.085170213 1.57271222 0.0074532847 IDAHO 1.0421207 0.669179027 -0.117730415 0.64849768 -0.0022465829 ILLINOIS 2.7209986 0.267159900 0.562804445 -0.02583567 -0.0177828867 INDIANA -0.1958694 0.094433742 0.431361911 0.73159208 -0.0122411911 IOWA 0.6519703 0.315068074 -0.448937790 1.65819044 0.0129198630 KANSAS 4.2616134 -0.577090938 1.009232156 0.13734950 -0.0196568696 KENTUCKY 4.8589548 -0.339802089 0.167695130 1.03522134 0.0065278923 LOUISIANA 9.1692397 -0.766043907 0.413122049 0.68899848 -0.0110422846 MAINE 3.4194783 -0.574727885 -0.041140070 1.85593766 0.0073599832 MARYLAND 2.0836014 0.271279613 0.402774922 0.25721726 -0.0230198852 MASSACHUSETTS 4.1480748 -0.126316063 0.707872550 0.10829928 -0.0189627335 MICHIGAN -2.6289878 0.705179007 0.558204463 0.06149498 -0.0276171611 MINNESOTA 3.5131086 -0.468420802 0.282842652 1.22538453 0.0010910168 MISSISSIPPI 2.7454146 -0.509188897 0.612760021 0.87390876 -0.0001383713 MISSOURI 1.4819126 -0.100664957 0.143924926 1.19037073 -0.0023792574 MONTANA -0.3975081 0.906695490 -0.138785995 0.56898527 -0.0040704700 NEBRASKA 1.8053647 -0.623472299 0.551767246 1.31024056 0.0121187207 NEVADA 3.3304637 0.249054180 -0.164545890 0.95418780 -0.0045551636 NEW_HAMPSHIRE 4.4065779 -0.780667745 0.210132132 1.59805922 0.0039615055 NEW_JERSEY 1.3141522 0.017454286 0.220817100 0.95635811 -0.0095804572 NEW_MEXICO 1.8088567 0.090400088 0.333034832 0.63443828 -0.0045526412 NEW_YORK -3.7077921 0.093171306 -0.056573857 1.76714934 0.0086511927 NORTH_CAROLINA 2.2505857 -0.487354616 0.118923522 1.60259767 0.0068840855 NORTH_DAKOTA -3.0588977 1.031200556 0.026176397 0.60159442 -0.0150841340 OHIO -1.3583003 0.295918542 0.085197133 1.07805190 -0.0031490545 OKLAHOMA 3.2764622 0.164259723 0.271001283 0.41794500 -0.0090860260 OREGON 1.2354574 0.445167666 -0.201887776 1.02059519 -0.0045336550 PENNSYLVANIA 1.7248609 -0.108841546 0.444167530 0.73210793 -0.0070284949 RHODE_ISLAND 9.3379762 -0.577016355 0.245877611 0.46142711 -0.0191099852 SOUTH_CAROLINA 3.3022915 -1.288197300 0.392689259 2.10581712 0.0218609130 SOUTH_DAKOTA 9.1628627 -0.447357034 -0.523648862 1.53736101 0.0290171539 TENNESSE 4.1986320 -0.935719227 0.571154076 1.32848192 0.0017310495 TEXAS 1.2099713 0.582364320 -0.020745015 0.57923229 -0.0128918651 UTAH 1.9181219 0.134459770 -0.060675214 1.14524806 0.0027350512 VERMONT 5.1444050 -0.582739243 0.580579238 0.62039329 -0.0138483279 VIRGINIA 4.4370130 -0.376766084 0.199786090 1.09146532 0.0035871770 WASHINGTON 3.0425029 -0.108432994 0.328467872 0.75846943 -0.0127182870 WEST_VIRGINIA 3.7057369 -0.184318358 0.398998044 0.58982596 0.0016567262 WISCONSIN 3.5501092 -0.605349607 1.232166571 0.04221983 -0.0186540424 WYOMING 4.4713754 -0.005717267 0.144026008 0.67212383 -0.0120261384 > class(zw$coefficients) [1] "data.frame" > summary(zw) Oneway (individual) effect No-pooling model Call: pvcm(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "within") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0828078889 -0.0118150348 0.0004246566 0.0126479124 0.1189647497 Coefficients: (Intercept) log(pcap) log(pc) log(emp) Min. :-3.708 Min. :-1.4426 Min. :-0.52365 Min. :-0.02584 1st Qu.: 1.229 1st Qu.:-0.5065 1st Qu.:-0.02584 1st Qu.: 0.61569 Median : 2.733 Median :-0.1086 Median : 0.23335 Median : 0.87256 Mean : 2.672 Mean :-0.1049 Mean : 0.21825 Mean : 0.93348 3rd Qu.: 4.214 3rd Qu.: 0.2682 3rd Qu.: 0.41768 3rd Qu.: 1.25307 Max. : 9.338 Max. : 1.0312 Max. : 1.23217 Max. : 2.10582 unemp Min. :-0.027617 1st Qu.:-0.012080 Median :-0.003905 Mean :-0.003722 3rd Qu.: 0.002948 Max. : 0.029017 Total Sum of Squares: 19352 Residual Sum of Squares: 0.33009 Multiple R-Squared: 0.99998 > pwaldtest(zw) Chisq p(chisq) F p(F) df1 df2 ALABAMA 608.35870 2.405146e-130 152.08968 3.606344e-10 4 12 ARIZONA 4650.92920 0.000000e+00 1162.73230 2.028960e-15 4 12 ARKANSAS 1127.26898 9.298613e-243 281.81725 9.473034e-12 4 12 CALIFORNIA 1311.43665 1.102881e-282 327.85916 3.859918e-12 4 12 COLORADO 10200.49901 0.000000e+00 2550.12475 1.840584e-17 4 12 CONNECTICUT 282.95948 5.127218e-60 70.73987 3.063349e-08 4 12 DELAWARE 173.69088 1.687421e-36 43.42272 4.816082e-07 4 12 FLORIDA 4558.68150 0.000000e+00 1139.67037 2.287291e-15 4 12 GEORGIA 2488.67481 0.000000e+00 622.16870 8.512403e-14 4 12 IDAHO 986.69428 2.729551e-212 246.67357 2.084942e-11 4 12 ILLINOIS 63.17981 6.219594e-13 15.79495 9.992685e-05 4 12 INDIANA 289.02919 2.517767e-61 72.25730 2.712909e-08 4 12 IOWA 549.73446 1.167830e-117 137.43361 6.530903e-10 4 12 KANSAS 270.69566 2.258559e-57 67.67392 3.946158e-08 4 12 KENTUCKY 584.40233 3.679698e-125 146.10058 4.564511e-10 4 12 LOUISIANA 88.37106 2.920576e-18 22.09276 1.834764e-05 4 12 MAINE 1269.31000 1.499880e-273 317.32750 4.685542e-12 4 12 MARYLAND 541.76813 6.179148e-116 135.44203 7.113368e-10 4 12 MASSACHUSETTS 260.01564 4.524989e-55 65.00391 4.964571e-08 4 12 MICHIGAN 492.17850 3.293440e-105 123.04463 1.246602e-09 4 12 MINNESOTA 255.09049 5.210273e-54 63.77262 5.535791e-08 4 12 MISSISSIPPI 905.15764 1.271065e-194 226.28941 3.472350e-11 4 12 MISSOURI 309.22602 1.107820e-65 77.30650 1.841567e-08 4 12 MONTANA 270.41724 2.593262e-57 67.60431 3.969410e-08 4 12 NEBRASKA 289.70382 1.801051e-61 72.42596 2.676926e-08 4 12 NEVADA 9261.32661 0.000000e+00 2315.33165 3.283146e-17 4 12 NEW_HAMPSHIRE 5506.44464 0.000000e+00 1376.61116 7.387120e-16 4 12 NEW_JERSEY 373.53886 1.447747e-79 93.38471 6.194878e-09 4 12 NEW_MEXICO 1231.29696 2.613967e-265 307.82424 5.612139e-12 4 12 NEW_YORK 92.52523 3.827538e-19 23.13131 1.445009e-05 4 12 NORTH_CAROLINA 1510.13232 0.000000e+00 377.53308 1.669269e-12 4 12 NORTH_DAKOTA 144.23838 3.491932e-30 36.05959 1.342405e-06 4 12 OHIO 94.45113 1.490988e-19 23.61278 1.297635e-05 4 12 OKLAHOMA 1037.33839 2.887734e-223 259.33460 1.550294e-11 4 12 OREGON 1858.64461 0.000000e+00 464.66115 4.851134e-13 4 12 PENNSYLVANIA 86.72150 6.541313e-18 21.68037 2.022700e-05 4 12 RHODE_ISLAND 207.12437 1.103799e-43 51.78109 1.799541e-07 4 12 SOUTH_CAROLINA 826.52725 1.377735e-177 206.63181 5.939122e-11 4 12 SOUTH_DAKOTA 341.19419 1.396796e-72 85.29855 1.045367e-08 4 12 TENNESSE 1275.46135 6.956728e-275 318.86534 4.552990e-12 4 12 TEXAS 1953.19048 0.000000e+00 488.29762 3.609762e-13 4 12 UTAH 6393.09582 0.000000e+00 1598.27396 3.022273e-16 4 12 VERMONT 761.63640 1.565355e-163 190.40910 9.619474e-11 4 12 VIRGINIA 2971.90248 0.000000e+00 742.97562 2.951061e-14 4 12 WASHINGTON 5912.95778 0.000000e+00 1478.23944 4.823023e-16 4 12 WEST_VIRGINIA 148.55583 4.151249e-31 37.13896 1.142025e-06 4 12 WISCONSIN 535.63434 1.312010e-114 133.90859 7.603384e-10 4 12 WYOMING 259.30125 6.450019e-55 64.82531 5.043004e-08 4 12 > > print(zr$residuals) 1 2 3 4 5 -0.1598309367 -0.1413932393 -0.1296755830 -0.1256475777 -0.1456964364 6 7 8 9 10 -0.1365309042 -0.1446423082 -0.1442139555 -0.1364633060 -0.1315445319 11 12 13 14 15 -0.1427098604 -0.1093396729 -0.0975727602 -0.0656988168 -0.0535980386 16 17 18 19 20 -0.0540246714 -0.0428827413 0.0759103352 0.0997564004 0.0950370866 21 22 23 24 25 0.0768897259 0.0528831705 0.0639290457 0.0725393834 0.0811276232 26 27 28 29 30 0.0750457060 0.0718399680 0.0639745727 0.0403876604 0.0150391034 31 32 33 34 35 0.0367487830 0.0416402174 0.0527316508 0.0510703277 -0.1130673576 36 37 38 39 40 -0.0924886213 -0.0584793782 -0.0532266841 -0.0731200324 -0.0499345143 41 42 43 44 45 -0.0682073161 -0.0662119917 -0.0450965370 -0.0537842075 -0.0584844545 46 47 48 49 50 -0.0215891111 -0.0264839613 -0.0156284990 0.0125966876 0.0115467768 51 52 53 54 55 0.0319430523 0.1309432077 0.1401643851 0.1474190780 0.1316274236 56 57 58 59 60 0.1140338490 0.1333631854 0.1371784559 0.1341642620 0.1220706890 61 62 63 64 65 0.1062865602 0.0952180551 0.0557382750 0.0579591664 0.0841762605 66 67 68 69 70 0.0907790320 0.0999086854 0.0958525374 0.0791528968 0.0846454515 71 72 73 74 75 0.0665062630 0.0795580753 0.0696888192 0.0898118178 0.0678498934 76 77 78 79 80 0.0816156402 0.0776813714 0.0727339789 0.0682954434 0.0232702609 81 82 83 84 85 0.0247983117 0.0390754342 0.0416594317 0.0580545159 0.1021329495 86 87 88 89 90 0.0887202094 0.1128389024 0.1232671210 0.1211746686 0.0869020730 91 92 93 94 95 0.0723087346 0.1179839904 0.1105923926 0.0934360624 0.0740874022 96 97 98 99 100 0.0472500444 0.0709785864 0.0681912060 0.1166301230 0.1445452436 101 102 103 104 105 0.1670671365 0.1704912229 0.1191199193 0.1582466159 0.1751536766 106 107 108 109 110 0.2353737337 0.1567883936 0.1555175148 0.1782010027 0.1949548869 111 112 113 114 115 0.1594529838 0.1163905187 0.0765461202 0.0884067312 0.0946064996 116 117 118 119 120 0.1165526076 0.1090888188 0.0926646443 0.0805653699 -0.0096617241 121 122 123 124 125 -0.0186239923 -0.0117608708 -0.0023613885 -0.0185325162 0.0036766564 126 127 128 129 130 -0.0324805894 -0.0363664429 -0.0447357835 -0.0524199457 -0.0692300665 131 132 133 134 135 -0.0859249074 -0.0897686957 -0.0583179100 -0.0599985578 -0.0491904406 136 137 138 139 140 -0.0633346130 -0.1622358585 -0.1433245192 -0.1150387405 -0.1116258309 141 142 143 144 145 -0.1360884698 -0.1198812534 -0.1099482883 -0.0941858096 -0.1021830251 146 147 148 149 150 -0.1082588363 -0.1159370008 -0.1109792985 -0.1040512665 -0.0703075895 151 152 153 154 155 -0.0468650218 -0.0378744520 -0.0374250422 0.1024494002 0.0723875954 156 157 158 159 160 0.0739440222 0.0605897095 0.0717222560 0.0602277527 0.0443463345 161 162 163 164 165 0.0226846546 0.0315803897 0.0167405259 0.0487969134 0.0499058542 166 167 168 169 170 0.0527577266 0.0776226010 0.0664244321 0.0995343477 0.1234050896 171 172 173 174 175 -0.0256020189 0.0008763130 0.0306857535 0.0430901269 0.0113816172 176 177 178 179 180 0.0127338637 0.0197892172 0.0271429458 0.0248464032 -0.0018031319 181 182 183 184 185 -0.0408186904 0.0024287418 -0.0033491086 0.0125854286 0.0492305448 186 187 188 189 190 0.0532757198 0.0773111276 -0.1219588079 -0.0874772519 -0.0853803563 191 192 193 194 195 -0.0641089268 -0.1008984167 -0.1063832669 -0.0803532337 -0.0792084873 196 197 198 199 200 -0.0830739002 -0.0959210717 -0.1046025854 -0.0784008135 -0.0984684764 201 202 203 204 205 -0.0880688188 -0.0563994126 -0.0502429816 -0.0460927908 0.0065401774 206 207 208 209 210 0.0014370612 0.0251962035 0.0463453695 -0.0039428028 0.0175119200 211 212 213 214 215 0.0084362380 0.0020364914 0.0109333727 0.0148444660 0.0087847608 216 217 218 219 220 0.0898559472 0.0575481832 0.0114008665 0.0509217713 0.0676891861 221 222 223 224 225 0.1217919559 0.1235952091 0.1493743004 0.1377473836 0.1108651183 226 227 228 229 230 0.0750195226 0.0627550231 0.0489290369 0.0238469070 0.0110133633 231 232 233 234 235 0.0179189470 -0.0065368029 0.0035545939 0.0212340902 0.0301007919 236 237 238 239 240 0.0432453251 0.0583574851 0.0759645234 0.1014196190 0.1097746384 241 242 243 244 245 0.1071656495 0.1092031224 0.0818241174 0.0725210233 0.0691422185 246 247 248 249 250 0.0725889446 0.0671088624 0.0605746534 0.0555859690 0.0917240949 251 252 253 254 255 0.0951256075 0.1118609617 0.1260298803 0.1113179467 0.1054175447 256 257 258 259 260 0.4252508586 0.4394857759 0.4148240137 0.3710134697 0.3026745017 261 262 263 264 265 0.2517813065 0.2666513429 0.2576580499 0.2450929990 0.2227648228 266 267 268 269 270 0.1970614888 0.2001076217 0.1885930078 0.1718599857 0.1796799208 271 272 273 274 275 0.1691935345 0.1407033947 -0.1150351576 -0.0984253304 -0.0825082562 276 277 278 279 280 -0.0702033459 -0.0892952242 -0.1018486010 -0.0603618128 -0.0614032261 281 282 283 284 285 -0.0684272922 -0.0650253261 -0.0781390862 -0.0467207972 -0.0326703764 286 287 288 289 290 0.0012972026 0.0059476437 0.0134397546 0.0137787442 0.0436149920 291 292 293 294 295 0.0510394054 0.0639239009 0.0718257410 0.0457359239 0.0452756241 296 297 298 299 300 0.0791755672 0.0713376269 0.0527853254 0.0201112940 -0.0053003177 301 302 303 304 305 0.0130715959 0.0209328787 0.0363075213 0.0421454527 0.0486270520 306 307 308 309 310 0.0496205000 -0.0616997840 -0.0327328433 -0.0130322552 -0.0101184677 311 312 313 314 315 -0.0517172606 -0.0482702394 -0.0286094180 -0.0341249285 -0.0582507595 316 317 318 319 320 -0.0750058427 -0.0984742056 -0.0807295812 -0.0753307257 -0.0362077695 321 322 323 324 325 -0.0080919136 0.0202497471 0.0310119863 0.0246758110 0.0715227656 326 327 328 329 330 0.0861564345 0.1052883590 0.0495865739 0.0410527046 0.0779810117 331 332 333 334 335 0.1005836767 0.0904217862 0.0609993280 0.0296786514 0.0393791802 336 337 338 339 340 0.0109592427 0.0398346489 0.0604596842 0.0603415824 0.0647447972 341 342 343 344 345 -0.0319228471 -0.0151049932 -0.0146246609 0.0072034865 -0.0375044543 346 347 348 349 350 -0.0456024193 -0.0172899028 -0.0160355372 -0.0321337616 -0.0413831634 351 352 353 354 355 -0.0509049918 -0.0311842104 -0.0122520881 0.0039656214 0.0344219446 356 357 358 359 360 0.0484846246 0.0774059578 -0.0822486294 -0.0753789254 -0.0811350032 361 362 363 364 365 -0.0805736098 -0.1286446196 -0.0942161612 -0.0594265880 -0.0457487823 366 367 368 369 370 -0.0557866889 -0.0664428718 -0.0785664325 -0.0310435265 -0.0125036319 371 372 373 374 375 -0.0087626332 0.0155028153 0.0018504955 0.0114956652 -0.0830458746 376 377 378 379 380 -0.0447505890 -0.0312603963 -0.0291447018 -0.0765144955 -0.0727571401 381 382 383 384 385 -0.0413108513 -0.0236916711 -0.0295911718 -0.0509764204 -0.0725871571 386 387 388 389 390 -0.0488556301 -0.0523228669 -0.0203981717 -0.0060883226 -0.0101472416 391 392 393 394 395 -0.0109828604 0.1691714439 0.1385298205 0.1752082054 0.1802017925 396 397 398 399 400 0.1629425499 0.1524850381 0.1057918622 0.0742240062 0.1064609158 401 402 403 404 405 0.1201147015 0.1436363933 0.1752727697 0.1698600554 0.1517510731 406 407 408 409 410 0.1202493657 0.0789127158 0.1442343726 0.0378887235 0.0610462991 411 412 413 414 415 0.0566332896 0.0545525539 0.0086616459 0.0439584319 0.0326109611 416 417 418 419 420 0.0187357335 0.0259978863 0.0234136381 0.0095520196 0.0611455450 421 422 423 424 425 0.0625075022 0.0312027571 0.0598777415 0.0879829751 0.1114299900 426 427 428 429 430 0.1214680463 0.1201625604 0.1207398808 0.1091845860 0.0735532626 431 432 433 434 435 0.0766146312 0.0612773240 0.0560306003 0.0619006004 0.0647098130 436 437 438 439 440 0.0746903969 0.0666611710 0.0587941570 0.0740889403 0.0585979458 441 442 443 444 445 0.0537284554 0.0125526507 -0.0711088399 -0.0554776761 -0.0589181413 446 447 448 449 450 -0.0544204093 -0.0816485627 -0.0688347071 -0.0558104043 -0.0557923337 451 452 453 454 455 -0.0309434041 -0.0320519370 -0.0355217824 -0.0156406754 0.0117876428 456 457 458 459 460 0.0584057861 0.0815526257 0.1205926560 0.1287059823 0.0123775091 461 462 463 464 465 0.0456514338 0.0665463640 0.0769740560 0.0346520209 0.0229255432 466 467 468 469 470 0.0629664728 0.0639291475 0.0514394010 0.0388307751 0.0135921437 471 472 473 474 475 0.0299263790 0.0406319644 0.0709682396 0.0803481046 0.0869557030 476 477 478 479 480 0.0994443119 0.2606606465 0.2508802076 0.2252793173 0.2177021701 481 482 483 484 485 0.2203282899 0.2237657174 0.1805403919 0.1746161068 0.1654768840 486 487 488 489 490 0.1796938721 0.1982521476 0.2130884554 0.2052142620 0.2076104898 491 492 493 494 495 0.2047989133 0.1962494531 0.1581053626 0.0442643466 0.0744272327 496 497 498 499 500 0.0902360207 0.0942775551 0.0627114816 0.0697844736 0.1180198424 501 502 503 504 505 0.1249437483 0.0994263552 0.0709033367 0.0405698923 0.0604698687 506 507 508 509 510 0.0587296651 0.0926941836 0.1106191026 0.1140118171 0.1380442010 511 512 513 514 515 -0.1936408767 -0.1749825159 -0.1457059397 -0.1428928746 -0.1682479478 516 517 518 519 520 -0.1498875184 -0.1599696556 -0.1472336010 -0.1444176124 -0.1618116640 521 522 523 524 525 -0.1622281164 -0.1378279990 -0.1331909803 -0.1025087935 -0.0838265878 526 527 528 529 530 -0.0864307790 -0.0985707303 0.1110391339 0.1748011644 0.1905230632 531 532 533 534 535 0.2870623340 0.2093026095 0.1939164038 0.1082939891 0.0780372278 536 537 538 539 540 0.1321079035 0.1411489153 0.1332600895 0.1681452036 0.1423799957 541 542 543 544 545 0.0771667422 0.1028219906 0.0890992569 0.0957837866 -0.0894996537 546 547 548 549 550 -0.0668069252 -0.0540780404 -0.0378402074 -0.0770612579 -0.0941166964 551 552 553 554 555 -0.0540090731 -0.0448902420 -0.0453422656 -0.0635030531 -0.0852869872 556 557 558 559 560 -0.0451460353 -0.0494166374 -0.0262664508 -0.0028179785 -0.0037631170 561 562 563 564 565 0.0005742932 0.2150411124 0.2169659190 0.2070792432 0.1898446396 566 567 568 569 570 0.1411951509 0.1311976561 0.1135105765 0.1191319958 0.1083532894 571 572 573 574 575 0.1008742051 0.0900207579 0.0587988831 0.0791302277 0.0767247971 576 577 578 579 580 0.0832407121 0.0853096681 0.1145164617 0.0063701698 0.0190901666 581 582 583 584 585 0.0394603917 0.0448952377 0.0511442395 0.0489359065 0.0554980341 586 587 588 589 590 0.0443108039 0.0399404872 0.0386006478 0.0326091358 0.0197304638 591 592 593 594 595 0.0020968526 0.0143254628 0.0238581788 0.0250638880 0.0425412668 596 597 598 599 600 -0.1252886135 -0.1114219542 -0.0937337802 -0.0744827792 -0.1002060344 601 602 603 604 605 -0.1135293530 -0.0879729296 -0.0755431476 -0.0876628594 -0.1047280315 606 607 608 609 610 -0.1269439900 -0.0980020223 -0.1011630968 -0.0714932777 -0.0622821371 611 612 613 614 615 -0.0599443786 -0.0453449628 0.0781191488 0.0865320874 0.0765611357 616 617 618 619 620 0.0701492186 -0.0001623288 0.0026707562 0.0226529892 0.0171354658 621 622 623 624 625 -0.0041700033 -0.0122615532 -0.0372378513 -0.0092511569 -0.0067807132 626 627 628 629 630 0.0066084437 0.0286355112 0.0356996814 0.0542789857 -0.2611766254 631 632 633 634 635 -0.2624969924 -0.2619589912 -0.2558775222 -0.2787397613 -0.2627416991 636 637 638 639 640 -0.2721818450 -0.2545296845 -0.2492022445 -0.2421621529 -0.2397677782 641 642 643 644 645 -0.2050046635 -0.1890524689 -0.1562210785 -0.1451769565 -0.1498256511 646 647 648 649 650 -0.1621065847 0.0631280062 0.0759983731 0.0833830421 0.1161269736 651 652 653 654 655 0.0592564355 0.0737430809 -0.0051104682 0.0330933022 0.0389576349 656 657 658 659 660 0.0629724158 0.0353594486 0.0691318304 0.0703792509 0.0275860641 661 662 663 664 665 0.0464027928 0.0629749688 0.1103081304 -0.1989961398 -0.1701468487 666 667 668 669 670 -0.1487049348 -0.1352614627 -0.1665787453 -0.1468935676 -0.1353477813 671 672 673 674 675 -0.1222766180 -0.1043809024 -0.1108998390 -0.1148558809 -0.0939818074 676 677 678 679 680 -0.0753422893 -0.0450222745 -0.0296119065 -0.0243446456 -0.0138528954 681 682 683 684 685 0.1122872944 0.1150489865 0.1115957779 0.1104495570 0.0897378526 686 687 688 689 690 0.0938551275 0.0894072501 0.1056340543 0.0920898361 0.0615069898 691 692 693 694 695 0.0350090031 0.0123005368 -0.0016306647 0.0200470112 0.0287294863 696 697 698 699 700 0.0397678676 0.0455712654 0.0155401451 0.0253975635 0.0335812204 701 702 703 704 705 0.0364856529 0.0190657247 0.0177392851 -0.0056495139 0.0059119511 706 707 708 709 710 0.0082326360 0.0036595292 0.0196107076 0.0321471563 0.0162682799 711 712 713 714 715 0.0484603011 0.0686910936 0.0691175901 0.0573367163 0.0673752861 716 717 718 719 720 0.0865974018 0.0862688689 0.0714559748 0.0277968426 0.0072503230 721 722 723 724 725 0.0288016860 -0.0010108427 0.0148302794 0.0069355779 0.0056567679 726 727 728 729 730 0.0169815630 0.0207020194 0.0651696396 0.0806895131 0.1002238406 731 732 733 734 735 0.0903832867 0.0196934134 0.0185179058 0.0184624274 0.0276404507 736 737 738 739 740 0.0056818809 0.0193019903 0.0131524039 0.0173360689 0.0155558170 741 742 743 744 745 -0.0060314767 -0.0210288246 0.0041562841 0.0065920190 0.0257954076 746 747 748 749 750 0.0308467508 0.0263114543 0.0173753601 0.1522534357 0.1549539785 751 752 753 754 755 0.1570980073 0.1708591217 0.1662094587 0.1680162322 0.1563036471 756 757 758 759 760 0.1514342562 0.1627049311 0.1569585913 0.1352253018 0.1173533175 761 762 763 764 765 0.1119454669 0.1341833537 0.1299264616 0.1259190578 0.1452449836 766 767 768 769 770 0.0292449491 0.0431934212 0.0529585596 0.0338891171 -0.0238642790 771 772 773 774 775 -0.0224211269 -0.0121009967 0.0026829656 0.0001247510 -0.0146174181 776 777 778 779 780 -0.0084803213 0.0329304832 0.0404474150 0.0679029244 0.0698428550 781 782 783 784 785 0.0581211746 0.0615024591 -0.0651068083 -0.0394111468 -0.0293530058 786 787 788 789 790 -0.0181331867 -0.0533994937 -0.0553562878 -0.0354320764 -0.0237291534 791 792 793 794 795 -0.0243677642 -0.0403732990 -0.0507068738 -0.0293434583 -0.0146815588 796 797 798 799 800 0.0054218074 0.0210091163 0.0297638497 0.0449087743 0.7110506355 801 802 803 804 805 0.6322117486 0.6169051065 0.5761255535 0.5890389085 0.5380985910 806 807 808 809 810 0.4408877105 0.4346699690 0.4605321898 0.4716938019 0.5098425684 811 812 813 814 815 0.4759799521 0.4495227669 0.4331758016 0.4311517407 0.4184801848 816 0.3943271427 1 2 3 4 5 -0.1598309367 -0.1413932393 -0.1296755830 -0.1256475777 -0.1456964364 6 7 8 9 10 -0.1365309042 -0.1446423082 -0.1442139555 -0.1364633060 -0.1315445319 11 12 13 14 15 -0.1427098604 -0.1093396729 -0.0975727602 -0.0656988168 -0.0535980386 16 17 18 19 20 -0.0540246714 -0.0428827413 0.0759103352 0.0997564004 0.0950370866 21 22 23 24 25 0.0768897259 0.0528831705 0.0639290457 0.0725393834 0.0811276232 26 27 28 29 30 0.0750457060 0.0718399680 0.0639745727 0.0403876604 0.0150391034 31 32 33 34 35 0.0367487830 0.0416402174 0.0527316508 0.0510703277 -0.1130673576 36 37 38 39 40 -0.0924886213 -0.0584793782 -0.0532266841 -0.0731200324 -0.0499345143 41 42 43 44 45 -0.0682073161 -0.0662119917 -0.0450965370 -0.0537842075 -0.0584844545 46 47 48 49 50 -0.0215891111 -0.0264839613 -0.0156284990 0.0125966876 0.0115467768 51 52 53 54 55 0.0319430523 0.1309432077 0.1401643851 0.1474190780 0.1316274236 56 57 58 59 60 0.1140338490 0.1333631854 0.1371784559 0.1341642620 0.1220706890 61 62 63 64 65 0.1062865602 0.0952180551 0.0557382750 0.0579591664 0.0841762605 66 67 68 69 70 0.0907790320 0.0999086854 0.0958525374 0.0791528968 0.0846454515 71 72 73 74 75 0.0665062630 0.0795580753 0.0696888192 0.0898118178 0.0678498934 76 77 78 79 80 0.0816156402 0.0776813714 0.0727339789 0.0682954434 0.0232702609 81 82 83 84 85 0.0247983117 0.0390754342 0.0416594317 0.0580545159 0.1021329495 86 87 88 89 90 0.0887202094 0.1128389024 0.1232671210 0.1211746686 0.0869020730 91 92 93 94 95 0.0723087346 0.1179839904 0.1105923926 0.0934360624 0.0740874022 96 97 98 99 100 0.0472500444 0.0709785864 0.0681912060 0.1166301230 0.1445452436 101 102 103 104 105 0.1670671365 0.1704912229 0.1191199193 0.1582466159 0.1751536766 106 107 108 109 110 0.2353737337 0.1567883936 0.1555175148 0.1782010027 0.1949548869 111 112 113 114 115 0.1594529838 0.1163905187 0.0765461202 0.0884067312 0.0946064996 116 117 118 119 120 0.1165526076 0.1090888188 0.0926646443 0.0805653699 -0.0096617241 121 122 123 124 125 -0.0186239923 -0.0117608708 -0.0023613885 -0.0185325162 0.0036766564 126 127 128 129 130 -0.0324805894 -0.0363664429 -0.0447357835 -0.0524199457 -0.0692300665 131 132 133 134 135 -0.0859249074 -0.0897686957 -0.0583179100 -0.0599985578 -0.0491904406 136 137 138 139 140 -0.0633346130 -0.1622358585 -0.1433245192 -0.1150387405 -0.1116258309 141 142 143 144 145 -0.1360884698 -0.1198812534 -0.1099482883 -0.0941858096 -0.1021830251 146 147 148 149 150 -0.1082588363 -0.1159370008 -0.1109792985 -0.1040512665 -0.0703075895 151 152 153 154 155 -0.0468650218 -0.0378744520 -0.0374250422 0.1024494002 0.0723875954 156 157 158 159 160 0.0739440222 0.0605897095 0.0717222560 0.0602277527 0.0443463345 161 162 163 164 165 0.0226846546 0.0315803897 0.0167405259 0.0487969134 0.0499058542 166 167 168 169 170 0.0527577266 0.0776226010 0.0664244321 0.0995343477 0.1234050896 171 172 173 174 175 -0.0256020189 0.0008763130 0.0306857535 0.0430901269 0.0113816172 176 177 178 179 180 0.0127338637 0.0197892172 0.0271429458 0.0248464032 -0.0018031319 181 182 183 184 185 -0.0408186904 0.0024287418 -0.0033491086 0.0125854286 0.0492305448 186 187 188 189 190 0.0532757198 0.0773111276 -0.1219588079 -0.0874772519 -0.0853803563 191 192 193 194 195 -0.0641089268 -0.1008984167 -0.1063832669 -0.0803532337 -0.0792084873 196 197 198 199 200 -0.0830739002 -0.0959210717 -0.1046025854 -0.0784008135 -0.0984684764 201 202 203 204 205 -0.0880688188 -0.0563994126 -0.0502429816 -0.0460927908 0.0065401774 206 207 208 209 210 0.0014370612 0.0251962035 0.0463453695 -0.0039428028 0.0175119200 211 212 213 214 215 0.0084362380 0.0020364914 0.0109333727 0.0148444660 0.0087847608 216 217 218 219 220 0.0898559472 0.0575481832 0.0114008665 0.0509217713 0.0676891861 221 222 223 224 225 0.1217919559 0.1235952091 0.1493743004 0.1377473836 0.1108651183 226 227 228 229 230 0.0750195226 0.0627550231 0.0489290369 0.0238469070 0.0110133633 231 232 233 234 235 0.0179189470 -0.0065368029 0.0035545939 0.0212340902 0.0301007919 236 237 238 239 240 0.0432453251 0.0583574851 0.0759645234 0.1014196190 0.1097746384 241 242 243 244 245 0.1071656495 0.1092031224 0.0818241174 0.0725210233 0.0691422185 246 247 248 249 250 0.0725889446 0.0671088624 0.0605746534 0.0555859690 0.0917240949 251 252 253 254 255 0.0951256075 0.1118609617 0.1260298803 0.1113179467 0.1054175447 256 257 258 259 260 0.4252508586 0.4394857759 0.4148240137 0.3710134697 0.3026745017 261 262 263 264 265 0.2517813065 0.2666513429 0.2576580499 0.2450929990 0.2227648228 266 267 268 269 270 0.1970614888 0.2001076217 0.1885930078 0.1718599857 0.1796799208 271 272 273 274 275 0.1691935345 0.1407033947 -0.1150351576 -0.0984253304 -0.0825082562 276 277 278 279 280 -0.0702033459 -0.0892952242 -0.1018486010 -0.0603618128 -0.0614032261 281 282 283 284 285 -0.0684272922 -0.0650253261 -0.0781390862 -0.0467207972 -0.0326703764 286 287 288 289 290 0.0012972026 0.0059476437 0.0134397546 0.0137787442 0.0436149920 291 292 293 294 295 0.0510394054 0.0639239009 0.0718257410 0.0457359239 0.0452756241 296 297 298 299 300 0.0791755672 0.0713376269 0.0527853254 0.0201112940 -0.0053003177 301 302 303 304 305 0.0130715959 0.0209328787 0.0363075213 0.0421454527 0.0486270520 306 307 308 309 310 0.0496205000 -0.0616997840 -0.0327328433 -0.0130322552 -0.0101184677 311 312 313 314 315 -0.0517172606 -0.0482702394 -0.0286094180 -0.0341249285 -0.0582507595 316 317 318 319 320 -0.0750058427 -0.0984742056 -0.0807295812 -0.0753307257 -0.0362077695 321 322 323 324 325 -0.0080919136 0.0202497471 0.0310119863 0.0246758110 0.0715227656 326 327 328 329 330 0.0861564345 0.1052883590 0.0495865739 0.0410527046 0.0779810117 331 332 333 334 335 0.1005836767 0.0904217862 0.0609993280 0.0296786514 0.0393791802 336 337 338 339 340 0.0109592427 0.0398346489 0.0604596842 0.0603415824 0.0647447972 341 342 343 344 345 -0.0319228471 -0.0151049932 -0.0146246609 0.0072034865 -0.0375044543 346 347 348 349 350 -0.0456024193 -0.0172899028 -0.0160355372 -0.0321337616 -0.0413831634 351 352 353 354 355 -0.0509049918 -0.0311842104 -0.0122520881 0.0039656214 0.0344219446 356 357 358 359 360 0.0484846246 0.0774059578 -0.0822486294 -0.0753789254 -0.0811350032 361 362 363 364 365 -0.0805736098 -0.1286446196 -0.0942161612 -0.0594265880 -0.0457487823 366 367 368 369 370 -0.0557866889 -0.0664428718 -0.0785664325 -0.0310435265 -0.0125036319 371 372 373 374 375 -0.0087626332 0.0155028153 0.0018504955 0.0114956652 -0.0830458746 376 377 378 379 380 -0.0447505890 -0.0312603963 -0.0291447018 -0.0765144955 -0.0727571401 381 382 383 384 385 -0.0413108513 -0.0236916711 -0.0295911718 -0.0509764204 -0.0725871571 386 387 388 389 390 -0.0488556301 -0.0523228669 -0.0203981717 -0.0060883226 -0.0101472416 391 392 393 394 395 -0.0109828604 0.1691714439 0.1385298205 0.1752082054 0.1802017925 396 397 398 399 400 0.1629425499 0.1524850381 0.1057918622 0.0742240062 0.1064609158 401 402 403 404 405 0.1201147015 0.1436363933 0.1752727697 0.1698600554 0.1517510731 406 407 408 409 410 0.1202493657 0.0789127158 0.1442343726 0.0378887235 0.0610462991 411 412 413 414 415 0.0566332896 0.0545525539 0.0086616459 0.0439584319 0.0326109611 416 417 418 419 420 0.0187357335 0.0259978863 0.0234136381 0.0095520196 0.0611455450 421 422 423 424 425 0.0625075022 0.0312027571 0.0598777415 0.0879829751 0.1114299900 426 427 428 429 430 0.1214680463 0.1201625604 0.1207398808 0.1091845860 0.0735532626 431 432 433 434 435 0.0766146312 0.0612773240 0.0560306003 0.0619006004 0.0647098130 436 437 438 439 440 0.0746903969 0.0666611710 0.0587941570 0.0740889403 0.0585979458 441 442 443 444 445 0.0537284554 0.0125526507 -0.0711088399 -0.0554776761 -0.0589181413 446 447 448 449 450 -0.0544204093 -0.0816485627 -0.0688347071 -0.0558104043 -0.0557923337 451 452 453 454 455 -0.0309434041 -0.0320519370 -0.0355217824 -0.0156406754 0.0117876428 456 457 458 459 460 0.0584057861 0.0815526257 0.1205926560 0.1287059823 0.0123775091 461 462 463 464 465 0.0456514338 0.0665463640 0.0769740560 0.0346520209 0.0229255432 466 467 468 469 470 0.0629664728 0.0639291475 0.0514394010 0.0388307751 0.0135921437 471 472 473 474 475 0.0299263790 0.0406319644 0.0709682396 0.0803481046 0.0869557030 476 477 478 479 480 0.0994443119 0.2606606465 0.2508802076 0.2252793173 0.2177021701 481 482 483 484 485 0.2203282899 0.2237657174 0.1805403919 0.1746161068 0.1654768840 486 487 488 489 490 0.1796938721 0.1982521476 0.2130884554 0.2052142620 0.2076104898 491 492 493 494 495 0.2047989133 0.1962494531 0.1581053626 0.0442643466 0.0744272327 496 497 498 499 500 0.0902360207 0.0942775551 0.0627114816 0.0697844736 0.1180198424 501 502 503 504 505 0.1249437483 0.0994263552 0.0709033367 0.0405698923 0.0604698687 506 507 508 509 510 0.0587296651 0.0926941836 0.1106191026 0.1140118171 0.1380442010 511 512 513 514 515 -0.1936408767 -0.1749825159 -0.1457059397 -0.1428928746 -0.1682479478 516 517 518 519 520 -0.1498875184 -0.1599696556 -0.1472336010 -0.1444176124 -0.1618116640 521 522 523 524 525 -0.1622281164 -0.1378279990 -0.1331909803 -0.1025087935 -0.0838265878 526 527 528 529 530 -0.0864307790 -0.0985707303 0.1110391339 0.1748011644 0.1905230632 531 532 533 534 535 0.2870623340 0.2093026095 0.1939164038 0.1082939891 0.0780372278 536 537 538 539 540 0.1321079035 0.1411489153 0.1332600895 0.1681452036 0.1423799957 541 542 543 544 545 0.0771667422 0.1028219906 0.0890992569 0.0957837866 -0.0894996537 546 547 548 549 550 -0.0668069252 -0.0540780404 -0.0378402074 -0.0770612579 -0.0941166964 551 552 553 554 555 -0.0540090731 -0.0448902420 -0.0453422656 -0.0635030531 -0.0852869872 556 557 558 559 560 -0.0451460353 -0.0494166374 -0.0262664508 -0.0028179785 -0.0037631170 561 562 563 564 565 0.0005742932 0.2150411124 0.2169659190 0.2070792432 0.1898446396 566 567 568 569 570 0.1411951509 0.1311976561 0.1135105765 0.1191319958 0.1083532894 571 572 573 574 575 0.1008742051 0.0900207579 0.0587988831 0.0791302277 0.0767247971 576 577 578 579 580 0.0832407121 0.0853096681 0.1145164617 0.0063701698 0.0190901666 581 582 583 584 585 0.0394603917 0.0448952377 0.0511442395 0.0489359065 0.0554980341 586 587 588 589 590 0.0443108039 0.0399404872 0.0386006478 0.0326091358 0.0197304638 591 592 593 594 595 0.0020968526 0.0143254628 0.0238581788 0.0250638880 0.0425412668 596 597 598 599 600 -0.1252886135 -0.1114219542 -0.0937337802 -0.0744827792 -0.1002060344 601 602 603 604 605 -0.1135293530 -0.0879729296 -0.0755431476 -0.0876628594 -0.1047280315 606 607 608 609 610 -0.1269439900 -0.0980020223 -0.1011630968 -0.0714932777 -0.0622821371 611 612 613 614 615 -0.0599443786 -0.0453449628 0.0781191488 0.0865320874 0.0765611357 616 617 618 619 620 0.0701492186 -0.0001623288 0.0026707562 0.0226529892 0.0171354658 621 622 623 624 625 -0.0041700033 -0.0122615532 -0.0372378513 -0.0092511569 -0.0067807132 626 627 628 629 630 0.0066084437 0.0286355112 0.0356996814 0.0542789857 -0.2611766254 631 632 633 634 635 -0.2624969924 -0.2619589912 -0.2558775222 -0.2787397613 -0.2627416991 636 637 638 639 640 -0.2721818450 -0.2545296845 -0.2492022445 -0.2421621529 -0.2397677782 641 642 643 644 645 -0.2050046635 -0.1890524689 -0.1562210785 -0.1451769565 -0.1498256511 646 647 648 649 650 -0.1621065847 0.0631280062 0.0759983731 0.0833830421 0.1161269736 651 652 653 654 655 0.0592564355 0.0737430809 -0.0051104682 0.0330933022 0.0389576349 656 657 658 659 660 0.0629724158 0.0353594486 0.0691318304 0.0703792509 0.0275860641 661 662 663 664 665 0.0464027928 0.0629749688 0.1103081304 -0.1989961398 -0.1701468487 666 667 668 669 670 -0.1487049348 -0.1352614627 -0.1665787453 -0.1468935676 -0.1353477813 671 672 673 674 675 -0.1222766180 -0.1043809024 -0.1108998390 -0.1148558809 -0.0939818074 676 677 678 679 680 -0.0753422893 -0.0450222745 -0.0296119065 -0.0243446456 -0.0138528954 681 682 683 684 685 0.1122872944 0.1150489865 0.1115957779 0.1104495570 0.0897378526 686 687 688 689 690 0.0938551275 0.0894072501 0.1056340543 0.0920898361 0.0615069898 691 692 693 694 695 0.0350090031 0.0123005368 -0.0016306647 0.0200470112 0.0287294863 696 697 698 699 700 0.0397678676 0.0455712654 0.0155401451 0.0253975635 0.0335812204 701 702 703 704 705 0.0364856529 0.0190657247 0.0177392851 -0.0056495139 0.0059119511 706 707 708 709 710 0.0082326360 0.0036595292 0.0196107076 0.0321471563 0.0162682799 711 712 713 714 715 0.0484603011 0.0686910936 0.0691175901 0.0573367163 0.0673752861 716 717 718 719 720 0.0865974018 0.0862688689 0.0714559748 0.0277968426 0.0072503230 721 722 723 724 725 0.0288016860 -0.0010108427 0.0148302794 0.0069355779 0.0056567679 726 727 728 729 730 0.0169815630 0.0207020194 0.0651696396 0.0806895131 0.1002238406 731 732 733 734 735 0.0903832867 0.0196934134 0.0185179058 0.0184624274 0.0276404507 736 737 738 739 740 0.0056818809 0.0193019903 0.0131524039 0.0173360689 0.0155558170 741 742 743 744 745 -0.0060314767 -0.0210288246 0.0041562841 0.0065920190 0.0257954076 746 747 748 749 750 0.0308467508 0.0263114543 0.0173753601 0.1522534357 0.1549539785 751 752 753 754 755 0.1570980073 0.1708591217 0.1662094587 0.1680162322 0.1563036471 756 757 758 759 760 0.1514342562 0.1627049311 0.1569585913 0.1352253018 0.1173533175 761 762 763 764 765 0.1119454669 0.1341833537 0.1299264616 0.1259190578 0.1452449836 766 767 768 769 770 0.0292449491 0.0431934212 0.0529585596 0.0338891171 -0.0238642790 771 772 773 774 775 -0.0224211269 -0.0121009967 0.0026829656 0.0001247510 -0.0146174181 776 777 778 779 780 -0.0084803213 0.0329304832 0.0404474150 0.0679029244 0.0698428550 781 782 783 784 785 0.0581211746 0.0615024591 -0.0651068083 -0.0394111468 -0.0293530058 786 787 788 789 790 -0.0181331867 -0.0533994937 -0.0553562878 -0.0354320764 -0.0237291534 791 792 793 794 795 -0.0243677642 -0.0403732990 -0.0507068738 -0.0293434583 -0.0146815588 796 797 798 799 800 0.0054218074 0.0210091163 0.0297638497 0.0449087743 0.7110506355 801 802 803 804 805 0.6322117486 0.6169051065 0.5761255535 0.5890389085 0.5380985910 806 807 808 809 810 0.4408877105 0.4346699690 0.4605321898 0.4716938019 0.5098425684 811 812 813 814 815 0.4759799521 0.4495227669 0.4331758016 0.4311517407 0.4184801848 816 0.3943271427 > class(zr$residuals) [1] "pseries" "numeric" > print(zr$coefficients) (Intercept) log(pcap) log(pc) log(emp) unemp 2.56606170 -0.07862810 0.21243586 0.92456793 -0.00405491 > class(zr$coefficients) [1] "numeric" > summary(zr) Oneway (individual) effect Random coefficients model Call: pvcm(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "random") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.27874 -0.03826 0.03301 0.03531 0.08882 0.71105 Estimated mean of the coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.5660617 0.4646077 5.5231 3.331e-08 *** log(pcap) -0.0786281 0.0890076 -0.8834 0.3770276 log(pc) 0.2124359 0.0569555 3.7299 0.0001916 *** log(emp) 0.9245679 0.0837552 11.0389 < 2.2e-16 *** unemp -0.0040549 0.0018892 -2.1464 0.0318437 * --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Estimated variance of the coefficients: (Intercept) log(pcap) log(pc) log(emp) unemp (Intercept) 8.1735012 -1.124405 0.1967614 0.0736650 0.00495130 log(pcap) -1.1244046 0.306534 -0.0874932 -0.1182381 -0.00234697 log(pc) 0.1967614 -0.087493 0.1204141 -0.0871019 -0.00188835 log(emp) 0.0736650 -0.118238 -0.0871019 0.2700516 0.00511478 unemp 0.0049513 -0.002347 -0.0018884 0.0051148 0.00012953 Total Sum of Squares: 19352 Residual Sum of Squares: 12.785 Multiple R-Squared: 0.99934 Chisq: 946.626 on 4 DF, p-value: < 2.22e-16 > pwaldtest(zr) Wald test for joint significance data: log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp Chisq = 946.63, df = 4, p-value < 2.2e-16 alternative hypothesis: at least one coefficient is not null > > > # run tests intercept-only models > zwint <- pvcm(log(gsp) ~ 1, data = Produc, model = "within") > zwint2 <- pvcm(log(gsp) ~ 1, data = Produc[1:17, ], model = "within") # test with only one individual > summary(zwint) # gave multiple intercept summaries up until rev. 1199 Oneway (individual) effect No-pooling model Call: pvcm(formula = log(gsp) ~ 1, data = Produc, model = "within") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.446136619 -0.106991792 0.007483416 0.101613714 0.534427803 Coefficients: (Intercept) Min. : 8.593 1st Qu.: 9.737 Median :10.583 Mean :10.509 3rd Qu.:11.084 Max. :12.751 Total Sum of Squares: 849.81 Residual Sum of Squares: 18.941 Multiple R-Squared: 0.97771 > stopifnot(dim(coef(zwint)) == c(48, 1)) > # pwaldtest(zwint) # errors rightfully, and since rev. 1200 also informatively > > zrint <- pvcm(log(gsp) ~ 1, data = Produc, model = "random") > # zrint2 <- pvcm(log(gsp) ~ 1, data = Produc[1:17, ], model = "random") # only one individual -> errors -> catch case? > summary(zrint) # does not calculate Wald statistic (rightfully, as only intercept) Oneway (individual) effect Random coefficients model Call: pvcm(formula = log(gsp) ~ 1, data = Produc, model = "random") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -2.1302626 -0.7979111 0.0871967 -0.0002632 0.6200014 2.5397116 Estimated mean of the coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 10.50911 0.14719 71.399 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Estimated variance of the coefficients: (Intercept) (Intercept) 1.0384 Total Sum of Squares: 849.81 Residual Sum of Squares: 849.81 Multiple R-Squared: -6.6519e-08 > # pwaldtest(zrint) # errors rightfully, and since rev. 1202 also informatively > > ## Stata example: > ## http://www.stata.com/manuals/xtxtrc.pdf > ## replicate Stata's example: > # dat <- haven::read_dta("http://www.stata-press.com/data/r15/invest2.dta") > # pvcm(invest ~ market + stock, data = dat, index = c("company", "time"), model = "random") > > > proc.time() user system elapsed 1.25 0.17 1.40 plm/inst/tests/test_punbalancedness.R0000644000176200001440000001506214124132276017516 0ustar liggesusers# Test of punbalanced (1) measures for unbalancedness as defined in Ahrens/Pincus (1981) # and (2) of extension to nested panel structures (Baltagi/Song/Jung (2001), p. 368-369)) # comparison to literature results ################## (1) ######### two-dimensional panel ######################################## # Test data as described in Baltagi/Song/Jung (2002), p. 488: # 5(15) means: 15 individuals, each with 5 observations # P1 = 5(15), 9(15) # P2 = 5(10), 7(10), 9(10) # P3 = 3(6), 5(6), 7(6), 9(6), 11(6) # P4 = 3(9), 5(6), 9(6), 11(9) # P5 = 3(24), 23(6) # P6 = 2(15), 12(15) # => total of 210 obs in each Pi # results: # r = (0.918, 0.841, 0.813, 0.754, 0.519, 0.490). ##### BEGIN build test panel data ##### # P1 = 5(15), 9(15) ind_p1 <- c( rep(c(1), 5), rep(c(2), 5), rep(c(3), 5), rep(c(4), 5), rep(c(5), 5), rep(c(6), 5), rep(c(7), 5), rep(c(8), 5), rep(c(9), 5), rep(c(10), 5), rep(c(11), 5), rep(c(12), 5), rep(c(13), 5), rep(c(14), 5), rep(c(15), 5), rep(c(16), 9), rep(c(17), 9), rep(c(18), 9), rep(c(19), 9), rep(c(20), 9), rep(c(21), 9), rep(c(22), 9), rep(c(23), 9), rep(c(24), 9), rep(c(25), 9), rep(c(26), 9), rep(c(27), 9), rep(c(28), 9), rep(c(29), 9), rep(c(30), 9) ) # P4 = 3(9), 5(6), 9(6), 11(9) ind_p4 <- c( rep(c(1), 3), rep(c(2), 3), rep(c(3), 3), rep(c(4), 3), rep(c(5), 3), rep(c(6), 3), rep(c(7), 3), rep(c(8), 3), rep(c(9), 3), rep(c(10), 5), rep(c(11), 5), rep(c(12), 5), rep(c(13), 5), rep(c(14), 5), rep(c(15), 5), rep(c(16), 9), rep(c(17), 9), rep(c(18), 9), rep(c(19), 9), rep(c(20), 9), rep(c(21), 9), rep(c(22), 11), rep(c(23), 11), rep(c(24), 11), rep(c(25), 11), rep(c(26), 11), rep(c(27), 11), rep(c(28), 11), rep(c(29), 11), rep(c(30), 11) ) # P6 = 2(15), 12(15) ind_p6 <- c( rep(c(1), 2), rep(c(2), 2), rep(c(3), 2), rep(c(4), 2), rep(c(5), 2), rep(c(6), 2), rep(c(7), 2), rep(c(8), 2), rep(c(9), 2), rep(c(10), 2), rep(c(11), 2), rep(c(12), 2), rep(c(13), 2), rep(c(14), 2), rep(c(15), 2), rep(c(16), 12), rep(c(17), 12), rep(c(18), 12), rep(c(19), 12), rep(c(20), 12), rep(c(21), 12), rep(c(22), 12), rep(c(23), 12), rep(c(24), 12), rep(c(25), 12), rep(c(26), 12), rep(c(27), 12), rep(c(28), 12), rep(c(29), 12), rep(c(30), 12) ) # P1 = 5(15), 9(15) time_p1 <- c(rep(c(1:5), 15), rep(c(1:9), 15)) # P4 = 3(9), 5(6), 9(6), 11(9) time_p4 <- c(rep(c(1:3), 9), rep(c(1:5), 6), rep(c(1:9), 6), rep(c(1:11), 9)) # P6 = 2(15), 12(15) time_p6 <- c(rep(c(1:2), 15), rep(c(1:12), 15)) # test data from Ahrens/Pincus (1981), p. 234 # design no. 1 and no. 4 # results: # no. 1: 0.868 and 0.886 # no. 4: 0.642 and 0.726 ind_d1 <- c( rep(c(1), 3), rep(c(2), 3), rep(c(3), 5), rep(c(4), 7), rep(c(5), 7)) time_d1 <- c(rep(c(1:3), 2), rep(c(1:5), 1), rep(c(1:7), 2)) ind_d4 <- c( rep(c(1), 2), rep(c(2), 3), rep(c(3), 5), rep(c(4), 10), rep(c(5), 12)) time_d4 <- c(rep(c(1:2), 1), rep(c(1:3), 1), rep(c(1:5), 1), rep(c(1:10), 1), rep(c(1:12), 1)) df_p1 <- data.frame(ind_p1, time_p1) df_p4 <- data.frame(ind_p4, time_p4) df_p6 <- data.frame(ind_p6, time_p6) df_d1 <- data.frame(ind_d1, time_d1) df_d4 <- data.frame(ind_d4, time_d4) ##### END build test panel data ##### library(plm) # replicate gamma in Baltagi et al. (2002), p. 488 punbalancedness(df_p1)[1] # 0.918 punbalancedness(df_p4)["gamma"] # 0.754 punbalancedness(df_p6)[1] # 0.490 # replicate Ahrens/Pincus (1981), p. 234 punbalancedness(df_d1) # no. 1: 0.868 and 0.886 punbalancedness(df_d4) # no. 4: 0.642 and 0.726 # for balanced panels, both measures == 1 data("Grunfeld", package = "plm") # test on data.frame punbalancedness(Grunfeld) # test on data.frame with index argument # (indexes not in first two columns) Grunfeld2 <- Grunfeld Grunfeld2 <- Grunfeld2[ , c(3:length(Grunfeld2) , c(1,2))] punbalancedness(Grunfeld2, index = c("firm", "year")) # test on pdata.frame punbalancedness(pdata.frame(Grunfeld)) # Test on estimated model object mod <- plm(inv ~ value + capital, data = Grunfeld) punbalancedness(mod) mod2 <- plm(inv ~ value + capital, data = Grunfeld[1:99, ]) punbalancedness(mod2) ################## (2) ######### test of nested panel data (additionally with a group) #################### # Baltagi/Song/Jung (2001), p. 368-369: # P1: # M = 10 # Ni pattern: (8,8,8,10,10,10,10,12,12,12) # Ti pattern: (6,6,6, 5, 5, 5, 5, 5, 4, 4) # 500 = 3*(8*6) + 4*(10*5) + 1*(12*5)+2*(12*4) nest_grp_p1 <- c(rep(1, 8*6), rep(2, 8*6), rep(3, 8*6), rep(4, 10*5), rep(5, 10*5), rep(6, 10*5), rep(7, 10*5), rep(8, 12*5), rep(9, 12*4), rep(10, 12*4)) length(nest_grp_p1) nest_id_p1 <- c(rep(c(1:8), 6), rep(c(9:(9+7)), 6), rep(c(18:(18+7)), 6), rep(c(27:(27+9)), 5), rep(c(38:(38+9)), 5), rep(c(49:(49+9)), 5), rep(c(60:(60+9)), 5), rep(c(71:(71+11)), 5), rep(c(84:(84+11)), 4), rep(c(97:(97+11)), 4)) nest_id_p1 <- sort(nest_id_p1) length(nest_id_p1) nest_time_p1 <- c(rep(rep(c(1:6), 8), 3), rep(rep(c(1:5), 10), 4), rep(rep(c(1:5), 12), 1), rep(rep(c(1:4), 12), 2)) length(nest_time_p1) df_nested_p1 <- data.frame(nest_id_p1, nest_time_p1, nest_grp_p1) pdf_nested_p1 <- pdata.frame(df_nested_p1, index = c("nest_id_p1", "nest_time_p1", "nest_grp_p1")) # on pdata.frame punbalancedness(pdf_nested_p1) # on data.frame punbalancedness(df_nested_p1, index = c("nest_id_p1", "nest_time_p1", "nest_grp_p1")) data("Produc", package = "plm") punbalancedness(Produc, index = c("state", "year", "region")) # on plm object pProduc <- pdata.frame(Produc, index = c("state", "year", "region")) form <- log(gsp) ~ log(pc) + log(emp) + log(hwy) + log(water) + log(util) + unemp nested_mod <- plm(form, data = pProduc, model = "random", effect = "nested") punbalancedness(nested_mod) plm/inst/tests/test_pht.R0000644000176200001440000000526614124132276015151 0ustar liggesusers # replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 # pht vs plm(., random.model="ht", inst.method="ht/am/bms") vs. plm(, model = "ht") library("plm") data("Wages", package = "plm") ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "ht", index = 595) summary(ht) ht2 <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "am", index = 595) summary(ht2) ht3 <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "bms", index = 595) summary(ht3) ht4 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, model = "ht", data = Wages, index = 595) summary(ht4) # estimating with pht and plm(., model = "ht") should give the same results stopifnot(isTRUE(all.equal(coef(ht4), coef(ht)))) # estimating with pht and plm(., model = "random", random.method = "ht", inst.method = "baltagi") should give the same results ht5 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), model = "random", random.method = "ht", inst.method = "baltagi", data = Wages, index = 595) summary(ht5) ht6 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), model = "random", random.method = "ht", inst.method = "am", data = Wages, index = 595) summary(ht6) ht7 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp ^ 2), model = "random", random.method = "ht", inst.method = "bms", data = Wages, index = 595) summary(ht7) stopifnot(isTRUE(all.equal(coef(ht5), coef(ht)))) stopifnot(isTRUE(all.equal(coef(ht6), coef(ht2)))) stopifnot(isTRUE(all.equal(coef(ht7), coef(ht3)))) plm/inst/tests/test_plm.data.R0000644000176200001440000000367114124132276016054 0ustar liggesusers# 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" # 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) data("Hedonic", package = "plm") pHed <- pdata.frame(Hedonic, index = "townid") plm:::pos.index(pHed) # gives position of indexes pHed_new_plm.data <- plm.data(Hedonic, indexes = "townid") #pHed_old_plm.data <- plm:::plm.data_depr_orig(Hedonic, indexes = "townid") ## if (!identical(pHed_new_plm.data, pHed_old_plm.data)) ## stop("plm.data stub function using pdata.frame() does not recreate ('identical()') the original plm.dim object once produced by the original plm.data() ") ## if (!isTRUE(all.equal(pHed_new_plm.data, pHed_old_plm.data))) ## stop("plm.data stub function using pdata.frame() does not recreate ('all.equal()') the original plm.dim object once produced by the original plm.data() ") # introduce constant columns Hedonic_const <- Hedonic Hedonic_const$constantNr <- 1 Hedonic_const$constantStr <- "constant" Hedonic_const <- Hedonic_const[ , c("constantNr", setdiff(names(Hedonic), c("constantNr", "constantStr")), "constantStr")] pHed_const_new_plm.data <- plm.data(Hedonic_const, indexes = "townid") #pHed_const_old_plm.data <- plm:::plm.data_depr_orig(Hedonic_const, indexes = "townid") #if (!isTRUE(all.equal(pHed_const_new_plm.data, pHed_const_old_plm.data))) # stop("plm.data stub function using pdata.frame() does not recreate ('all.equal()') the original plm.dim object once produced by the original plm.data() ") class(pHed_const_new_plm.data) #class(pHed_const_old_plm.data) names(pHed_const_new_plm.data) #names(pHed_const_old_plm.data) lapply(pHed_const_new_plm.data, class) #lapply(pHed_const_old_plm.data, class) plm/inst/tests/test_pvar.R0000644000176200001440000000546114126005612015316 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") # corner case make one - id NA and rest non varying # non-variation was detected prior to rev. 206 Grunfeld_1NA_nonvari <- Grunfeld Grunfeld_1NA_nonvari[ 1:20, "capital"] <- NA Grunfeld_1NA_nonvari[21:200, "capital"] <- Grunfeld_1NA_nonvari[21:200, "firm"] print(pvar(Grunfeld_1NA_nonvari)) Grunfeld_1NA_nonvari_time <- Grunfeld Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year == 1935, "capital"] <- NA Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year != 1935, "capital"] <- Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year != 1935, "year"] print(pvar(Grunfeld_1NA_nonvari_time)) ## for one id all NA -> time dimension affected Grunfeld_1NA <- Grunfeld Grunfeld_1NA[1:20, "capital"] <- NA print(pvar(Grunfeld_1NA)) Grunfeld_2NA <- Grunfeld Grunfeld_2NA[1:20, "capital"] <- NA Grunfeld_2NA[21:40, "value"] <- NA print(pvar(Grunfeld_2NA)) ## one time period all NA -> id dimension affected Grunfeld_1NA_time <- Grunfeld Grunfeld_1NA_time[Grunfeld_1NA_time$year == 1935, "capital"] <- NA print(pvar(Grunfeld_1NA_time)) Grunfeld_2NA_time <- Grunfeld Grunfeld_2NA_time[Grunfeld_2NA_time$year == 1935, c("value", "capital")] <- NA print(pvar(Grunfeld_2NA_time)) # input only 1-column data.frame (1 variable) with all NA for one id Grunfeld_1var <- Grunfeld Grunfeld_1var <- pdata.frame(Grunfeld, drop.index = TRUE) Grunfeld_1var$inv <- NULL Grunfeld_1var$value <- NULL Grunfeld_1var1NA <- Grunfeld_1var Grunfeld_1var1NA[c(1:20), "capital"] <- NA print(pvar(Grunfeld_1var1NA)) Grunfeld_1var1NA_time <- Grunfeld_1var Grunfeld_1var1NA_time[c(1,21,41,61,81,101,121,141,161,181), "capital"] <- NA print(pvar(Grunfeld_1var1NA_time)) ## data.frame print(pvar(Grunfeld, index=c("firm"))) ## one variable all NA -> gets removed by pdata.frame Grunfeld_allNA <- Grunfeld Grunfeld_allNA[ , "capital"] <- NA print(pvar(Grunfeld_allNA)) # Matrix Grunfeld_mat <- as.matrix(Grunfeld) Grunfeld_mat <- as.matrix(Grunfeld) pvar(Grunfeld_mat) pvar(Grunfeld_mat, index=c("firm")) Grunfeld_mat_allNA <- as.matrix(Grunfeld_allNA) pvar(Grunfeld_mat_allNA) ## pseries pGrunfeld <- pdata.frame(Grunfeld) pvar(pGrunfeld$capital) # should indicate variation in both dimensions (nothing is printed) pvar(pGrunfeld[1:20, ]$capital) # should indicate no indivivual variation (b/c only 1 individual is evaluated) # library(foreign);library(plm) # jtrain <- read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/jtrain.dta") # # # Define panel data (for 1987 and 1988 only) # jtrain.87.88 <- subset(jtrain,year<=1988) # jtrain.p<-pdata.frame(jtrain.87.88, index=c("fcode","year")) # # pvar(jtrain.p) # print(pvar(jtrain.p)) # # pvar(jtrain.p[ , c(20:26)]) # print(pvar(jtrain.p[ , c(20:26)])) plm/inst/tests/test_within_intercept.R0000644000176200001440000003442414124132276017733 0ustar liggesusers### Test of within_intercept in connection with fixef() and comparison to Stata and Gretl # # results for within_intercept matches EViews, also in the two-way unbalanced case # # (1) balanced # (2) unbalanced # test in connection with fixef: library(plm) data("Grunfeld", package = "plm") ############# (1) balanced ############## # oneway individual balanced gi <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "individual") f_level_gi <- fixef(gi, type = "level") f_dmean_gi <- fixef(gi, type = "dmean") int_gi <- within_intercept(gi) mod_int_gi <- within_intercept(gi, return.model = TRUE) int_manual_gi <- mean(fixef(gi)) individual_intercepts_gi <- int_gi + f_dmean_gi # check consistency of functions fixef and within_intercept # works if (!isTRUE(all.equal(individual_intercepts_gi, f_level_gi, check.attributes = FALSE))) stop("within_intercept: something is wrong") if (!isTRUE(all.equal(int_gi, int_manual_gi, check.attributes = FALSE))) stop("within_intercept: something is wrong") # oneway time balanced gt <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "time") f_level_gt <- fixef(gt, type = "level") f_dmean_gt <- fixef(gt, type = "dmean") int_gt <- within_intercept(gt) mod_int_gt <- within_intercept(gt, return.model = TRUE) int_manual_gt <- mean(fixef(gt)) individual_intercepts_gt <- int_gt + f_dmean_gt # check consistency of functions fixef and within_intercept # works if(!isTRUE(all.equal(individual_intercepts_gt, f_level_gt, check.attributes = FALSE))) stop("within_intercept: something is wrong") if(!isTRUE(all.equal(int_gt, int_manual_gt, check.attributes = FALSE))) stop("within_intercept: something is wrong") # two-way individual, time balanced gtw <- plm(inv ~ value + capital, data = Grunfeld, model = "within", effect = "twoways") f_level_tw_i <- fixef(gtw, type = "level", effect = "individual") f_dmean_tw_i <- fixef(gtw, type = "dmean", effect = "individual") f_level_tw_t <- fixef(gtw, type = "level", effect = "time") f_dmean_tw_t <- fixef(gtw, type = "dmean", effect = "time") int_tw <- within_intercept(gtw) mod_int_tw <- within_intercept(gtw, return.model = TRUE) int_manual_tw_i <- mean(f_level_tw_i) int_manual_tw_t <- mean(f_level_tw_t) individual_intercepts_tw_i <- int_tw + f_dmean_tw_i individual_intercepts_tw_t <- int_tw + f_dmean_tw_t # check consistency of functions fixef and within_intercept # if(!isTRUE(all.equal(individual_intercepts_tw_i, f_level_tw_i, check.attributes = FALSE))) stop("within_intercept twoways, individual: something is wrong") # if(!isTRUE(all.equal(individual_intercepts_tw_t, f_level_tw_t, check.attributes = FALSE))) stop("within_intercept twoways, time: something is wrong") ############# (2) unbalanced tests ################ Grunfeld_unbalanced <- Grunfeld[-c(200), ] # oneway individual unbalanced gi_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "individual") f_level_gi_u <- fixef(gi_u, type = "level") f_dmean_gi_u <- fixef(gi_u, type = "dmean") # in the one-way unbalanced case: is the overall intercept is the _weighted_ mean of the effects # (with the current fixef implementation) - this check also depends on how type = "dmean" is calculated in fixef int_gi_u <- within_intercept(gi_u) mod_int_gi_u <- within_intercept(gi_u, return.model = TRUE) individual_intercepts_gi_u <- int_gi_u + f_dmean_gi_u int_manual_gi_u <- weighted.mean(fixef(gi_u), as.numeric(table(index(gi_u)[[1]]))) mean(f_level_gi_u) # check consistency of functions in themselves if(!isTRUE(all.equal(individual_intercepts_gi_u, f_level_gi_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") if(!isTRUE(all.equal(int_gi_u, int_manual_gi_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") # oneway time unbalanced gt_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "time") f_level_gt_u <- fixef(gt_u, type = "level") f_dmean_gt_u <- fixef(gt_u, type = "dmean") int_gt_u <- within_intercept(gt_u) mod_int_gt_u <- within_intercept(gt_u, return.model = TRUE) individual_intercepts_gt_u <- int_gt_u + f_dmean_gt_u int_manual_gt_u <- weighted.mean(fixef(gt_u), as.numeric(table(index(gt_u)[[2]]))) mean(f_level_gt_u) # mean is not correct for unbalanced case! int_gt_u <- within_intercept(gt_u) # check consistency of functions in themselves if(!isTRUE(all.equal(individual_intercepts_gt_u, f_level_gt_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") if(!isTRUE(all.equal(int_gt_u, int_manual_gt_u, check.attributes = FALSE))) stop("within_intercept, unbalanced: something is wrong") ## twoways unbalanced gtw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, model = "within", effect = "twoways") f_level_tw_i_u <- fixef(gtw_u, type = "level", effect = "individual") f_level_tw_t_u <- fixef(gtw_u, type = "level", effect = "time") f_dmean_tw_i_u <- fixef(gtw_u, type = "dmean", effect = "individual") f_dmean_tw_t_u <- fixef(gtw_u, type = "dmean", effect = "time") int_tw_u <- within_intercept(gtw_u) ## mean() is not correct in unbalanced case # int_manual_tw_i_u <- mean(f_level_tw_i_u) # int_manual_tw_t_u <- mean(f_level_tw_t_u) # int_manual_tw_i_u + int_manual_tw_t_u # all.equal(int_manual_tw_i_u, int_manual_tw_t_u) # not equal int_manual_tw_i_u <- weighted.mean(f_level_tw_i_u, w = pdim(gtw_u)$Tint$Ti) int_manual_tw_t_u <- weighted.mean(f_level_tw_t_u, w = pdim(gtw_u)$Tint$nt) int_manual_tw_i_u + int_manual_tw_t_u all.equal(int_manual_tw_i_u, int_manual_tw_t_u) # not equal individual_intercepts_tw_i_u <- int_manual_tw_i_u + f_dmean_tw_i_u individual_intercepts_tw_t_u <- int_manual_tw_t_u + f_dmean_tw_t_u mod_lm <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) # check consistency of functions fixef and within_intercept if(!isTRUE(all.equal(individual_intercepts_tw_i_u, f_level_tw_i_u, check.attributes = FALSE))) stop("within_intercept twoways, individual: something is wrong") if(!isTRUE(all.equal(individual_intercepts_tw_t_u, f_level_tw_t_u, check.attributes = FALSE))) stop("within_intercept twoways, time: something is wrong") f_level_tw_u <- as.numeric(fixef(gtw_u, "twoways", "level")) f_level_tw_u_test <- int_tw_u + f_dmean_tw_i_u[index(gtw_u)[[1L]]] + f_dmean_tw_t_u[index(gtw_u)[[2L]]] if(!isTRUE(all.equal(f_level_tw_u, f_level_tw_u_test, check.attributes = FALSE))) stop("within_intercept twoways, individual, time: something is wrong") ### print all within intercepts (to have them compared to the reference output test_within_intercept.Rout.save) print(within_intercept(gi)) print(within_intercept(gi_u)) print(within_intercept(gt)) print(within_intercept(gt_u)) print(within_intercept(gtw)) print(within_intercept(gtw_u)) ######### Test with reference case: balanced panel ## commented because it needs extra library 'foreign' # library(foreign) # library(plm) # wagepan <- read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/wagepan.dta") # pwagepan <- pdata.frame(wagepan, index = c("nr", "year")) # pdim(pwagepan) # # mod_fe_ind <- plm(lwage ~ exper + hours + married + expersq, data = pwagepan, model = "within", effect = "individual") # summary(mod_fe_ind) # # matches gretl, balanced panel, individual effect (see below) # inter_mod_fe_ind <- within_intercept(mod_fe_ind) # print(inter_mod_fe_ind) # mean(fixef(mod_fe_ind)) # print(inter_mod_fe_ind) # # # matches Gretl robust SE # inter_mod_fe_ind_robust <- within_intercept(mod_fe_ind, vcov = function(x) vcovHC(x, method="arellano", type="HC0")) # print(inter_mod_fe_ind_robust) # print(summary(within_intercept(mod_fe_ind, return.model = TRUE), vcov = function(x) vcovHC(x, method="arellano", type="HC0"))) # Some data to compare to: # gretl: Data wagepan, individual effects, "normal" standard errors # # Model 1: Fixed-effects, using 4360 observations # Included 545 cross-sectional units # Time-series length = 8 # Dependent variable: lwage # # coefficient std. error t-ratio p-value # ----------------------------------------------------------- # const 1.30069 0.0334564 38.88 8.95e-279 *** # exper 0.137331 0.00856279 16.04 4.56e-056 *** # hours −0.000136467 1.33668e-05 −10.21 3.67e-024 *** # married 0.0481248 0.0181012 2.659 0.0079 *** # expersq −0.00532076 0.000606304 −8.776 2.52e-018 *** # # Mean dependent var 1.649147 S.D. dependent var 0.532609 # Sum squared resid 459.8591 S.E. of regression 0.347371 # LSDV R-squared 0.628105 Within R-squared 0.196125 # LSDV F(548, 3811) 11.74547 P-value(F) 0.000000 # Log-likelihood −1283.082 Akaike criterion 3664.165 # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 # rho 0.065436 Durbin-Watson 1.546260 # # Joint test on named regressors - # Test statistic: F(4, 3811) = 232.447 # with p-value = P(F(4, 3811) > 232.447) = 8.13484e-179 # # Test for differing group intercepts - # Null hypothesis: The groups have a common intercept # Test statistic: F(544, 3811) = 10.3148 # with p-value = P(F(544, 3811) > 10.3148) = 0 # gretl: Data wagepan, individual effects, HAC standard errors # # Model 1: Fixed-effects, using 4360 observations # Included 545 cross-sectional units # Time-series length = 8 # Dependent variable: lwage # Robust (HAC) standard errors # Omitted due to exact collinearity: black hisp # # coefficient std. error t-ratio p-value # ----------------------------------------------------------- # const 1.30069 0.0550059 23.65 1.82e-115 *** # exper 0.137331 0.0108281 12.68 3.92e-036 *** # hours −0.000136467 2.13420e-05 −6.394 1.81e-010 *** # married 0.0481248 0.0212938 2.260 0.0239 ** # expersq −0.00532076 0.000691230 −7.698 1.76e-014 *** # # Mean dependent var 1.649147 S.D. dependent var 0.532609 # Sum squared resid 459.8591 S.E. of regression 0.347371 # LSDV R-squared 0.628105 Within R-squared 0.196125 # Log-likelihood −1283.082 Akaike criterion 3664.165 # Schwarz criterion 7166.910 Hannan-Quinn 4900.376 # rho 0.065436 Durbin-Watson 1.546260 # # Joint test on named regressors - # Test statistic: F(4, 3811) = 121.497 # with p-value = P(F(4, 3811) > 121.497) = 1.02521e-097 # # Robust test for differing group intercepts - # Null hypothesis: The groups have a common intercept # Test statistic: Welch F(544, 1276.3) = 27.3958 # with p-value = P(F(544, 1276.3) > 27.3958) = 0 #### # Gretl, twoways, Grunfeld, balanced panel, normal SEs # -- Gretl does only time dummies, no sweeping out of time effect in the data # -> not comparable because constant becomes the reference year # Model 2: Fixed-effects, using 200 observations # Included 10 cross-sectional units # Time-series length = 20 # Dependent variable: inv # # coefficient std. error t-ratio p-value # --------------------------------------------------------- # const −32.8363 18.8753 −1.740 0.0837 * # value 0.117716 0.0137513 8.560 6.65e-015 *** # capital 0.357916 0.0227190 15.75 5.45e-035 *** # dt_2 −19.1974 23.6759 −0.8108 0.4186 # dt_3 −40.6900 24.6954 −1.648 0.1013 # dt_4 −39.2264 23.2359 −1.688 0.0932 * # dt_5 −69.4703 23.6561 −2.937 0.0038 *** # dt_6 −44.2351 23.8098 −1.858 0.0649 * # dt_7 −18.8045 23.6940 −0.7936 0.4285 # dt_8 −21.1398 23.3816 −0.9041 0.3672 # dt_9 −42.9776 23.5529 −1.825 0.0698 * # dt_10 −43.0988 23.6102 −1.825 0.0697 * # dt_11 −55.6830 23.8956 −2.330 0.0210 ** # dt_12 −31.1693 24.1160 −1.292 0.1980 # dt_13 −39.3922 23.7837 −1.656 0.0995 * # dt_14 −43.7165 23.9697 −1.824 0.0699 * # dt_15 −73.4951 24.1829 −3.039 0.0028 *** # dt_16 −75.8961 24.3455 −3.117 0.0021 *** # dt_17 −62.4809 24.8643 −2.513 0.0129 ** # dt_18 −64.6323 25.3495 −2.550 0.0117 ** # dt_19 −67.7180 26.6111 −2.545 0.0118 ** # dt_20 −93.5262 27.1079 −3.450 0.0007 *** ## Test unbalanced panel ####### replicate Stata's fixed effects estimator, R-squared, F statistic ### ## http://www.stata.com/manuals14/xtxtreg.pdf [example 2 on p. 14, ex. 3 on p. 16] # # commented because it needs extra library 'foreign' # # normal SE (ex. 2, p. 14) # Stata's intercept (coefficient, Standard error) # _cons 1.03732 , .0485546 # # robust SE (ex. 3, p. 16) # _cons 1.03732 , .0739644 # library(plm) # library(haven) # nlswork <- haven::read_dta("http://www.stata-press.com/data/r14/nlswork.dta") # large file # nlswork$race <- factor(nlswork$race) # convert # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example # nlswork$grade <- as.numeric(nlswork$grade) # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) # # form_nls_ex2 <- formula(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south) # # plm_fe_nlswork <- plm(form_nls_ex2, data = pnlswork, model = "within", effect = "individual") # # int_fe_nls_work <- within_intercept(plm_fe_nlswork) # matches Stata "normal" SE # print(int_fe_nls_work) # weighted.mean(fixef(plm_fe_nlswork), w = as.numeric(table(index(plm_fe_nlswork)[[1]]))) # summary(plm_fe_nlswork) # summary(plm_fe_nlswork, vcov = vcovHC(plm_fe_nlswork, type="sss")) # int_fe_nls_work_robust <- within_intercept(plm_fe_nlswork, vcov = function(x) vcovHC(x, type="sss")) # matches Stata robust SE # print(int_fe_nls_work_robust) plm/inst/tests/test_as.data.frame_as.matrix.R0000644000176200001440000000130214126005512020725 0ustar liggesusers# Test of coercering a data.frame and a pdata.frame to matrix # Currently (in at least rev. 195), there is a difference between the both. library(plm) data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) matGrunfeld <- as.matrix(Grunfeld) matpGrunfeld <- as.matrix(pGrunfeld) mat_df_pGrunfeld <- as.matrix(as.data.frame(pGrunfeld)) class(matGrunfeld) class(matpGrunfeld) class(mat_df_pGrunfeld) lapply(matGrunfeld, function(x) class(x)) # all numeric lapply(matpGrunfeld, function(x) class(x)) # all character # Also all character in (at least) rev. 195, albeit pdata.frame was coerced to data.frame first lapply(mat_df_pGrunfeld, function(x) class(x)) plm/inst/tests/test_pwfdtest_pwartest.R0000644000176200001440000000556414124132276020150 0ustar liggesusers### Wooldridge's Tests ### ### pwfdtest() ### pwartest() # attempt to replicate results in Drukker (2003) # Drukker, David M. (2003), Testing for serial correlation in linear panel-data models, # The Stata Journal (2003) 3, Number 2, pp. 168–177. # online: http://www.stata-journal.com/sjpdf.html?articlenum=st0039 library(plm) # library(haven) # nlswork_r8 <- read_dta("http://www.stata-press.com/data/r8/nlswork.dta") # pnlswork_r8 <- pdata.frame(nlswork_r8, index=c("idcode", "year"), drop.index=F) # pdim(pnlswork_r8) # # pnlswork_r8$age2 <- (pnlswork_r8$age)^2 # pnlswork_r8$tenure2 <- (pnlswork_r8$tenure)^2 # # form_nls <- formula(ln_wage ~ age + age2 + ttl_exp + tenure + tenure2 + south) # # fe_nls <- plm(form_nls, data = pnlswork_r8, model = "within") # fd_nls <- plm(form_nls, data = pnlswork_r8, model = "fd") # # # results of regression differ, likely because the model matrices used differ (cf. number of obs) # # in Stata example : Number of obs: 10528 used in regression # summary(fd_nls) # # # both result in error in plm v1.4-0 (CRAN) and dev version as of 2015-11-05 # pwfdtest(fd_nls) # pwfdtest(form_nls, data=pnlswork_r8) data("Grunfeld", package = "plm") Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) form_grun <- formula(inv ~ value + capital) fd_grun <- plm(form_grun, data=Grunfeldpdata, model="fd") fe_grun <- plm(form_grun, data=Grunfeldpdata, model="within") # pwfdtest() runs with Grunfeld data pwfdtest(fd_grun) pwfdtest(form_grun, data=Grunfeldpdata) # pwfdtest() has problem with this dataset # pwfdtest(fd_nls) # pwfdtest(form_nls, data=nlswork_r8) # # pwfdtest(fe_nls) # calling pwfdtest() on a FE model => problem in v1.4-0. Should this case be caught? Similar to calling pwartest on a FD model (see below)? # # # pwartest() # pwartest(fe_grun) # no problem # pwartest(fe_nls) # no problem # pwartest(fd_nls) # adopt this error message (slightly modified) for pwfdtest (FE model)? # # # make a short and unblanced version of Grunfeld data # g_short_unbalanced <- Grunfeld[1:20, ] # g_short_unbalanced[11:20, ]$firm <- 2L # g_short_unbalanced <- g_short_unbalanced[-3, ] # pg_short_unbalanced <- pdata.frame(g_short_unbalanced, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) # fd_grun_unbalanced <- plm(form_grun, data=pg_short_unbalanced, model="fd") # fe_grun_unbalanced <- plm(form_grun, data=pg_short_unbalanced, model="within") # # pwfdtest(fd_grun) # no problem # pwfdtest(fd_grun_unbalanced) # no problem # # pwfdtest(fe_grun) # calling pfdtest on a FE model => problem. Should this case be caught? Similar to calling pwartest on a FD model (see below)? # pwartest(fe_grun) # no problem # pwartest(fd_grun) # adopt this error message (slightly modified) for pwfdtest(fe_grun)? plm/inst/tests/test_plm_na.action.R0000644000176200001440000001365214124132276017076 0ustar liggesusers## plm does not respect argument na.action for padding residuals: ## There is no element "na.action" in the plm object. ## Putting it in, would allow for padding the residuals with NA to ## match the number of rows of the original data by using the standard ## framework like it is in place for lm(). ## ## However, many functions in the plm package (statistical tests, ...) rely ## on the non-padded residuals but extract the residuals by residuals(plm_object) ## or the shortcut resid(plm_object), instead of using plm_object$residuals which ## give the "correct" residuals for such tests. ## ## There is an experimental branch with an added na.action element and changed ## functions to use plm_object$residuals where appropriate, but likely not all ## cases have been caught in that branch. ## ## ## compare lm()'s and plm()'s behaviour ## when residuals() is called on plm objects, na.action element is disrepected; ## na.action = na.omit drops NAs from residuals extracted by residuals ## na.action = na.exclude performs NA padding to match original data length library(plm) data("Grunfeld", package = "plm") form <- formula(inv ~ value + capital) # set some arbitrary value to NA, so it is left out of the estimation Grunfeld_1NA <- Grunfeld line_no <- 6L Grunfeld_1NA[line_no, "inv"] <- NA ############ lm ############ # lm and na.action set to default [usually na.omit] lm_gr_1NA <- lm(form, data = Grunfeld_1NA) nobs(lm_gr_1NA) length(residuals(lm_gr_1NA)) residuals(lm_gr_1NA)[line_no] # lm and na.omit lm_gr_na_omit <- lm(form, data = Grunfeld_1NA, na.action = na.omit) nobs(lm_gr_na_omit) length(residuals(lm_gr_na_omit)) # should be equal to no. of obs used (199) residuals(lm_gr_na_omit)[line_no] # element #line_no should be non-NA (a real data point) is.na(residuals(lm_gr_na_omit)[line_no]) lm_gr_na_omit$na.action head(lm_gr_na_omit$model) na.action(lm_gr_na_omit) # lm and na.exclude lm_gr_na_exclude <- lm(form, data = Grunfeld_1NA, na.action = na.exclude) nobs(lm_gr_na_exclude) length(residuals(lm_gr_na_exclude)) # should be equal to length of original data, due to padding with NA values (200) length(lm_gr_na_exclude$residuals) # but element "residuals" in lm object has only values without NA residuals(lm_gr_na_exclude)[line_no] # element #line_no should be NA, due to padding performed is.na(residuals(lm_gr_na_exclude)[line_no]) head(lm_gr_na_exclude$model) na.action(lm_gr_na_exclude) # lm and na.pass # lm_gr_na_pass <- lm(form, data=Grunfeld_1NA, na.action = na.pass) # yields an error for lm: Error in lm.fit(....) : NA/NaN/Inf in 'y' # Should be TRUE [199 + 1 == 200] # if (!(length(residuals(lm_gr_na_omit)) + 1 == length(residuals(lm_gr_na_exclude)))) # stop("in lm: na.action with na.omit and na.exclude not working correctly") ############ plm ############ # plm and na.action set to default [usually na.omit] plm_gr_1NA <- plm(form, data = Grunfeld_1NA, model = "pooling") nobs(plm_gr_1NA) length(residuals(plm_gr_1NA)) residuals(plm_gr_1NA)[line_no] is.na(residuals(plm_gr_1NA)[line_no]) plm_gr_1NA$na.action # plm and na.omit plm_gr_na_omit <- plm(form, data = Grunfeld_1NA, model = "pooling", na.action = na.omit) nobs(plm_gr_na_omit) length(residuals(plm_gr_na_omit)) residuals(plm_gr_na_omit)[line_no] is.na(residuals(plm_gr_na_omit)[line_no]) plm_gr_na_omit$na.action #if (is.null(plm_gr_na_omit$na.action)) stop("no na.action element found") # plm and na.exclude plm_gr_na_exclude <- plm(form, data = Grunfeld_1NA, model = "pooling", na.action = na.exclude) nobs(plm_gr_na_exclude) length(residuals(plm_gr_na_exclude)) residuals(plm_gr_na_exclude)[line_no] is.na(residuals(plm_gr_na_exclude)[line_no]) plm_gr_na_exclude$na.action #if (is.null(plm_gr_na_exclude$na.action)) stop("no na.action element found") # plm and na.pass # as opposed to lm, plm does not stop with na.pass # NB: as na.pass returns the object unchanged, there is no attribute "na.action" # in this case for the data or for the plm object plm_gr_na_pass <- plm(form, data = Grunfeld_1NA, model = "pooling", na.action = na.pass) nobs(plm_gr_na_pass) length(residuals(plm_gr_na_pass)) residuals(plm_gr_na_pass)[line_no] is.na(residuals(plm_gr_na_pass)[line_no]) plm_gr_na_pass$na.action # if (!is.null(plm_gr_na_pass$na.action)) # stop("na.pass: na.action element found in plm object, albeit there should be non for na.action = na.pass") # plm and na.pass without NAs plm_gr_no_NA_na_pass <- plm(form, data = Grunfeld, model = "pooling", na.action = na.pass) # if (!is.null(plm_gr_no_NA_na_pass$na.action)) # stop("na.pass: na.action element found in plm object, albeit there should be non for na.action = na.pass") # Should be TRUE [199 + 1 == 200] length(residuals(plm_gr_na_omit)) + 1 == length(residuals(plm_gr_na_exclude)) # formal test: # if (!(length(residuals(plm_gr_na_omit)) + 1 == length(residuals(plm_gr_na_exclude)))) # stop("residuals not padded!") # test with randomly missing data Grunfeld_NA_rand <- Grunfeld set.seed(1) Grunfeld_NA_rand[sample(1:nrow(Grunfeld_NA_rand), size = 25), "inv"] <- NA sum(is.na(Grunfeld_NA_rand$inv)) plm_gr_wi_na_exclude <- plm(form, data = Grunfeld_NA_rand, model = "within", na.action = na.exclude) data_NA_structure <- is.na(Grunfeld_NA_rand$inv) res_NA_structure <- is.na(residuals(plm_gr_wi_na_exclude)) # if (!isTRUE(all.equal(data_NA_structure, res_NA_structure, check.attributes = FALSE))) # stop("na.exclude: NA pattern does not match NA pattern of original data") ## test with summary call etc. ## some show NA values summary(plm_gr_1NA) summary(plm_gr_na_omit) summary(plm_gr_na_exclude) summary(plm_gr_na_pass) summary(plm_gr_no_NA_na_pass) summary(plm_gr_wi_na_exclude) class(residuals(plm_gr_1NA)) class(residuals(plm_gr_na_omit)) class(residuals(plm_gr_na_exclude)) class(residuals(plm_gr_na_pass)) class(residuals(plm_gr_no_NA_na_pass)) class(residuals(plm_gr_wi_na_exclude)) plm/inst/tests/test_Errors.R0000644000176200001440000000123714125776262015636 0ustar liggesusers### Testing problematic and erroneous data library(plm) ### NA in the individual index: should give an informative error ind <- 1:100 ind[4] <- NA T <- 4 # balanced panel of length 4 alpha <- rnorm(length(ind)) # fixed effects eps <- rnorm(T*length(ind)) # idiosyncratic effect x <- runif(length(ind)) y <- x + alpha + eps dat <- data.frame(y, x, ind=rep(ind, T), t=rep(1:T, each=length(ind))) data <- pdata.frame(dat, index=c("ind", "t")) a <- try(m <- plm(y ~ x, data=data, model="random")) # should give an error: NA in the individual index plm/inst/tests/test_FD_models.Rout.save0000644000176200001440000001403414124132276017670 0ustar liggesusers R version 3.6.3 (2020-02-29) -- "Holding the Windsock" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Test of various models involving first-differences > > library(plm) > data("Produc", package = "plm") > > > # plm with intercept > fd_plm <- plm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") > # plm without intercept > fd_plm2 <- plm(log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") > > # pggls with intercept > fd_pggls <- pggls(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") > > # pggls without intercept > fd_pggls2 <- pggls(log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") > > > summary(fd_plm) Oneway (individual) effect First-Difference Model Call: plm(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") Balanced Panel: n = 48, T = 17, N = 816 Observations used in estimation: 768 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -0.0852334 -0.0108348 0.0016016 0.0126813 0.1024759 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) 0.01068526 0.00137639 7.7633 2.663e-14 *** log(pcap) -0.00660507 0.04593751 -0.1438 0.8857 log(pc) -0.03243575 0.02305050 -1.4072 0.1598 log(emp) 0.83147269 0.03696857 22.4913 < 2.2e-16 *** unemp -0.00598593 0.00076141 -7.8616 1.293e-14 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1.0802 Residual Sum of Squares: 0.33308 R-Squared: 0.69166 Adj. R-Squared: 0.69004 F-statistic: 427.885 on 4 and 763 DF, p-value: < 2.22e-16 > summary(fd_plm2) Oneway (individual) effect First-Difference Model Call: plm(formula = log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") Balanced Panel: n = 48, T = 17, N = 816 Observations used in estimation: 768 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.07921 -0.00908 0.00447 0.00321 0.01654 0.10380 Coefficients: Estimate Std. Error t-value Pr(>|t|) log(pcap) 0.12347223 0.04440085 2.7809 0.005555 ** log(pc) 0.01838177 0.02294278 0.8012 0.423264 log(emp) 0.95943399 0.03435017 27.9310 < 2.2e-16 *** unemp -0.00428020 0.00075677 -5.6559 2.192e-08 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 1.0802 Residual Sum of Squares: 0.35939 R-Squared: 0.67909 Adj. R-Squared: 0.67783 F-statistic: 735.389 on 4 and 764 DF, p-value: < 2.22e-16 > summary(fd_pggls) Oneway (individual) effect First-Difference FGLS model Call: pggls(formula = log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.0847594 -0.0103758 0.0024378 0.0007254 0.0133336 0.1018213 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 0.00942926 0.00106337 8.8673 < 2e-16 *** log(pcap) -0.04400764 0.02911083 -1.5117 0.13060 log(pc) -0.03100727 0.01248722 -2.4831 0.01302 * log(emp) 0.87411813 0.02077388 42.0777 < 2e-16 *** unemp -0.00483240 0.00040668 -11.8825 < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.33459 Multiple R-squared: 0.99961 > summary(fd_pggls2) Oneway (individual) effect First-Difference FGLS model Call: pggls(formula = log(gsp) ~ 0 + log(pcap) + log(pc) + log(emp) + unemp, data = Produc, model = "fd") Balanced Panel: n = 48, T = 17, N = 816 Residuals: Min. 1st Qu. Median Mean 3rd Qu. Max. -0.078700 -0.007233 0.005760 0.004556 0.018221 0.104727 Coefficients: Estimate Std. Error z-value Pr(>|z|) log(pcap) 0.07172150 0.02768373 2.5907 0.009577 ** log(pc) 0.00339678 0.01229449 0.2763 0.782329 log(emp) 0.96091335 0.01795985 53.5034 < 2.2e-16 *** unemp -0.00367101 0.00039837 -9.2150 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 849.81 Residual Sum of Squares: 0.36212 Multiple R-squared: 0.99957 > vcovHC(fd_plm) (Intercept) log(pcap) log(pc) log(emp) (Intercept) 1.535028e-06 -3.409304e-06 -9.074916e-06 -1.586871e-05 log(pcap) -3.409304e-06 1.904713e-03 -6.277947e-04 -5.320156e-04 log(pc) -9.074916e-06 -6.277947e-04 6.851179e-04 7.508316e-06 log(emp) -1.586871e-05 -5.320156e-04 7.508316e-06 1.004051e-03 unemp -1.441006e-07 -1.917667e-05 2.322284e-06 1.809700e-05 unemp (Intercept) -1.441006e-07 log(pcap) -1.917667e-05 log(pc) 2.322284e-06 log(emp) 1.809700e-05 unemp 6.273753e-07 attr(,"cluster") [1] "group" > vcovHC(fd_plm2) log(pcap) log(pc) log(emp) unemp log(pcap) 2.104941e-03 -7.261636e-04 -5.907699e-04 -2.007078e-05 log(pc) -7.261636e-04 6.968358e-04 -5.151465e-05 1.072643e-06 log(emp) -5.907699e-04 -5.151465e-05 9.602959e-04 1.788651e-05 unemp -2.007078e-05 1.072643e-06 1.788651e-05 6.544230e-07 attr(,"cluster") [1] "group" > ## vcovHC does not run pggls models > # vcovHC(fd_pggls) > # vcovHC(fd_pggls2) > > proc.time() user system elapsed 1.57 0.20 1.84 plm/inst/tests/test_as.list.pdata.frame.R0000644000176200001440000000427214125776262020122 0ustar liggesuserslibrary(plm) data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) # as.list.data.frame used on a pdata.frame strips the attributes (index, classes), # thus, need as.list.pdata.frame function to make lapply usable for pdata.frame # (otherwise as.list.data.frame is used and that does not work due to stripping the attributes) # Default behaviour is keep.attributes = TRUE => behaves identical to as.list.data.frame (because it uses it) # Do not change this default, because some code relies on it! if (!identical(as.list.data.frame(pGrunfeld), as.list(pGrunfeld))) stop("as.list.pdata.frame(x, keep.attributes = FALSE) does not produce identical structure compared as.list.data.frame") # test for keeping attributes (make a list of pseries objects) expected_result_classes <- list(firm = c("pseries", "factor"), year = c("pseries", "factor"), inv = c("pseries", "numeric"), value = c("pseries", "numeric"), capital = c("pseries", "numeric")) if (!identical(lapply(as.list(pGrunfeld, keep.attributes = TRUE), class), expected_result_classes)) stop("classes not correct") if (!class(as.list(pGrunfeld)) == "list") stop("class is not list") if (!class(as.list(pGrunfeld, keep.attributes = TRUE)) == "list") stop("class is not list") # test operation with lapply list_lags <- lapply(as.list(pGrunfeld, keep.attributes = TRUE), function(x) lag(x)) if (!all(class(list_lags[[1]]) == c("pseries", "factor"))) stop("wrong extracted class") if (!all(class(list_lags[["value"]]) == c("pseries", "numeric"))) stop("wrong extracted class") if (!identical(list_lags[["value"]], lag(pGrunfeld$value))) stop("lapply with function on pdata.frame produced incorrect results") # set on subsetted pdata.frame list_lags_sub <- lapply(as.list(pGrunfeld[1:50, ], keep.attributes = TRUE), function(x) lag(x)) if (!all(class(list_lags_sub[["value"]]) == c("pseries", "numeric"))) stop("wrong extracted class") if (!identical(list_lags_sub[["value"]], lag(pGrunfeld[1:50, ]$value))) stop("lapply with function on pdata.frame produced incorrect results") plm/inst/tests/test_purtest.Rout.save0000644000176200001440000007753214161716274017565 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Various run tests for purtest() and phansitest() > > # NB: p-values can differ slightly relative to .Rout.save file due to availability of package 'urca' > # for p-value approximation in individual (A)DF-regressions. > > library(plm) > data("Grunfeld", package = "plm") > pG <- pdata.frame(Grunfeld) > y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) > > # some general run tests > > purtest(pG$inv, pmax = 4, exo = "intercept", test = "ips") Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: pG$inv Wtbar = 2.5801, p-value = 0.9951 alternative hypothesis: stationarity > purtest(inv ~ 1, data = Grunfeld, index = "firm", pmax = 4, test = "madwu") Maddala-Wu Unit-Root Test (ex. var.: Individual Intercepts) data: inv ~ 1 chisq = 14.719, df = 20, p-value = 0.7923 alternative hypothesis: stationarity > > > summary(a1 <- purtest(pG$inv, lags = "SIC", exo = "intercept", test = "ips", pmax = 8)) # TODO: why is the data requirement check not triggered Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts Automatic selection of lags using SIC: 0 - 8 lags (max: 8) statistic (Wtbar): NA p-value: NA lags obs rho trho p.trho mean var 1 8 11 0.57372489 7.2972878 1.000000e+00 NA NA 2 7 12 -1.33500743 -2.1403062 2.288844e-01 NA NA 3 8 11 -0.24069010 -1.8357409 3.634387e-01 NA NA 4 0 19 -0.05374775 -0.4175477 9.039655e-01 -1.5204 0.8654 5 7 12 1.43387118 3.6341172 1.000000e+00 NA NA 6 8 11 1.47800229 45.8810140 1.000000e+00 NA NA 7 0 19 -0.13861644 -0.8207942 8.127581e-01 -1.5204 0.8654 8 8 11 -1.54461692 -12.2711923 1.366843e-26 NA NA 9 8 11 -1.72024968 -10.6042569 3.718916e-21 NA NA 10 7 12 -4.64427462 -34.2629736 4.912076e-39 NA NA > print(a1$args$lags) [1] "SIC" > if (length(a1$args$lags) != 1) stop("length(return_value$args$lags must be 1") > if (a1$args$lags != "SIC") stop("length(return_value$args$lags must be \"SIC\"") > > summary(a2 <- purtest(pG$inv, lags = 2, exo = "intercept", test = "ips")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 4.51 p-value: 1 lags obs rho trho p.trho mean var 1 2 17 0.37455746 1.69705718 0.9996764 -1.4034 1.0344 2 2 17 -0.33653803 -1.31826344 0.6233556 -1.4034 1.0344 3 2 17 -0.12937014 -0.65968273 0.8547816 -1.4034 1.0344 4 2 17 0.19494339 1.06936162 0.9973362 -1.4034 1.0344 5 2 17 0.02327321 0.08084075 0.9643497 -1.4034 1.0344 6 2 17 0.28398534 2.60790962 0.9999927 -1.4034 1.0344 7 2 17 0.13957097 0.65174468 0.9911239 -1.4034 1.0344 8 2 17 -0.28331574 -1.30317041 0.6304318 -1.4034 1.0344 9 2 17 -0.37152816 -1.88381502 0.3403028 -1.4034 1.0344 10 2 17 -0.07346420 -0.46967793 0.8946597 -1.4034 1.0344 > print(a2$args$lags) [1] 2 > if (length(a2$args$lags) != 1) stop("length(return_value$args$lags must be 1") > > summary(a3 <- purtest(pG$inv, lags = c(2,3,1,5,8,1,4,6,7,1), exo = "intercept", test = "ips")) # TODO: why is the data requirement check not triggered Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): NA p-value: NA lags obs rho trho p.trho mean var 1 2 17 0.37455746 1.69705718 0.999676427 -1.4034 1.0344 2 3 16 -0.21033975 -0.81675296 0.813913698 -1.3754 1.1522 3 1 18 -0.27302816 -1.65614389 0.453728694 -1.5108 0.9534 4 5 14 0.85015585 1.04616383 0.997140218 NA NA 5 8 11 1.06680894 1.96954663 0.999900000 NA NA 6 1 18 0.21710976 2.51472363 0.999988720 -1.5108 0.9534 7 4 15 0.01600785 0.05406133 0.962208297 -1.2600 1.2790 8 6 13 -0.12662404 -0.38012322 0.910249725 NA NA 9 7 12 -0.89993048 -4.03185909 0.001255622 NA NA 10 1 18 -0.23247810 -1.68616532 0.438360790 -1.5108 0.9534 > summary(a3_ok <- purtest(pG$inv, lags = c(2,3,1,4,4,1,4,4,4,1), exo = "intercept", test = "ips")) # TODO: ... and this works Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 4.225 p-value: 1 lags obs rho trho p.trho mean var 1 2 17 0.37455746 1.69705718 0.9996764 -1.4034 1.0344 2 3 16 -0.21033975 -0.81675296 0.8139137 -1.3754 1.1522 3 1 18 -0.27302816 -1.65614389 0.4537287 -1.5108 0.9534 4 4 15 0.81391748 1.73056665 0.9997139 -1.2600 1.2790 5 4 15 0.50411533 1.18402747 0.9981328 -1.2600 1.2790 6 1 18 0.21710976 2.51472363 0.9999887 -1.5108 0.9534 7 4 15 0.01600785 0.05406133 0.9622083 -1.2600 1.2790 8 4 15 -0.20997786 -0.85212458 0.8036037 -1.2600 1.2790 9 4 15 -0.34115868 -1.48936970 0.5392619 -1.2600 1.2790 10 1 18 -0.23247810 -1.68616532 0.4383608 -1.5108 0.9534 > length(a3$args$lags) [1] 10 > print(a3$args$lags) [1] 2 3 1 5 8 1 4 6 7 1 > if (length(a3$args$lags) != 10) stop("length(return_value$args$lags must be 10") > > ### pseries > purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "intercept") # works Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: pdata.frame(Grunfeld)[, "inv"] Wtbar = 2.5801, p-value = 0.9951 alternative hypothesis: stationarity > purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "trend") # works Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts and Trend) data: pdata.frame(Grunfeld)[, "inv"] Wtbar = -3.0337, p-value = 0.001208 alternative hypothesis: stationarity > # purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "none") # works as intended: gives informative error msg > > ### pdata.frame - individuals must be in columns! > df_inv <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) > purtest(df_inv, pmax = 4, test = "ips", exo = "intercept") Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: df_inv Wtbar = 2.5801, p-value = 0.9951 alternative hypothesis: stationarity > ### matrix > purtest(as.matrix(df_inv), pmax = 4, test = "ips", exo = "intercept") Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: as.matrix(df_inv) Wtbar = 2.5801, p-value = 0.9951 alternative hypothesis: stationarity > > > #### Hadri (2000) test > ## matches results vom EViews 9.5 (if dfcor = FALSE): > ## z stat = 4.18428, p = 0.0000 (intercept) > ## z stat het = 10.1553, p = 0.0000 (intercept) > ## z stat = 4.53395, p = 0.0000 (trend) > ## z stat het = 9.57816, p = 0.0000 (trend) > h_1.1 <- purtest(pG$value, exo = "intercept", test = "hadri", Hcons = FALSE) > h_1.2 <- purtest(pG$value, exo = "intercept", test = "hadri", Hcons = FALSE, dfcor = TRUE) > h_2.1 <- purtest(pG$value, exo = "intercept", test = "hadri") > h_2.2 <- purtest(pG$value, exo = "intercept", test = "hadri", dfcor = TRUE) > h_3.1 <- purtest(pG$value, exo = "trend", test = "hadri", Hcons = FALSE) > h_3.2 <- purtest(pG$value, exo = "trend", test = "hadri", Hcons = FALSE, dfcor = TRUE) > h_4.1 <- purtest(pG$value, exo = "trend", test = "hadri") > h_4.2 <- purtest(pG$value, exo = "trend", test = "hadri", dfcor = TRUE) > > summary(h_1.1) Hadri Test Exogenous variables: Individual Intercepts statistic: 4.184 p-value: 0 LM sigma2 [1,] 0.3143392 776878.74047 [2,] 0.0974765 86121.20788 [3,] 0.1464531 162702.95487 [4,] 0.2507621 24502.54190 [5,] 1.5352867 5179.84410 [6,] 1.7158789 44738.61027 [7,] 0.3565975 1030.01290 [8,] 1.0287779 46985.26090 [9,] 0.6875534 5669.88650 [10,] 0.3207828 81.68617 > summary(h_1.2) Hadri Test Exogenous variables: Individual Intercepts statistic: 3.798 p-value: 0 LM sigma2 [1,] 0.29862219 817767.09524 [2,] 0.09260268 90653.90303 [3,] 0.13913042 171266.26829 [4,] 0.23822401 25792.14937 [5,] 1.45852236 5452.46747 [6,] 1.63008494 47093.27397 [7,] 0.33876762 1084.22411 [8,] 0.97733904 49458.16937 [9,] 0.65317574 5968.30158 [10,] 0.30474367 85.98544 > summary(h_2.1) Hadri Test Exogenous variables: Individual Intercepts statistic: 10.155 p-value: 0 LM sigma2 [1,] 0.3143392 776878.74047 [2,] 0.0974765 86121.20788 [3,] 0.1464531 162702.95487 [4,] 0.2507621 24502.54190 [5,] 1.5352867 5179.84410 [6,] 1.7158789 44738.61027 [7,] 0.3565975 1030.01290 [8,] 1.0287779 46985.26090 [9,] 0.6875534 5669.88650 [10,] 0.3207828 81.68617 > summary(h_2.2) Hadri Test Exogenous variables: Individual Intercepts statistic: 9.471 p-value: 0 LM sigma2 [1,] 0.29862219 817767.09524 [2,] 0.09260268 90653.90303 [3,] 0.13913042 171266.26829 [4,] 0.23822401 25792.14937 [5,] 1.45852236 5452.46747 [6,] 1.63008494 47093.27397 [7,] 0.33876762 1084.22411 [8,] 0.97733904 49458.16937 [9,] 0.65317574 5968.30158 [10,] 0.30474367 85.98544 > summary(h_3.1) Hadri Test Exogenous variables: Individual Intercepts and Trend statistic: 4.534 p-value: 0 LM sigma2 [1,] 0.12037588 671266.58182 [2,] 0.10309400 86050.07644 [3,] 0.15460710 160987.22169 [4,] 0.04652752 21859.45611 [5,] 0.32820347 1319.04037 [6,] 0.41795730 6990.22810 [7,] 0.34773700 1022.55237 [8,] 0.16362350 21248.56152 [9,] 0.15446576 3832.05673 [10,] 0.09570977 71.11004 > summary(h_3.2) Hadri Test Exogenous variables: Individual Intercepts and Trend statistic: 3.576 p-value: 0 LM sigma2 [1,] 0.10833829 745851.75758 [2,] 0.09278460 95611.19605 [3,] 0.13914639 178874.69077 [4,] 0.04187476 24288.28457 [5,] 0.29538313 1465.60041 [6,] 0.37616157 7766.92011 [7,] 0.31296330 1136.16930 [8,] 0.14726115 23609.51281 [9,] 0.13901919 4257.84081 [10,] 0.08613879 79.01116 > summary(h_4.1) Hadri Test Exogenous variables: Individual Intercepts and Trend statistic: 9.578 p-value: 0 LM sigma2 [1,] 0.12037588 671266.58182 [2,] 0.10309400 86050.07644 [3,] 0.15460710 160987.22169 [4,] 0.04652752 21859.45611 [5,] 0.32820347 1319.04037 [6,] 0.41795730 6990.22810 [7,] 0.34773700 1022.55237 [8,] 0.16362350 21248.56152 [9,] 0.15446576 3832.05673 [10,] 0.09570977 71.11004 > summary(h_4.2) Hadri Test Exogenous variables: Individual Intercepts and Trend statistic: 8.116 p-value: 0 LM sigma2 [1,] 0.10833829 745851.75758 [2,] 0.09278460 95611.19605 [3,] 0.13914639 178874.69077 [4,] 0.04187476 24288.28457 [5,] 0.29538313 1465.60041 [6,] 0.37616157 7766.92011 [7,] 0.31296330 1136.16930 [8,] 0.14726115 23609.51281 [9,] 0.13901919 4257.84081 [10,] 0.08613879 79.01116 > > > ### IPS (2003) test > ## use dfcor = TRUE to match gretl 2017c and EViews 9.5 exactly > b <- purtest(pG$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE) > summary(b) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): -1.419 p-value: 0.078 lags obs rho trho p.trho mean var 1 0 19 -0.7221173 -3.0980241 0.0267255342 -1.5204 0.8654 2 0 19 -0.8376784 -3.9708351 0.0015756584 -1.5204 0.8654 3 0 19 -0.5503275 -2.4918122 0.1174272537 -1.5204 0.8654 4 0 19 -0.9812049 -4.4232340 0.0002648235 -1.5204 0.8654 5 0 19 -0.0246934 -0.2247631 0.9329996429 -1.5204 0.8654 6 0 19 0.1313902 2.0376353 0.9999127394 -1.5204 0.8654 7 0 19 -0.2767321 -1.5074566 0.5300598000 -1.5204 0.8654 8 0 19 -0.2343526 -1.4013933 0.5833071748 -1.5204 0.8654 9 0 19 -0.3064189 -1.4852375 0.5413593097 -1.5204 0.8654 10 0 19 -0.6898608 -2.8137835 0.0562945264 -1.5204 0.8654 > > # NB: In case of lags = 0 (DF-regression), gretl 2019d takes the finite sample p-values > # (finite sample p-values are not applicable for augmented DF-regressions) > > # For reference/reproducability purposes, use MacKinnon (1994) and MacKinnon (1996) each once: > summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, p.approx = "MacKinnon1994")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 1.496 p-value: 0.933 lags obs rho trho p.trho mean var 1 2 17 -0.77717841 -1.43117190 0.5672441 -1.4034 1.0344 2 2 17 -0.66130878 -1.83739675 0.3620596 -1.4034 1.0344 3 2 17 -0.53160334 -1.58422268 0.4915140 -1.4034 1.0344 4 2 17 -1.07349948 -2.15851492 0.2216450 -1.4034 1.0344 5 2 17 -0.01866852 -0.08602929 0.9508124 -1.4034 1.0344 6 2 17 0.25337574 2.80099666 0.9990856 -1.4034 1.0344 7 2 17 -0.38352999 -1.75556519 0.4027346 -1.4034 1.0344 8 2 17 0.35686831 1.02362053 0.9945090 -1.4034 1.0344 9 2 17 -0.86010702 -2.07408161 0.2550634 -1.4034 1.0344 10 2 17 -0.83869431 -2.11875217 0.2370414 -1.4034 1.0344 > summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, p.approx = "MacKinnon1996")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 1.496 p-value: 0.933 lags obs rho trho p.trho mean var 1 2 17 -0.77717841 -1.43117190 0.5685499 -1.4034 1.0344 2 2 17 -0.66130878 -1.83739675 0.3626320 -1.4034 1.0344 3 2 17 -0.53160334 -1.58422268 0.4906848 -1.4034 1.0344 4 2 17 -1.07349948 -2.15851492 0.2218810 -1.4034 1.0344 5 2 17 -0.01866852 -0.08602929 0.9492112 -1.4034 1.0344 6 2 17 0.25337574 2.80099666 0.9999971 -1.4034 1.0344 7 2 17 -0.38352999 -1.75556519 0.4031653 -1.4034 1.0344 8 2 17 0.35686831 1.02362053 0.9969373 -1.4034 1.0344 9 2 17 -0.86010702 -2.07408161 0.2554070 -1.4034 1.0344 10 2 17 -0.83869431 -2.11875217 0.2373267 -1.4034 1.0344 > > ## lags = 2 (lags > 0 gives the Wtbar stat in gretl and EViews) > b_lag2 <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE) > summary(b_lag2) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 1.496 p-value: 0.933 lags obs rho trho p.trho mean var 1 2 17 -0.77717841 -1.43117190 0.5685499 -1.4034 1.0344 2 2 17 -0.66130878 -1.83739675 0.3626320 -1.4034 1.0344 3 2 17 -0.53160334 -1.58422268 0.4906848 -1.4034 1.0344 4 2 17 -1.07349948 -2.15851492 0.2218810 -1.4034 1.0344 5 2 17 -0.01866852 -0.08602929 0.9492112 -1.4034 1.0344 6 2 17 0.25337574 2.80099666 0.9999971 -1.4034 1.0344 7 2 17 -0.38352999 -1.75556519 0.4031653 -1.4034 1.0344 8 2 17 0.35686831 1.02362053 0.9969373 -1.4034 1.0344 9 2 17 -0.86010702 -2.07408161 0.2554070 -1.4034 1.0344 10 2 17 -0.83869431 -2.11875217 0.2373267 -1.4034 1.0344 > > # unbalanced IPS > pG_unbal2 <- pG[1:190, ] > b_unbal <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE) Warning message: In selectT(l, theTs) : the time series is short > summary(b_unbal) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): -1.131 p-value: 0.129 lags obs rho trho p.trho mean var 1 0 19 -0.7221173 -3.0980241 0.0267255342 -1.5204 0.8654 2 0 19 -0.8376784 -3.9708351 0.0015756584 -1.5204 0.8654 3 0 19 -0.5503275 -2.4918122 0.1174272537 -1.5204 0.8654 4 0 19 -0.9812049 -4.4232340 0.0002648235 -1.5204 0.8654 5 0 19 -0.0246934 -0.2247631 0.9329996429 -1.5204 0.8654 6 0 19 0.1313902 2.0376353 0.9999127394 -1.5204 0.8654 7 0 19 -0.2767321 -1.5074566 0.5300598000 -1.5204 0.8654 8 0 19 -0.2343526 -1.4013933 0.5833071748 -1.5204 0.8654 9 0 19 -0.3064189 -1.4852375 0.5413593097 -1.5204 0.8654 10 0 9 -0.7843684 -1.9879749 0.2923700508 -1.5040 1.0690 > > # IPS - Ztbar > # matches gretl exactly # Z_tbar = -1.12782 [0.1297]; difference to EViews: Adjustment parameters (Etbar, Vtbar): > summary(b_unbal3 <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Ztbar): -1.128 p-value: 0.13 lags obs rho trho p.trho mean var 1 0 19 -0.7221173 -3.0980241 0.0267255342 -1.5204 0.8654 2 0 19 -0.8376784 -3.9708351 0.0015756584 -1.5204 0.8654 3 0 19 -0.5503275 -2.4918122 0.1174272537 -1.5204 0.8654 4 0 19 -0.9812049 -4.4232340 0.0002648235 -1.5204 0.8654 5 0 19 -0.0246934 -0.2247631 0.9329996429 -1.5204 0.8654 6 0 19 0.1313902 2.0376353 0.9999127394 -1.5204 0.8654 7 0 19 -0.2767321 -1.5074566 0.5300598000 -1.5204 0.8654 8 0 19 -0.2343526 -1.4013933 0.5833071748 -1.5204 0.8654 9 0 19 -0.3064189 -1.4852375 0.5413593097 -1.5204 0.8654 10 0 9 -0.7843684 -1.9879749 0.2923700508 -1.5010 1.1320 > > summary(b_ztbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Ztbar): -1.419 p-value: 0.078 lags obs rho trho p.trho mean var 1 0 19 -0.7221173 -3.0980241 0.0267255342 -1.5204 0.8654 2 0 19 -0.8376784 -3.9708351 0.0015756584 -1.5204 0.8654 3 0 19 -0.5503275 -2.4918122 0.1174272537 -1.5204 0.8654 4 0 19 -0.9812049 -4.4232340 0.0002648235 -1.5204 0.8654 5 0 19 -0.0246934 -0.2247631 0.9329996429 -1.5204 0.8654 6 0 19 0.1313902 2.0376353 0.9999127394 -1.5204 0.8654 7 0 19 -0.2767321 -1.5074566 0.5300598000 -1.5204 0.8654 8 0 19 -0.2343526 -1.4013933 0.5833071748 -1.5204 0.8654 9 0 19 -0.3064189 -1.4852375 0.5413593097 -1.5204 0.8654 10 0 19 -0.6898608 -2.8137835 0.0562945264 -1.5204 0.8654 > summary(b_ztbar_unbal <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Ztbar): -1.128 p-value: 0.13 lags obs rho trho p.trho mean var 1 0 19 -0.7221173 -3.0980241 0.0267255342 -1.5204 0.8654 2 0 19 -0.8376784 -3.9708351 0.0015756584 -1.5204 0.8654 3 0 19 -0.5503275 -2.4918122 0.1174272537 -1.5204 0.8654 4 0 19 -0.9812049 -4.4232340 0.0002648235 -1.5204 0.8654 5 0 19 -0.0246934 -0.2247631 0.9329996429 -1.5204 0.8654 6 0 19 0.1313902 2.0376353 0.9999127394 -1.5204 0.8654 7 0 19 -0.2767321 -1.5074566 0.5300598000 -1.5204 0.8654 8 0 19 -0.2343526 -1.4013933 0.5833071748 -1.5204 0.8654 9 0 19 -0.3064189 -1.4852375 0.5413593097 -1.5204 0.8654 10 0 9 -0.7843684 -1.9879749 0.2923700508 -1.5010 1.1320 > summary(b_ztbar_unbal2 <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "Ztbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Ztbar): 2.468 p-value: 0.993 lags obs rho trho p.trho mean var 1 2 17 -0.77717841 -1.43117190 0.5685499 -1.5172 0.8942 2 2 17 -0.66130878 -1.83739675 0.3626320 -1.5172 0.8942 3 2 17 -0.53160334 -1.58422268 0.4906848 -1.5172 0.8942 4 2 17 -1.07349948 -2.15851492 0.2218810 -1.5172 0.8942 5 2 17 -0.01866852 -0.08602929 0.9492112 -1.5172 0.8942 6 2 17 0.25337574 2.80099666 0.9999971 -1.5172 0.8942 7 2 17 -0.38352999 -1.75556519 0.4031653 -1.5172 0.8942 8 2 17 0.35686831 1.02362053 0.9969373 -1.5172 0.8942 9 2 17 -0.86010702 -2.07408161 0.2554070 -1.5172 0.8942 10 2 7 -0.75040885 -0.47470530 0.8937273 -1.5140 1.4140 > summary(b_lag2_ztbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "Ztbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Ztbar): 1.99 p-value: 0.977 lags obs rho trho p.trho mean var 1 2 17 -0.77717841 -1.43117190 0.5685499 -1.5172 0.8942 2 2 17 -0.66130878 -1.83739675 0.3626320 -1.5172 0.8942 3 2 17 -0.53160334 -1.58422268 0.4906848 -1.5172 0.8942 4 2 17 -1.07349948 -2.15851492 0.2218810 -1.5172 0.8942 5 2 17 -0.01866852 -0.08602929 0.9492112 -1.5172 0.8942 6 2 17 0.25337574 2.80099666 0.9999971 -1.5172 0.8942 7 2 17 -0.38352999 -1.75556519 0.4031653 -1.5172 0.8942 8 2 17 0.35686831 1.02362053 0.9969373 -1.5172 0.8942 9 2 17 -0.86010702 -2.07408161 0.2554070 -1.5172 0.8942 10 2 17 -0.83869431 -2.11875217 0.2373267 -1.5172 0.8942 > > > ## these two correctly errors with an informative message: > # summary(b_lag2_tbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "tbar")) > > # TODO: in case of automatic lag selection, the selected lags need to be outputted > # purtest(pG$value, test = "ips", dfcor = TRUE, ips.stat = "wtbar", exo = "intercept") # due to automatic lag selection (yields 10) > > > value4 <- pG[pG$year %in% as.character(1935:1938), ]$value > purtest(value4, test = "ips", dfcor = TRUE, ips.stat = "tbar", exo = "intercept", lags = 0) Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: value4 tbar = -1.8539, p-value = NA alternative hypothesis: stationarity tbar critival values: 1% 5% 10% -3.06 -2.42 -2.17 Warning message: In selectT(time, theTs) : the time series is short > > > > purtest(pG$value, test = "ips", exo = "intercept", lags = 5, dfcor = TRUE, ips.stat = "Wtbar") # TODO: how to detect this not detected? Im-Pesaran-Shin Unit-Root Test (ex. var.: Individual Intercepts) data: pG$value Wtbar = NA, p-value = NA alternative hypothesis: stationarity > summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 4, dfcor = TRUE, ips.stat = "Wtbar")) Im-Pesaran-Shin Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic (Wtbar): 1.394 p-value: 0.918 lags obs rho trho p.trho mean var 1 4 15 -1.9906352 -2.3035551 0.1708438 -1.26 1.279 2 4 15 -0.6131793 -1.3338339 0.6159886 -1.26 1.279 3 4 15 -0.8232601 -1.6864510 0.4382149 -1.26 1.279 4 4 15 -1.3023670 -1.4943688 0.5367235 -1.26 1.279 5 4 15 0.7068690 2.8414342 0.9999976 -1.26 1.279 6 4 15 0.4590103 1.5479686 0.9994468 -1.26 1.279 7 4 15 -0.4063862 -1.2425923 0.6581524 -1.26 1.279 8 4 15 -0.3520056 -0.4971782 0.8894773 -1.26 1.279 9 4 15 -0.9076888 -1.2201156 0.6681135 -1.26 1.279 10 4 15 -0.8549814 -2.2267094 0.1968232 -1.26 1.279 > > #### various tests from Choi (2001) [besides test = "madwu"] > purtest(pG$value, test = "Pm", exo = "intercept", lags = 2, dfcor = TRUE) Choi's modified P Unit-Root Test (ex. var.: Individual Intercepts) data: pG$value Pm = -0.77052, p-value = 0.7795 alternative hypothesis: stationarity > purtest(pG$value, test = "invnormal", exo = "intercept", lags = 2, dfcor = TRUE) Choi's Inverse Normal Unit-Root Test (ex. var.: Individual Intercepts) data: pG$value z = 1.9998, p-value = 0.9772 alternative hypothesis: stationarity > purtest(pG$value, test = "logit", exo = "intercept", lags = 2, dfcor = TRUE) Choi's Logit Unit-Root Test (ex. var.: Individual Intercepts) data: pG$value L* = 3.0637, df = 54, p-value = 0.9983 alternative hypothesis: stationarity > > > > #### Levin-Lin-Chu test > # matches gretl (almost) exactly: match gretl, set dfcor = FALSE > # NB: one remaining (asymptotically irrelevant) difference > # between gretl and purtest for LLC. Bandwidth calc for Bartlett kernel (in longrunvar), > # 3.21 * T^(1/3) purtest rounds, gretl truncates (no clear answer to this, LLC > # use rounding as becomes clear from their table 2 as they apply rounding for their > # "quick-and-dirty" values for bandwidth cutoff). > llc <- purtest(pG$value, test = "levinlin", exo = "none", lags = 0, dfcor = FALSE) Warning message: In selectT(l, theTs) : the time series is short > summary(llc) Levin-Lin-Chu Unit-Root Test Exogenous variables: None User-provided lags statistic: 2.589 p-value: 0.995 lags obs rho trho p.trho sigma2ST sigma2LT 1 0 19 0.0019996109 0.03663606 0.6945257 1072129.7840 279480.6956 2 0 19 0.0007285916 0.01736171 0.6883316 132098.1511 41445.4322 3 0 19 0.0227319953 0.48356807 0.8195756 156924.5211 107546.2409 4 0 19 -0.0294427058 -0.42462225 0.5303544 46185.8481 8199.4536 5 0 19 0.0428128365 1.42801803 0.9623315 936.0730 1442.4816 6 0 19 0.1036547749 4.03388318 0.9999898 2351.0265 15210.1791 7 0 19 0.0067226451 0.17399747 0.7367803 645.1893 368.9379 8 0 19 0.0572121415 1.19245684 0.9407269 19632.2543 24489.4498 9 0 19 0.0149651207 0.34199426 0.7839193 4049.2102 1790.0814 10 0 19 -0.0194609404 -0.57389170 0.4689788 113.6714 21.3401 > > llc_int <- purtest(pG$value, test = "levinlin", exo = "intercept", lags = 0, dfcor = FALSE) Warning message: In selectT(l, theTs) : the time series is short > summary(llc_int) Levin-Lin-Chu Unit-Root Test Exogenous variables: Individual Intercepts User-provided lags statistic: 0.119 p-value: 0.547 lags obs rho trho p.trho sigma2ST sigma2LT 1 0 19 -0.7221173 -3.2751947 1.605723e-02 674102.29560 211234.03828 2 0 19 -0.8376784 -4.1979203 6.603715e-04 67719.34761 40064.61858 3 0 19 -0.5503275 -2.6343147 8.602350e-02 111232.19021 98064.13746 4 0 19 -0.9812049 -4.6761911 8.947014e-05 21571.62709 6998.44059 5 0 19 -0.0246934 -0.2376169 9.313144e-01 913.97908 466.81572 6 0 19 0.1313902 2.1541642 9.999458e-01 2320.41041 4408.58528 7 0 19 -0.2767321 -1.5936655 4.858266e-01 562.71036 351.89070 8 0 19 -0.2343526 -1.4815366 5.432370e-01 16445.93254 11560.53123 9 0 19 -0.3064189 -1.5701756 4.979070e-01 3523.27233 1184.33960 10 0 19 -0.6898608 -2.9746990 3.733484e-02 78.58803 18.19652 > > llc_trend <- purtest(pG$value, test = "levinlin", exo = "trend", lags = 0, dfcor = FALSE) Warning message: In selectT(l, theTs) : the time series is short > summary(llc_trend) Levin-Lin-Chu Unit-Root Test Exogenous variables: Individual Intercepts and Trend User-provided lags statistic: -2.645 p-value: 0.004 lags obs rho trho p.trho sigma2ST sigma2LT 1 0 19 -0.7836305 -3.4975211 0.039570557 641603.1359 211062.8757 2 0 19 -0.8400949 -4.2846206 0.003261168 65367.5041 39183.4989 3 0 19 -0.5536329 -2.6416769 0.261552821 111050.4146 97040.4645 4 0 19 -1.0539785 -4.8189393 0.000398602 20585.7551 7237.7631 5 0 19 -0.3289082 -1.9170742 0.645464576 739.8359 180.4347 6 0 19 -0.0473435 -0.3191513 0.990184932 2127.9842 563.0777 7 0 19 -0.2737291 -1.5856239 0.798996102 555.4818 225.0138 8 0 19 -0.4713268 -2.3192335 0.422845594 14287.3717 11267.6335 9 0 19 -0.4875576 -2.3614046 0.400000183 3009.0288 767.5460 10 0 19 -0.7854102 -3.4617227 0.043582736 69.7076 21.5264 > > > ## Simes Test for panels by Hanck > phansitest(llc) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > phansitest(llc_int) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) Individual H0 rejected for 2 individual(s) (integer id(s)): 2, 4 > phansitest(llc_trend) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) Individual H0 rejected for 2 individual(s) (integer id(s)): 2, 4 > phansitest(purtest(pG$value, test = "Pm", exo = "intercept", lags = 2, dfcor = TRUE)) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > phansitest(purtest(pG$value, test = "invnormal", exo = "intercept", lags = 2, dfcor = TRUE)) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > phansitest(purtest(pG$value, test = "logit", exo = "intercept", lags = 2, dfcor = TRUE)) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > > phansitest(purtest(inv ~ 1, data = Grunfeld, index = "firm", pmax = 4, test = "madwu")) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > > phansitest(b_unbal3) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) Individual H0 rejected for 2 individual(s) (integer id(s)): 2, 4 > phansitest(b_ztbar) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) Individual H0 rejected for 2 individual(s) (integer id(s)): 2, 4 > phansitest(b_ztbar_unbal) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) Individual H0 rejected for 2 individual(s) (integer id(s)): 2, 4 > phansitest(b_ztbar_unbal2) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > phansitest(b_lag2_ztbar) Simes Test as Panel Unit Root Test (Hanck (2013)) H0: All individual series have a unit root HA: Stationarity for at least some individuals Alpha: 0.05 Number of individuals: 10 Evaluation: H0 rejected (globally) > > proc.time() user system elapsed 7.23 0.95 8.34 plm/inst/tests/test_model.frame.R0000644000176200001440000001456414124132276016550 0ustar liggesusers# tests if model is re-producable from plm_object$model (model.frame in plm_object) # => reproduction works library(plm) data("Grunfeld", package="plm") # requires package plm # generate dataset with NA in dependent and independent variable Grunfeld_NA_dep_var <- Grunfeld Grunfeld_NA_dep_var[1, ]$inv <- NA pGrunfeld_NA_dep_var <- pdata.frame(Grunfeld_NA_dep_var) Grunfeld_NA_indep_var <- Grunfeld Grunfeld_NA_indep_var[1, ]$value <- NA pGrunfeld_NA_indep_var <- pdata.frame(Grunfeld_NA_indep_var) #### input more NAs in dep var pGrunfeld_NA_dep_var_more <- pGrunfeld_NA_dep_var pGrunfeld_NA_dep_var_more[c(1:10, 21:30), ]$inv <- NA # generate dataset with NA row Grunfeld_NA_row <- Grunfeld Grunfeld_NA_row[1, c("inv", "value", "capital")] <- NA pGrunfeld_NA_row <- pdata.frame(Grunfeld_NA_row) form <- formula(inv ~ value + capital) # 200 rows nrow(Grunfeld) nrow(Grunfeld_NA_dep_var) nrow(Grunfeld_NA_row) plm_fe <- plm(form, data=Grunfeld, model="within") plm_fe_NA_dep_var <- plm(form, data=pGrunfeld_NA_dep_var, model="within") plm_fe_NA_dep_var_more <- plm(form, data=pGrunfeld_NA_dep_var_more, model="within") plm_fe_NA_dep_var_tw <- plm(form, data=pGrunfeld_NA_dep_var, model="within", effect = "twoways") plm_re <- plm(form, data=Grunfeld, model="random") plm_re_NA_dep_var <- plm(form, data=pGrunfeld_NA_dep_var, model="random") plm_re_NA_dep_var_more <- plm(form, data=pGrunfeld_NA_dep_var_more, model="random") # plm_re_NA_dep_var_tw <- plm(form, data=pGrunfeld_NA_dep_var, model="random", effect = "twoways") # not implemented # plm_re_NA_tw <- plm(form, data=Grunfeld, model="random", effect = "twoways") # est. variance of time effect < 0 if (nrow(plm_fe$model) != 200) stop("should be 200 rows") # 200 (correct) if (nrow(plm_fe_NA_dep_var$model) != 199) stop("should be 199 rows") # 199 (correct) if (nrow(plm_fe_NA_dep_var_more$model) != 180) stop("should be 180 rows") # 180 (correct) if (nrow(plm_fe_NA_dep_var_tw$model) != 199) stop("should be 199 rows") # 199 (correct) if (nrow(plm_re$model) != 200) stop("should be 200 rows") # 200 (correct) if (nrow(plm_re_NA_dep_var$model) != 199) stop("should be 199 rows") # 199 (correct) if (nrow(plm_re_NA_dep_var_more$model) != 180) stop("should be 180 rows") # 180 (correct) #nrow(plm_fe_NA_dep_var_tw$model) # not implemented ###### re-produce FE model plm_fe_NA_dep_var2 <- plm(form, data=plm_fe_NA_dep_var$model, model="within") # coefficients are the same if(!all(plm_fe_NA_dep_var$coefficients == plm_fe_NA_dep_var2$coefficients)) stop("coefficients diverge") # model.frames in plm_objects are the same if(!all(plm_fe_NA_dep_var$model == plm_fe_NA_dep_var2$model)) stop("model.frames diverge") if(!all.equal(plm_fe_NA_dep_var$model, plm_fe_NA_dep_var2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_fe_NA_dep_var$model), as.data.frame(plm_fe_NA_dep_var2$model), ignoreAttrs = TRUE) # TRUE ###### re-produce FE model with more NAs plm_fe_NA_dep_var_more2 <- plm(form, data=plm_fe_NA_dep_var_more$model, model="within") # coefficients are the same if (!all(plm_fe_NA_dep_var_more$coefficients == plm_fe_NA_dep_var_more2$coefficients)) stop("coefficients diverge") # model.frame in plm_object is same if (!all(plm_fe_NA_dep_var_more$model == plm_fe_NA_dep_var_more2$model)) stop("model.frames diverge") if (!all.equal(plm_fe_NA_dep_var_more$model, plm_fe_NA_dep_var_more2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_fe_NA_dep_var_more$model), as.data.frame(plm_fe_NA_dep_var_more2$model), ignoreAttrs = TRUE) # TRUE ###### re-produce for twoway FE model plm_fe_NA_dep_var_tw2 <- plm(form, data=plm_fe_NA_dep_var_tw$model, model="within", effect = "twoways") # coefficients are the same if (!all(plm_fe_NA_dep_var_tw$coefficients == plm_fe_NA_dep_var_tw2$coefficients)) stop("coefficients diverge") # model.frame in plm_object is same if (!all(plm_fe_NA_dep_var_tw$model == plm_fe_NA_dep_var_tw$model)) stop("model.frames diverge") if (!all.equal(plm_fe_NA_dep_var_tw$model, plm_fe_NA_dep_var_tw2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_fe_NA_dep_var_tw$model), as.data.frame(plm_fe_NA_dep_var_tw2$model), ignoreAttrs = TRUE) # TRUE ###### re-produce RE model plm_re_NA_dep_var2 <- plm(form, data=plm_re_NA_dep_var$model, model="random") # coefficients are the same if (!all(plm_re_NA_dep_var$coefficients == plm_re_NA_dep_var2$coefficients)) stop("coefficients diverge") # model.frames in plm_objects are the same if (!all(plm_re_NA_dep_var$model == plm_re_NA_dep_var2$model)) stop("model.frames diverge") if (!all.equal(plm_re_NA_dep_var$model, plm_re_NA_dep_var2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_re_NA_dep_var$model), as.data.frame(plm_re_NA_dep_var2$model), ignoreAttrs = TRUE) # TRUE ###### re-produce RE model with more NAs plm_re_NA_dep_var_more2 <- plm(form, data=plm_re_NA_dep_var_more$model, model="random") # coefficients are the same if (!all(plm_re_NA_dep_var_more$coefficients == plm_re_NA_dep_var_more2$coefficients)) stop("coefficients diverge") # model.frame in plm_object is same if (!all(plm_re_NA_dep_var_more$model == plm_re_NA_dep_var_more2$model)) stop("model.frames diverge") if (!all.equal(plm_re_NA_dep_var_more$model, plm_re_NA_dep_var_more2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_re_NA_dep_var_more$model), as.data.frame(plm_re_NA_dep_var_more2$model), ignoreAttrs = TRUE) # TRUE ###### re-produce for twoway RE model - not implemented # plm_re_NA_dep_var_tw2 <- plm(form, data=plm_re_NA_dep_var_tw$model, model="within", effect = "twoways") # # # coefficients are the same # if(!all(plm_re_NA_dep_var_tw$coefficients == plm_re_NA_dep_var_tw2$coefficients)) stop("coefficients diverge") # # # model.frame in plm_object is same # if(!all(plm_re_NA_dep_var_tw$model == plm_re_NA_dep_var_tw$model)) stop("model.frames diverge") # if(!all.equal(plm_re_NA_dep_var_tw$model, plm_re_NA_dep_var_tw2$model, check.attributes = FALSE)) stop("model.frames diverge") #compare::compare(as.data.frame(plm_re_NA_dep_var_tw$model), as.data.frame(plm_re_NA_dep_var_tw2$model), ignoreAttrs = TRUE) # TRUE plm/inst/tests/test_pdiff_fd.Rout.save0000644000176200001440000001665114126045017017602 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Test for pdiff (internal function) for the time dimension (effect = "time") > > library(plm) > data("Grunfeld", package = "plm") > pGrunfeld <- pdata.frame(Grunfeld) > form <- inv ~ value + capital > fd_id <- plm(form, data = Grunfeld, model = "fd") > > print(summary(fd_id)) Oneway (individual) effect First-Difference Model Call: plm(formula = form, data = Grunfeld, model = "fd") Balanced Panel: n = 10, T = 20, N = 200 Observations used in estimation: 190 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -200.889558 -13.889063 0.016677 9.504223 195.634938 Coefficients: Estimate Std. Error t-value Pr(>|t|) (Intercept) -1.8188902 3.5655931 -0.5101 0.6106 value 0.0897625 0.0083636 10.7325 < 2.2e-16 *** capital 0.2917667 0.0537516 5.4281 1.752e-07 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 584410 Residual Sum of Squares: 345460 R-Squared: 0.40888 Adj. R-Squared: 0.40256 F-statistic: 64.6736 on 2 and 187 DF, p-value: < 2.22e-16 > print(vcovHC(fd_id)) (Intercept) value capital (Intercept) 9.56375529 0.0341636854 -0.407853075 value 0.03416369 0.0001641264 -0.001280677 capital -0.40785308 -0.0012806771 0.021508668 attr(,"cluster") [1] "group" > print(vcovHC(fd_id, cluster = "time")) (Intercept) value capital (Intercept) 25.19337837 -0.019969776 -0.423306798 value -0.01996978 0.000212163 0.001003194 capital -0.42330680 0.001003194 0.013679807 attr(,"cluster") [1] "time" > > ## FD models with effect = "time" are be prevented from estimation due to > ## not meaningful ordering of individuals > # > # fd_time <- plm(form, data = Grunfeld, model = "fd", effect = "time") > # summary(fd_time) > # vcovHC(fd_time) > # vcovHC(fd_time, cluster = "group") > > > pGrunfeld <- pdata.frame(Grunfeld) > #MM modmat_id <- model.matrix(pFormula(form), data = pGrunfeld, model = "fd", effect = "individual") > modmat_id <- model.matrix(model.frame(pGrunfeld, form), model = "fd", effect = "individual") > #YC modmat_time <- model.matrix(pFormula(form), data = pGrunfeld, model = "fd", effect = "time") > > if (nrow(modmat_id) != 190) stop(paste0("nrow not correct, should be 190, is: ", nrow(modmat_id))) > #YC if (nrow(modmat_time) != 180) stop(paste0("nrow not correct, should be 180, is: ", nrow(modmat_time))) > > # "layout" of resulting matrix for effect = "time": > 1362.4 - 3078.5 # pos 1 t_1 - t_1 for id 2,1 [orig pos 21 - orig pos 1] [1] -1716.1 > 1170.6 - 1362.4 # pos 21 t_t - t_1 for id 3,2 [orig pos 41 - orig pos 21] [1] -191.8 > 417.5 - 1170.6 # pos 41 t_t - t_1 for id 4,3 [orig pos 61 - orig pos 41] [1] -753.1 > > # formal test > #YC if (!isTRUE(all.equal(1362.4-3078.5, modmat_time[1, "value"]))) stop("position for effect = \"time\" not correct") > #YC if (!isTRUE(all.equal(1170.6-1362.4, modmat_time[21, "value"]))) stop("position for effect = \"time\" not correct") > #YC if (!isTRUE(all.equal(417.5-1170.6, modmat_time[41, "value"]))) stop("position for effect = \"time\" not correct") > > head(modmat_id, 41) (Intercept) value capital 2 1 1583.2 49.8 3 1 725.4 104.3 4 1 -2594.9 52.3 5 1 1521.0 -5.8 6 1 330.7 3.8 7 1 -92.7 48.0 8 1 -1307.1 48.5 9 1 809.6 -39.6 10 1 325.6 -62.5 11 1 461.6 63.4 12 1 60.0 137.2 13 1 -1374.4 359.3 14 1 -271.8 160.9 15 1 445.5 97.7 16 1 55.4 78.9 17 1 1077.4 108.7 18 1 91.9 222.8 19 1 1316.8 346.8 20 1 -648.1 449.0 22 1 444.7 -3.3 23 1 869.2 67.6 24 1 -874.4 142.1 25 1 155.4 52.5 26 1 245.6 -58.5 27 1 177.6 7.2 28 1 -211.9 37.3 29 1 -183.5 3.1 30 1 -171.2 -22.7 31 1 36.3 -65.3 32 1 217.5 -81.2 33 1 -271.0 132.2 34 1 -170.9 42.1 35 1 41.2 44.2 36 1 10.4 6.7 37 1 612.1 -15.7 38 1 -130.1 102.1 39 1 -128.1 179.4 40 1 84.2 46.1 42 1 845.2 6.6 43 1 787.5 13.6 44 1 -763.6 38.2 > #YC head(modmat_time, 41) > head(Grunfeld, 41) firm year inv value capital 1 1 1935 317.6 3078.5 2.8 2 1 1936 391.8 4661.7 52.6 3 1 1937 410.6 5387.1 156.9 4 1 1938 257.7 2792.2 209.2 5 1 1939 330.8 4313.2 203.4 6 1 1940 461.2 4643.9 207.2 7 1 1941 512.0 4551.2 255.2 8 1 1942 448.0 3244.1 303.7 9 1 1943 499.6 4053.7 264.1 10 1 1944 547.5 4379.3 201.6 11 1 1945 561.2 4840.9 265.0 12 1 1946 688.1 4900.9 402.2 13 1 1947 568.9 3526.5 761.5 14 1 1948 529.2 3254.7 922.4 15 1 1949 555.1 3700.2 1020.1 16 1 1950 642.9 3755.6 1099.0 17 1 1951 755.9 4833.0 1207.7 18 1 1952 891.2 4924.9 1430.5 19 1 1953 1304.4 6241.7 1777.3 20 1 1954 1486.7 5593.6 2226.3 21 2 1935 209.9 1362.4 53.8 22 2 1936 355.3 1807.1 50.5 23 2 1937 469.9 2676.3 118.1 24 2 1938 262.3 1801.9 260.2 25 2 1939 230.4 1957.3 312.7 26 2 1940 361.6 2202.9 254.2 27 2 1941 472.8 2380.5 261.4 28 2 1942 445.6 2168.6 298.7 29 2 1943 361.6 1985.1 301.8 30 2 1944 288.2 1813.9 279.1 31 2 1945 258.7 1850.2 213.8 32 2 1946 420.3 2067.7 132.6 33 2 1947 420.5 1796.7 264.8 34 2 1948 494.5 1625.8 306.9 35 2 1949 405.1 1667.0 351.1 36 2 1950 418.8 1677.4 357.8 37 2 1951 588.2 2289.5 342.1 38 2 1952 645.5 2159.4 444.2 39 2 1953 641.0 2031.3 623.6 40 2 1954 459.3 2115.5 669.7 41 3 1935 33.1 1170.6 97.8 > > > # check pseries > pdiff_id <- plm:::pdiff(pGrunfeld[ , "value"], effect = "individual") > #YC pdiff_time <- plm:::pdiff(pGrunfeld[ , "value"], effect = "time") > > pos_first_id <- which(pGrunfeld$firm == 1) > pos_first_time <- which(pGrunfeld$year == 1935) > > diff_id <- base::diff(Grunfeld[pos_first_id, "value"]) > diff_time <- base::diff(Grunfeld[pos_first_time, "value"]) > > if (!isTRUE(all.equal(pdiff_id[pos_first_id[-length(pos_first_id)]], diff_id, check.attributes = FALSE))) stop("pdiff on individual not correct") > #YC if (!isTRUE(all.equal(pdiff_time[pos_first_time[-length(pos_first_time)]], diff_time, check.attributes = FALSE))) stop("pdiff on time not correct") > > proc.time() user system elapsed 3.34 0.57 4.14 plm/inst/tests/test_R2_adj_R2.R0000644000176200001440000000530714124132276016016 0ustar liggesusers## Comparison of lm()'s adjusted R-squared and plm()'s R-squared ## for pooling models require(plm) data("Grunfeld") ##### with intercept ### lm mod_lm <- lm(inv ~ value + capital, Grunfeld) r2_lm <- summary(mod_lm)$r.squared r2_adj_lm <- summary(mod_lm)$adj.r.squared ### plm mod_plm <- plm(inv ~ value + capital , data=Grunfeld, model = "pooling") r2_plm <- summary(mod_plm)$r.squared[1] # R^2 r2_adj_plm <- summary(mod_plm)$r.squared[2] # adj. R^2 if (!isTRUE(all.equal(r2_lm, r2_plm, check.attributes = F))) stop("r squares differ (with intercept)") if (!isTRUE(all.equal(r2_adj_lm, r2_adj_plm, check.attributes = F))) stop("adjusted r squareds differ (with intercept)") ##### without intercept ## lm - see summary.lm's source how the checking for the presence of an intercept is done mod_wo_int_lm <- lm(inv ~ value + capital -1 , Grunfeld) r2_wo_int_lm <- summary(mod_wo_int_lm)$r.squared r2_adj_wo_int_lm <- summary(mod_wo_int_lm)$adj.r.squared ## plm mod_wo_int_plm <- plm(inv ~ value + capital -1, data=Grunfeld, model = "pooling") r2_wo_int_plm <- summary(mod_wo_int_plm)$r.squared[1] # R^2 r2_adj_wo_int_plm <- summary(mod_wo_int_plm)$r.squared[2] # adj. R^2 #### fails in rev 261, 292 #if (!isTRUE(all.equal(r2_wo_int_lm, r2_wo_int_plm, check.attributes = F))) stop("r squareds differ") #if (!isTRUE(all.equal(r2_adj_wo_int_lm, r2_adj_wo_int_plm, check.attributes = F))) stop("adjusted r squareds differ") ##### test if 'model' argument works correctly - does not in rev. 261, 292 ### # take pooling model as input and calculate r-squared for corresponding within model wi <- plm(inv ~ value + capital, data = Grunfeld, model = "within") re <- plm(inv ~ value + capital, data = Grunfeld, model = "random") # if(!isTRUE(all.equal(r.squared(wi), r.squared(mod_plm, model = "within")))) stop("r squareds differ") # if(!isTRUE(all.equal(r.squared(re), r.squared(mod_plm, model = "random")))) stop("r squareds differ") # if(!isTRUE(all.equal(r.squared(mod_plm), r.squared(re, model = "pooling")))) stop("r squareds differ") # if(!isTRUE(all.equal(r.squared(mod_plm), r.squared(wi, model = "pooling")))) stop("r squareds differ") # These all yield different values r.squared(mod_plm, type = "cor", model = "within") # ! YC r.squared(mod_plm, type = "rss", model = "within") r.squared(mod_plm, type = "ess", model = "within") # formal test #if(!isTRUE(all.equal(r.squared(mod_plm, type = "cor", model = "within"), r.squared(mod_plm, type = "rss", model = "within")))) stop("r squareds differ") #if(!isTRUE(all.equal(r.squared(mod_plm, type = "cor", model = "within"), r.squared(mod_plm, type = "ess", model = "within")))) stop("r squareds differ") plm/inst/tests/test_fixef2.Rout.save0000644000176200001440000014110214154734502017217 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### test file to test plm::fixef(), inner consistency and vs. fixest::fixef() and lfe::getfe() > ## (1) ordinary regression models > ## (2) IV regression models > > library(plm) > data("Grunfeld", package = "plm") > Grunfeld_unbalanced <- Grunfeld[1:199, ] > > > ################## (1) ordinary models (non-IV) ################## > > plm_tw <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways") > plm_tw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "twoways") > > plm_ow_id <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual") > plm_ow_u_id <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "individual") > plm_ow_ti <- plm(inv ~ value + capital, data = Grunfeld, effect = "time") > plm_ow_u_ti <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "time") > > > ## lm_tw <- lm(inv ~ 0 + value + capital + factor(firm) + factor(year), data = Grunfeld) > ## lm_tw_int <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld) > ## lm_tw_u <- lm(inv ~ 0 + value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) > ## lm_tw_u_int <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) > > #### tw unbalanced #### > ## sum of effects > plm_tw_u_fixef_tw <- as.numeric(fixef(plm_tw_u, "twoways")) > > # manual > pred_betas <- as.numeric(tcrossprod(coef(plm_tw_u), model.matrix(plm_tw_u, model = "pooling")[ , -1L])) > pred_y <- plm_tw_u$model[ , 1] - plm_tw_u$residuals > pred_effs_tw <- pred_y - pred_betas > > ## split in a individual and in a time component > plm_tw_u_fixef_id_dfirst <- c(0, as.numeric(fixef(plm_tw_u, "individual", "dfirst"))) > plm_tw_u_fixef_ti_dfirst <- c(0, as.numeric(fixef(plm_tw_u, "time", "dfirst"))) > > plm_tw_u_fixef_id_level <- as.numeric(fixef(plm_tw_u, "individual")) > plm_tw_u_fixef_ti_level <- as.numeric(fixef(plm_tw_u, "time")) > > ## check the summed up effects and splits > # effect = "twoways" (= sum) vs. manual > stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, + as.numeric(pred_effs_tw), + check.attributes = FALSE))) > # sum = id level + time dfirst > stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, + plm_tw_u_fixef_id_level[ index(plm_tw_u)[[1L]]] + + plm_tw_u_fixef_ti_dfirst[index(plm_tw_u)[[2L]]], + check.attributes = FALSE))) > # sum = id dfirst + time level > stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, + plm_tw_u_fixef_id_dfirst[index(plm_tw_u)[[1L]]] + + plm_tw_u_fixef_ti_level[ index(plm_tw_u)[[2L]]], + check.attributes = FALSE))) > > > ### # checks vs. a twoway model implemented via one-way augmented > plm_tw_u_aug_id <- plm(inv ~ value + capital + factor(year), data = Grunfeld_unbalanced, effect = "individual") > plm_tw_u_aug_ti <- plm(inv ~ value + capital + factor(firm), data = Grunfeld_unbalanced, effect = "time") > > plm_tw_u_aug_id_id <- as.numeric(fixef(plm_tw_u_aug_id, "individual")) > plm_tw_u_aug_ti_ti <- as.numeric(fixef(plm_tw_u_aug_ti, "time")) > > # id level > stopifnot(isTRUE(all.equal(plm_tw_u_fixef_id_level, + plm_tw_u_aug_id_id, + check.attributes = FALSE))) > # time level > stopifnot(isTRUE(all.equal(plm_tw_u_fixef_ti_level, + plm_tw_u_aug_ti_ti, + check.attributes = FALSE))) > > > #### oneway balanced #### > plm_ow_fixef_id_level <- as.numeric(fixef(plm_ow_id)) > plm_ow_fixef_ti_level <- as.numeric(fixef(plm_ow_ti)) > > > #### oneway unbalanced #### > plm_ow_u_fixef_id_level <- as.numeric(fixef(plm_ow_u_id)) > plm_ow_u_fixef_ti_level <- as.numeric(fixef(plm_ow_u_ti)) > > > > #### tw balanced #### > ## sum of effects > plm_tw_fixef_tw <- as.numeric(fixef(plm_tw, "twoways")) > > # manual > bal_pred_betas <- as.numeric(tcrossprod(coef(plm_tw), model.matrix(plm_tw, model = "pooling")[ , -1L])) > bal_pred_y <- plm_tw$model[ , 1] - plm_tw$residuals > bal_pred_effs_tw <- bal_pred_y - bal_pred_betas > > stopifnot(isTRUE(all.equal(as.numeric(bal_pred_effs_tw), + plm_tw_fixef_tw, + check.attributes = FALSE))) > > ## split in a individual and in a time component > plm_tw_fixef_id_dfirst <- c(0, as.numeric(fixef(plm_tw, "individual", "dfirst"))) > plm_tw_fixef_ti_dfirst <- c(0, as.numeric(fixef(plm_tw, "time", "dfirst"))) > > plm_tw_fixef_id_level <- as.numeric(fixef(plm_tw, "individual", "level")) > plm_tw_fixef_ti_level <- as.numeric(fixef(plm_tw, "time", "level")) > > ## check the summed up effects and splits > stopifnot(isTRUE(all.equal(plm_tw_fixef_tw, + plm_tw_fixef_id_level[ index(plm_tw)[[1L]]] + + plm_tw_fixef_ti_dfirst[index(plm_tw)[[2L]]], + check.attributes = FALSE))) > stopifnot(isTRUE(all.equal(plm_tw_fixef_tw, + plm_tw_fixef_id_dfirst[index(plm_tw)[[1L]]] + + plm_tw_fixef_ti_level[ index(plm_tw)[[2L]]], + check.attributes = FALSE))) > > ### # checks vs. a twoway model implemented via one-way augmented > plm_tw_aug_id <- plm(inv ~ value + capital + factor(year), data = Grunfeld, effect = "individual") > plm_tw_aug_ti <- plm(inv ~ value + capital + factor(firm), data = Grunfeld, effect = "time") > > plm_tw_aug_id_id <- as.numeric(fixef(plm_tw_aug_id, "individual")) > plm_tw_aug_ti_ti <- as.numeric(fixef(plm_tw_aug_ti, "time")) > > # id level > stopifnot(isTRUE(all.equal(plm_tw_fixef_id_level, + plm_tw_aug_id_id, + check.attributes = FALSE))) > # time level > stopifnot(isTRUE(all.equal(plm_tw_fixef_ti_level, + plm_tw_aug_ti_ti, + check.attributes = FALSE))) > > > ## checks vs. fixest::feols > fixest.avail <- if(!requireNamespace("fixest", quietly = TRUE)) FALSE else TRUE > if(fixest.avail) { + suppressPackageStartupMessages(library(fixest)) + + # twoways balanced (one level, one dfirst) + feols_tw <- fixest::feols(inv ~ value + capital | firm + year, data = Grunfeld) + stopifnot(isTRUE(all.equal(feols_tw$sumFE, plm_tw_fixef_tw, check.attributes = FALSE))) # sum + stopifnot(isTRUE(all.equal(fixef(feols_tw)$year, plm_tw_fixef_ti_dfirst, check.attributes = FALSE))) # time + stopifnot(isTRUE(all.equal(fixef(feols_tw)$firm, plm_tw_fixef_id_level, check.attributes = FALSE))) # individual + + # oneway balanced (levels) + feols_ow_id <- fixest::feols(inv ~ value + capital | firm, data = Grunfeld) + feols_ow_ti <- fixest::feols(inv ~ value + capital | year, data = Grunfeld) + stopifnot(isTRUE(all.equal(fixef(feols_ow_ti)$year, plm_ow_fixef_ti_level, check.attributes = FALSE))) # time + stopifnot(isTRUE(all.equal(fixef(feols_ow_id)$firm, plm_ow_fixef_id_level, check.attributes = FALSE))) # individual + + # twoways unbalanced (one level, one dfirst) + feols_tw_u <- fixest::feols(inv ~ value + capital | firm + year, data = Grunfeld_unbalanced) + stopifnot(isTRUE(all.equal(feols_tw_u$sumFE, plm_tw_u_fixef_tw, check.attributes = FALSE))) # sum + stopifnot(isTRUE(all.equal(fixef(feols_tw_u)$year, plm_tw_u_fixef_ti_dfirst, check.attributes = FALSE))) # time + stopifnot(isTRUE(all.equal(fixef(feols_tw_u)$firm, plm_tw_u_fixef_id_level, check.attributes = FALSE))) # individual + + # oneway unbalanced (levels) + feols_ow_u_id <- fixest::feols(inv ~ value + capital | firm, data = Grunfeld_unbalanced) + feols_ow_u_ti <- fixest::feols(inv ~ value + capital | year, data = Grunfeld_unbalanced) + stopifnot(isTRUE(all.equal(fixef(feols_ow_u_id)$firm, plm_ow_u_fixef_id_level, check.attributes = FALSE))) # individual + stopifnot(isTRUE(all.equal(fixef(feols_ow_u_ti)$year, plm_ow_u_fixef_ti_level, check.attributes = FALSE))) # time + } > > # checks vs. lfe::felm > lfe.avail <- if(!requireNamespace("lfe", quietly = TRUE)) FALSE else TRUE > if(lfe.avail) { + library(lfe) # version 2.8-7 + + # twoways balanced (one level, one dfirst) + # (lfe::felm's default reference is vice verse compared to fixest::feols) + felm_tw <- lfe::felm(inv ~ value + capital | firm + year, data = Grunfeld) + felm_tw_fixef_id <- lfe::getfe(felm_tw)[lfe::getfe(felm_tw)[["fe"]] == "firm", 1] + felm_tw_fixef_ti <- lfe::getfe(felm_tw)[lfe::getfe(felm_tw)[["fe"]] == "year", 1] + + stopifnot(isTRUE(all.equal(felm_tw_fixef_id, plm_tw_fixef_id_dfirst, check.attributes = FALSE))) # individual + stopifnot(isTRUE(all.equal(felm_tw_fixef_ti, plm_tw_fixef_ti_level, check.attributes = FALSE))) # time + + # oneway balanced (levels) + felm_ow_id <- lfe::felm(inv ~ value + capital | firm, data = Grunfeld) + felm_ow_ti <- lfe::felm(inv ~ value + capital | year, data = Grunfeld) + felm_ow_id_fixef_id <- lfe::getfe(felm_ow_id)[lfe::getfe(felm_ow_id)[["fe"]] == "firm", 1] + felm_ow_ti_fixef_ti <- lfe::getfe(felm_ow_ti)[lfe::getfe(felm_ow_ti)[["fe"]] == "year", 1] + + stopifnot(isTRUE(all.equal(felm_ow_id_fixef_id, plm_ow_fixef_id_level, check.attributes = FALSE))) # individual + stopifnot(isTRUE(all.equal(felm_ow_ti_fixef_ti, plm_ow_fixef_ti_level, check.attributes = FALSE))) # time + + # twoways unbalanced (one level, one dfirst) + # (lfe::felm's default reference is vice verse compared to fixest::feols) + felm_tw_u <- lfe::felm(inv ~ value + capital | firm + year, data = Grunfeld_unbalanced) + felm_tw_u_fixef_id <- lfe::getfe(felm_tw_u)[lfe::getfe(felm_tw_u)[["fe"]] == "firm", 1] + felm_tw_u_fixef_ti <- lfe::getfe(felm_tw_u)[lfe::getfe(felm_tw_u)[["fe"]] == "year", 1] + + stopifnot(isTRUE(all.equal(felm_tw_u_fixef_id, plm_tw_u_fixef_id_dfirst, check.attributes = FALSE))) # individual + stopifnot(isTRUE(all.equal(felm_tw_u_fixef_ti, plm_tw_u_fixef_ti_level, check.attributes = FALSE))) # time + + # oneway unbalanced (levels) + felm_ow_u_id <- lfe::felm(inv ~ value + capital | firm, data = Grunfeld_unbalanced) + felm_ow_u_ti <- lfe::felm(inv ~ value + capital | year, data = Grunfeld_unbalanced) + felm_ow_u_id_fixef_id <- lfe::getfe(felm_ow_u_id)[lfe::getfe(felm_ow_u_id)[["fe"]] == "firm", 1] + felm_ow_u_ti_fixef_ti <- lfe::getfe(felm_ow_u_ti)[lfe::getfe(felm_ow_u_ti)[["fe"]] == "year", 1] + stopifnot(isTRUE(all.equal(felm_ow_u_id_fixef_id, plm_ow_u_fixef_id_level, check.attributes = FALSE))) # individual + stopifnot(isTRUE(all.equal(felm_ow_u_ti_fixef_ti, plm_ow_u_fixef_ti_level, check.attributes = FALSE))) # time + } Loading required package: Matrix Attaching package: 'lfe' The following object is masked from 'package:plm': sargan > > > > ################## (2) Instrumental Variable (IV) Models ################## > # > ## IV balanced twoways > data("Crime", package = "plm") > > # in the unbalanced twoway case, getfe() sets as reference a level depending on the unbalancedness structure > # -> somewhat arbitrary -> see also https://github.com/sgaure/lfe/issues/52 > # for this example, the unbalancedness structure leads to the first time period being the reference > delrows <- -c(10,12,17,18) > # delrows <- -c(1,2,10,12) > # delrows <- -c(9) > > crime_formula_plm <- lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + + lwsta + lwloc + lpctymle | . - lprbarr - lpolpc + ltaxpc + lmix > > FE2SLS_id <- plm(crime_formula_plm, data = Crime, model = "within", effect = "individual") > FE2SLS_ti <- plm(crime_formula_plm, data = Crime, model = "within", effect = "time") > fixef(FE2SLS_id, effect = "individual") 1 3 5 7 9 11 13 15 17 19 21 4.2444 3.8930 3.3937 4.0075 3.7022 2.7624 4.3154 4.0981 3.9185 3.5553 3.9533 23 25 27 33 35 37 39 41 45 47 49 3.7718 3.9917 3.8702 4.0912 4.0481 3.7669 3.3836 3.9352 4.1127 3.7884 3.9903 51 53 55 57 59 61 63 65 67 69 71 4.0780 3.3406 3.2879 4.0704 3.7751 3.8371 4.1083 4.5761 3.9043 4.1252 4.0651 77 79 81 83 85 87 89 91 93 97 99 3.8814 3.4405 4.2056 4.3159 3.9709 3.9026 4.2362 4.1008 4.2901 4.2764 2.8191 101 105 107 109 111 113 115 117 119 123 125 4.0834 4.4076 4.2159 3.6829 3.6950 2.5152 1.9191 4.5046 4.4769 3.8071 3.7587 127 129 131 133 135 137 139 141 143 145 147 4.6757 4.5385 4.2245 3.5513 3.5345 3.6066 4.1108 3.6227 3.9323 4.0947 4.1254 149 151 153 155 157 159 161 163 165 167 169 3.3748 3.8971 4.3841 4.3347 3.9785 4.0201 3.9632 3.8159 4.5412 3.7986 3.7232 171 173 175 179 181 183 185 187 189 191 193 3.7177 2.1067 3.3199 3.9192 4.3799 4.0194 3.2286 4.2319 3.0091 3.8677 4.0338 195 197 3.9454 3.4783 > fixef(FE2SLS_ti, effect = "time") 81 82 83 84 85 86 87 0.61247 0.62108 0.57692 0.45365 0.46376 0.54111 0.54620 > > FE2SLS_tw <- plm(crime_formula_plm, data = Crime, model = "within", effect = "twoways") > fixef(FE2SLS_tw, effect = "individual") 1 3 5 7 9 11 13 15 17 19 21 3.1500 2.8955 2.5652 3.1431 2.8080 1.9961 3.4568 3.2522 3.0930 2.7022 2.9518 23 25 27 33 35 37 39 41 45 47 49 2.8030 2.9542 2.9071 3.1848 3.0011 2.9431 2.5912 3.0347 3.1068 2.9937 2.9858 51 53 55 57 59 61 63 65 67 69 71 3.0229 2.5745 2.7554 3.0000 2.8250 2.9734 3.0497 3.6319 2.8637 3.1034 2.9967 77 79 81 83 85 87 89 91 93 97 99 3.0571 2.5876 3.0886 3.3662 3.0820 2.9978 3.1701 3.2093 3.4233 3.2858 2.0471 101 105 107 109 111 113 115 117 119 123 125 3.1869 3.4149 3.2667 2.6911 2.7953 1.8028 1.0940 3.5264 3.3132 3.0621 2.8959 127 129 131 133 135 137 139 141 143 145 147 3.6324 3.4015 3.2864 2.5904 2.6448 2.8445 3.0686 3.0737 3.1298 3.1786 3.1787 149 151 153 155 157 159 161 163 165 167 169 2.5638 2.9134 3.4171 3.3507 3.0009 2.9952 2.9722 2.9668 3.5714 2.8148 2.7585 171 173 175 179 181 183 185 187 189 191 193 2.7937 1.5817 2.5056 2.9755 3.4290 2.9540 2.3959 3.3825 2.1802 2.9523 3.0693 195 197 3.0031 2.6044 > fixef(FE2SLS_tw, effect = "time") 81 82 83 84 85 86 87 3.1500 3.1878 3.1056 3.1048 3.1290 3.1563 3.1935 > fixef(FE2SLS_tw, effect = "twoways") 1-81 1-82 1-83 1-84 1-85 1-86 1-87 3-81 3-82 3-83 3-84 3.1500 3.1878 3.1056 3.1048 3.1290 3.1563 3.1935 2.8955 2.9333 2.8511 2.8503 3-85 3-86 3-87 5-81 5-82 5-83 5-84 5-85 5-86 5-87 7-81 2.8745 2.9018 2.9390 2.5652 2.6031 2.5208 2.5200 2.5443 2.5715 2.6087 3.1431 7-82 7-83 7-84 7-85 7-86 7-87 9-81 9-82 9-83 9-84 9-85 3.1810 3.0987 3.0979 3.1222 3.1494 3.1866 2.8080 2.8458 2.7636 2.7628 2.7870 9-86 9-87 11-81 11-82 11-83 11-84 11-85 11-86 11-87 13-81 13-82 2.8143 2.8515 1.9961 2.0339 1.9517 1.9509 1.9751 2.0024 2.0396 3.4568 3.4947 13-83 13-84 13-85 13-86 13-87 15-81 15-82 15-83 15-84 15-85 15-86 3.4124 3.4116 3.4359 3.4631 3.5003 3.2522 3.2901 3.2078 3.2070 3.2313 3.2585 15-87 17-81 17-82 17-83 17-84 17-85 17-86 17-87 19-81 19-82 19-83 3.2957 3.0930 3.1309 3.0486 3.0478 3.0721 3.0994 3.1365 2.7022 2.7401 2.6578 19-84 19-85 19-86 19-87 21-81 21-82 21-83 21-84 21-85 21-86 21-87 2.6570 2.6813 2.7085 2.7457 2.9518 2.9897 2.9075 2.9066 2.9309 2.9582 2.9953 23-81 23-82 23-83 23-84 23-85 23-86 23-87 25-81 25-82 25-83 25-84 2.8030 2.8409 2.7587 2.7579 2.7821 2.8094 2.8466 2.9542 2.9921 2.9099 2.9091 25-85 25-86 25-87 27-81 27-82 27-83 27-84 27-85 27-86 27-87 33-81 2.9333 2.9606 2.9977 2.9071 2.9449 2.8627 2.8619 2.8861 2.9134 2.9506 3.1848 33-82 33-83 33-84 33-85 33-86 33-87 35-81 35-82 35-83 35-84 35-85 3.2227 3.1404 3.1396 3.1639 3.1911 3.2283 3.0011 3.0390 2.9567 2.9559 2.9802 35-86 35-87 37-81 37-82 37-83 37-84 37-85 37-86 37-87 39-81 39-82 3.0074 3.0446 2.9431 2.9810 2.8987 2.8979 2.9222 2.9494 2.9866 2.5912 2.6291 39-83 39-84 39-85 39-86 39-87 41-81 41-82 41-83 41-84 41-85 41-86 2.5468 2.5460 2.5703 2.5975 2.6347 3.0347 3.0726 2.9903 2.9895 3.0138 3.0410 41-87 45-81 45-82 45-83 45-84 45-85 45-86 45-87 47-81 47-82 47-83 3.0782 3.1068 3.1446 3.0624 3.0616 3.0858 3.1131 3.1503 2.9937 3.0315 2.9493 47-84 47-85 47-86 47-87 49-81 49-82 49-83 49-84 49-85 49-86 49-87 2.9485 2.9727 3.0000 3.0372 2.9858 3.0236 2.9414 2.9406 2.9649 2.9921 3.0293 51-81 51-82 51-83 51-84 51-85 51-86 51-87 53-81 53-82 53-83 53-84 3.0229 3.0608 2.9786 2.9778 3.0020 3.0293 3.0664 2.5745 2.6124 2.5301 2.5293 53-85 53-86 53-87 55-81 55-82 55-83 55-84 55-85 55-86 55-87 57-81 2.5536 2.5809 2.6180 2.7554 2.7933 2.7110 2.7102 2.7345 2.7617 2.7989 3.0000 57-82 57-83 57-84 57-85 57-86 57-87 59-81 59-82 59-83 59-84 59-85 3.0379 2.9556 2.9548 2.9791 3.0063 3.0435 2.8250 2.8628 2.7806 2.7798 2.8040 59-86 59-87 61-81 61-82 61-83 61-84 61-85 61-86 61-87 63-81 63-82 2.8313 2.8685 2.9734 3.0113 2.9290 2.9282 2.9525 2.9797 3.0169 3.0497 3.0875 63-83 63-84 63-85 63-86 63-87 65-81 65-82 65-83 65-84 65-85 65-86 3.0053 3.0045 3.0287 3.0560 3.0932 3.6319 3.6698 3.5876 3.5868 3.6110 3.6383 65-87 67-81 67-82 67-83 67-84 67-85 67-86 67-87 69-81 69-82 69-83 3.6754 2.8637 2.9016 2.8193 2.8185 2.8428 2.8700 2.9072 3.1034 3.1412 3.0590 69-84 69-85 69-86 69-87 71-81 71-82 71-83 71-84 71-85 71-86 71-87 3.0582 3.0824 3.1097 3.1469 2.9967 3.0346 2.9523 2.9515 2.9758 3.0030 3.0402 77-81 77-82 77-83 77-84 77-85 77-86 77-87 79-81 79-82 79-83 79-84 3.0571 3.0949 3.0127 3.0119 3.0361 3.0634 3.1006 2.5876 2.6254 2.5432 2.5424 79-85 79-86 79-87 81-81 81-82 81-83 81-84 81-85 81-86 81-87 83-81 2.5666 2.5939 2.6311 3.0886 3.1265 3.0442 3.0434 3.0677 3.0949 3.1321 3.3662 83-82 83-83 83-84 83-85 83-86 83-87 85-81 85-82 85-83 85-84 85-85 3.4041 3.3218 3.3210 3.3453 3.3725 3.4097 3.0820 3.1199 3.0376 3.0368 3.0611 85-86 85-87 87-81 87-82 87-83 87-84 87-85 87-86 87-87 89-81 89-82 3.0883 3.1255 2.9978 3.0356 2.9534 2.9526 2.9768 3.0041 3.0413 3.1701 3.2079 89-83 89-84 89-85 89-86 89-87 91-81 91-82 91-83 91-84 91-85 91-86 3.1257 3.1249 3.1491 3.1764 3.2136 3.2093 3.2472 3.1650 3.1642 3.1884 3.2157 91-87 93-81 93-82 93-83 93-84 93-85 93-86 93-87 97-81 97-82 97-83 3.2529 3.4233 3.4612 3.3789 3.3781 3.4024 3.4296 3.4668 3.2858 3.3237 3.2415 97-84 97-85 97-86 97-87 99-81 99-82 99-83 99-84 99-85 99-86 99-87 3.2407 3.2649 3.2922 3.3294 2.0471 2.0850 2.0028 2.0020 2.0262 2.0535 2.0907 101-81 101-82 101-83 101-84 101-85 101-86 101-87 105-81 105-82 105-83 105-84 3.1869 3.2247 3.1425 3.1417 3.1659 3.1932 3.2304 3.4149 3.4528 3.3706 3.3698 105-85 105-86 105-87 107-81 107-82 107-83 107-84 107-85 107-86 107-87 109-81 3.3940 3.4213 3.4584 3.2667 3.3045 3.2223 3.2215 3.2457 3.2730 3.3102 2.6911 109-82 109-83 109-84 109-85 109-86 109-87 111-81 111-82 111-83 111-84 111-85 2.7289 2.6467 2.6459 2.6701 2.6974 2.7346 2.7953 2.8332 2.7509 2.7501 2.7744 111-86 111-87 113-81 113-82 113-83 113-84 113-85 113-86 113-87 115-81 115-82 2.8016 2.8388 1.8028 1.8406 1.7584 1.7576 1.7818 1.8091 1.8463 1.0940 1.1318 115-83 115-84 115-85 115-86 115-87 117-81 117-82 117-83 117-84 117-85 117-86 1.0496 1.0488 1.0730 1.1003 1.1375 3.5264 3.5642 3.4820 3.4812 3.5054 3.5327 117-87 119-81 119-82 119-83 119-84 119-85 119-86 119-87 123-81 123-82 123-83 3.5699 3.3132 3.3510 3.2688 3.2680 3.2922 3.3195 3.3567 3.0621 3.1000 3.0177 123-84 123-85 123-86 123-87 125-81 125-82 125-83 125-84 125-85 125-86 125-87 3.0169 3.0412 3.0684 3.1056 2.8959 2.9338 2.8515 2.8507 2.8750 2.9022 2.9394 127-81 127-82 127-83 127-84 127-85 127-86 127-87 129-81 129-82 129-83 129-84 3.6324 3.6703 3.5880 3.5872 3.6115 3.6387 3.6759 3.4015 3.4393 3.3571 3.3563 129-85 129-86 129-87 131-81 131-82 131-83 131-84 131-85 131-86 131-87 133-81 3.3805 3.4078 3.4450 3.2864 3.3243 3.2421 3.2412 3.2655 3.2928 3.3299 2.5904 133-82 133-83 133-84 133-85 133-86 133-87 135-81 135-82 135-83 135-84 135-85 2.6282 2.5460 2.5452 2.5694 2.5967 2.6339 2.6448 2.6827 2.6005 2.5996 2.6239 135-86 135-87 137-81 137-82 137-83 137-84 137-85 137-86 137-87 139-81 139-82 2.6512 2.6883 2.8445 2.8823 2.8001 2.7993 2.8235 2.8508 2.8880 3.0686 3.1065 139-83 139-84 139-85 139-86 139-87 141-81 141-82 141-83 141-84 141-85 141-86 3.0242 3.0234 3.0477 3.0749 3.1121 3.0737 3.1116 3.0293 3.0285 3.0528 3.0800 141-87 143-81 143-82 143-83 143-84 143-85 143-86 143-87 145-81 145-82 145-83 3.1172 3.1298 3.1677 3.0854 3.0846 3.1089 3.1361 3.1733 3.1786 3.2164 3.1342 145-84 145-85 145-86 145-87 147-81 147-82 147-83 147-84 147-85 147-86 147-87 3.1334 3.1576 3.1849 3.2221 3.1787 3.2166 3.1343 3.1335 3.1578 3.1850 3.2222 149-81 149-82 149-83 149-84 149-85 149-86 149-87 151-81 151-82 151-83 151-84 2.5638 2.6016 2.5194 2.5186 2.5429 2.5701 2.6073 2.9134 2.9513 2.8690 2.8682 151-85 151-86 151-87 153-81 153-82 153-83 153-84 153-85 153-86 153-87 155-81 2.8925 2.9198 2.9569 3.4171 3.4549 3.3727 3.3719 3.3961 3.4234 3.4606 3.3507 155-82 155-83 155-84 155-85 155-86 155-87 157-81 157-82 157-83 157-84 157-85 3.3885 3.3063 3.3055 3.3297 3.3570 3.3942 3.0009 3.0388 2.9565 2.9557 2.9800 157-86 157-87 159-81 159-82 159-83 159-84 159-85 159-86 159-87 161-81 161-82 3.0072 3.0444 2.9952 3.0331 2.9508 2.9500 2.9743 3.0015 3.0387 2.9722 3.0101 161-83 161-84 161-85 161-86 161-87 163-81 163-82 163-83 163-84 163-85 163-86 2.9278 2.9270 2.9513 2.9785 3.0157 2.9668 3.0046 2.9224 2.9216 2.9458 2.9731 163-87 165-81 165-82 165-83 165-84 165-85 165-86 165-87 167-81 167-82 167-83 3.0103 3.5714 3.6092 3.5270 3.5262 3.5504 3.5777 3.6149 2.8148 2.8526 2.7704 167-84 167-85 167-86 167-87 169-81 169-82 169-83 169-84 169-85 169-86 169-87 2.7696 2.7938 2.8211 2.8583 2.7585 2.7963 2.7141 2.7133 2.7375 2.7648 2.8020 171-81 171-82 171-83 171-84 171-85 171-86 171-87 173-81 173-82 173-83 173-84 2.7937 2.8315 2.7493 2.7485 2.7727 2.8000 2.8372 1.5817 1.6195 1.5373 1.5365 173-85 173-86 173-87 175-81 175-82 175-83 175-84 175-85 175-86 175-87 179-81 1.5607 1.5880 1.6252 2.5056 2.5435 2.4612 2.4604 2.4847 2.5119 2.5491 2.9755 179-82 179-83 179-84 179-85 179-86 179-87 181-81 181-82 181-83 181-84 181-85 3.0134 2.9311 2.9303 2.9546 2.9818 3.0190 3.4290 3.4669 3.3846 3.3838 3.4081 181-86 181-87 183-81 183-82 183-83 183-84 183-85 183-86 183-87 185-81 185-82 3.4354 3.4725 2.9540 2.9919 2.9096 2.9088 2.9331 2.9603 2.9975 2.3959 2.4338 185-83 185-84 185-85 185-86 185-87 187-81 187-82 187-83 187-84 187-85 187-86 2.3515 2.3507 2.3750 2.4022 2.4394 3.3825 3.4204 3.3381 3.3373 3.3616 3.3888 187-87 189-81 189-82 189-83 189-84 189-85 189-86 189-87 191-81 191-82 191-83 3.4260 2.1802 2.2181 2.1359 2.1351 2.1593 2.1866 2.2237 2.9523 2.9901 2.9079 191-84 191-85 191-86 191-87 193-81 193-82 193-83 193-84 193-85 193-86 193-87 2.9071 2.9313 2.9586 2.9958 3.0693 3.1071 3.0249 3.0241 3.0483 3.0756 3.1128 195-81 195-82 195-83 195-84 195-85 195-86 195-87 197-81 197-82 197-83 197-84 3.0031 3.0410 2.9587 2.9579 2.9822 3.0094 3.0466 2.6044 2.6423 2.5601 2.5593 197-85 197-86 197-87 2.5835 2.6108 2.6480 > > ## IV unbalanced twoways > FE2SLS_id_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "individual") > FE2SLS_ti_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "time") > fixef(FE2SLS_id_unbal, effect = "individual") 1 3 5 7 9 11 13 15 17 19 21 4.7010 4.2924 3.5966 4.3008 4.0593 3.0086 4.6124 4.3784 4.1802 3.8157 4.3787 23 25 27 33 35 37 39 41 45 47 49 4.1492 4.4422 4.2339 4.4346 4.4805 4.0481 3.6642 4.2752 4.5200 4.0346 4.3122 51 53 55 57 59 61 63 65 67 69 71 4.4947 3.6154 3.4231 4.5125 4.1545 4.1372 4.5478 4.9165 4.4198 4.4796 4.5358 77 79 81 83 85 87 89 91 93 97 99 4.1416 3.7717 4.6861 4.6699 4.2891 4.2115 4.6716 4.4061 4.5927 4.6742 3.0269 101 105 107 109 111 113 115 117 119 123 125 4.4230 4.7880 4.5820 4.0936 4.0704 2.7355 2.1845 4.8859 4.9861 4.0583 4.0768 127 129 131 133 135 137 139 141 143 145 147 5.0911 5.0513 4.5586 3.8526 3.8374 3.8755 4.5077 3.7504 4.2284 4.4254 4.4581 149 151 153 155 157 159 161 163 165 167 169 3.6775 4.2687 4.7628 4.7298 4.3762 4.4345 4.3364 4.1172 4.9095 4.1833 4.0979 171 173 175 179 181 183 185 187 189 191 193 4.0681 2.2208 3.5979 4.2856 4.7458 4.4532 3.5340 4.5216 3.2699 4.2562 4.3968 195 197 4.3073 3.8315 > fixef(FE2SLS_ti_unbal, effect = "time") 81 82 83 84 85 86 87 0.51560 0.52300 0.47597 0.35325 0.36528 0.43883 0.44269 > > FE2SLS_tw_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "twoways") > fixef(FE2SLS_tw_unbal, effect = "individual") 1 3 5 7 9 11 13 15 17 19 3.21845 2.92397 2.36665 3.02584 2.76891 1.84400 3.33574 3.14201 2.93973 2.51609 21 23 25 27 33 35 37 39 41 45 2.95483 2.78270 3.00498 2.87171 3.15203 3.03046 2.80318 2.44600 2.94790 3.11452 47 49 51 53 55 57 59 61 63 65 2.79889 2.95643 3.09821 2.46340 2.41300 3.05295 2.80573 2.87058 3.06787 3.56797 67 69 71 77 79 81 83 85 87 89 2.98796 3.05747 3.05870 2.89742 2.54248 3.16383 3.31662 3.02735 2.86312 3.18830 91 93 97 99 101 105 107 109 111 113 3.12308 3.34172 3.28033 1.89711 3.11504 3.38228 3.21231 2.71145 2.76745 1.61157 115 117 119 123 125 127 129 131 133 135 0.89916 3.52718 3.41088 2.89073 2.79550 3.65757 3.51147 3.25613 2.63101 2.57112 137 139 141 143 145 147 149 151 153 155 2.72543 3.11178 2.74321 3.02945 3.09698 3.13617 2.42469 2.88858 3.39734 3.36562 157 159 161 163 165 167 169 171 173 175 2.98606 3.00323 2.94192 2.85201 3.54095 2.79548 2.75467 2.74131 1.23830 2.34379 179 181 183 185 187 189 191 193 195 197 2.94447 3.38860 2.99807 2.28880 3.27922 2.09247 2.95449 3.04436 2.93793 2.55053 > fixef(FE2SLS_tw_unbal, effect = "time") 81 82 83 84 85 86 87 3.2185 3.2609 3.1691 3.1625 3.1888 3.2017 3.2239 > fixef(FE2SLS_tw_unbal, effect = "twoways") 1-81 1-82 1-83 1-84 1-85 1-86 1-87 3-81 3-82 3-84 3.21845 3.26092 3.16910 3.16249 3.18877 3.20173 3.22385 2.92397 2.96644 2.86801 3-86 3-87 5-81 5-82 5-85 5-86 5-87 7-81 7-82 7-83 2.90724 2.92937 2.36665 2.40911 2.33697 2.34992 2.37204 3.02584 3.06831 2.97649 7-84 7-85 7-86 7-87 9-81 9-82 9-83 9-84 9-85 9-86 2.96988 2.99616 3.00911 3.03124 2.76891 2.81137 2.71955 2.71295 2.73923 2.75218 9-87 11-81 11-82 11-83 11-84 11-85 11-86 11-87 13-81 13-82 2.77430 1.84400 1.88646 1.79464 1.78804 1.81431 1.82727 1.84939 3.33574 3.37821 13-83 13-84 13-85 13-86 13-87 15-81 15-82 15-83 15-84 15-85 3.28639 3.27978 3.30606 3.31901 3.34114 3.14201 3.18448 3.09266 3.08605 3.11233 15-86 15-87 17-81 17-82 17-83 17-84 17-85 17-86 17-87 19-81 3.12528 3.14741 2.93973 2.98220 2.89038 2.88377 2.91005 2.92300 2.94513 2.51609 19-82 19-83 19-84 19-85 19-86 19-87 21-81 21-82 21-83 21-84 2.55855 2.46673 2.46013 2.48641 2.49936 2.52148 2.95483 2.99730 2.90548 2.89887 21-85 21-86 21-87 23-81 23-82 23-83 23-84 23-85 23-86 23-87 2.92515 2.93810 2.96023 2.78270 2.82517 2.73335 2.72674 2.75302 2.76597 2.78810 25-81 25-82 25-83 25-84 25-85 25-86 25-87 27-81 27-82 27-83 3.00498 3.04744 2.95562 2.94902 2.97530 2.98825 3.01037 2.87171 2.91417 2.82236 27-84 27-85 27-86 27-87 33-81 33-82 33-83 33-84 33-85 33-86 2.81575 2.84203 2.85498 2.87711 3.15203 3.19449 3.10268 3.09607 3.12235 3.13530 33-87 35-81 35-82 35-83 35-84 35-85 35-86 35-87 37-81 37-82 3.15743 3.03046 3.07293 2.98111 2.97450 3.00078 3.01373 3.03586 2.80318 2.84564 37-83 37-84 37-85 37-86 37-87 39-81 39-82 39-83 39-84 39-85 2.75383 2.74722 2.77350 2.78645 2.80858 2.44600 2.48846 2.39665 2.39004 2.41632 39-86 39-87 41-81 41-82 41-83 41-84 41-85 41-86 41-87 45-81 2.42927 2.45140 2.94790 2.99037 2.89855 2.89194 2.91822 2.93118 2.95330 3.11452 45-82 45-83 45-84 45-85 45-86 45-87 47-81 47-82 47-83 47-84 3.15699 3.06517 3.05856 3.08484 3.09779 3.11992 2.79889 2.84136 2.74954 2.74293 47-85 47-86 47-87 49-81 49-82 49-83 49-84 49-85 49-86 49-87 2.76921 2.78217 2.80429 2.95643 2.99889 2.90707 2.90047 2.92675 2.93970 2.96182 51-81 51-82 51-83 51-84 51-85 51-86 51-87 53-81 53-82 53-83 3.09821 3.14068 3.04886 3.04225 3.06853 3.08149 3.10361 2.46340 2.50586 2.41404 53-84 53-85 53-86 53-87 55-81 55-82 55-83 55-84 55-85 55-86 2.40744 2.43372 2.44667 2.46879 2.41300 2.45547 2.36365 2.35704 2.38332 2.39627 55-87 57-81 57-82 57-83 57-84 57-85 57-86 57-87 59-81 59-82 2.41840 3.05295 3.09542 3.00360 2.99699 3.02327 3.03623 3.05835 2.80573 2.84820 59-83 59-84 59-85 59-86 59-87 61-81 61-82 61-83 61-84 61-85 2.75638 2.74977 2.77605 2.78900 2.81113 2.87058 2.91304 2.82122 2.81462 2.84090 61-86 61-87 63-81 63-82 63-83 63-84 63-85 63-86 63-87 65-81 2.85385 2.87598 3.06787 3.11034 3.01852 3.01191 3.03819 3.05114 3.07327 3.56797 65-82 65-83 65-84 65-85 65-86 65-87 67-81 67-82 67-83 67-84 3.61044 3.51862 3.51201 3.53829 3.55124 3.57337 2.98796 3.03043 2.93861 2.93200 67-85 67-86 67-87 69-81 69-82 69-83 69-84 69-85 69-86 69-87 2.95828 2.97123 2.99336 3.05747 3.09994 3.00812 3.00151 3.02779 3.04074 3.06287 71-81 71-82 71-83 71-84 71-85 71-86 71-87 77-81 77-82 77-83 3.05870 3.10116 3.00934 3.00274 3.02902 3.04197 3.06410 2.89742 2.93989 2.84807 77-84 77-85 77-86 77-87 79-81 79-82 79-83 79-84 79-85 79-86 2.84146 2.86774 2.88069 2.90282 2.54248 2.58495 2.49313 2.48652 2.51280 2.52576 79-87 81-81 81-82 81-83 81-84 81-85 81-86 81-87 83-81 83-82 2.54788 3.16383 3.20630 3.11448 3.10787 3.13415 3.14710 3.16923 3.31662 3.35909 83-83 83-84 83-85 83-86 83-87 85-81 85-82 85-83 85-84 85-85 3.26727 3.26066 3.28694 3.29989 3.32202 3.02735 3.06982 2.97800 2.97139 2.99767 85-86 85-87 87-81 87-82 87-83 87-84 87-85 87-86 87-87 89-81 3.01063 3.03275 2.86312 2.90559 2.81377 2.80716 2.83344 2.84639 2.86852 3.18830 89-82 89-83 89-84 89-85 89-86 89-87 91-81 91-82 91-83 91-84 3.23077 3.13895 3.13234 3.15862 3.17157 3.19370 3.12308 3.16554 3.07373 3.06712 91-85 91-86 91-87 93-81 93-82 93-83 93-84 93-85 93-86 93-87 3.09340 3.10635 3.12848 3.34172 3.38419 3.29237 3.28576 3.31204 3.32499 3.34712 97-81 97-82 97-83 97-84 97-85 97-86 97-87 99-81 99-82 99-83 3.28033 3.32280 3.23098 3.22437 3.25065 3.26360 3.28573 1.89711 1.93958 1.84776 99-84 99-85 99-86 99-87 101-81 101-82 101-83 101-84 101-85 101-86 1.84115 1.86743 1.88038 1.90251 3.11504 3.15751 3.06569 3.05908 3.08536 3.09831 101-87 105-81 105-82 105-83 105-84 105-85 105-86 105-87 107-81 107-82 3.12044 3.38228 3.42474 3.33292 3.32632 3.35260 3.36555 3.38767 3.21231 3.25478 107-83 107-84 107-85 107-86 107-87 109-81 109-82 109-83 109-84 109-85 3.16296 3.15635 3.18263 3.19558 3.21771 2.71145 2.75392 2.66210 2.65549 2.68177 109-86 109-87 111-81 111-82 111-83 111-84 111-85 111-86 111-87 113-81 2.69472 2.71685 2.76745 2.80992 2.71810 2.71149 2.73777 2.75072 2.77285 1.61157 113-82 113-83 113-84 113-85 113-86 113-87 115-81 115-82 115-83 115-84 1.65403 1.56221 1.55561 1.58189 1.59484 1.61696 0.89916 0.94163 0.84981 0.84320 115-85 115-86 115-87 117-81 117-82 117-83 117-84 117-85 117-86 117-87 0.86948 0.88243 0.90456 3.52718 3.56965 3.47783 3.47122 3.49750 3.51045 3.53258 119-81 119-82 119-83 119-84 119-85 119-86 119-87 123-81 123-82 123-83 3.41088 3.45335 3.36153 3.35492 3.38120 3.39416 3.41628 2.89073 2.93319 2.84137 123-84 123-85 123-86 123-87 125-81 125-82 125-83 125-84 125-85 125-86 2.83477 2.86105 2.87400 2.89612 2.79550 2.83797 2.74615 2.73954 2.76582 2.77877 125-87 127-81 127-82 127-83 127-84 127-85 127-86 127-87 129-81 129-82 2.80090 3.65757 3.70004 3.60822 3.60161 3.62789 3.64084 3.66297 3.51147 3.55394 129-83 129-84 129-85 129-86 129-87 131-81 131-82 131-83 131-84 131-85 3.46212 3.45551 3.48179 3.49475 3.51687 3.25613 3.29859 3.20677 3.20017 3.22645 131-86 131-87 133-81 133-82 133-83 133-84 133-85 133-86 133-87 135-81 3.23940 3.26152 2.63101 2.67347 2.58166 2.57505 2.60133 2.61428 2.63641 2.57112 135-82 135-83 135-84 135-85 135-86 135-87 137-81 137-82 137-83 137-84 2.61358 2.52176 2.51516 2.54144 2.55439 2.57651 2.72543 2.76790 2.67608 2.66947 137-85 137-86 137-87 139-81 139-82 139-83 139-84 139-85 139-86 139-87 2.69575 2.70870 2.73083 3.11178 3.15425 3.06243 3.05582 3.08210 3.09505 3.11718 141-81 141-82 141-83 141-84 141-85 141-86 141-87 143-81 143-82 143-83 2.74321 2.78568 2.69386 2.68725 2.71353 2.72648 2.74861 3.02945 3.07192 2.98010 143-84 143-85 143-86 143-87 145-81 145-82 145-83 145-84 145-85 145-86 2.97349 2.99977 3.01273 3.03485 3.09698 3.13945 3.04763 3.04102 3.06730 3.08025 145-87 147-81 147-82 147-83 147-84 147-85 147-86 147-87 149-81 149-82 3.10238 3.13617 3.17863 3.08681 3.08021 3.10649 3.11944 3.14156 2.42469 2.46716 149-83 149-84 149-85 149-86 149-87 151-81 151-82 151-83 151-84 151-85 2.37534 2.36873 2.39501 2.40796 2.43009 2.88858 2.93105 2.83923 2.83262 2.85890 151-86 151-87 153-81 153-82 153-83 153-84 153-85 153-86 153-87 155-81 2.87186 2.89398 3.39734 3.43980 3.34799 3.34138 3.36766 3.38061 3.40274 3.36562 155-82 155-83 155-84 155-85 155-86 155-87 157-81 157-82 157-83 157-84 3.40808 3.31626 3.30966 3.33594 3.34889 3.37101 2.98606 3.02853 2.93671 2.93010 157-85 157-86 157-87 159-81 159-82 159-83 159-84 159-85 159-86 159-87 2.95638 2.96933 2.99146 3.00323 3.04569 2.95387 2.94727 2.97355 2.98650 3.00862 161-81 161-82 161-83 161-84 161-85 161-86 161-87 163-81 163-82 163-83 2.94192 2.98438 2.89256 2.88596 2.91224 2.92519 2.94731 2.85201 2.89447 2.80265 163-84 163-85 163-86 163-87 165-81 165-82 165-83 165-84 165-85 165-86 2.79605 2.82233 2.83528 2.85741 3.54095 3.58341 3.49160 3.48499 3.51127 3.52422 165-87 167-81 167-82 167-83 167-84 167-85 167-86 167-87 169-81 169-82 3.54635 2.79548 2.83795 2.74613 2.73952 2.76580 2.77875 2.80088 2.75467 2.79714 169-83 169-84 169-85 169-86 169-87 171-81 171-82 171-83 171-84 171-85 2.70532 2.69871 2.72499 2.73794 2.76007 2.74131 2.78377 2.69195 2.68535 2.71163 171-86 171-87 173-81 173-82 173-83 173-84 173-85 173-86 173-87 175-81 2.72458 2.74671 1.23830 1.28077 1.18895 1.18234 1.20862 1.22157 1.24370 2.34379 175-82 175-83 175-84 175-85 175-86 175-87 179-81 179-82 179-83 179-84 2.38626 2.29444 2.28783 2.31411 2.32706 2.34919 2.94447 2.98694 2.89512 2.88851 179-85 179-86 179-87 181-81 181-82 181-83 181-84 181-85 181-86 181-87 2.91479 2.92774 2.94987 3.38860 3.43107 3.33925 3.33264 3.35892 3.37187 3.39400 183-81 183-82 183-83 183-84 183-85 183-86 183-87 185-81 185-82 185-83 2.99807 3.04053 2.94871 2.94211 2.96839 2.98134 3.00346 2.28880 2.33126 2.23945 185-84 185-85 185-86 185-87 187-81 187-82 187-83 187-84 187-85 187-86 2.23284 2.25912 2.27207 2.29420 3.27922 3.32169 3.22987 3.22326 3.24954 3.26249 187-87 189-81 189-82 189-83 189-84 189-85 189-86 189-87 191-81 191-82 3.28462 2.09247 2.13494 2.04312 2.03651 2.06279 2.07574 2.09787 2.95449 2.99696 191-83 191-84 191-85 191-86 191-87 193-81 193-82 193-83 193-84 193-85 2.90514 2.89853 2.92481 2.93777 2.95989 3.04436 3.08683 2.99501 2.98840 3.01468 193-86 193-87 195-81 195-82 195-83 195-84 195-85 195-86 195-87 197-81 3.02764 3.04976 2.93793 2.98039 2.88858 2.88197 2.90825 2.92120 2.94333 2.55053 197-82 197-83 197-84 197-85 197-86 197-87 2.59300 2.50118 2.49457 2.52085 2.53380 2.55593 > > > ## check vs. fixest::feols > if(fixest.avail) { + suppressPackageStartupMessages(library(fixest)) + # fixest versions < 0.10.0 do not compute fixef() for IV models correctly, + # fixed in 0.10.0, see bug report: + # https://github.com/lrberge/fixest/issues/190 + # fix commit 2021-08-31: https://github.com/lrberge/fixest/commit/9cdd106b4fe87c0bfc5cbde1102ac1952e246ab0 + + crime_formula_fixest_id <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + county | + lprbarr + lpolpc ~ ltaxpc + lmix + + crime_formula_fixest_ti <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + year | + lprbarr + lpolpc ~ ltaxpc + lmix + + crime_formula_fixest_tw <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + county + year | + lprbarr + lpolpc ~ ltaxpc + lmix + + + FE2SLS_id.fixest <- fixest::feols(crime_formula_fixest_id, data = Crime) + FE2SLS_ti.fixest <- fixest::feols(crime_formula_fixest_ti, data = Crime) + + FE2SLS_id_unbal.fixest <- fixest::feols(crime_formula_fixest_id, data = Crime[delrows, ]) + FE2SLS_ti_unbal.fixest <- fixest::feols(crime_formula_fixest_ti, data = Crime[delrows, ]) + + FE2SLS_tw.fixest <- fixest::feols(crime_formula_fixest_tw, data = Crime) + FE2SLS_tw_unbal.fixest <- fixest::feols(crime_formula_fixest_tw, data = Crime[delrows, ]) + + # First, check if model estimations are the same + stopifnot(isTRUE(all.equal(FE2SLS_id$coefficients, FE2SLS_id.fixest$coefficients, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_ti$coefficients, FE2SLS_ti.fixest$coefficients, check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(FE2SLS_id_unbal$coefficients, FE2SLS_id_unbal.fixest$coefficients, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_ti_unbal$coefficients, FE2SLS_ti_unbal.fixest$coefficients, check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(FE2SLS_tw$coefficients, FE2SLS_tw.fixest$coefficients, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_tw_unbal$coefficients, FE2SLS_tw_unbal.fixest$coefficients, check.attributes = FALSE))) + + ## check fixef + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id)), fixef(FE2SLS_id.fixest)[["county"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti)), fixef(FE2SLS_ti.fixest)[["year"]], check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id_unbal)), fixef(FE2SLS_id_unbal.fixest)[["county"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti_unbal)), fixef(FE2SLS_ti_unbal.fixest)[["year"]], check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw)), fixef(FE2SLS_tw.fixest)[["county"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw, "time", "dfirst"))), fixef(FE2SLS_tw.fixest)[["year"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw, "twoways")), FE2SLS_tw.fixest$sumFE, check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal)), fixef(FE2SLS_tw_unbal.fixest)[["county"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw_unbal, "time", "dfirst"))), fixef(FE2SLS_tw_unbal.fixest)[["year"]], check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal, "twoways")), FE2SLS_tw_unbal.fixest$sumFE, check.attributes = FALSE))) + + fixef(FE2SLS_id.fixest) + fixef(FE2SLS_id_unbal.fixest) + + fixef(FE2SLS_ti.fixest) + fixef(FE2SLS_ti_unbal.fixest) + + fixef(FE2SLS_tw.fixest)[["county"]] + fixef(FE2SLS_tw.fixest)[["year"]] + fixef(FE2SLS_tw_unbal.fixest)[["county"]] + fixef(FE2SLS_tw_unbal.fixest)[["year"]] + } 81 82 83 84 85 86 0.000000000 0.042466794 -0.049352287 -0.055959916 -0.029680284 -0.016728912 87 0.005398275 > > if(lfe.avail) { + library(lfe) # version 2.8-7 + + # check vs. lfe::felm/getfe + formula_lfe_id <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + county | + (lprbarr|lpolpc ~ ltaxpc + lmix) + + formula_lfe_ti <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + year | + (lprbarr|lpolpc ~ ltaxpc + lmix) + + formula_lfe_tw <- lcrmrte ~ lprbconv + lprbpris + lavgsen + + ldensity + lwcon + lwtuc + lwtrd + lwfir + + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | + county + year | + (lprbarr|lpolpc ~ ltaxpc + lmix) + + + FE2SLS_id.felm <- lfe::felm(formula_lfe_id, data = Crime) + FE2SLS_ti.felm <- lfe::felm(formula_lfe_ti, data = Crime) + FE2SLS_id_unbal.felm <- lfe::felm(formula_lfe_id, data = Crime[delrows, ]) + FE2SLS_ti_unbal.felm <- lfe::felm(formula_lfe_ti, data = Crime[delrows, ]) + FE2SLS_tw.felm <- lfe::felm(formula_lfe_tw, data = Crime) + FE2SLS_tw_unbal.felm <- lfe::felm(formula_lfe_tw, data = Crime[delrows, ]) + + # same order of coef as other estimations + FE2SLS_id.felm.coef <- as.numeric(FE2SLS_id.felm$coefficients) + names(FE2SLS_id.felm.coef) <- rownames(FE2SLS_id.felm$coefficients) + FE2SLS_id.felm.coef <- FE2SLS_id.felm.coef[c(15, 16, 1:14)] + + FE2SLS_ti.felm.coef <- as.numeric(FE2SLS_ti.felm$coefficients) + names(FE2SLS_ti.felm.coef) <- rownames(FE2SLS_ti.felm$coefficients) + FE2SLS_ti.felm.coef <- FE2SLS_ti.felm.coef[c(15, 16, 1:14)] + + FE2SLS_id_unbal.felm.coef <- as.numeric(FE2SLS_id_unbal.felm$coefficients) + names(FE2SLS_id_unbal.felm.coef) <- rownames(FE2SLS_id_unbal.felm$coefficients) + FE2SLS_id_unbal.felm.coef <- FE2SLS_id_unbal.felm.coef[c(15, 16, 1:14)] + + FE2SLS_ti_unbal.felm.coef <- as.numeric(FE2SLS_ti_unbal.felm$coefficients) + names(FE2SLS_ti_unbal.felm.coef) <- rownames(FE2SLS_ti_unbal.felm$coefficients) + FE2SLS_ti_unbal.felm.coef <- FE2SLS_ti_unbal.felm.coef[c(15, 16, 1:14)] + + FE2SLS_tw.felm.coef <- as.numeric(FE2SLS_tw.felm$coefficients) + names(FE2SLS_tw.felm.coef) <- rownames(FE2SLS_tw.felm$coefficients) + FE2SLS_tw.felm.coef <- FE2SLS_tw.felm.coef[c(15, 16, 1:14)] + + FE2SLS_tw_unbal.felm.coef <- as.numeric(FE2SLS_tw_unbal.felm$coefficients) + names(FE2SLS_tw_unbal.felm.coef) <- rownames(FE2SLS_tw_unbal.felm$coefficients) + FE2SLS_tw_unbal.felm.coef <- FE2SLS_tw_unbal.felm.coef[c(15, 16, 1:14)] + + # First, check if model estimations are the same + stopifnot(isTRUE(all.equal(FE2SLS_id$coefficients, FE2SLS_id.felm.coef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_ti$coefficients, FE2SLS_ti.felm.coef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_id_unbal$coefficients, FE2SLS_id_unbal.felm.coef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_ti_unbal$coefficients, FE2SLS_ti_unbal.felm.coef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_tw$coefficients, FE2SLS_tw.felm.coef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(FE2SLS_tw_unbal$coefficients, FE2SLS_tw_unbal.felm.coef, check.attributes = FALSE))) + + FE2SLS_id.felm_fixef <- lfe::getfe(FE2SLS_id.felm)[lfe::getfe(FE2SLS_id.felm)[["fe"]] == "county", 1] + FE2SLS_id_unbal.felm_fixef <- lfe::getfe(FE2SLS_id_unbal.felm)[lfe::getfe(FE2SLS_id_unbal.felm)[["fe"]] == "county", 1] + + FE2SLS_ti.felm_fixef <- lfe::getfe(FE2SLS_ti.felm)[lfe::getfe(FE2SLS_ti.felm)[["fe"]] == "year", 1] + FE2SLS_ti_unbal.felm_fixef <- lfe::getfe(FE2SLS_ti_unbal.felm)[lfe::getfe(FE2SLS_ti_unbal.felm)[["fe"]] == "year", 1] + + FE2SLS_tw.id.felm_fixef <- lfe::getfe(FE2SLS_tw.felm)[lfe::getfe(FE2SLS_tw.felm)[["fe"]] == "county", 1] + FE2SLS_tw.id_unbal.felm_fixef <- lfe::getfe(FE2SLS_tw_unbal.felm)[lfe::getfe(FE2SLS_tw_unbal.felm)[["fe"]] == "county", 1] + FE2SLS_tw.ti.felm_fixef <- lfe::getfe(FE2SLS_tw.felm)[lfe::getfe(FE2SLS_tw.felm)[["fe"]] == "year", 1] + FE2SLS_tw.ti_unbal.felm_fixef <- lfe::getfe(FE2SLS_tw_unbal.felm)[lfe::getfe(FE2SLS_tw_unbal.felm)[["fe"]] == "year", 1] + + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id)), FE2SLS_id.felm_fixef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti)), FE2SLS_ti.felm_fixef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id_unbal)), FE2SLS_id_unbal.felm_fixef, check.attributes = FALSE))) + + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti_unbal)), FE2SLS_ti_unbal.felm_fixef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw)), FE2SLS_tw.id.felm_fixef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw, "time", "dfirst"))), FE2SLS_tw.ti.felm_fixef, check.attributes = FALSE, tolerance = 10^(-6)))) + + # in the unbalanced twoway case, getfe() sets as reference a level depending on the unbalancedness structure + # -> somewhat arbitrary -> see also https://github.com/sgaure/lfe/issues/52 + # for this example, the unbalancedness structure leads to the first time period being the reference + stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal)), FE2SLS_tw.id_unbal.felm_fixef, check.attributes = FALSE))) + stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw_unbal, "time", "dfirst"))), FE2SLS_tw.ti_unbal.felm_fixef, check.attributes = FALSE, tolerance = 10^(-6)))) + } > > proc.time() user system elapsed 4.28 0.68 5.07 plm/inst/tests/test_pvar.Rout.save0000644000176200001440000001360314126007621017002 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(plm) > data("Grunfeld", package = "plm") > > > > # corner case make one - id NA and rest non varying > # non-variation was detected prior to rev. 206 > Grunfeld_1NA_nonvari <- Grunfeld > Grunfeld_1NA_nonvari[ 1:20, "capital"] <- NA > Grunfeld_1NA_nonvari[21:200, "capital"] <- Grunfeld_1NA_nonvari[21:200, "firm"] > print(pvar(Grunfeld_1NA_nonvari)) no time variation: firm capital no individual variation: year capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > Grunfeld_1NA_nonvari_time <- Grunfeld > Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year == 1935, "capital"] <- NA > Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year != 1935, "capital"] <- Grunfeld_1NA_nonvari_time[Grunfeld_1NA_nonvari_time$year != 1935, "year"] > print(pvar(Grunfeld_1NA_nonvari_time)) no time variation: firm capital no individual variation: year capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > > ## for one id all NA -> time dimension affected > Grunfeld_1NA <- Grunfeld > Grunfeld_1NA[1:20, "capital"] <- NA > print(pvar(Grunfeld_1NA)) no time variation: firm no individual variation: year capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > Grunfeld_2NA <- Grunfeld > Grunfeld_2NA[1:20, "capital"] <- NA > Grunfeld_2NA[21:40, "value"] <- NA > print(pvar(Grunfeld_2NA)) no time variation: firm no individual variation: year value capital all NA in time dimension for at least one individual: value capital all NA in ind. dimension for at least one time period: value capital > > > ## one time period all NA -> id dimension affected > Grunfeld_1NA_time <- Grunfeld > Grunfeld_1NA_time[Grunfeld_1NA_time$year == 1935, "capital"] <- NA > print(pvar(Grunfeld_1NA_time)) no time variation: firm capital no individual variation: year all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > Grunfeld_2NA_time <- Grunfeld > Grunfeld_2NA_time[Grunfeld_2NA_time$year == 1935, c("value", "capital")] <- NA > print(pvar(Grunfeld_2NA_time)) no time variation: firm value capital no individual variation: year all NA in time dimension for at least one individual: value capital all NA in ind. dimension for at least one time period: value capital > > > > # input only 1-column data.frame (1 variable) with all NA for one id > Grunfeld_1var <- Grunfeld > Grunfeld_1var <- pdata.frame(Grunfeld, drop.index = TRUE) > Grunfeld_1var$inv <- NULL > Grunfeld_1var$value <- NULL > Grunfeld_1var1NA <- Grunfeld_1var > Grunfeld_1var1NA[c(1:20), "capital"] <- NA > print(pvar(Grunfeld_1var1NA)) no individual variation: capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > Grunfeld_1var1NA_time <- Grunfeld_1var > Grunfeld_1var1NA_time[c(1,21,41,61,81,101,121,141,161,181), "capital"] <- NA > print(pvar(Grunfeld_1var1NA_time)) no time variation: capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > > ## data.frame > print(pvar(Grunfeld, index=c("firm"))) no time variation: firm no individual variation: year time > > ## one variable all NA -> gets removed by pdata.frame > Grunfeld_allNA <- Grunfeld > Grunfeld_allNA[ , "capital"] <- NA > print(pvar(Grunfeld_allNA)) no time variation: firm capital no individual variation: year capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > > > > # Matrix > Grunfeld_mat <- as.matrix(Grunfeld) > > Grunfeld_mat <- as.matrix(Grunfeld) > pvar(Grunfeld_mat) no time variation: firm no individual variation: year > pvar(Grunfeld_mat, index=c("firm")) no time variation: firm no individual variation: year time > > Grunfeld_mat_allNA <- as.matrix(Grunfeld_allNA) > pvar(Grunfeld_mat_allNA) no time variation: firm capital no individual variation: year capital all NA in time dimension for at least one individual: capital all NA in ind. dimension for at least one time period: capital > > > > ## pseries > pGrunfeld <- pdata.frame(Grunfeld) > pvar(pGrunfeld$capital) # should indicate variation in both dimensions (nothing is printed) > pvar(pGrunfeld[1:20, ]$capital) # should indicate no indivivual variation (b/c only 1 individual is evaluated) no individual variation: x > > > # library(foreign);library(plm) > # jtrain <- read.dta("http://fmwww.bc.edu/ec-p/data/wooldridge/jtrain.dta") > # > # # Define panel data (for 1987 and 1988 only) > # jtrain.87.88 <- subset(jtrain,year<=1988) > # jtrain.p<-pdata.frame(jtrain.87.88, index=c("fcode","year")) > # > # pvar(jtrain.p) > # print(pvar(jtrain.p)) > # > # pvar(jtrain.p[ , c(20:26)]) > # print(pvar(jtrain.p[ , c(20:26)])) > > > proc.time() user system elapsed 0.92 0.10 1.00 plm/inst/tests/test_preserve_rownames.R0000644000176200001440000001213014124132276020110 0ustar liggesusers## testfile for preserving row.names in plm_object$model and as.data.frame library(plm) data("Grunfeld", package = "plm") row.names(Grunfeld) # row.names are a sequence 1:nrow(Grunfeld) originally gr <- plm(inv ~ value + capital, data=Grunfeld, model="pooling") # same row.names and names as before estimation [i. e. original row.names are preserved] if(!isTRUE(all.equal(row.names(gr$model), row.names(Grunfeld)))) stop("original rownames not preserved in plm_obj$model") if(!isTRUE(all.equal(row.names(model.frame(gr)), row.names(Grunfeld)))) stop("original rownames not preserved in model.frame(plm_obj)") if(!isTRUE(all.equal(names(pmodel.response(gr)), row.names(Grunfeld)))) stop("original rownames not preserved in names(pmodel.response(plm_obj))") if(!isTRUE(all.equal(names(residuals(gr)), row.names(Grunfeld)))) stop("original rownames not preserved in names(residuals(plm_obj))") # make a pdata.frame with "fancy" row.names (default) # [i.e., combination of individual index an 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") # original row.names of pGrunfeld (i.e., "fancy" row.names) are preserved if(!isTRUE(all.equal(row.names(gr_fancy_rownames$model), row.names(pGrunfeld)))) stop("original rownames not preserved in plm_obj$model") if(!isTRUE(all.equal(row.names(model.frame(gr_fancy_rownames)), row.names(pGrunfeld)))) stop("original rownames not preserved in model.frame(plm_obj)") if(!isTRUE(all.equal(names(pmodel.response(gr_fancy_rownames)), row.names(pGrunfeld)))) stop("original rownames not preserved in names(pmodel.response(plm_obj))") if(!isTRUE(all.equal(names(residuals(gr_fancy_rownames)), row.names(pGrunfeld)))) stop("original rownames not preserved in names(residuals(plm_obj))") # test with one missing observation # set some arbitrary value to NA, so it is left out of the estimation # data.frame Grunfeld_1NA <- Grunfeld line_no <- 6L Grunfeld_1NA[line_no, "inv"] <- NA gr_1NA <- plm(inv ~ value + capital, data=Grunfeld_1NA, model="pooling") nobs(gr_1NA) # 199 nrow(Grunfeld_1NA) # 200 if(!isTRUE(all.equal(row.names(gr_1NA$model), row.names(Grunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in plm_obj$model") if(!isTRUE(all.equal(row.names(model.frame(gr_1NA)), row.names(Grunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in model.frame(plm_obj)") if(!isTRUE(all.equal(names(pmodel.response(gr_1NA)), row.names(Grunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in names(pmodel.response(plm_obj))") if(!isTRUE(all.equal(names(residuals(gr_1NA)), row.names(Grunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in names(residuals(plm_obj))") # Should be TRUE # [199 + 1 == 200] # [199 == 199] if(!isTRUE(length(residuals(gr_1NA)) + 1 == length(row.names(Grunfeld_1NA)))) stop("length not correct") if(!isTRUE(length(residuals(gr_1NA)) == length(row.names(Grunfeld_1NA[-line_no, ])))) stop("length not correct") # pdata.frame pGrunfeld_1NA <- pGrunfeld line_no <- 6L pGrunfeld_1NA[line_no, "inv"] <- NA gr_fancy_rownames_1NA <- plm(inv ~ value + capital, data=pGrunfeld_1NA, model="pooling") nobs(gr_fancy_rownames_1NA) # 199 nrow(pGrunfeld_1NA) # 200 if(!isTRUE(all.equal(row.names(gr_fancy_rownames_1NA$model), row.names(pGrunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in plm_obj$model") if(!isTRUE(all.equal(row.names(model.frame(gr_fancy_rownames_1NA)), row.names(pGrunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in model.frame(plm_obj)") if(!isTRUE(all.equal(names(pmodel.response(gr_fancy_rownames_1NA)), row.names(pGrunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in names(pmodel.response(plm_obj))") if(!isTRUE(all.equal(names(residuals(gr_fancy_rownames_1NA)), row.names(pGrunfeld_1NA[-line_no, ])))) stop("original rownames not preserved in names(residuals(plm_obj))") # Should be TRUE # [199 + 1 == 200] # [199 == 199] if(!isTRUE(length(residuals(gr_fancy_rownames_1NA)) + 1 == length(row.names(pGrunfeld_1NA)))) stop("length not correct") if(!isTRUE(length(residuals(gr_fancy_rownames_1NA)) == length(row.names(pGrunfeld_1NA[-line_no, ])))) stop("length not correct") # test as.data.frame.pdata.frame row.names(as.data.frame(pGrunfeld)) row.names(as.data.frame(pGrunfeld, row.names = NULL)) # NULL is default, same as FALSE row.names(as.data.frame(pGrunfeld, row.names = FALSE)) # same as NULL row.names(as.data.frame(pGrunfeld, row.names = TRUE)) # fancy row names are added # test data.frame - argument row.names has a different meaning here compared to as.data.frame.pdata.frame row.names(data.frame(pGrunfeld)) row.names(data.frame(pGrunfeld, row.names = c(1:nrow(pGrunfeld)))) # row.names(data.frame(pGrunfeld, row.names = TRUE)) # error due to diff. meaning # row.names(data.frame(pGrunfeld, row.names = FALSE)) # error due to diff. meaning plm/inst/tests/test_pbsytest_unbalanced.Rout.save0000644000176200001440000002550014124132276022065 0ustar liggesusers R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # test pbsytest() - unbalanced and balanced version > > ################### Bera, Sosa-Escudero and Yoon (2001) and joint test of Baltagi/Li (1991) ############### > # see Baltagi (2005), Econometric Analysis of Panel Data, 3rd edition, pp. 96-97 > # or Baltagi (2013), Econometric Analysis of Panel Data, 5th edition, p. 108. > # > ## only balanced tests described in Bera, Sosa-Escudero and Yoon (2001) and Baltagi (2005, 2013)! > # > # Baltagi (2013), p. 108: > # Grunfeld data, (table 4.2) > # LM_mu = 798.162 (with Stata's xttest0 command) [-> plmtest(pool_grunfeld, type = "bp")] > # LM_rho = 143.523, LM*_mu = 664.948, LM*_rho = 10.310, joint test (LM1) = 808.471 (all using TSP) > # > # comments about significance in book: > # joint test (LM1): rejects null hypo (no first-order serial correlation and no random effects) > # LM_rho, LM*_rho: reject null hypo (no first-order serial correlation) > # LM_mu, LM*_mu: reject null hypo (no random effects) > > > library(plm) > data("Grunfeld", package = "plm") > Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) > form_gunfeld <- formula(inv ~ value + capital) > pool_grunfeld <- plm(form_gunfeld, data = Grunfeldpdata, model="pooling") > > pbsytest(pool_grunfeld, test = "ar") # chisq = 10.31 => LM*_rho in Baltagi's book (RS*_lambda from Sosa-Escudero/Bera (2008), p. 73) Bera, Sosa-Escudero and Yoon locally robust test - balanced panel data: formula chisq = 10.31, df = 1, p-value = 0.001323 alternative hypothesis: AR(1) errors sub random effects > pbsytest(pool_grunfeld, test = "re", re.normal = FALSE) # chisq = 664.948 => LM*_mu in Baltagi's book (RS*_mu from Sosa-Escudero/Bera (2008), p. 73) Bera, Sosa-Escudero and Yoon locally robust test (two-sided) - balanced panel data: formula chisq = 664.95, df = 1, p-value < 2.2e-16 alternative hypothesis: random effects sub AR(1) errors > pbsytest(pool_grunfeld, test = "re") # [sqrt(chisq) = z = 25.787] => RSO*_mu from Sosa-Escudero/Bera (2008), p. 75 Bera, Sosa-Escudero and Yoon locally robust test (one-sided) - balanced panel data: formula z = 25.787, p-value < 2.2e-16 alternative hypothesis: random effects sub AR(1) errors > pbsytest(pool_grunfeld, test = "j") # chisq = 808.47 => LM1 in Baltagi's book (RS_lambda_mu in Sosa-Escudero/Bera (2008), p. 74) Baltagi and Li AR-RE joint test - balanced panel data: formula chisq = 808.47, df = 2, p-value < 2.2e-16 alternative hypothesis: AR(1) errors or random effects > > # formula interface > pbsytest(form_gunfeld, data = Grunfeld, test = "ar") Bera, Sosa-Escudero and Yoon locally robust test - balanced panel data: formula chisq = 10.31, df = 1, p-value = 0.001323 alternative hypothesis: AR(1) errors sub random effects > pbsytest(form_gunfeld, data = Grunfeld, test = "re") Bera, Sosa-Escudero and Yoon locally robust test (one-sided) - balanced panel data: formula z = 25.787, p-value < 2.2e-16 alternative hypothesis: random effects sub AR(1) errors > pbsytest(form_gunfeld, data = Grunfeld, test = "re", re.normal = FALSE) Bera, Sosa-Escudero and Yoon locally robust test (two-sided) - balanced panel data: formula chisq = 664.95, df = 1, p-value < 2.2e-16 alternative hypothesis: random effects sub AR(1) errors > pbsytest(form_gunfeld, data = Grunfeld, test = "j") Baltagi and Li AR-RE joint test - balanced panel data: formula chisq = 808.47, df = 2, p-value < 2.2e-16 alternative hypothesis: AR(1) errors or random effects > > plmtest(pool_grunfeld, type = "bp") # LM_mu in Baltagi's book Lagrange Multiplier Test - (Breusch-Pagan) for balanced panels data: form_gunfeld chisq = 798.16, df = 1, p-value < 2.2e-16 alternative hypothesis: significant effects > > ############### balanced version ################### > ### Results from Bera et al. (2001), p. 13: > > ## Bera/Sosa-Escudero/Yoon (2001), Tests for the error component model in the presence of local misspecifcation, > ## Journal of Econometrics 101 (2001), pp. 1-23. > > # To replicate, a special version of the Grunfeld data set is needed: only 5 selected firms (total of 100 obs) > # from http://pages.stern.nyu.edu/~wgreene/Text/tables/TableF13-1.txt > # or http://statmath.wu.ac.at/~zeileis/grunfeld/TableF13-1.txt > # > # NB: this data set contains 3 errors compared to the original Grunfeld data, see e.g., the > # analysis of various different Grundfeld data sets circulating at http://statmath.wu-wien.ac.at/~zeileis/grunfeld/ > # or https://eeecon.uibk.ac.at/~zeileis/grunfeld/ > # > ## commented due to file download > > # Grunfeld_greene_5firms <- read.csv("http://pages.stern.nyu.edu/~wgreene/Text/tables/TableF13-1.txt", sep="") > # # Grunfeld_greene_5firms <- read.csv("http://statmath.wu.ac.at/~zeileis/grunfeld/TableF13-1.txt", sep="") # alternative source > # > # # Matching to Grunfeld data set in plm > # # Grunfeld[c(1:20, 41:60), 3:5] == Grunfeld_greene_5firms[c(1:20, 41:60), 3:5] > # # Grunfeld[61:80, 3:5] == Grunfeld_greene_5firms[21:40, 3:5] > # # Grunfeld[141:160, 3:5] == Grunfeld_greene_5firms[61:80, 3:5] > # # Grunfeld[21:40, 3:5] == Grunfeld_greene_5firms[81:100, 3:5] # almost all equal, 3 values differ (3 errors in the Greene 5 firm version) > # > # pGrunfeld_greene_5firms <- pdata.frame(Grunfeld_greene_5firms, index = c("Firm", "Year"), drop.index = FALSE, row.names = TRUE) > # form_gunfeld_half <- formula(I ~ F + C) > # pool_grunfeld_half <- plm(form_gunfeld_half, data=pGrunfeld_greene_5firms, model = "pooling") > # re_grunfeld_half <- plm(form_gunfeld_half, data=pGrunfeld_greene_5firms, model = "random") > # > # pbsytest(pool_grunfeld_half, test = "ar") # chisq = 3.7125 => RS*_rho in Bera et al. (2001), p. 13 > # pbsytest(pool_grunfeld_half, test = "re") # normal = 19.601; p = 0 => RSO*_mu > # pbsytest(pool_grunfeld_half, test = "re", re.normal = FALSE) # chisq = 384.183 => RS*_mu [sqrt(chisq) = z = 19.601] > # pbsytest(pool_grunfeld_half, test = "j") # chisq = 457.53 => RS_mu_rho > # > # # plmtest's statistic is also mentioned in paper > # plmtest(pool_grunfeld_half, type = "bp") # chisq = 453.82 => RS_mu in Bera et al. (2001), p. 13 > # plmtest(pool_grunfeld_half, type = "honda") # normal = 21.3031 => RSO_mu > # > # > # ## RS_rho in Bera et al (2001), p. 9 (formula 19) is not implemented > # ## it's origin is in Baltagi/Li (1991), but there is is just a side result > # ## in terms of n, t, b of pbsystest it is: (n*t^2*(B^2)) / (t-1) > # > # # formula interface > # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "ar") > # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "re") > # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "re", re.normal = FALSE) > # pbsytest(form_gunfeld_half, data = pGrunfeld_greene_5firms, test = "j") > # > # plmtest(form_gunfeld_half, data = pGrunfeld_greene_5firms, type = "bp") > > > ############ Replicate tests from original paper Sosa-Escudero/Bera (2008) #################### > ############ unbalanced panel #################### > ## > ## data set for test from Sosa-Escudero/Bera (2008), pp. 75-77 > ## available as Stata .dta file at http://www.stata-journal.com/software/sj8-1/sg164_1/ginipanel5.dta > ## > ## Sosa-Escudero/Bera (2008), Tests for unbalanced error-components models under local misspecification, > ## The Stata Journal (2008), Vol. 8, Number 1, pp. 68-78. > > ## Commented due to extra package needed > > # library(haven) > # ginipanel5 <- read_dta("http://www.stata-journal.com/software/sj8-1/sg164_1/ginipanel5.dta") > # pginipanel5 <- pdata.frame(ginipanel5, index = c("naglo", "ano"), drop.index = FALSE, row.names = TRUE) > # > # # Stata command for RE model: xtreg gini ie ie2 indus adpubedsal desempleo tactiv invipib apertura pyas4 e64 supc tamfam, re > # # use pooling model in R: > # formula_gini <- formula(gini ~ ie + ie2 + indus + adpubedsal + desempleo + tactiv + invipib + apertura + pyas4 + e64 + supc + tamfam) > # pool_gini <- plm(formula_gini, data = pginipanel5, model = "pooling") > # > # pdim(pool_gini) # Unbalanced Panel: n=17, T=6-8, N=128 > # > # # Stata's Output of xttest1, unadjusted (Sosa-Escudero/Bera (2008), p. 77): > # # > # # Random Effects, Two Sided: > # # LM(Var(u)=0) = 13.50 Pr>chi2(1) = 0.0002 > # # ALM(Var(u)=0) = 6.03 Pr>chi2(1) = 0.0141 # test="re", re.normal = FALSE > # # > # # Random Effects, One Sided: > # # LM(Var(u)=0) = 3.67 Pr>N(0,1) = 0.0001 > # # ALM(Var(u)=0) = 2.46 Pr>N(0,1) = 0.0070 # test="re", re.normal = TRUE > # # > # # Serial Correlation: > # # LM(lambda=0) = 9.32 Pr>chi2(1) = 0.0023 > # # ALM(lambda=0) = 1.86 Pr>chi2(1) = 0.1732 # test="ar" > # # > # # Joint Test: > # # LM(Var(u)=0,lambda=0) = 15.35 Pr>chi2(2) = 0.0005 # test="j" > # > # > # pbsytest(pool_gini, test = "re", re.normal = FALSE) # chisq = 6.0288793, df = 1, p-value = 0.01407367 > # pbsytest(pool_gini, test = "re") # normal = 2.4553776, n/a p-value = 0.007036833 > # pbsytest(pool_gini, test = "ar") # chisq = 1.8550073, df = 1, p-value = 0.1732021 > # pbsytest(pool_gini, test = "j") # chisq = 15.352307, df = 2, p-value = 0.0004637552 > # > # # formula interface > # pbsytest(formula_gini, data = pginipanel5, test = "re", re.normal = FALSE) # chisq = 6.0288793, df = 1, p-value = 0.01407367 > # pbsytest(formula_gini, data = pginipanel5, test = "re") # normal = 2.4553776, n/a p-value = 0.007036833 > # pbsytest(formula_gini, data = pginipanel5, test = "ar") # chisq = 1.8550073, df = 1, p-value = 0.1732021 > # pbsytest(formula_gini, data = pginipanel5, test = "j") # chisq = 15.352307, df = 2, p-value = 0.0004637552 > # > > proc.time() user system elapsed 0.62 0.17 0.78 plm/inst/tests/test_pwaldtest_vcovG_attr_cluster.Rout.save0000644000176200001440000003375714124132276024017 0ustar liggesusers R version 3.6.3 (2020-02-29) -- "Holding the Windsock" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #### Testfile to see the attr(vcov, which="cluster") for various vcovXX methods > # > # see also testfile tests/test_pwaldtest.R for general tests of the F test and Chisq test > > options(scipen = 999) > options(digits = 8) > library(plm) > data("Grunfeld", package="plm") > gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") > gi <- plm(inv ~ value + capital, data = Grunfeld, + effect = "individual", model = "within") > gt <- plm(inv ~ value + capital, data = Grunfeld, + effect = "time", model = "within") > gd <- plm(inv ~ value + capital, data = Grunfeld, + effect = "twoways", model = "within") > > # vcovHC > print(attr(vcovHC(gi), which="cluster")) # group - default [1] "group" > print(attr(vcovHC(gi, cluster="group"), which="cluster")) # group [1] "group" > print(attr(vcovHC(gi, cluster="time"), which="cluster")) # time [1] "time" > > # vcovBK > print(attr(vcovBK(gi), which="cluster")) # group - default [1] "group" > print(attr(vcovBK(gi, cluster="group"), which="cluster")) # group [1] "group" > print(attr(vcovBK(gi, cluster="time"), which="cluster")) # time [1] "time" > > # vcovSCC > print(attr(vcovSCC(gi), which="cluster")) # time - default and should be the only option for SCC [1] "time" > print(attr(vcovSCC(gi, cluster="group"), which="cluster")) # group [1] "group" > print(attr(vcovSCC(gi, cluster="time"), which="cluster")) # time [1] "time" > > # vcovNW > print(attr(vcovNW(gi), which="cluster")) # time - default and should be the only option for NW [1] "time" > print(attr(vcovNW(gi, cluster="group"), which="cluster")) # group [1] "group" > print(attr(vcovNW(gi, cluster="time"), which="cluster")) # time [1] "time" > > # vcovDC > print(attr(vcovDC(gi), which="cluster")) # group-time - nothing else possible [1] "group-time" > > > # pooling model F test - robust - function > plm::pwaldtest(gp, test = "F", vcov = vcovHC) F test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital F = 57.9049, df1 = 2, df2 = 9, p-value = 0.0000072606 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "F", vcov = vcovBK) F test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital F = 32.9422, df1 = 2, df2 = 9, p-value = 0.000072332 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "F", vcov = vcovSCC) F test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital F = 105.718, df1 = 2, df2 = 19, p-value = 0.000000000050573 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "F", vcov = vcovNW) F test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital F = 92.1225, df1 = 2, df2 = 19, p-value = 0.00000000016671 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering F test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital F = 65.0889, df1 = 2, df2 = 197, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model individual F test - robust - function > plm::pwaldtest(gi, test = "F", vcov = vcovHC) F test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital F = 31.7744, df1 = 2, df2 = 9, p-value = 0.000083417 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcovBK) F test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital F = 64.3086, df1 = 2, df2 = 9, p-value = 0.000004678 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcovSCC) F test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital F = 75.9419, df1 = 2, df2 = 19, p-value = 0.00000000086597 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcovNW) F test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital F = 29.0557, df1 = 2, df2 = 19, p-value = 0.0000016616 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering F test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital F = 55.4686, df1 = 2, df2 = 188, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model time F test - robust - function > plm::pwaldtest(gt, test = "F", vcov = vcovHC) F test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital F = 62.1078, df1 = 2, df2 = 9, p-value = 0.0000054149 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcovBK) F test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital F = 28.7897, df1 = 2, df2 = 9, p-value = 0.00012276 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcovSCC) F test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital F = 89.0247, df1 = 2, df2 = 19, p-value = 0.00000000022372 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcovNW) F test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital F = 103.116, df1 = 2, df2 = 19, p-value = 0.000000000062831 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering F test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital F = 64.2897, df1 = 2, df2 = 178, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model twoways F test - robust - function > plm::pwaldtest(gd, test = "F", vcov = vcovHC) F test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital F = 74.6338, df1 = 2, df2 = 9, p-value = 0.0000024936 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcovBK) F test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital F = 58.0144, df1 = 2, df2 = 9, p-value = 0.0000072035 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcovSCC) F test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital F = 46.9641, df1 = 2, df2 = 19, p-value = 0.000000044313 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcovNW) F test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital F = 33.8818, df1 = 2, df2 = 19, p-value = 0.00000054194 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "F", vcov = vcovDC) # no finite-sample adj. for df2 done, because not yet clear how to handle "group-time" clustering F test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital F = 104.851, df1 = 2, df2 = 169, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # pooling model Chisq - robust - function > plm::pwaldtest(gp, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 115.81, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "Chisq", vcov = vcovBK) Wald test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital Chisq = 65.8844, df = 2, p-value = 0.0000000000000049361 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "Chisq", vcov = vcovSCC) Wald test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital Chisq = 211.437, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "Chisq", vcov = vcovNW) Wald test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital Chisq = 184.245, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gp, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test Wald test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital Chisq = 130.178, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model individual Chisq - robust - function > plm::pwaldtest(gi, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 63.5489, df = 2, p-value = 0.000000000000015869 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovBK) Wald test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital Chisq = 128.617, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovSCC) Wald test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital Chisq = 151.884, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovNW) Wald test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital Chisq = 58.1114, df = 2, p-value = 0.00000000000024058 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gi, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test Wald test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital Chisq = 110.937, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model time Chisq - robust - function > plm::pwaldtest(gt, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 124.216, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovBK) Wald test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital Chisq = 57.5795, df = 2, p-value = 0.00000000000031389 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovSCC) Wald test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital Chisq = 178.049, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovNW) Wald test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital Chisq = 206.232, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gt, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test Wald test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital Chisq = 128.579, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > # within model twoways Chisq - robust - function > plm::pwaldtest(gd, test = "Chisq", vcov = vcovHC) Wald test for joint significance (robust), vcov: vcovHC data: inv ~ value + capital Chisq = 149.268, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovBK) Wald test for joint significance (robust), vcov: vcovBK data: inv ~ value + capital Chisq = 116.029, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovSCC) Wald test for joint significance (robust), vcov: vcovSCC data: inv ~ value + capital Chisq = 93.9283, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovNW) Wald test for joint significance (robust), vcov: vcovNW data: inv ~ value + capital Chisq = 67.7637, df = 2, p-value = 0.0000000000000019289 alternative hypothesis: at least one coefficient is not null > plm::pwaldtest(gd, test = "Chisq", vcov = vcovDC) # finite-sample adj. for df2 irrelevant b/c Chisq test Wald test for joint significance (robust), vcov: vcovDC data: inv ~ value + capital Chisq = 209.701, df = 2, p-value < 0.000000000000000222 alternative hypothesis: at least one coefficient is not null > > > > > proc.time() user system elapsed 2.56 0.23 2.78 plm/inst/tests/test_groupGenerics_pseries.R0000644000176200001440000002441714154734502020726 0ustar liggesusers## test of groupGernerics for 'pseries' objects work ## test of propagation ## ## see further down below (5) for an example of R's behaviour for a wrapping class "myclass" without group Generics ## see also (6) for a case which cannot be worked around (best to my knowledge) library(plm) data("Grunfeld", package = "plm") Grunfeld[ , "integer"] <- rep(c(1L, 2L, 3L, 4L), 25) Grunfeld[ , "logi"] <- rep(c(TRUE, FALSE, TRUE, FALSE), 25) Grunfeld[ , "complex"] <- rep(c(1+0i, 2+1i), 100) Grunfeld[ , "char"] <- rep(c("a1", "b2"), 100) Grunfeld[ , "fac"] <- factor(rep(c("a", "b"), 100)) pGrunfeld <- pdata.frame(Grunfeld, stringsAsFactors = FALSE) ############### (1) general checks if group generics and propagation works ########### # check Ops: integer -> numeric stopifnot(all.equal(c("pseries", class(Grunfeld$integer / 33)), class(pGrunfeld$integer / 33))) # check Ops: logical -> numeric stopifnot(all.equal(c("pseries", class(Grunfeld$logi + 1.1)), class(pGrunfeld$logi + 1.1))) stopifnot(all.equal(c("pseries", class(-Grunfeld$logi)), class(-pGrunfeld$logi))) stopifnot(all(class(diff(pGrunfeld$logi)) == c("pseries", "integer"))) ## check Ops: non-vector result, result is matrix (may not be class c("pseries", "matrix")) mdat <- matrix(c(1:200), nrow = 200, ncol = 1, byrow = TRUE) stopifnot(inherits(pGrunfeld$integer * mdat, "matrix")) stopifnot(inherits(pGrunfeld$logi * mdat, "matrix")) stopifnot(inherits(mdat * pGrunfeld$integer, "matrix")) stopifnot(inherits(mdat * pGrunfeld$logi, "matrix")) # check Math: also with optional second argument (check calculation and class) stopifnot(all.equal(log(Grunfeld$integer), as.numeric(log(pGrunfeld$integer)))) stopifnot(all.equal(c("pseries", class(log(Grunfeld$integer))), class(log(pGrunfeld$integer)))) stopifnot(all.equal(log(Grunfeld$integer, 20), as.numeric(log(pGrunfeld$integer, 20)))) stopifnot(all.equal(c("pseries", class(log(Grunfeld$integer, 20))), class(log(pGrunfeld$integer, 20)))) # check Complex stopifnot(all(c("pseries", class(Re(Grunfeld$logi))) == class(Re(pGrunfeld$logi)))) stopifnot(all(c("pseries", class(Im(Grunfeld$logi))) == class(Im(pGrunfeld$logi)))) stopifnot(all(c("pseries", class(Conj(Grunfeld$logi))) == class(Re(pGrunfeld$logi)))) stopifnot(all(c("pseries", class(Conj(Grunfeld$complex))) == class(Conj(pGrunfeld$complex)))) # this is a downward propagation complex -> numeric stopifnot(all(c("pseries", class(Re(Grunfeld$complex))) == class(Re(pGrunfeld$complex)))) ############# (2) check of model estimation with dependent variable as integer ######### ## During testing phase of the implementation of groupGenerics, it became apparent that ## non-correct implementation yields different results when an integer serves as dependent ## variable -> use an integer as test case data("Produc", package = "plm") ## gsp is an integer form <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp zz <- plm(form, data = Produc, index=c("state","year"), model = "within") print(summary(zz)) pProduc <- pdata.frame(Produc) pProduc$gsp2 <- as.numeric(pProduc$gsp) zz2 <- plm(update(form, log(gsp2) ~ . ), data = pProduc, index = c("state","year"), model = "within") print(summary(zz2)) if (!isTRUE(all.equal(zz$coefficients, zz2$coefficients))) stop("estimation results not equal") ############# (3) assinging 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. Grunfeld[ , "integer"] <- rep(c(1L, 2L, 3L, 4L), 25) Grunfeld[ , "logi"] <- rep(c(TRUE, FALSE, TRUE, FALSE), 25) pGrunfeld <- pdata.frame(Grunfeld) class(pGrunfeld[ , "integer"]) class(pGrunfeld[ , "integer"] / 3) # assign: we don't (yet?) have methods for [<-.pdata.frame and [[<-.pdata.frame, so it dispatches to the respective data.frame methods # This results in really assigning a pseries to the pdata.frame in case of [<- and [[<- as can be seen by lapply(pGrunfeld, class) pGrunfeld[ , "int2double"] <- pGrunfeld$integer / 30 pGrunfeld$int2double2 <- pGrunfeld$integer / 30 # this case by assigning with $<- is treated differently as we have "$<-.pdata.frame" defined pGrunfeld[["int2double3"]] <- pGrunfeld$integer / 30 class(pGrunfeld[ , "int2double"]) class(pGrunfeld[ , "int2double2"]) class(pGrunfeld[ , "int2double3"]) typeof(pGrunfeld[ , "int2double"]) typeof(pGrunfeld[ , "int2double2"]) typeof(pGrunfeld[ , "int2double3"]) # check values if(isTRUE(all.equal(as.numeric(pGrunfeld[ , "int2double"]), rep(0, 200)))) stop("when assigning by [<-: double casted to integer (wrong result)") if(isTRUE(all.equal(as.numeric(pGrunfeld$int2double2), rep(0, 200)))) stop("when assigning by $<-: double casted to integer (wrong result)") if(isTRUE(all.equal(as.numeric(pGrunfeld[ , "int2double3"]), rep(0, 200)))) stop("when assigning by [[<-: double casted to integer (wrong result)") # check classes if(!isTRUE(all.equal(class(pGrunfeld[ , "int2double"]), c("pseries", "numeric")))) stop("when assigning by [<-: double casted to logical (wrong class)") if(!isTRUE(all.equal(class(pGrunfeld$int2double2), c("pseries", "numeric")))) stop("when assigning by $<-: double casted to logical (wrong class)") if(!isTRUE(all.equal(class(pGrunfeld[ , "int2double3"]), c("pseries", "numeric")))) stop("when assigning by [[<-: double casted to logical (wrong class)") ## same with logicals: pGrunfeld[ , "logi2double1"] <- pGrunfeld$logi / 10 pGrunfeld$logi2double2 <- pGrunfeld$logi / 10 pGrunfeld[["logi2double3"]] <- pGrunfeld$logi / 10 class(pGrunfeld[ , "logi2double1"]) class(pGrunfeld[ , "logi2double2"]) class(pGrunfeld[ , "logi2double3"]) typeof(pGrunfeld[ , "logi2double1"]) typeof(pGrunfeld[ , "logi2double2"]) typeof(pGrunfeld[ , "logi2double3"]) # check values if(!isTRUE(all.equal(as.numeric(pGrunfeld[ , "logi2double1"]), rep(c(0.1, 0.0), 100)))) stop("when assigning by [<-: double casted to logical (wrong result)") if(!isTRUE(all.equal(as.numeric(pGrunfeld$logi2double2), rep(c(0.1, 0.0), 100)))) stop("when assigning by $<-: double casted to logical (wrong result)") if(!isTRUE(all.equal(as.numeric(pGrunfeld[ , "logi2double3"]), rep(c(0.1, 0.0), 100)))) stop("when assigning by [[<-: double casted to logical (wrong result)") # check classes if(!isTRUE(all.equal(class(pGrunfeld[ , "logi2double1"]), c("pseries", "numeric")))) stop("when assigning by [<-: double casted to logical (wrong class)") if(!isTRUE(all.equal(class(pGrunfeld$logi2double2), c("pseries", "numeric")))) stop("when assigning by $<-: double casted to logical (wrong class)") if(!isTRUE(all.equal(class(pGrunfeld[ , "logi2double3"]), c("pseries", "numeric")))) stop("when assigning by [[<-: double casted to logical (wrong class)") ############## (4) test for various kinds of argument combinations in Ops.pseries ############## # e1: pseries, e2: not a pseries and vice versa # -> result must be a pseries in both cases e1e2_a <- `*`(pGrunfeld$integer, 4L) e1e2_b <- `*`(4L, pGrunfeld$integer) class(e1e2_a) class(e1e2_b) stopifnot(is.pseries(e1e2_a)) stopifnot(is.pseries(e1e2_b)) stopifnot(isTRUE(all.equal(e1e2_a, e1e2_b))) # e1, e2: pseries with varying length # -> result must have index of longer pseries (as the shorter pseries is recycled) pGrunfeld_short <- pGrunfeld[4:5, ] e1e2_c <- `*`(pGrunfeld$integer, pGrunfeld_short$integer) e1e2_d <- `*`(pGrunfeld_short$integer, pGrunfeld$integer) length(e1e2_c) length(e1e2_d) index(e1e2_c) index(e1e2_d) nrow(index(e1e2_c)) nrow(index(e1e2_d)) stopifnot(is.pseries(e1e2_c)) stopifnot(is.pseries(e1e2_d)) stopifnot(isTRUE(all.equal(index(e1e2_c), index(pGrunfeld$integer)))) stopifnot(isTRUE(all.equal(index(e1e2_d), index(pGrunfeld$integer)))) # e1, e2: pseries with index of same length but different content # -> result is assigned index of first operand Gr <- Grunfeld Gr$firm <- sort(rep(LETTERS[1:10], 20)) # make individual index different pGr <- pdata.frame(Gr, stringsAsFactors = FALSE) e1e2_e <- `*`(pGr$integer, pGrunfeld$integer) e1e2_f <- `*`(pGrunfeld$integer, pGr$integer) index(e1e2_e) index(e1e2_f) stopifnot(is.pseries(e1e2_e)) stopifnot(is.pseries(e1e2_f)) ############## (5) demonstration of R's behaviour for a wrapping class "myclass" without group generics ############## x <- c(1L, 2L, 3L) class(x) # integer mode(x) typeof(x) y <- x class(y) <- c("myclass", class(y)) class(y) # c("myclass", "integer") mode(y) typeof(y) x2 <- x / 10 class(x2) # numeric - propagated to higher class numeric mode(x2) typeof(x2) y2 <- y / 10 class(y2) # c("myclass", "interger") - 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! y3 <- y2 typeof(y3) # double class(y3) <- setdiff(class(y3), "myclass") class(y3) # integer mode(y3) typeof(y3) # integer y3 # 0 0 0 - integers after class() <- "integer" y4 <- y2 attr(y4, "class") attr(y4, "class") <- NULL class(y4) mode(y4) typeof(y4) y4 # 0.1 0.2 0.3 numerics after attr(obj, "class") <- NULL fac <- factor(x) class(fac) typeof(fac) mode(fac) logi <- c(TRUE, FALSE, TRUE) class(logi) # logical typeof(logi) # logical class(logi) <- c("myclass", class(logi)) class(logi) # myclass logical loginum <- logi - 1.5 class(loginum) # myclass logical typeof(loginum) # double ############## (6) demonstrate case of R's behaviour which cannot be worked around even with without group generics ############## # dpois() (also dnorm() and likely more) does not strip unnecessary classes and custom attributes # before it performs its operations ## see also ## see also: https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17516 class(pGrunfeld$integer) # "pseries" "integer" set.seed(42) res_dpois <- dpois(pGrunfeld$integer, sample(1:10, 200, replace = TRUE)) class(res_dpois) # "pseries" "integer" <-- can do nothing about his typeof(res_dpois) # double str(res_dpois) res_pmax <- pmax(res_dpois, .Machine[["double.eps"]]) # this errored for a while when no correction in remove_pseries_features() was in place: if(isTRUE(all.equal(as.numeric(res_pmax), rep(.Machine[["double.eps"]], 200)))) { stop("pmax gives wrong result due wrong coercion (integer/numeric)") } plm/inst/tests/test_purtest.R0000644000176200001440000001623714161714556016074 0ustar liggesusers# Various run tests for purtest() and phansitest() # NB: p-values can differ slightly relative to .Rout.save file due to availability of package 'urca' # for p-value approximation in individual (A)DF-regressions. library(plm) data("Grunfeld", package = "plm") pG <- pdata.frame(Grunfeld) y <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) # some general run tests purtest(pG$inv, pmax = 4, exo = "intercept", test = "ips") purtest(inv ~ 1, data = Grunfeld, index = "firm", pmax = 4, test = "madwu") summary(a1 <- purtest(pG$inv, lags = "SIC", exo = "intercept", test = "ips", pmax = 8)) # TODO: why is the data requirement check not triggered print(a1$args$lags) if (length(a1$args$lags) != 1) stop("length(return_value$args$lags must be 1") if (a1$args$lags != "SIC") stop("length(return_value$args$lags must be \"SIC\"") summary(a2 <- purtest(pG$inv, lags = 2, exo = "intercept", test = "ips")) print(a2$args$lags) if (length(a2$args$lags) != 1) stop("length(return_value$args$lags must be 1") summary(a3 <- purtest(pG$inv, lags = c(2,3,1,5,8,1,4,6,7,1), exo = "intercept", test = "ips")) # TODO: why is the data requirement check not triggered summary(a3_ok <- purtest(pG$inv, lags = c(2,3,1,4,4,1,4,4,4,1), exo = "intercept", test = "ips")) # TODO: ... and this works length(a3$args$lags) print(a3$args$lags) if (length(a3$args$lags) != 10) stop("length(return_value$args$lags must be 10") ### pseries purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "intercept") # works purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "trend") # works # purtest(pdata.frame(Grunfeld)[ , "inv"], pmax = 4, test = "ips", exo = "none") # works as intended: gives informative error msg ### pdata.frame - individuals must be in columns! df_inv <- data.frame(split(Grunfeld$inv, Grunfeld$firm)) purtest(df_inv, pmax = 4, test = "ips", exo = "intercept") ### matrix purtest(as.matrix(df_inv), pmax = 4, test = "ips", exo = "intercept") #### Hadri (2000) test ## matches results vom EViews 9.5 (if dfcor = FALSE): ## z stat = 4.18428, p = 0.0000 (intercept) ## z stat het = 10.1553, p = 0.0000 (intercept) ## z stat = 4.53395, p = 0.0000 (trend) ## z stat het = 9.57816, p = 0.0000 (trend) h_1.1 <- purtest(pG$value, exo = "intercept", test = "hadri", Hcons = FALSE) h_1.2 <- purtest(pG$value, exo = "intercept", test = "hadri", Hcons = FALSE, dfcor = TRUE) h_2.1 <- purtest(pG$value, exo = "intercept", test = "hadri") h_2.2 <- purtest(pG$value, exo = "intercept", test = "hadri", dfcor = TRUE) h_3.1 <- purtest(pG$value, exo = "trend", test = "hadri", Hcons = FALSE) h_3.2 <- purtest(pG$value, exo = "trend", test = "hadri", Hcons = FALSE, dfcor = TRUE) h_4.1 <- purtest(pG$value, exo = "trend", test = "hadri") h_4.2 <- purtest(pG$value, exo = "trend", test = "hadri", dfcor = TRUE) summary(h_1.1) summary(h_1.2) summary(h_2.1) summary(h_2.2) summary(h_3.1) summary(h_3.2) summary(h_4.1) summary(h_4.2) ### IPS (2003) test ## use dfcor = TRUE to match gretl 2017c and EViews 9.5 exactly b <- purtest(pG$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE) summary(b) # NB: In case of lags = 0 (DF-regression), gretl 2019d takes the finite sample p-values # (finite sample p-values are not applicable for augmented DF-regressions) # For reference/reproducability purposes, use MacKinnon (1994) and MacKinnon (1996) each once: summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, p.approx = "MacKinnon1994")) summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, p.approx = "MacKinnon1996")) ## lags = 2 (lags > 0 gives the Wtbar stat in gretl and EViews) b_lag2 <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE) summary(b_lag2) # unbalanced IPS pG_unbal2 <- pG[1:190, ] b_unbal <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE) summary(b_unbal) # IPS - Ztbar # matches gretl exactly # Z_tbar = -1.12782 [0.1297]; difference to EViews: Adjustment parameters (Etbar, Vtbar): summary(b_unbal3 <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) summary(b_ztbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) summary(b_ztbar_unbal <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 0, dfcor = TRUE, ips.stat = "Ztbar")) summary(b_ztbar_unbal2 <- purtest(pG_unbal2$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "Ztbar")) summary(b_lag2_ztbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "Ztbar")) ## these two correctly errors with an informative message: # summary(b_lag2_tbar <- purtest(pG$value, test = "ips", exo = "intercept", lags = 2, dfcor = TRUE, ips.stat = "tbar")) # TODO: in case of automatic lag selection, the selected lags need to be outputted # purtest(pG$value, test = "ips", dfcor = TRUE, ips.stat = "wtbar", exo = "intercept") # due to automatic lag selection (yields 10) value4 <- pG[pG$year %in% as.character(1935:1938), ]$value purtest(value4, test = "ips", dfcor = TRUE, ips.stat = "tbar", exo = "intercept", lags = 0) purtest(pG$value, test = "ips", exo = "intercept", lags = 5, dfcor = TRUE, ips.stat = "Wtbar") # TODO: how to detect this not detected? summary(purtest(pG$value, test = "ips", exo = "intercept", lags = 4, dfcor = TRUE, ips.stat = "Wtbar")) #### various tests from Choi (2001) [besides test = "madwu"] purtest(pG$value, test = "Pm", exo = "intercept", lags = 2, dfcor = TRUE) purtest(pG$value, test = "invnormal", exo = "intercept", lags = 2, dfcor = TRUE) purtest(pG$value, test = "logit", exo = "intercept", lags = 2, dfcor = TRUE) #### Levin-Lin-Chu test # matches gretl (almost) exactly: match gretl, set dfcor = FALSE # NB: one remaining (asymptotically irrelevant) difference # between gretl and purtest for LLC. Bandwidth calc for Bartlett kernel (in longrunvar), # 3.21 * T^(1/3) purtest rounds, gretl truncates (no clear answer to this, LLC # use rounding as becomes clear from their table 2 as they apply rounding for their # "quick-and-dirty" values for bandwidth cutoff). llc <- purtest(pG$value, test = "levinlin", exo = "none", lags = 0, dfcor = FALSE) summary(llc) llc_int <- purtest(pG$value, test = "levinlin", exo = "intercept", lags = 0, dfcor = FALSE) summary(llc_int) llc_trend <- purtest(pG$value, test = "levinlin", exo = "trend", lags = 0, dfcor = FALSE) summary(llc_trend) ## Simes Test for panels by Hanck phansitest(llc) phansitest(llc_int) phansitest(llc_trend) phansitest(purtest(pG$value, test = "Pm", exo = "intercept", lags = 2, dfcor = TRUE)) phansitest(purtest(pG$value, test = "invnormal", exo = "intercept", lags = 2, dfcor = TRUE)) phansitest(purtest(pG$value, test = "logit", exo = "intercept", lags = 2, dfcor = TRUE)) phansitest(purtest(inv ~ 1, data = Grunfeld, index = "firm", pmax = 4, test = "madwu")) phansitest(b_unbal3) phansitest(b_ztbar) phansitest(b_ztbar_unbal) phansitest(b_ztbar_unbal2) phansitest(b_lag2_ztbar) plm/inst/tests/test_pFtest.R0000644000176200001440000000210614124132276015611 0ustar liggesusers#### Testfile for pFtest() # SAS 9.4 Output for F Test [fixed one-way estimates, individual effect] # # F Test for No Fixed Effects # # Num DF Den DF F statistic Pr > F # 9 188 49.18 < .0001 library(plm) data("Grunfeld", package="plm") gp <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") gi <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual", model = "within") gt <- plm(inv ~ value + capital, data = Grunfeld, effect = "time", model = "within") gd <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways", model = "within") pFtest(gi, gp) # test for individual effects matches SAS's Output pFtest(gt, gp) pFtest(gd, gp) print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "individual")) print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "time")) print(pFtest(inv ~ value + capital, data = Grunfeld, effect = "twoways")) # test for wrong order of arguments, this is supposed to give a meaningful error message # pFtest(gi, gd)plm/inst/tests/test_pht.Rout.save0000644000176200001440000004153714124132276016637 0ustar liggesusers R version 4.1.0 (2021-05-18) -- "Camp Pontanezen" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > # replicates Baltagi (2005, 2013), table 7.4; Baltagi (2021), table 7.5 > # pht vs plm(., random.model="ht", inst.method="ht/am/bms") vs. plm(, model = "ht") > library("plm") > data("Wages", package = "plm") > ht <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, + data = Wages, model = "ht", index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(ht) Oneway (individual) effect Hausman-Taylor Model (Hausman-Taylor estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "ht", index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9193535 -0.0707404 0.0065708 0.0796568 2.0250882 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9127e+00 2.8365e-01 10.2687 < 2.2e-16 *** wks 8.3740e-04 5.9973e-04 1.3963 0.16263 southyes 7.4398e-03 3.1955e-02 0.2328 0.81590 smsayes -4.1833e-02 1.8958e-02 -2.2066 0.02734 * marriedyes -2.9851e-02 1.8980e-02 -1.5728 0.11578 exp 1.1313e-01 2.4710e-03 45.7851 < 2.2e-16 *** I(exp^2) -4.1886e-04 5.4598e-05 -7.6718 1.696e-14 *** bluecolyes -2.0705e-02 1.3781e-02 -1.5024 0.13299 ind 1.3604e-02 1.5237e-02 0.8928 0.37196 unionyes 3.2771e-02 1.4908e-02 2.1982 0.02794 * sexfemale -1.3092e-01 1.2666e-01 -1.0337 0.30129 blackyes -2.8575e-01 1.5570e-01 -1.8352 0.06647 . ed 1.3794e-01 2.1248e-02 6.4919 8.474e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.947 Chisq: 6891.87 on 12 DF, p-value: < 2.22e-16 > > > ht2 <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, + data = Wages, model = "am", index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(ht2) Oneway (individual) effect Hausman-Taylor Model (Amemiya-MaCurdy estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "am", index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9192710 -0.0705595 0.0065602 0.0794836 2.0248644 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9273e+00 2.7513e-01 10.6399 < 2.2e-16 *** wks 8.3806e-04 5.9945e-04 1.3980 0.16210 southyes 7.2818e-03 3.1936e-02 0.2280 0.81964 smsayes -4.1951e-02 1.8947e-02 -2.2141 0.02682 * marriedyes -3.0089e-02 1.8967e-02 -1.5864 0.11266 exp 1.1297e-01 2.4688e-03 45.7584 < 2.2e-16 *** I(exp^2) -4.2140e-04 5.4554e-05 -7.7244 1.124e-14 *** bluecolyes -2.0850e-02 1.3765e-02 -1.5147 0.12986 ind 1.3629e-02 1.5229e-02 0.8949 0.37082 unionyes 3.2475e-02 1.4894e-02 2.1804 0.02922 * sexfemale -1.3201e-01 1.2660e-01 -1.0427 0.29709 blackyes -2.8590e-01 1.5549e-01 -1.8388 0.06595 . ed 1.3720e-01 2.0570e-02 6.6703 2.553e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.871 Chisq: 6879.2 on 12 DF, p-value: < 2.22e-16 > > ht3 <- pht(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, + data = Wages, model = "bms", index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(ht3) Oneway (individual) effect Hausman-Taylor Model (Breusch-Mizon-Schmidt estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, model = "bms", index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9416123 -0.0680109 0.0064741 0.0769607 2.0178587 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.9794e+00 2.6724e-01 7.4071 1.291e-13 *** wks 7.9537e-04 5.9850e-04 1.3289 0.183869 southyes 1.4668e-02 3.1883e-02 0.4601 0.645478 smsayes -5.2042e-02 1.8911e-02 -2.7520 0.005923 ** marriedyes -3.9262e-02 1.8925e-02 -2.0747 0.038017 * exp 1.0867e-01 2.4557e-03 44.2513 < 2.2e-16 *** I(exp^2) -4.9060e-04 5.4352e-05 -9.0265 < 2.2e-16 *** bluecolyes -1.5389e-02 1.3737e-02 -1.1203 0.262596 ind 1.9024e-02 1.5202e-02 1.2514 0.210795 unionyes 3.7855e-02 1.4864e-02 2.5467 0.010873 * sexfemale -1.8027e-01 1.2639e-01 -1.4263 0.153769 blackyes -1.5636e-01 1.5506e-01 -1.0084 0.313276 ed 2.2066e-01 1.9850e-02 11.1162 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.578 Chisq: 6467.37 on 12 DF, p-value: < 2.22e-16 > > ht4 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + + bluecol + ind + union + sex + black + ed | + sex + black + bluecol + south + smsa + ind, model = "ht", + data = Wages, index = 595) Warning message: uses of 'pht()' and 'plm(., model = "ht")' are discouraged, better use 'plm(., model = "random", random.method = "ht", inst.method = "baltagi"/"am"/"bms")' for Hausman-Taylor, Amemiya-MaCurdy, and Breusch-Mizon-Schmidt estimator > summary(ht4) Oneway (individual) effect Hausman-Taylor Model (Hausman-Taylor estimator) Call: pht(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | sex + black + bluecol + south + smsa + ind, data = Wages, index = 595) T.V. exo : bluecol, south, smsa, ind T.V. endo : wks, married, exp, I(exp^2), union T.I. exo : sex, black T.I. endo : ed Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -1.9193535 -0.0707404 0.0065708 0.0796568 2.0250882 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9127e+00 2.8365e-01 10.2687 < 2.2e-16 *** wks 8.3740e-04 5.9973e-04 1.3963 0.16263 southyes 7.4398e-03 3.1955e-02 0.2328 0.81590 smsayes -4.1833e-02 1.8958e-02 -2.2066 0.02734 * marriedyes -2.9851e-02 1.8980e-02 -1.5728 0.11578 exp 1.1313e-01 2.4710e-03 45.7851 < 2.2e-16 *** I(exp^2) -4.1886e-04 5.4598e-05 -7.6718 1.696e-14 *** bluecolyes -2.0705e-02 1.3781e-02 -1.5024 0.13299 ind 1.3604e-02 1.5237e-02 0.8928 0.37196 unionyes 3.2771e-02 1.4908e-02 2.1982 0.02794 * sexfemale -1.3092e-01 1.2666e-01 -1.0337 0.30129 blackyes -2.8575e-01 1.5570e-01 -1.8352 0.06647 . ed 1.3794e-01 2.1248e-02 6.4919 8.474e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 886.9 Residual Sum of Squares: 95.947 Chisq: 6891.87 on 12 DF, p-value: < 2.22e-16 > > # estimating with pht and plm(., model = "ht") should give the same results > stopifnot(isTRUE(all.equal(coef(ht4), coef(ht)))) > > # estimating with pht and plm(., model = "random", random.method = "ht", inst.method = "baltagi") should give the same results > ht5 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + + bluecol + ind + union + sex + black + ed | + bluecol + south + smsa + ind + sex + black | + wks + married + union + exp + I(exp ^ 2), + model = "random", random.method = "ht", inst.method = "baltagi", + data = Wages, index = 595) > summary(ht5) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Baltagi's transformation) Call: plm(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp^2), data = Wages, model = "random", random.method = "ht", inst.method = "baltagi", index = 595) Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.643736 -0.466002 0.043285 0.524739 13.340263 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9127e+00 2.8365e-01 10.2687 < 2.2e-16 *** wks 8.3740e-04 5.9973e-04 1.3963 0.16263 southyes 7.4398e-03 3.1955e-02 0.2328 0.81590 smsayes -4.1833e-02 1.8958e-02 -2.2066 0.02734 * marriedyes -2.9851e-02 1.8980e-02 -1.5728 0.11578 exp 1.1313e-01 2.4710e-03 45.7851 < 2.2e-16 *** I(exp^2) -4.1886e-04 5.4598e-05 -7.6718 1.696e-14 *** bluecolyes -2.0705e-02 1.3781e-02 -1.5024 0.13299 ind 1.3604e-02 1.5237e-02 0.8928 0.37196 unionyes 3.2771e-02 1.4908e-02 2.1982 0.02794 * sexfemale -1.3092e-01 1.2666e-01 -1.0337 0.30129 blackyes -2.8575e-01 1.5570e-01 -1.8352 0.06647 . ed 1.3794e-01 2.1248e-02 6.4919 8.474e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4163.6 R-Squared: 0.60945 Adj. R-Squared: 0.60833 Chisq: 6891.87 on 12 DF, p-value: < 2.22e-16 > > ht6 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + + bluecol + ind + union + sex + black + ed | + bluecol + south + smsa + ind + sex + black | + wks + married + union + exp + I(exp ^ 2), + model = "random", random.method = "ht", inst.method = "am", + data = Wages, index = 595) > summary(ht6) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Amemiya-MaCurdy's transformation) Call: plm(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp^2), data = Wages, model = "random", random.method = "ht", inst.method = "am", index = 595) Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.643192 -0.464811 0.043216 0.523598 13.338789 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 2.9273e+00 2.7513e-01 10.6399 < 2.2e-16 *** wks 8.3806e-04 5.9945e-04 1.3980 0.16210 southyes 7.2818e-03 3.1936e-02 0.2280 0.81964 smsayes -4.1951e-02 1.8947e-02 -2.2141 0.02682 * marriedyes -3.0089e-02 1.8967e-02 -1.5864 0.11266 exp 1.1297e-01 2.4688e-03 45.7584 < 2.2e-16 *** I(exp^2) -4.2140e-04 5.4554e-05 -7.7244 1.124e-14 *** bluecolyes -2.0850e-02 1.3765e-02 -1.5147 0.12986 ind 1.3629e-02 1.5229e-02 0.8949 0.37082 unionyes 3.2475e-02 1.4894e-02 2.1804 0.02922 * sexfemale -1.3201e-01 1.2660e-01 -1.0427 0.29709 blackyes -2.8590e-01 1.5549e-01 -1.8388 0.06595 . ed 1.3720e-01 2.0570e-02 6.6703 2.553e-11 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4160.3 R-Squared: 0.60948 Adj. R-Squared: 0.60835 Chisq: 6879.2 on 12 DF, p-value: < 2.22e-16 > > ht7 <- plm(lwage ~ wks + south + smsa + married + exp + I(exp ^ 2) + + bluecol + ind + union + sex + black + ed | + bluecol + south + smsa + ind + sex + black | + wks + married + union + exp + I(exp ^ 2), + model = "random", random.method = "ht", inst.method = "bms", + data = Wages, index = 595) > summary(ht7) Oneway (individual) effect Random Effect Model (Hausman-Taylor's transformation) Instrumental variable estimation (Breusch-Mizon-Schmidt's transformation) Call: plm(formula = lwage ~ wks + south + smsa + married + exp + I(exp^2) + bluecol + ind + union + sex + black + ed | bluecol + south + smsa + ind + sex + black | wks + married + union + exp + I(exp^2), data = Wages, model = "random", random.method = "ht", inst.method = "bms", index = 595) Balanced Panel: n = 595, T = 7, N = 4165 Effects: var std.dev share idiosyncratic 0.02304 0.15180 0.025 individual 0.88699 0.94180 0.975 theta: 0.9392 Residuals: Min. 1st Qu. Median 3rd Qu. Max. -12.790365 -0.448022 0.042648 0.506978 13.292638 Coefficients: Estimate Std. Error z-value Pr(>|z|) (Intercept) 1.9794e+00 2.6724e-01 7.4071 1.291e-13 *** wks 7.9537e-04 5.9850e-04 1.3289 0.183869 southyes 1.4668e-02 3.1883e-02 0.4601 0.645478 smsayes -5.2042e-02 1.8911e-02 -2.7520 0.005923 ** marriedyes -3.9262e-02 1.8925e-02 -2.0747 0.038017 * exp 1.0867e-01 2.4557e-03 44.2513 < 2.2e-16 *** I(exp^2) -4.9060e-04 5.4352e-05 -9.0265 < 2.2e-16 *** bluecolyes -1.5389e-02 1.3737e-02 -1.1203 0.262596 ind 1.9024e-02 1.5202e-02 1.2514 0.210795 unionyes 3.7855e-02 1.4864e-02 2.5467 0.010873 * sexfemale -1.8027e-01 1.2639e-01 -1.4263 0.153769 blackyes -1.5636e-01 1.5506e-01 -1.0084 0.313276 ed 2.2066e-01 1.9850e-02 11.1162 < 2.2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Total Sum of Squares: 243.04 Residual Sum of Squares: 4147.6 R-Squared: 0.60686 Adj. R-Squared: 0.60572 Chisq: 6467.37 on 12 DF, p-value: < 2.22e-16 > > stopifnot(isTRUE(all.equal(coef(ht5), coef(ht)))) > stopifnot(isTRUE(all.equal(coef(ht6), coef(ht2)))) > stopifnot(isTRUE(all.equal(coef(ht7), coef(ht3)))) > > > > proc.time() user system elapsed 10.18 0.40 10.87 plm/inst/tests/test_fixef2.R0000644000176200001440000005435114154734502015543 0ustar liggesusers### test file to test plm::fixef(), inner consistency and vs. fixest::fixef() and lfe::getfe() ## (1) ordinary regression models ## (2) IV regression models library(plm) data("Grunfeld", package = "plm") Grunfeld_unbalanced <- Grunfeld[1:199, ] ################## (1) ordinary models (non-IV) ################## plm_tw <- plm(inv ~ value + capital, data = Grunfeld, effect = "twoways") plm_tw_u <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "twoways") plm_ow_id <- plm(inv ~ value + capital, data = Grunfeld, effect = "individual") plm_ow_u_id <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "individual") plm_ow_ti <- plm(inv ~ value + capital, data = Grunfeld, effect = "time") plm_ow_u_ti <- plm(inv ~ value + capital, data = Grunfeld_unbalanced, effect = "time") ## lm_tw <- lm(inv ~ 0 + value + capital + factor(firm) + factor(year), data = Grunfeld) ## lm_tw_int <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld) ## lm_tw_u <- lm(inv ~ 0 + value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) ## lm_tw_u_int <- lm(inv ~ value + capital + factor(firm) + factor(year), data = Grunfeld_unbalanced) #### tw unbalanced #### ## sum of effects plm_tw_u_fixef_tw <- as.numeric(fixef(plm_tw_u, "twoways")) # manual pred_betas <- as.numeric(tcrossprod(coef(plm_tw_u), model.matrix(plm_tw_u, model = "pooling")[ , -1L])) pred_y <- plm_tw_u$model[ , 1] - plm_tw_u$residuals pred_effs_tw <- pred_y - pred_betas ## split in a individual and in a time component plm_tw_u_fixef_id_dfirst <- c(0, as.numeric(fixef(plm_tw_u, "individual", "dfirst"))) plm_tw_u_fixef_ti_dfirst <- c(0, as.numeric(fixef(plm_tw_u, "time", "dfirst"))) plm_tw_u_fixef_id_level <- as.numeric(fixef(plm_tw_u, "individual")) plm_tw_u_fixef_ti_level <- as.numeric(fixef(plm_tw_u, "time")) ## check the summed up effects and splits # effect = "twoways" (= sum) vs. manual stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, as.numeric(pred_effs_tw), check.attributes = FALSE))) # sum = id level + time dfirst stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, plm_tw_u_fixef_id_level[ index(plm_tw_u)[[1L]]] + plm_tw_u_fixef_ti_dfirst[index(plm_tw_u)[[2L]]], check.attributes = FALSE))) # sum = id dfirst + time level stopifnot(isTRUE(all.equal(plm_tw_u_fixef_tw, plm_tw_u_fixef_id_dfirst[index(plm_tw_u)[[1L]]] + plm_tw_u_fixef_ti_level[ index(plm_tw_u)[[2L]]], check.attributes = FALSE))) ### # checks vs. a twoway model implemented via one-way augmented plm_tw_u_aug_id <- plm(inv ~ value + capital + factor(year), data = Grunfeld_unbalanced, effect = "individual") plm_tw_u_aug_ti <- plm(inv ~ value + capital + factor(firm), data = Grunfeld_unbalanced, effect = "time") plm_tw_u_aug_id_id <- as.numeric(fixef(plm_tw_u_aug_id, "individual")) plm_tw_u_aug_ti_ti <- as.numeric(fixef(plm_tw_u_aug_ti, "time")) # id level stopifnot(isTRUE(all.equal(plm_tw_u_fixef_id_level, plm_tw_u_aug_id_id, check.attributes = FALSE))) # time level stopifnot(isTRUE(all.equal(plm_tw_u_fixef_ti_level, plm_tw_u_aug_ti_ti, check.attributes = FALSE))) #### oneway balanced #### plm_ow_fixef_id_level <- as.numeric(fixef(plm_ow_id)) plm_ow_fixef_ti_level <- as.numeric(fixef(plm_ow_ti)) #### oneway unbalanced #### plm_ow_u_fixef_id_level <- as.numeric(fixef(plm_ow_u_id)) plm_ow_u_fixef_ti_level <- as.numeric(fixef(plm_ow_u_ti)) #### tw balanced #### ## sum of effects plm_tw_fixef_tw <- as.numeric(fixef(plm_tw, "twoways")) # manual bal_pred_betas <- as.numeric(tcrossprod(coef(plm_tw), model.matrix(plm_tw, model = "pooling")[ , -1L])) bal_pred_y <- plm_tw$model[ , 1] - plm_tw$residuals bal_pred_effs_tw <- bal_pred_y - bal_pred_betas stopifnot(isTRUE(all.equal(as.numeric(bal_pred_effs_tw), plm_tw_fixef_tw, check.attributes = FALSE))) ## split in a individual and in a time component plm_tw_fixef_id_dfirst <- c(0, as.numeric(fixef(plm_tw, "individual", "dfirst"))) plm_tw_fixef_ti_dfirst <- c(0, as.numeric(fixef(plm_tw, "time", "dfirst"))) plm_tw_fixef_id_level <- as.numeric(fixef(plm_tw, "individual", "level")) plm_tw_fixef_ti_level <- as.numeric(fixef(plm_tw, "time", "level")) ## check the summed up effects and splits stopifnot(isTRUE(all.equal(plm_tw_fixef_tw, plm_tw_fixef_id_level[ index(plm_tw)[[1L]]] + plm_tw_fixef_ti_dfirst[index(plm_tw)[[2L]]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(plm_tw_fixef_tw, plm_tw_fixef_id_dfirst[index(plm_tw)[[1L]]] + plm_tw_fixef_ti_level[ index(plm_tw)[[2L]]], check.attributes = FALSE))) ### # checks vs. a twoway model implemented via one-way augmented plm_tw_aug_id <- plm(inv ~ value + capital + factor(year), data = Grunfeld, effect = "individual") plm_tw_aug_ti <- plm(inv ~ value + capital + factor(firm), data = Grunfeld, effect = "time") plm_tw_aug_id_id <- as.numeric(fixef(plm_tw_aug_id, "individual")) plm_tw_aug_ti_ti <- as.numeric(fixef(plm_tw_aug_ti, "time")) # id level stopifnot(isTRUE(all.equal(plm_tw_fixef_id_level, plm_tw_aug_id_id, check.attributes = FALSE))) # time level stopifnot(isTRUE(all.equal(plm_tw_fixef_ti_level, plm_tw_aug_ti_ti, check.attributes = FALSE))) ## checks vs. fixest::feols fixest.avail <- if(!requireNamespace("fixest", quietly = TRUE)) FALSE else TRUE if(fixest.avail) { suppressPackageStartupMessages(library(fixest)) # twoways balanced (one level, one dfirst) feols_tw <- fixest::feols(inv ~ value + capital | firm + year, data = Grunfeld) stopifnot(isTRUE(all.equal(feols_tw$sumFE, plm_tw_fixef_tw, check.attributes = FALSE))) # sum stopifnot(isTRUE(all.equal(fixef(feols_tw)$year, plm_tw_fixef_ti_dfirst, check.attributes = FALSE))) # time stopifnot(isTRUE(all.equal(fixef(feols_tw)$firm, plm_tw_fixef_id_level, check.attributes = FALSE))) # individual # oneway balanced (levels) feols_ow_id <- fixest::feols(inv ~ value + capital | firm, data = Grunfeld) feols_ow_ti <- fixest::feols(inv ~ value + capital | year, data = Grunfeld) stopifnot(isTRUE(all.equal(fixef(feols_ow_ti)$year, plm_ow_fixef_ti_level, check.attributes = FALSE))) # time stopifnot(isTRUE(all.equal(fixef(feols_ow_id)$firm, plm_ow_fixef_id_level, check.attributes = FALSE))) # individual # twoways unbalanced (one level, one dfirst) feols_tw_u <- fixest::feols(inv ~ value + capital | firm + year, data = Grunfeld_unbalanced) stopifnot(isTRUE(all.equal(feols_tw_u$sumFE, plm_tw_u_fixef_tw, check.attributes = FALSE))) # sum stopifnot(isTRUE(all.equal(fixef(feols_tw_u)$year, plm_tw_u_fixef_ti_dfirst, check.attributes = FALSE))) # time stopifnot(isTRUE(all.equal(fixef(feols_tw_u)$firm, plm_tw_u_fixef_id_level, check.attributes = FALSE))) # individual # oneway unbalanced (levels) feols_ow_u_id <- fixest::feols(inv ~ value + capital | firm, data = Grunfeld_unbalanced) feols_ow_u_ti <- fixest::feols(inv ~ value + capital | year, data = Grunfeld_unbalanced) stopifnot(isTRUE(all.equal(fixef(feols_ow_u_id)$firm, plm_ow_u_fixef_id_level, check.attributes = FALSE))) # individual stopifnot(isTRUE(all.equal(fixef(feols_ow_u_ti)$year, plm_ow_u_fixef_ti_level, check.attributes = FALSE))) # time } # checks vs. lfe::felm lfe.avail <- if(!requireNamespace("lfe", quietly = TRUE)) FALSE else TRUE if(lfe.avail) { library(lfe) # version 2.8-7 # twoways balanced (one level, one dfirst) # (lfe::felm's default reference is vice verse compared to fixest::feols) felm_tw <- lfe::felm(inv ~ value + capital | firm + year, data = Grunfeld) felm_tw_fixef_id <- lfe::getfe(felm_tw)[lfe::getfe(felm_tw)[["fe"]] == "firm", 1] felm_tw_fixef_ti <- lfe::getfe(felm_tw)[lfe::getfe(felm_tw)[["fe"]] == "year", 1] stopifnot(isTRUE(all.equal(felm_tw_fixef_id, plm_tw_fixef_id_dfirst, check.attributes = FALSE))) # individual stopifnot(isTRUE(all.equal(felm_tw_fixef_ti, plm_tw_fixef_ti_level, check.attributes = FALSE))) # time # oneway balanced (levels) felm_ow_id <- lfe::felm(inv ~ value + capital | firm, data = Grunfeld) felm_ow_ti <- lfe::felm(inv ~ value + capital | year, data = Grunfeld) felm_ow_id_fixef_id <- lfe::getfe(felm_ow_id)[lfe::getfe(felm_ow_id)[["fe"]] == "firm", 1] felm_ow_ti_fixef_ti <- lfe::getfe(felm_ow_ti)[lfe::getfe(felm_ow_ti)[["fe"]] == "year", 1] stopifnot(isTRUE(all.equal(felm_ow_id_fixef_id, plm_ow_fixef_id_level, check.attributes = FALSE))) # individual stopifnot(isTRUE(all.equal(felm_ow_ti_fixef_ti, plm_ow_fixef_ti_level, check.attributes = FALSE))) # time # twoways unbalanced (one level, one dfirst) # (lfe::felm's default reference is vice verse compared to fixest::feols) felm_tw_u <- lfe::felm(inv ~ value + capital | firm + year, data = Grunfeld_unbalanced) felm_tw_u_fixef_id <- lfe::getfe(felm_tw_u)[lfe::getfe(felm_tw_u)[["fe"]] == "firm", 1] felm_tw_u_fixef_ti <- lfe::getfe(felm_tw_u)[lfe::getfe(felm_tw_u)[["fe"]] == "year", 1] stopifnot(isTRUE(all.equal(felm_tw_u_fixef_id, plm_tw_u_fixef_id_dfirst, check.attributes = FALSE))) # individual stopifnot(isTRUE(all.equal(felm_tw_u_fixef_ti, plm_tw_u_fixef_ti_level, check.attributes = FALSE))) # time # oneway unbalanced (levels) felm_ow_u_id <- lfe::felm(inv ~ value + capital | firm, data = Grunfeld_unbalanced) felm_ow_u_ti <- lfe::felm(inv ~ value + capital | year, data = Grunfeld_unbalanced) felm_ow_u_id_fixef_id <- lfe::getfe(felm_ow_u_id)[lfe::getfe(felm_ow_u_id)[["fe"]] == "firm", 1] felm_ow_u_ti_fixef_ti <- lfe::getfe(felm_ow_u_ti)[lfe::getfe(felm_ow_u_ti)[["fe"]] == "year", 1] stopifnot(isTRUE(all.equal(felm_ow_u_id_fixef_id, plm_ow_u_fixef_id_level, check.attributes = FALSE))) # individual stopifnot(isTRUE(all.equal(felm_ow_u_ti_fixef_ti, plm_ow_u_fixef_ti_level, check.attributes = FALSE))) # time } ################## (2) Instrumental Variable (IV) Models ################## # ## IV balanced twoways data("Crime", package = "plm") # in the unbalanced twoway case, getfe() sets as reference a level depending on the unbalancedness structure # -> somewhat arbitrary -> see also https://github.com/sgaure/lfe/issues/52 # for this example, the unbalancedness structure leads to the first time period being the reference delrows <- -c(10,12,17,18) # delrows <- -c(1,2,10,12) # delrows <- -c(9) crime_formula_plm <- lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | . - lprbarr - lpolpc + ltaxpc + lmix FE2SLS_id <- plm(crime_formula_plm, data = Crime, model = "within", effect = "individual") FE2SLS_ti <- plm(crime_formula_plm, data = Crime, model = "within", effect = "time") fixef(FE2SLS_id, effect = "individual") fixef(FE2SLS_ti, effect = "time") FE2SLS_tw <- plm(crime_formula_plm, data = Crime, model = "within", effect = "twoways") fixef(FE2SLS_tw, effect = "individual") fixef(FE2SLS_tw, effect = "time") fixef(FE2SLS_tw, effect = "twoways") ## IV unbalanced twoways FE2SLS_id_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "individual") FE2SLS_ti_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "time") fixef(FE2SLS_id_unbal, effect = "individual") fixef(FE2SLS_ti_unbal, effect = "time") FE2SLS_tw_unbal <- plm(crime_formula_plm, data = Crime[delrows, ], model = "within", effect = "twoways") fixef(FE2SLS_tw_unbal, effect = "individual") fixef(FE2SLS_tw_unbal, effect = "time") fixef(FE2SLS_tw_unbal, effect = "twoways") ## check vs. fixest::feols if(fixest.avail) { suppressPackageStartupMessages(library(fixest)) # fixest versions < 0.10.0 do not compute fixef() for IV models correctly, # fixed in 0.10.0, see bug report: # https://github.com/lrberge/fixest/issues/190 # fix commit 2021-08-31: https://github.com/lrberge/fixest/commit/9cdd106b4fe87c0bfc5cbde1102ac1952e246ab0 crime_formula_fixest_id <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | county | lprbarr + lpolpc ~ ltaxpc + lmix crime_formula_fixest_ti <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | year | lprbarr + lpolpc ~ ltaxpc + lmix crime_formula_fixest_tw <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | county + year | lprbarr + lpolpc ~ ltaxpc + lmix FE2SLS_id.fixest <- fixest::feols(crime_formula_fixest_id, data = Crime) FE2SLS_ti.fixest <- fixest::feols(crime_formula_fixest_ti, data = Crime) FE2SLS_id_unbal.fixest <- fixest::feols(crime_formula_fixest_id, data = Crime[delrows, ]) FE2SLS_ti_unbal.fixest <- fixest::feols(crime_formula_fixest_ti, data = Crime[delrows, ]) FE2SLS_tw.fixest <- fixest::feols(crime_formula_fixest_tw, data = Crime) FE2SLS_tw_unbal.fixest <- fixest::feols(crime_formula_fixest_tw, data = Crime[delrows, ]) # First, check if model estimations are the same stopifnot(isTRUE(all.equal(FE2SLS_id$coefficients, FE2SLS_id.fixest$coefficients, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_ti$coefficients, FE2SLS_ti.fixest$coefficients, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_id_unbal$coefficients, FE2SLS_id_unbal.fixest$coefficients, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_ti_unbal$coefficients, FE2SLS_ti_unbal.fixest$coefficients, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_tw$coefficients, FE2SLS_tw.fixest$coefficients, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_tw_unbal$coefficients, FE2SLS_tw_unbal.fixest$coefficients, check.attributes = FALSE))) ## check fixef stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id)), fixef(FE2SLS_id.fixest)[["county"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti)), fixef(FE2SLS_ti.fixest)[["year"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id_unbal)), fixef(FE2SLS_id_unbal.fixest)[["county"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti_unbal)), fixef(FE2SLS_ti_unbal.fixest)[["year"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw)), fixef(FE2SLS_tw.fixest)[["county"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw, "time", "dfirst"))), fixef(FE2SLS_tw.fixest)[["year"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw, "twoways")), FE2SLS_tw.fixest$sumFE, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal)), fixef(FE2SLS_tw_unbal.fixest)[["county"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw_unbal, "time", "dfirst"))), fixef(FE2SLS_tw_unbal.fixest)[["year"]], check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal, "twoways")), FE2SLS_tw_unbal.fixest$sumFE, check.attributes = FALSE))) fixef(FE2SLS_id.fixest) fixef(FE2SLS_id_unbal.fixest) fixef(FE2SLS_ti.fixest) fixef(FE2SLS_ti_unbal.fixest) fixef(FE2SLS_tw.fixest)[["county"]] fixef(FE2SLS_tw.fixest)[["year"]] fixef(FE2SLS_tw_unbal.fixest)[["county"]] fixef(FE2SLS_tw_unbal.fixest)[["year"]] } if(lfe.avail) { library(lfe) # version 2.8-7 # check vs. lfe::felm/getfe formula_lfe_id <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | county | (lprbarr|lpolpc ~ ltaxpc + lmix) formula_lfe_ti <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | year | (lprbarr|lpolpc ~ ltaxpc + lmix) formula_lfe_tw <- lcrmrte ~ lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle | county + year | (lprbarr|lpolpc ~ ltaxpc + lmix) FE2SLS_id.felm <- lfe::felm(formula_lfe_id, data = Crime) FE2SLS_ti.felm <- lfe::felm(formula_lfe_ti, data = Crime) FE2SLS_id_unbal.felm <- lfe::felm(formula_lfe_id, data = Crime[delrows, ]) FE2SLS_ti_unbal.felm <- lfe::felm(formula_lfe_ti, data = Crime[delrows, ]) FE2SLS_tw.felm <- lfe::felm(formula_lfe_tw, data = Crime) FE2SLS_tw_unbal.felm <- lfe::felm(formula_lfe_tw, data = Crime[delrows, ]) # same order of coef as other estimations FE2SLS_id.felm.coef <- as.numeric(FE2SLS_id.felm$coefficients) names(FE2SLS_id.felm.coef) <- rownames(FE2SLS_id.felm$coefficients) FE2SLS_id.felm.coef <- FE2SLS_id.felm.coef[c(15, 16, 1:14)] FE2SLS_ti.felm.coef <- as.numeric(FE2SLS_ti.felm$coefficients) names(FE2SLS_ti.felm.coef) <- rownames(FE2SLS_ti.felm$coefficients) FE2SLS_ti.felm.coef <- FE2SLS_ti.felm.coef[c(15, 16, 1:14)] FE2SLS_id_unbal.felm.coef <- as.numeric(FE2SLS_id_unbal.felm$coefficients) names(FE2SLS_id_unbal.felm.coef) <- rownames(FE2SLS_id_unbal.felm$coefficients) FE2SLS_id_unbal.felm.coef <- FE2SLS_id_unbal.felm.coef[c(15, 16, 1:14)] FE2SLS_ti_unbal.felm.coef <- as.numeric(FE2SLS_ti_unbal.felm$coefficients) names(FE2SLS_ti_unbal.felm.coef) <- rownames(FE2SLS_ti_unbal.felm$coefficients) FE2SLS_ti_unbal.felm.coef <- FE2SLS_ti_unbal.felm.coef[c(15, 16, 1:14)] FE2SLS_tw.felm.coef <- as.numeric(FE2SLS_tw.felm$coefficients) names(FE2SLS_tw.felm.coef) <- rownames(FE2SLS_tw.felm$coefficients) FE2SLS_tw.felm.coef <- FE2SLS_tw.felm.coef[c(15, 16, 1:14)] FE2SLS_tw_unbal.felm.coef <- as.numeric(FE2SLS_tw_unbal.felm$coefficients) names(FE2SLS_tw_unbal.felm.coef) <- rownames(FE2SLS_tw_unbal.felm$coefficients) FE2SLS_tw_unbal.felm.coef <- FE2SLS_tw_unbal.felm.coef[c(15, 16, 1:14)] # First, check if model estimations are the same stopifnot(isTRUE(all.equal(FE2SLS_id$coefficients, FE2SLS_id.felm.coef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_ti$coefficients, FE2SLS_ti.felm.coef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_id_unbal$coefficients, FE2SLS_id_unbal.felm.coef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_ti_unbal$coefficients, FE2SLS_ti_unbal.felm.coef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_tw$coefficients, FE2SLS_tw.felm.coef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(FE2SLS_tw_unbal$coefficients, FE2SLS_tw_unbal.felm.coef, check.attributes = FALSE))) FE2SLS_id.felm_fixef <- lfe::getfe(FE2SLS_id.felm)[lfe::getfe(FE2SLS_id.felm)[["fe"]] == "county", 1] FE2SLS_id_unbal.felm_fixef <- lfe::getfe(FE2SLS_id_unbal.felm)[lfe::getfe(FE2SLS_id_unbal.felm)[["fe"]] == "county", 1] FE2SLS_ti.felm_fixef <- lfe::getfe(FE2SLS_ti.felm)[lfe::getfe(FE2SLS_ti.felm)[["fe"]] == "year", 1] FE2SLS_ti_unbal.felm_fixef <- lfe::getfe(FE2SLS_ti_unbal.felm)[lfe::getfe(FE2SLS_ti_unbal.felm)[["fe"]] == "year", 1] FE2SLS_tw.id.felm_fixef <- lfe::getfe(FE2SLS_tw.felm)[lfe::getfe(FE2SLS_tw.felm)[["fe"]] == "county", 1] FE2SLS_tw.id_unbal.felm_fixef <- lfe::getfe(FE2SLS_tw_unbal.felm)[lfe::getfe(FE2SLS_tw_unbal.felm)[["fe"]] == "county", 1] FE2SLS_tw.ti.felm_fixef <- lfe::getfe(FE2SLS_tw.felm)[lfe::getfe(FE2SLS_tw.felm)[["fe"]] == "year", 1] FE2SLS_tw.ti_unbal.felm_fixef <- lfe::getfe(FE2SLS_tw_unbal.felm)[lfe::getfe(FE2SLS_tw_unbal.felm)[["fe"]] == "year", 1] stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id)), FE2SLS_id.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti)), FE2SLS_ti.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_id_unbal)), FE2SLS_id_unbal.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_ti_unbal)), FE2SLS_ti_unbal.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw)), FE2SLS_tw.id.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw, "time", "dfirst"))), FE2SLS_tw.ti.felm_fixef, check.attributes = FALSE, tolerance = 10^(-6)))) # in the unbalanced twoway case, getfe() sets as reference a level depending on the unbalancedness structure # -> somewhat arbitrary -> see also https://github.com/sgaure/lfe/issues/52 # for this example, the unbalancedness structure leads to the first time period being the reference stopifnot(isTRUE(all.equal(as.numeric(fixef(FE2SLS_tw_unbal)), FE2SLS_tw.id_unbal.felm_fixef, check.attributes = FALSE))) stopifnot(isTRUE(all.equal(as.numeric(c(0, fixef(FE2SLS_tw_unbal, "time", "dfirst"))), FE2SLS_tw.ti_unbal.felm_fixef, check.attributes = FALSE, tolerance = 10^(-6)))) } plm/inst/tests/test_pcdtest.R0000644000176200001440000000540614124132276016020 0ustar liggesusers## tests for pcdtest ## test pcdtest for NaN value in result ## * due to non-intersecting pairs, fixed in rev. 339 ## * due to only ony period in intersection, fixed in rev. 345 library(plm) data("Grunfeld", package = "plm") ## just a run test without obstacles mod_pool <- plm(inv ~ value + capital, data = Grunfeld, model = "pooling") testres1 <- pcdtest(mod_pool, test = "cd") if (is.nan(testres1$statistic)) stop("statistic is NaN") if (is.na(testres1$statistic)) stop("statistic is NA") if (is.na(testres1$p.value)) stop("p-value is NA") ## no intersection for firm 1 and 2: # firm 1 years: 1935 to 1944 # firm 2 years: 1945 to 1954 Grunfeld_no_intersect <- Grunfeld[-c(11:20, 21:30), ] mod_pool_no_intersect <- plm(inv ~ value + capital, data = Grunfeld_no_intersect, model = "pooling") testres2 <- pcdtest(mod_pool_no_intersect, test = "cd") if (is.nan(testres2$statistic)) stop("statistic is NaN") if (is.na(testres2$statistic)) stop("statistic is NA") if (is.na(testres2$p.value)) stop("p-value is NA") ## fixed in rev. 345 ## only 1 intersection for firm 1 and 2: # firm 1 years: 1935 to 1945 # firm 2 years: 1945 to 1954 Grunfeld_one_intersect <- Grunfeld[-c(12:20, 20:30), ] mod_pool_one_intersect <- plm(inv ~ value + capital, data = Grunfeld_one_intersect, model = "pooling") testres3 <- pcdtest(mod_pool_one_intersect, test = "cd") if (is.nan(testres3$statistic)) stop("statistic is NaN") if (is.na(testres3$statistic)) stop("statistic is NA") if (is.na(testres3$p.value)) stop("p-value is NA") ## make it also unbalanced for other individuals Grunfeld_no_intersect_unbal <- Grunfeld_no_intersect[-c(65:66, 71, 103:110), ] mod_pool_no_intersect_unbal <- plm(inv ~ value + capital, data = Grunfeld_no_intersect_unbal, model = "pooling") testres4 <- pcdtest(mod_pool_no_intersect_unbal, test = "cd") if (is.nan(testres4$statistic)) stop("statistic is NaN") if (is.na(testres4$statistic)) stop("statistic is NA") if (is.na(testres4$p.value)) stop("p-value is NA") ## test case for regression of variable on constant ## resulted in error pre rev. 342: ## "Error in lm.fit(tX, ty) : 'x' must be a matrix" pcdtest(value ~ 1, data = Grunfeld) ## tests of local test (with arg w) w <- diag(1, nrow = 10) w[2,1] <- 1 testres5 <- pcdtest(mod_pool, test = "cd", w = w) if (is.nan(testres5$statistic)) stop("statistic is NaN") if (is.na(testres5$statistic)) stop("statistic is NA") if (is.na(testres5$p.value)) stop("p-value is NA") ### should result in meaningful errors ## upper and lower triangular part define different neighbours # w1 <- diag(1, nrow = 10) # w1[1,3] <- 1 # w1[2,1] <- 1 # pcdtest(mod_pool, test = "cd", w = w1) ## wrong dimension # w2 <- diag(1, nrow = 10, ncol = 11) # pcdtest(mod_pool, test = "cd", w = w2) plm/inst/tests/test_residuals_overall_fitted_exp.R0000644000176200001440000001371714124132276022310 0ustar liggesusers # tests for experimental, non-exported methods: # * residuals_overall_exp.plm # * fitted_exp.plm # # TODO: plm model "ht": is that deprecated? currently, it is not supported by residuals_overall_exp.plm and fitted_exp.plm library(plm) data("Grunfeld", package = "plm") # due to functions being non-exported: fitted_exp.plm <- plm:::fitted_exp.plm residuals_overall_exp.plm <- plm:::residuals_overall_exp.plm # random - balanced re_id_bal <- plm(inv ~ value + capital, model = "random", effect = "individual", data = Grunfeld) re_time_bal <- plm(inv ~ value + capital, model = "random", effect = "time", data = Grunfeld) re2_bal <- plm(inv ~ value + capital, model = "random", effect = "twoways", data = Grunfeld) # random - unbalanced re_id_unbal <- plm(inv ~ value + capital, model = "random", effect = "individual", data = Grunfeld[1:199, ]) re_time_unbal <- plm(inv ~ value + capital, model = "random", effect = "time", data = Grunfeld[1:199, ]) re2_unbal <- plm(inv ~ value + capital, model = "random", effect = "twoways", data = Grunfeld[1:199, ]) # fixed - balanced fe_id_bal <- plm(inv ~ value + capital, model = "within", effect = "individual", data = Grunfeld) fe_time_bal <- plm(inv ~ value + capital, model = "within", effect = "time", data = Grunfeld) fe2_bal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld) # fixed - unbalanced fe_id_unbal <- plm(inv ~ value + capital, model = "within", effect = "individual", data = Grunfeld[1:199, ]) fe_time_unbal <- plm(inv ~ value + capital, model = "within", effect = "time", data = Grunfeld[1:199, ]) fe2_unbal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld[1:199, ]) # between be_bal <- plm(inv ~ value + capital, model = "between", data = Grunfeld) be_unbal <- plm(inv ~ value + capital, model = "between", data = Grunfeld[1:199, ]) # pooling pool_bal <- plm(inv ~ value + capital, model = "pooling", data = Grunfeld) pool_unbal <- plm(inv ~ value + capital, model = "pooling", data = Grunfeld[1:199, ]) # fd fd_bal <- plm(inv ~ value + capital, model = "fd", data = Grunfeld) fd_unbal <- plm(inv ~ value + capital, model = "fd", data = Grunfeld[1:199, ]) # ht ## data("Wages", package = "plm") ## ht <- plm(lwage ~ wks + south + smsa + married + exp + I(exp^2) + ## bluecol + ind + union + sex + black + ed | ## sex + black + bluecol + south + smsa + ind, ## data = Wages, model = "ht", index = 595) ### Tests ### # random - balanced if (!isTRUE(all.equal(re_id_bal$model[,1], fitted_exp.plm(re_id_bal) + residuals_overall_exp.plm(re_id_bal), check.attributes = F))) stop("model random not equal") if (!isTRUE(all.equal(re_time_bal$model[,1], fitted_exp.plm(re_time_bal) + residuals_overall_exp.plm(re_time_bal), check.attributes = F))) stop("model random not equal") if (!isTRUE(all.equal(re2_bal$model[,1], fitted_exp.plm(re2_bal) + residuals_overall_exp.plm(re2_bal), check.attributes = F))) stop("model random not equal") # random - unbalanced if (!isTRUE(all.equal(re_id_unbal$model[,1], fitted_exp.plm(re_id_unbal) + residuals_overall_exp.plm(re_id_unbal), check.attributes = F))) stop("model random not equal") if (!isTRUE(all.equal(re_time_unbal$model[,1], fitted_exp.plm(re_time_unbal) + residuals_overall_exp.plm(re_time_unbal), check.attributes = F))) stop("model random not equal") if (!isTRUE(all.equal(re2_unbal$model[,1], fitted_exp.plm(re2_unbal) + residuals_overall_exp.plm(re2_unbal), check.attributes = F))) stop("model random not equal") # fixed - balanced if (!isTRUE(all.equal(fe_id_bal$model[,1], fitted_exp.plm(fe_id_bal) + residuals_overall_exp.plm(fe_id_bal), check.attributes = F))) stop("model within not equal") if (!isTRUE(all.equal(fe_time_bal$model[,1], fitted_exp.plm(fe_time_bal) + residuals_overall_exp.plm(fe_time_bal), check.attributes = F))) stop("model within not equal") if (!isTRUE(all.equal(fe2_bal$model[,1], fitted_exp.plm(fe2_bal) + residuals_overall_exp.plm(fe2_bal), check.attributes = F))) stop("model within not equal") # fixed - unbalanced if (!isTRUE(all.equal(fe_id_unbal$model[,1], fitted_exp.plm(fe_id_unbal) + residuals_overall_exp.plm(fe_id_unbal), check.attributes = F))) stop("model within not equal") if (!isTRUE(all.equal(fe_time_unbal$model[,1], fitted_exp.plm(fe_time_unbal) + residuals_overall_exp.plm(fe_time_unbal), check.attributes = F))) stop("model within not equal") if (!isTRUE(all.equal(fe2_unbal$model[,1], fitted_exp.plm(fe2_unbal) + residuals_overall_exp.plm(fe2_unbal), check.attributes = F))) stop("model within not equal") # between if (!isTRUE(all.equal(as.numeric(pmodel.response(be_bal)), as.numeric(fitted_exp.plm(be_bal) + residuals_overall_exp.plm(be_bal)), check.attributes = F))) stop("model be not equal") if (!isTRUE(all.equal(as.numeric(pmodel.response(be_unbal)), as.numeric(fitted_exp.plm(be_unbal) + residuals_overall_exp.plm(be_unbal)), check.attributes = F))) stop("model be not equal") # pooling if (!isTRUE(all.equal(pool_bal$model[,1], fitted_exp.plm(pool_bal) + residuals_overall_exp.plm(pool_bal), check.attributes = F))) stop("model pool not equal") if (!isTRUE(all.equal(pool_unbal$model[,1], fitted_exp.plm(pool_unbal) + residuals_overall_exp.plm(pool_unbal), check.attributes = F))) stop("model pool not equal") # fd if (!isTRUE(all.equal(as.numeric(pmodel.response(fd_bal)), as.numeric(fitted_exp.plm(fd_bal) + residuals_overall_exp.plm(fd_bal)), check.attributes = F))) stop("model fd not equal") if (!isTRUE(all.equal(as.numeric(pmodel.response(fd_unbal)), as.numeric(fitted_exp.plm(fd_unbal) + residuals_overall_exp.plm(fd_unbal)), check.attributes = F))) stop("model fd not equal") # ht # if (!isTRUE(all.equal(ht$model[,1], as.numeric(fitted_exp.plm(ht) + residuals_overall_exp.plm(ht)), check.attributes = F))) stop("model ht not equal") plm/inst/tests/test_pdiff_fd.R0000644000176200001440000000502014124132276016103 0ustar liggesusers# Test for pdiff (internal function) for the time dimension (effect = "time") library(plm) data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) form <- inv ~ value + capital fd_id <- plm(form, data = Grunfeld, model = "fd") print(summary(fd_id)) print(vcovHC(fd_id)) print(vcovHC(fd_id, cluster = "time")) ## FD models with effect = "time" are be prevented from estimation due to ## not meaningful ordering of individuals # # fd_time <- plm(form, data = Grunfeld, model = "fd", effect = "time") # summary(fd_time) # vcovHC(fd_time) # vcovHC(fd_time, cluster = "group") pGrunfeld <- pdata.frame(Grunfeld) #MM modmat_id <- model.matrix(pFormula(form), data = pGrunfeld, model = "fd", effect = "individual") modmat_id <- model.matrix(model.frame(pGrunfeld, form), model = "fd", effect = "individual") #YC modmat_time <- model.matrix(pFormula(form), data = pGrunfeld, model = "fd", effect = "time") if (nrow(modmat_id) != 190) stop(paste0("nrow not correct, should be 190, is: ", nrow(modmat_id))) #YC if (nrow(modmat_time) != 180) stop(paste0("nrow not correct, should be 180, is: ", nrow(modmat_time))) # "layout" of resulting matrix for effect = "time": 1362.4 - 3078.5 # pos 1 t_1 - t_1 for id 2,1 [orig pos 21 - orig pos 1] 1170.6 - 1362.4 # pos 21 t_t - t_1 for id 3,2 [orig pos 41 - orig pos 21] 417.5 - 1170.6 # pos 41 t_t - t_1 for id 4,3 [orig pos 61 - orig pos 41] # formal test #YC if (!isTRUE(all.equal(1362.4-3078.5, modmat_time[1, "value"]))) stop("position for effect = \"time\" not correct") #YC if (!isTRUE(all.equal(1170.6-1362.4, modmat_time[21, "value"]))) stop("position for effect = \"time\" not correct") #YC if (!isTRUE(all.equal(417.5-1170.6, modmat_time[41, "value"]))) stop("position for effect = \"time\" not correct") head(modmat_id, 41) #YC head(modmat_time, 41) head(Grunfeld, 41) # check pseries pdiff_id <- plm:::pdiff(pGrunfeld[ , "value"], effect = "individual") #YC pdiff_time <- plm:::pdiff(pGrunfeld[ , "value"], effect = "time") pos_first_id <- which(pGrunfeld$firm == 1) pos_first_time <- which(pGrunfeld$year == 1935) diff_id <- base::diff(Grunfeld[pos_first_id, "value"]) diff_time <- base::diff(Grunfeld[pos_first_time, "value"]) if (!isTRUE(all.equal(pdiff_id[pos_first_id[-length(pos_first_id)]], diff_id, check.attributes = FALSE))) stop("pdiff on individual not correct") #YC if (!isTRUE(all.equal(pdiff_time[pos_first_time[-length(pos_first_time)]], diff_time, check.attributes = FALSE))) stop("pdiff on time not correct") plm/inst/tests/test_pdata.frame_pseriesfy.Rout.save0000644000176200001440000000560114126032274022306 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # test of pseriesfy() (turns all columns of a pdata.frame into pseries) > > library("plm") > data("Grunfeld", package = "plm") > Grunfeld$fac <- factor(1:200) > pGrun <- pdata.frame(Grunfeld) > > options("plm.fast" = FALSE) > pGrunpser1.1 <- pseriesfy(pGrun) > > ## Run tests only if package 'collapse' is available > ## (as they are 'Suggests' dependencies) > collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE > > if(collapse.avail) { + + options("plm.fast" = TRUE) + pGrunpser2.1 <- pseriesfy(pGrun) + options("plm.fast" = FALSE) + + # Tests for base R vs. collapse version + class(pGrunpser1.1) + class(pGrunpser2.1) + + stopifnot(identical(pGrunpser1.1, pGrunpser2.1)) + + lapply(pGrunpser1.1, class) + lapply(pGrunpser2.1, class) + + lapply(pGrunpser1.1, names) + lapply(pGrunpser2.1, names) + + form <- inv ~ value + capital + plm(form, pGrunpser1.1, model = "within") + plm(form, pGrunpser2.1, model = "within") + + # apply again to an already pseriesfy-ed pdata.frame (result should not change) + options("plm.fast" = FALSE) + pGrunpser1.2 <- pseriesfy(pGrunpser1.1) + options("plm.fast" = TRUE) + pGrunpser2.2 <- pseriesfy(pGrunpser2.1) + options("plm.fast" = FALSE) + + class(pGrunpser1.2) + class(pGrunpser2.2) + + lapply(pGrunpser1.2, class) + lapply(pGrunpser2.2, class) + + lapply(pGrunpser1.2, names) + lapply(pGrunpser2.2, names) + + stopifnot(identical(pGrunpser1.1, pGrunpser1.2)) + stopifnot(identical(pGrunpser2.1, pGrunpser2.2)) + + stopifnot(identical(pGrunpser1.2, pGrunpser2.2)) + + with(pGrun, lag(value)) # dispatches to base R's lag + with(pGrunpser1.1, lag(value)) # dispatches to plm's lag() respect. panel structure + invisible(NULL) + } > > ### benchmark: collapse version about 10x faster > # library(collapse) > # data("wlddev", package = "collapse") > # pwld <- pdata.frame(wlddev, index = c("iso3c", "year")) > # options("plm.fast" = FALSE) > # microbenchmark::microbenchmark(pseriesfy(pwld), times = 100, unit = "us") > # options("plm.fast" = TRUE) > # microbenchmark::microbenchmark(pseriesfy(pwld), times = 100, unit = "us") > # options("plm.fast" = FALSE) > > proc.time() user system elapsed 2.73 0.50 3.25 plm/inst/tests/test_order_between_fixef_ranef.R0000644000176200001440000004213114126025430021521 0ustar liggesusers## test for order of output of between() and hence fixef() and ranef() # -> factor level order or order of appearance in original data ## "since ever" plm had level order but this was changed to appearance order # in plm 2.4-0 and changed back in rev. 1307 for plm 2.4-2. # => factor level order makes more sense! library(plm) data("Crime", package = "plm") delrows.a <- -c( 1, 2, 10, 12) delrows.b <- -c(10, 12, 17, 18) Crime.unbal.a <- Crime[delrows.a, ] Crime.unbal.b <- Crime[delrows.b, ] pCrime.unbal.a <- pdata.frame(Crime.unbal.a) pCrime.unbal.b <- pdata.frame(Crime.unbal.b) ix.a <- index(pCrime.unbal.a) # unclass for speed ix.b <- index(pCrime.unbal.b) # unclass for speed ## between.default ## options("plm.fast" = FALSE) (bet.def.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[1L]])) # individual effect (bet.def.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[1L]])) # individual effect options("plm.fast" = FALSE) (bet.def.plm.slow.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.def.plm.slow.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[2L]])) # year 81 first ## Run tests only if package 'collapse' is available ## (as they are 'Suggests' dependencies) collapse.avail <- if (!requireNamespace("collapse", quietly = TRUE)) FALSE else TRUE if(collapse.avail) { options("plm.fast" = TRUE) # same (bet.def.plm.fast.unbal.a <- between(Crime.unbal.a$crmrte, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.def.plm.fast.unbal.b <- between(Crime.unbal.b$crmrte, effect = ix.b[[2L]])) # year 81 first stopifnot(isTRUE(all.equal(names(bet.def.unbal.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(bet.def.unbal.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(bet.def.plm.slow.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.def.plm.slow.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.def.plm.fast.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.def.plm.fast.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(bet.def.plm.slow.unbal.a, bet.def.plm.fast.unbal.a))) stopifnot(isTRUE(all.equal(bet.def.plm.slow.unbal.b, bet.def.plm.fast.unbal.b))) ## between.pseries ## options("plm.fast" = FALSE) (bet.pser.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "individual")) (bet.pser.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "individual")) options("plm.fast" = FALSE) (bet.pser.plm.slow.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.pser.plm.slow.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "time")) # year 81 first options("plm.fast" = TRUE) # same (bet.pser.plm.fast.unbal.a <- between(pCrime.unbal.a$crmrte, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.pser.plm.fast.unbal.b <- between(pCrime.unbal.b$crmrte, effect = "time")) # year 81 first stopifnot(isTRUE(all.equal(names(bet.pser.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[1L]])))) stopifnot(isTRUE(all.equal(names(bet.pser.unbal.b), levels(index(pCrime.unbal.b$crmrte)[[1L]])))) stopifnot(isTRUE(all.equal(names(bet.pser.plm.slow.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.pser.plm.slow.unbal.a), levels(index(pCrime.unbal.b$crmrte)[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.pser.plm.fast.unbal.a), levels(index(pCrime.unbal.a$crmrte)[[2L]])))) stopifnot(isTRUE(all.equal(names(bet.pser.plm.fast.unbal.a), levels(index(pCrime.unbal.b$crmrte)[[2L]])))) stopifnot(isTRUE(all.equal(bet.pser.plm.slow.unbal.a, bet.pser.plm.fast.unbal.a))) stopifnot(isTRUE(all.equal(bet.pser.plm.slow.unbal.b, bet.pser.plm.fast.unbal.b))) ## between.matrix - no index case ## mat_no_index.unbal.a <- as.matrix(Crime.unbal.a[ , 1:6])[ , 3:4] mat_no_index.unbal.b <- as.matrix(Crime.unbal.b[ , 1:6])[ , 3:4] options("plm.fast" = FALSE) (bet.matnoi.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[1L]])) # individual effect (bet.matnoi.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[1L]])) # individual effect options("plm.fast" = FALSE) (bet.matnoi.plm.slow.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.matnoi.plm.slow.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[2L]])) # year 81 first options("plm.fast" = TRUE) (bet.matnoi.plm.fast.unbal.a <- between(mat_no_index.unbal.a, effect = ix.a[[2L]])) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.matnoi.plm.fast.unbal.b <- between(mat_no_index.unbal.b, effect = ix.b[[2L]])) # year 81 first stopifnot(isTRUE(all.equal(rownames(bet.matnoi.unbal.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(rownames(bet.matnoi.unbal.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.slow.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.slow.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.fast.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.matnoi.plm.fast.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(bet.matnoi.plm.slow.unbal.a, bet.matnoi.plm.fast.unbal.a))) stopifnot(isTRUE(all.equal(bet.matnoi.plm.slow.unbal.b, bet.matnoi.plm.fast.unbal.b))) ## between.matrix - index case ## mat_index.unbal.a <- mat_no_index.unbal.a mat_index.unbal.b <- mat_no_index.unbal.b attr(mat_index.unbal.a, "index") <- ix.a attr(mat_index.unbal.b, "index") <- ix.b options("plm.fast" = FALSE) (bet.mati.unbal.a <- between(mat_index.unbal.a, effect = "individual")) # individual effect (bet.mati.unbal.b <- between(mat_index.unbal.b, effect = "individual")) # individual effect options("plm.fast" = FALSE) (bet.mati.plm.slow.unbal.a <- between(mat_index.unbal.a, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.mati.plm.slow.unbal.b <- between(mat_index.unbal.b, effect = "time")) # year 81 first options("plm.fast" = TRUE) (bet.mati.plm.fast.unbal.a <- between(mat_index.unbal.a, effect = "time")) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (bet.mati.plm.fast.unbal.b <- between(mat_index.unbal.b, effect = "time")) # year 81 first stopifnot(isTRUE(all.equal(rownames(bet.mati.unbal.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(rownames(bet.mati.unbal.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.slow.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.slow.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.fast.unbal.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(rownames(bet.mati.plm.fast.unbal.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(bet.mati.plm.slow.unbal.a, bet.mati.plm.fast.unbal.a))) stopifnot(isTRUE(all.equal(bet.mati.plm.slow.unbal.b, bet.mati.plm.fast.unbal.b))) ### fixef ### crime_formula_plm_FE <- lcrmrte ~ lprbarr + lpolpc + lprbconv + lprbpris + lavgsen + ldensity + lwcon + lwtuc + lwtrd + lwfir + lwser + lwmfg + lwfed + lwsta + lwloc + lpctymle FE_id.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "individual") FE_ti.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "time") FE_tw.a <- plm(crime_formula_plm_FE, data = pCrime.unbal.a, model = "within", effect = "twoways") FE_id.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "individual") FE_ti.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "time") FE_tw.b <- plm(crime_formula_plm_FE, data = pCrime.unbal.b, model = "within", effect = "twoways") options("plm.fast" = FALSE) (fx_fe_plm.slow.id.a <- fixef(FE_id.a)) (fx_fe_plm.slow.ti.a <- fixef(FE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_fe_plm.slow.tw.id.a <- fixef(FE_tw.a, effect = "individual")) (fx_fe_plm.slow.tw.ti.a <- fixef(FE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) (fx_fe_plm.slow.tw.tw.a <- fixef(FE_tw.a, effect = "twoways")) (fx_fe_plm.slow.id.b <- fixef(FE_id.b)) (fx_fe_plm.slow.ti.b <- fixef(FE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_fe_plm.slow.tw.id.b <- fixef(FE_tw.b, effect = "individual")) (fx_fe_plm.slow.tw.ti.b <- fixef(FE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) (fx_fe_plm.slow.tw.tw.b <- fixef(FE_tw.b, effect = "twoways")) options("plm.fast" = TRUE) # same (fx_fe_plm.fast.id.a <- fixef(FE_id.a)) (fx_fe_plm.fast.ti.a <- fixef(FE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_fe_plm.fast.tw.id.a <- fixef(FE_tw.a, effect = "individual")) (fx_fe_plm.fast.tw.ti.a <- fixef(FE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) (fx_fe_plm.fast.tw.tw.a <- fixef(FE_tw.a, effect = "twoways")) (fx_fe_plm.fast.id.b <- fixef(FE_id.b)) (fx_fe_plm.fast.ti.b <- fixef(FE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_fe_plm.fast.tw.id.b <- fixef(FE_tw.b, effect = "individual")) (fx_fe_plm.fast.tw.ti.b <- fixef(FE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) (fx_fe_plm.fast.tw.tw.b <- fixef(FE_tw.b, effect = "twoways")) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.a), paste(ix.a[[1L]], ix.a[[2L]], sep = "-")))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.b), paste(ix.b[[1L]], ix.b[[2L]], sep = "-")))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.tw.a), paste(ix.a[[1L]], ix.a[[2L]], sep = "-")))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_fe_plm.fast.tw.tw.b), paste(ix.b[[1L]], ix.b[[2L]], sep = "-")))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.id.a, fx_fe_plm.fast.id.a))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.ti.a, fx_fe_plm.fast.ti.a))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.id.a, fx_fe_plm.fast.tw.id.a))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.ti.a, fx_fe_plm.fast.tw.ti.a))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.tw.a, fx_fe_plm.fast.tw.tw.a))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.id.b, fx_fe_plm.fast.id.b))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.ti.b, fx_fe_plm.fast.ti.b))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.id.b, fx_fe_plm.fast.tw.id.b))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.ti.b, fx_fe_plm.fast.tw.ti.b))) stopifnot(isTRUE(all.equal(fx_fe_plm.slow.tw.tw.b, fx_fe_plm.fast.tw.tw.b))) ### ranef ### crime_formula_plm_RE <- lpctymle ~ lmix + lprbconv RE_id.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "individual") RE_ti.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "time") RE_tw.a <- plm(crime_formula_plm_RE, data = pCrime.unbal.a, model = "random", effect = "twoways") RE_id.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "individual") RE_ti.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "time") RE_tw.b <- plm(crime_formula_plm_RE, data = pCrime.unbal.b, model = "random", effect = "twoways") options("plm.fast" = FALSE) (fx_re_plm.slow.id.a <- ranef(RE_id.a)) (fx_re_plm.slow.ti.a <- ranef(RE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_re_plm.slow.tw.id.a <- ranef(RE_tw.a, effect = "individual")) (fx_re_plm.slow.tw.ti.a <- ranef(RE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) # (fx_re_plm.slow.tw.tw.a <- ranef(RE_tw.a, effect = "twoways")) # do not have this for ranef (fx_re_plm.slow.id.b <- ranef(RE_id.b)) (fx_re_plm.slow.ti.b <- ranef(RE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_re_plm.slow.tw.id.b <- ranef(RE_tw.b, effect = "individual")) (fx_re_plm.slow.tw.ti.b <- ranef(RE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) # (fx_re_plm.slow.tw.tw.b <- ranef(RE_tw.b, effect = "twoways")) # do not have this for ranef options("plm.fast" = TRUE) # same (fx_re_plm.fast.id.a <- ranef(RE_id.a)) (fx_re_plm.fast.ti.a <- ranef(RE_ti.a)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_re_plm.fast.tw.id.a <- ranef(RE_tw.a, effect = "individual")) (fx_re_plm.fast.tw.ti.a <- ranef(RE_tw.a, effect = "time")) # year 81 first (order same as *.b for 2-ways FE) # (fx_re_plm.fast.tw.tw.a <- ranef(RE_tw.a, effect = "twoways")) # do not have this for ranef (fx_re_plm.fast.id.b <- ranef(RE_id.b)) (fx_re_plm.fast.ti.b <- ranef(RE_ti.b)) # year 81 first from rev. 1307 (and plm < 2.4-0) (year 83 first in rev. 1305 (and plm 2.4-0/1)) (fx_re_plm.fast.tw.id.b <- ranef(RE_tw.b, effect = "individual")) (fx_re_plm.fast.tw.ti.b <- ranef(RE_tw.b, effect = "time")) # year 81 first (order same as *.a for 2-ways FE) # (fx_re_plm.fast.tw.tw.b <- # ranef(RE_tw.b, effect = "twoways")) # do not have this for ranef stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.ti.a), levels(ix.a[[2L]])))) # stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.tw.a), levels(ix.a[[2L]])))) # don't have this for ranef stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.slow.tw.ti.b), levels(ix.b[[2L]])))) # stopifnot(isTRUE(all.equal(names(fx_fe_plm.slow.tw.tw.b), levels(ix.b[[2L]])) # don't have this for ranef stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.ti.a), levels(ix.a[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.id.a), levels(ix.a[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.ti.a), levels(ix.a[[2L]])))) # stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.tw.a), levels(ix.a[[2L]])))) # don't have this for ranef stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.ti.b), levels(ix.b[[2L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.id.b), levels(ix.b[[1L]])))) stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.ti.b), levels(ix.b[[2L]])))) # stopifnot(isTRUE(all.equal(names(fx_re_plm.fast.tw.tw.b), levels(ix.b[[2L]])))) # don't have this for ranef stopifnot(isTRUE(all.equal(fx_re_plm.slow.id.a, fx_re_plm.fast.id.a))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.ti.a, fx_re_plm.fast.ti.a))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.id.a, fx_re_plm.fast.tw.id.a))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.ti.a, fx_re_plm.fast.tw.ti.a))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.id.b, fx_re_plm.fast.id.b))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.ti.b, fx_re_plm.fast.ti.b))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.id.b, fx_re_plm.fast.tw.id.b))) stopifnot(isTRUE(all.equal(fx_re_plm.slow.tw.ti.b, fx_re_plm.fast.tw.ti.b))) }plm/inst/tests/test_model.matrix_effects.Rout.save0000644000176200001440000026257514164773126022166 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # TODO: add all cases: all model objects with all combinations of available model and effect values > # request all combinations from all model objects > > library(plm) > data("Grunfeld", package = "plm") > > fe2_bal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld) > fe2_unbal <- plm(inv ~ value + capital, model = "within", effect = "twoways", data = Grunfeld[1:199, ]) > > model.matrix(fe2_bal, model = "pooling", effect = "individual") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 200 1 58.12 14.33 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > model.matrix(fe2_bal, model = "pooling", effect = "time") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 200 1 58.12 14.33 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > model.matrix(fe2_bal, model = "pooling", effect = "twoways") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 200 1 58.12 14.33 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > > model.matrix(fe2_unbal, model = "pooling", effect = "individual") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 > model.matrix(fe2_unbal, model = "pooling", effect = "time") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 > model.matrix(fe2_unbal, model = "pooling", effect = "twoways") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 > > # this resulted pre rev. 298 in an error due to the effect argument saved in > # plm_object$args$effect = "twoways" which gets interpreted by model.matrix > # and "applied" to model = "pooling" > model.matrix(fe2_unbal, model = "pooling") (Intercept) value capital 1 1 3078.50 2.80 2 1 4661.70 52.60 3 1 5387.10 156.90 4 1 2792.20 209.20 5 1 4313.20 203.40 6 1 4643.90 207.20 7 1 4551.20 255.20 8 1 3244.10 303.70 9 1 4053.70 264.10 10 1 4379.30 201.60 11 1 4840.90 265.00 12 1 4900.90 402.20 13 1 3526.50 761.50 14 1 3254.70 922.40 15 1 3700.20 1020.10 16 1 3755.60 1099.00 17 1 4833.00 1207.70 18 1 4924.90 1430.50 19 1 6241.70 1777.30 20 1 5593.60 2226.30 21 1 1362.40 53.80 22 1 1807.10 50.50 23 1 2676.30 118.10 24 1 1801.90 260.20 25 1 1957.30 312.70 26 1 2202.90 254.20 27 1 2380.50 261.40 28 1 2168.60 298.70 29 1 1985.10 301.80 30 1 1813.90 279.10 31 1 1850.20 213.80 32 1 2067.70 132.60 33 1 1796.70 264.80 34 1 1625.80 306.90 35 1 1667.00 351.10 36 1 1677.40 357.80 37 1 2289.50 342.10 38 1 2159.40 444.20 39 1 2031.30 623.60 40 1 2115.50 669.70 41 1 1170.60 97.80 42 1 2015.80 104.40 43 1 2803.30 118.00 44 1 2039.70 156.20 45 1 2256.20 172.60 46 1 2132.20 186.60 47 1 1834.10 220.90 48 1 1588.00 287.80 49 1 1749.40 319.90 50 1 1687.20 321.30 51 1 2007.70 319.60 52 1 2208.30 346.00 53 1 1656.70 456.40 54 1 1604.40 543.40 55 1 1431.80 618.30 56 1 1610.50 647.40 57 1 1819.40 671.30 58 1 2079.70 726.10 59 1 2371.60 800.30 60 1 2759.90 888.90 61 1 417.50 10.50 62 1 837.80 10.20 63 1 883.90 34.70 64 1 437.90 51.80 65 1 679.70 64.30 66 1 727.80 67.10 67 1 643.60 75.20 68 1 410.90 71.40 69 1 588.40 67.10 70 1 698.40 60.50 71 1 846.40 54.60 72 1 893.80 84.80 73 1 579.00 96.80 74 1 694.60 110.20 75 1 590.30 147.40 76 1 693.50 163.20 77 1 809.00 203.50 78 1 727.00 290.60 79 1 1001.50 346.10 80 1 703.20 414.90 81 1 157.70 183.20 82 1 167.90 204.00 83 1 192.90 236.00 84 1 156.70 291.70 85 1 191.40 323.10 86 1 185.50 344.00 87 1 199.60 367.70 88 1 189.50 407.20 89 1 151.20 426.60 90 1 187.70 470.00 91 1 214.70 499.20 92 1 232.90 534.60 93 1 249.00 566.60 94 1 224.50 595.30 95 1 237.30 631.40 96 1 240.10 662.30 97 1 327.30 683.90 98 1 359.40 729.30 99 1 398.40 774.30 100 1 365.70 804.90 101 1 197.00 6.50 102 1 210.30 15.80 103 1 223.10 27.70 104 1 216.70 39.20 105 1 286.40 48.60 106 1 298.00 52.50 107 1 276.90 61.50 108 1 272.60 80.50 109 1 287.40 94.40 110 1 330.30 92.60 111 1 324.40 92.30 112 1 401.90 94.20 113 1 407.40 111.40 114 1 409.20 127.40 115 1 482.20 149.30 116 1 673.80 164.40 117 1 676.90 177.20 118 1 702.00 200.00 119 1 793.50 211.50 120 1 927.30 238.70 121 1 138.00 100.20 122 1 200.10 125.00 123 1 210.10 142.40 124 1 161.20 165.10 125 1 161.70 194.80 126 1 145.10 222.90 127 1 110.60 252.10 128 1 98.10 276.30 129 1 108.80 300.30 130 1 118.20 318.20 131 1 126.50 336.20 132 1 156.70 351.20 133 1 119.40 373.60 134 1 129.10 389.40 135 1 134.80 406.70 136 1 140.80 429.50 137 1 179.00 450.60 138 1 178.10 466.90 139 1 186.80 486.20 140 1 192.70 511.30 141 1 191.50 1.80 142 1 516.00 0.80 143 1 729.00 7.40 144 1 560.40 18.10 145 1 519.90 23.50 146 1 628.50 26.50 147 1 537.10 36.20 148 1 561.20 60.80 149 1 617.20 84.40 150 1 626.70 91.20 151 1 737.20 92.40 152 1 760.50 86.00 153 1 581.40 111.10 154 1 662.30 130.60 155 1 583.80 141.80 156 1 635.20 136.70 157 1 723.80 129.70 158 1 864.10 145.50 159 1 1193.50 174.80 160 1 1188.90 213.50 161 1 290.60 162.00 162 1 291.10 174.00 163 1 335.00 183.00 164 1 246.00 198.00 165 1 356.20 208.00 166 1 289.80 223.00 167 1 268.20 234.00 168 1 213.30 248.00 169 1 348.20 274.00 170 1 374.20 282.00 171 1 387.20 316.00 172 1 347.40 302.00 173 1 291.90 333.00 174 1 297.20 359.00 175 1 276.90 370.00 176 1 274.60 376.00 177 1 339.90 391.00 178 1 474.80 414.00 179 1 496.00 443.00 180 1 474.50 468.00 181 1 70.91 4.50 182 1 87.94 4.71 183 1 82.20 4.57 184 1 58.72 4.56 185 1 80.54 4.38 186 1 86.47 4.21 187 1 77.68 4.12 188 1 62.16 3.83 189 1 62.24 3.58 190 1 61.82 3.41 191 1 65.85 3.31 192 1 69.54 3.23 193 1 64.97 3.90 194 1 68.00 5.38 195 1 71.24 7.39 196 1 69.05 8.74 197 1 83.04 9.07 198 1 74.42 9.93 199 1 63.51 11.68 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 > pmodel.response(fe2_unbal, model = "pooling") 1 2 3 4 5 6 7 8 9 10 317.60 391.80 410.60 257.70 330.80 461.20 512.00 448.00 499.60 547.50 11 12 13 14 15 16 17 18 19 20 561.20 688.10 568.90 529.20 555.10 642.90 755.90 891.20 1304.40 1486.70 21 22 23 24 25 26 27 28 29 30 209.90 355.30 469.90 262.30 230.40 361.60 472.80 445.60 361.60 288.20 31 32 33 34 35 36 37 38 39 40 258.70 420.30 420.50 494.50 405.10 418.80 588.20 645.50 641.00 459.30 41 42 43 44 45 46 47 48 49 50 33.10 45.00 77.20 44.60 48.10 74.40 113.00 91.90 61.30 56.80 51 52 53 54 55 56 57 58 59 60 93.60 159.90 147.20 146.30 98.30 93.50 135.20 157.30 179.50 189.60 61 62 63 64 65 66 67 68 69 70 40.29 72.76 66.26 51.60 52.41 69.41 68.35 46.80 47.40 59.57 71 72 73 74 75 76 77 78 79 80 88.78 74.12 62.68 89.36 78.98 100.66 160.62 145.00 174.93 172.49 81 82 83 84 85 86 87 88 89 90 39.68 50.73 74.24 53.51 42.65 46.48 61.40 39.67 62.24 52.32 91 92 93 94 95 96 97 98 99 100 63.21 59.37 58.02 70.34 67.42 55.74 80.30 85.40 91.90 81.43 101 102 103 104 105 106 107 108 109 110 20.36 25.98 25.94 27.53 24.60 28.54 43.41 42.81 27.84 32.60 111 112 113 114 115 116 117 118 119 120 39.03 50.17 51.85 64.03 68.16 77.34 95.30 99.49 127.52 135.72 121 122 123 124 125 126 127 128 129 130 24.43 23.21 32.78 32.54 26.65 33.71 43.50 34.46 44.28 70.80 131 132 133 134 135 136 137 138 139 140 44.12 48.98 48.51 50.00 50.59 42.53 64.77 72.68 73.86 89.51 141 142 143 144 145 146 147 148 149 150 12.93 25.90 35.05 22.89 18.84 28.57 48.51 43.34 37.02 37.81 151 152 153 154 155 156 157 158 159 160 39.27 53.46 55.56 49.56 32.04 32.24 54.38 71.78 90.08 68.60 161 162 163 164 165 166 167 168 169 170 26.63 23.39 30.65 20.89 28.78 26.93 32.08 32.21 35.69 62.47 171 172 173 174 175 176 177 178 179 180 52.32 56.95 54.32 40.53 32.54 43.48 56.49 65.98 66.11 49.34 181 182 183 184 185 186 187 188 189 190 2.54 2.00 2.19 1.99 2.03 1.81 2.14 1.86 0.93 1.18 191 192 193 194 195 196 197 198 199 1.36 2.24 3.81 5.66 4.21 3.42 4.67 6.00 6.53 > > #### "mean" > model.matrix(fe2_unbal, model = "mean") [,1] [,2] [,3] [1,] 1 1086.825 277.3322 [2,] 1 1086.825 277.3322 [3,] 1 1086.825 277.3322 [4,] 1 1086.825 277.3322 [5,] 1 1086.825 277.3322 [6,] 1 1086.825 277.3322 [7,] 1 1086.825 277.3322 [8,] 1 1086.825 277.3322 [9,] 1 1086.825 277.3322 [10,] 1 1086.825 277.3322 [11,] 1 1086.825 277.3322 [12,] 1 1086.825 277.3322 [13,] 1 1086.825 277.3322 [14,] 1 1086.825 277.3322 [15,] 1 1086.825 277.3322 [16,] 1 1086.825 277.3322 [17,] 1 1086.825 277.3322 [18,] 1 1086.825 277.3322 [19,] 1 1086.825 277.3322 [20,] 1 1086.825 277.3322 [21,] 1 1086.825 277.3322 [22,] 1 1086.825 277.3322 [23,] 1 1086.825 277.3322 [24,] 1 1086.825 277.3322 [25,] 1 1086.825 277.3322 [26,] 1 1086.825 277.3322 [27,] 1 1086.825 277.3322 [28,] 1 1086.825 277.3322 [29,] 1 1086.825 277.3322 [30,] 1 1086.825 277.3322 [31,] 1 1086.825 277.3322 [32,] 1 1086.825 277.3322 [33,] 1 1086.825 277.3322 [34,] 1 1086.825 277.3322 [35,] 1 1086.825 277.3322 [36,] 1 1086.825 277.3322 [37,] 1 1086.825 277.3322 [38,] 1 1086.825 277.3322 [39,] 1 1086.825 277.3322 [40,] 1 1086.825 277.3322 [41,] 1 1086.825 277.3322 [42,] 1 1086.825 277.3322 [43,] 1 1086.825 277.3322 [44,] 1 1086.825 277.3322 [45,] 1 1086.825 277.3322 [46,] 1 1086.825 277.3322 [47,] 1 1086.825 277.3322 [48,] 1 1086.825 277.3322 [49,] 1 1086.825 277.3322 [50,] 1 1086.825 277.3322 [51,] 1 1086.825 277.3322 [52,] 1 1086.825 277.3322 [53,] 1 1086.825 277.3322 [54,] 1 1086.825 277.3322 [55,] 1 1086.825 277.3322 [56,] 1 1086.825 277.3322 [57,] 1 1086.825 277.3322 [58,] 1 1086.825 277.3322 [59,] 1 1086.825 277.3322 [60,] 1 1086.825 277.3322 [61,] 1 1086.825 277.3322 [62,] 1 1086.825 277.3322 [63,] 1 1086.825 277.3322 [64,] 1 1086.825 277.3322 [65,] 1 1086.825 277.3322 [66,] 1 1086.825 277.3322 [67,] 1 1086.825 277.3322 [68,] 1 1086.825 277.3322 [69,] 1 1086.825 277.3322 [70,] 1 1086.825 277.3322 [71,] 1 1086.825 277.3322 [72,] 1 1086.825 277.3322 [73,] 1 1086.825 277.3322 [74,] 1 1086.825 277.3322 [75,] 1 1086.825 277.3322 [76,] 1 1086.825 277.3322 [77,] 1 1086.825 277.3322 [78,] 1 1086.825 277.3322 [79,] 1 1086.825 277.3322 [80,] 1 1086.825 277.3322 [81,] 1 1086.825 277.3322 [82,] 1 1086.825 277.3322 [83,] 1 1086.825 277.3322 [84,] 1 1086.825 277.3322 [85,] 1 1086.825 277.3322 [86,] 1 1086.825 277.3322 [87,] 1 1086.825 277.3322 [88,] 1 1086.825 277.3322 [89,] 1 1086.825 277.3322 [90,] 1 1086.825 277.3322 [91,] 1 1086.825 277.3322 [92,] 1 1086.825 277.3322 [93,] 1 1086.825 277.3322 [94,] 1 1086.825 277.3322 [95,] 1 1086.825 277.3322 [96,] 1 1086.825 277.3322 [97,] 1 1086.825 277.3322 [98,] 1 1086.825 277.3322 [99,] 1 1086.825 277.3322 [100,] 1 1086.825 277.3322 [101,] 1 1086.825 277.3322 [102,] 1 1086.825 277.3322 [103,] 1 1086.825 277.3322 [104,] 1 1086.825 277.3322 [105,] 1 1086.825 277.3322 [106,] 1 1086.825 277.3322 [107,] 1 1086.825 277.3322 [108,] 1 1086.825 277.3322 [109,] 1 1086.825 277.3322 [110,] 1 1086.825 277.3322 [111,] 1 1086.825 277.3322 [112,] 1 1086.825 277.3322 [113,] 1 1086.825 277.3322 [114,] 1 1086.825 277.3322 [115,] 1 1086.825 277.3322 [116,] 1 1086.825 277.3322 [117,] 1 1086.825 277.3322 [118,] 1 1086.825 277.3322 [119,] 1 1086.825 277.3322 [120,] 1 1086.825 277.3322 [121,] 1 1086.825 277.3322 [122,] 1 1086.825 277.3322 [123,] 1 1086.825 277.3322 [124,] 1 1086.825 277.3322 [125,] 1 1086.825 277.3322 [126,] 1 1086.825 277.3322 [127,] 1 1086.825 277.3322 [128,] 1 1086.825 277.3322 [129,] 1 1086.825 277.3322 [130,] 1 1086.825 277.3322 [131,] 1 1086.825 277.3322 [132,] 1 1086.825 277.3322 [133,] 1 1086.825 277.3322 [134,] 1 1086.825 277.3322 [135,] 1 1086.825 277.3322 [136,] 1 1086.825 277.3322 [137,] 1 1086.825 277.3322 [138,] 1 1086.825 277.3322 [139,] 1 1086.825 277.3322 [140,] 1 1086.825 277.3322 [141,] 1 1086.825 277.3322 [142,] 1 1086.825 277.3322 [143,] 1 1086.825 277.3322 [144,] 1 1086.825 277.3322 [145,] 1 1086.825 277.3322 [146,] 1 1086.825 277.3322 [147,] 1 1086.825 277.3322 [148,] 1 1086.825 277.3322 [149,] 1 1086.825 277.3322 [150,] 1 1086.825 277.3322 [151,] 1 1086.825 277.3322 [152,] 1 1086.825 277.3322 [153,] 1 1086.825 277.3322 [154,] 1 1086.825 277.3322 [155,] 1 1086.825 277.3322 [156,] 1 1086.825 277.3322 [157,] 1 1086.825 277.3322 [158,] 1 1086.825 277.3322 [159,] 1 1086.825 277.3322 [160,] 1 1086.825 277.3322 [161,] 1 1086.825 277.3322 [162,] 1 1086.825 277.3322 [163,] 1 1086.825 277.3322 [164,] 1 1086.825 277.3322 [165,] 1 1086.825 277.3322 [166,] 1 1086.825 277.3322 [167,] 1 1086.825 277.3322 [168,] 1 1086.825 277.3322 [169,] 1 1086.825 277.3322 [170,] 1 1086.825 277.3322 [171,] 1 1086.825 277.3322 [172,] 1 1086.825 277.3322 [173,] 1 1086.825 277.3322 [174,] 1 1086.825 277.3322 [175,] 1 1086.825 277.3322 [176,] 1 1086.825 277.3322 [177,] 1 1086.825 277.3322 [178,] 1 1086.825 277.3322 [179,] 1 1086.825 277.3322 [180,] 1 1086.825 277.3322 [181,] 1 1086.825 277.3322 [182,] 1 1086.825 277.3322 [183,] 1 1086.825 277.3322 [184,] 1 1086.825 277.3322 [185,] 1 1086.825 277.3322 [186,] 1 1086.825 277.3322 [187,] 1 1086.825 277.3322 [188,] 1 1086.825 277.3322 [189,] 1 1086.825 277.3322 [190,] 1 1086.825 277.3322 [191,] 1 1086.825 277.3322 [192,] 1 1086.825 277.3322 [193,] 1 1086.825 277.3322 [194,] 1 1086.825 277.3322 [195,] 1 1086.825 277.3322 [196,] 1 1086.825 277.3322 [197,] 1 1086.825 277.3322 [198,] 1 1086.825 277.3322 [199,] 1 1086.825 277.3322 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 > model.matrix(fe2_bal, model = "mean") [,1] [,2] [,3] [1,] 1 1081.681 276.0172 [2,] 1 1081.681 276.0172 [3,] 1 1081.681 276.0172 [4,] 1 1081.681 276.0172 [5,] 1 1081.681 276.0172 [6,] 1 1081.681 276.0172 [7,] 1 1081.681 276.0172 [8,] 1 1081.681 276.0172 [9,] 1 1081.681 276.0172 [10,] 1 1081.681 276.0172 [11,] 1 1081.681 276.0172 [12,] 1 1081.681 276.0172 [13,] 1 1081.681 276.0172 [14,] 1 1081.681 276.0172 [15,] 1 1081.681 276.0172 [16,] 1 1081.681 276.0172 [17,] 1 1081.681 276.0172 [18,] 1 1081.681 276.0172 [19,] 1 1081.681 276.0172 [20,] 1 1081.681 276.0172 [21,] 1 1081.681 276.0172 [22,] 1 1081.681 276.0172 [23,] 1 1081.681 276.0172 [24,] 1 1081.681 276.0172 [25,] 1 1081.681 276.0172 [26,] 1 1081.681 276.0172 [27,] 1 1081.681 276.0172 [28,] 1 1081.681 276.0172 [29,] 1 1081.681 276.0172 [30,] 1 1081.681 276.0172 [31,] 1 1081.681 276.0172 [32,] 1 1081.681 276.0172 [33,] 1 1081.681 276.0172 [34,] 1 1081.681 276.0172 [35,] 1 1081.681 276.0172 [36,] 1 1081.681 276.0172 [37,] 1 1081.681 276.0172 [38,] 1 1081.681 276.0172 [39,] 1 1081.681 276.0172 [40,] 1 1081.681 276.0172 [41,] 1 1081.681 276.0172 [42,] 1 1081.681 276.0172 [43,] 1 1081.681 276.0172 [44,] 1 1081.681 276.0172 [45,] 1 1081.681 276.0172 [46,] 1 1081.681 276.0172 [47,] 1 1081.681 276.0172 [48,] 1 1081.681 276.0172 [49,] 1 1081.681 276.0172 [50,] 1 1081.681 276.0172 [51,] 1 1081.681 276.0172 [52,] 1 1081.681 276.0172 [53,] 1 1081.681 276.0172 [54,] 1 1081.681 276.0172 [55,] 1 1081.681 276.0172 [56,] 1 1081.681 276.0172 [57,] 1 1081.681 276.0172 [58,] 1 1081.681 276.0172 [59,] 1 1081.681 276.0172 [60,] 1 1081.681 276.0172 [61,] 1 1081.681 276.0172 [62,] 1 1081.681 276.0172 [63,] 1 1081.681 276.0172 [64,] 1 1081.681 276.0172 [65,] 1 1081.681 276.0172 [66,] 1 1081.681 276.0172 [67,] 1 1081.681 276.0172 [68,] 1 1081.681 276.0172 [69,] 1 1081.681 276.0172 [70,] 1 1081.681 276.0172 [71,] 1 1081.681 276.0172 [72,] 1 1081.681 276.0172 [73,] 1 1081.681 276.0172 [74,] 1 1081.681 276.0172 [75,] 1 1081.681 276.0172 [76,] 1 1081.681 276.0172 [77,] 1 1081.681 276.0172 [78,] 1 1081.681 276.0172 [79,] 1 1081.681 276.0172 [80,] 1 1081.681 276.0172 [81,] 1 1081.681 276.0172 [82,] 1 1081.681 276.0172 [83,] 1 1081.681 276.0172 [84,] 1 1081.681 276.0172 [85,] 1 1081.681 276.0172 [86,] 1 1081.681 276.0172 [87,] 1 1081.681 276.0172 [88,] 1 1081.681 276.0172 [89,] 1 1081.681 276.0172 [90,] 1 1081.681 276.0172 [91,] 1 1081.681 276.0172 [92,] 1 1081.681 276.0172 [93,] 1 1081.681 276.0172 [94,] 1 1081.681 276.0172 [95,] 1 1081.681 276.0172 [96,] 1 1081.681 276.0172 [97,] 1 1081.681 276.0172 [98,] 1 1081.681 276.0172 [99,] 1 1081.681 276.0172 [100,] 1 1081.681 276.0172 [101,] 1 1081.681 276.0172 [102,] 1 1081.681 276.0172 [103,] 1 1081.681 276.0172 [104,] 1 1081.681 276.0172 [105,] 1 1081.681 276.0172 [106,] 1 1081.681 276.0172 [107,] 1 1081.681 276.0172 [108,] 1 1081.681 276.0172 [109,] 1 1081.681 276.0172 [110,] 1 1081.681 276.0172 [111,] 1 1081.681 276.0172 [112,] 1 1081.681 276.0172 [113,] 1 1081.681 276.0172 [114,] 1 1081.681 276.0172 [115,] 1 1081.681 276.0172 [116,] 1 1081.681 276.0172 [117,] 1 1081.681 276.0172 [118,] 1 1081.681 276.0172 [119,] 1 1081.681 276.0172 [120,] 1 1081.681 276.0172 [121,] 1 1081.681 276.0172 [122,] 1 1081.681 276.0172 [123,] 1 1081.681 276.0172 [124,] 1 1081.681 276.0172 [125,] 1 1081.681 276.0172 [126,] 1 1081.681 276.0172 [127,] 1 1081.681 276.0172 [128,] 1 1081.681 276.0172 [129,] 1 1081.681 276.0172 [130,] 1 1081.681 276.0172 [131,] 1 1081.681 276.0172 [132,] 1 1081.681 276.0172 [133,] 1 1081.681 276.0172 [134,] 1 1081.681 276.0172 [135,] 1 1081.681 276.0172 [136,] 1 1081.681 276.0172 [137,] 1 1081.681 276.0172 [138,] 1 1081.681 276.0172 [139,] 1 1081.681 276.0172 [140,] 1 1081.681 276.0172 [141,] 1 1081.681 276.0172 [142,] 1 1081.681 276.0172 [143,] 1 1081.681 276.0172 [144,] 1 1081.681 276.0172 [145,] 1 1081.681 276.0172 [146,] 1 1081.681 276.0172 [147,] 1 1081.681 276.0172 [148,] 1 1081.681 276.0172 [149,] 1 1081.681 276.0172 [150,] 1 1081.681 276.0172 [151,] 1 1081.681 276.0172 [152,] 1 1081.681 276.0172 [153,] 1 1081.681 276.0172 [154,] 1 1081.681 276.0172 [155,] 1 1081.681 276.0172 [156,] 1 1081.681 276.0172 [157,] 1 1081.681 276.0172 [158,] 1 1081.681 276.0172 [159,] 1 1081.681 276.0172 [160,] 1 1081.681 276.0172 [161,] 1 1081.681 276.0172 [162,] 1 1081.681 276.0172 [163,] 1 1081.681 276.0172 [164,] 1 1081.681 276.0172 [165,] 1 1081.681 276.0172 [166,] 1 1081.681 276.0172 [167,] 1 1081.681 276.0172 [168,] 1 1081.681 276.0172 [169,] 1 1081.681 276.0172 [170,] 1 1081.681 276.0172 [171,] 1 1081.681 276.0172 [172,] 1 1081.681 276.0172 [173,] 1 1081.681 276.0172 [174,] 1 1081.681 276.0172 [175,] 1 1081.681 276.0172 [176,] 1 1081.681 276.0172 [177,] 1 1081.681 276.0172 [178,] 1 1081.681 276.0172 [179,] 1 1081.681 276.0172 [180,] 1 1081.681 276.0172 [181,] 1 1081.681 276.0172 [182,] 1 1081.681 276.0172 [183,] 1 1081.681 276.0172 [184,] 1 1081.681 276.0172 [185,] 1 1081.681 276.0172 [186,] 1 1081.681 276.0172 [187,] 1 1081.681 276.0172 [188,] 1 1081.681 276.0172 [189,] 1 1081.681 276.0172 [190,] 1 1081.681 276.0172 [191,] 1 1081.681 276.0172 [192,] 1 1081.681 276.0172 [193,] 1 1081.681 276.0172 [194,] 1 1081.681 276.0172 [195,] 1 1081.681 276.0172 [196,] 1 1081.681 276.0172 [197,] 1 1081.681 276.0172 [198,] 1 1081.681 276.0172 [199,] 1 1081.681 276.0172 [200,] 1 1081.681 276.0172 attr(,"assign") [1] 0 1 2 attr(,"index") firm year 1 1 1935 2 1 1936 3 1 1937 4 1 1938 5 1 1939 6 1 1940 7 1 1941 8 1 1942 9 1 1943 10 1 1944 11 1 1945 12 1 1946 13 1 1947 14 1 1948 15 1 1949 16 1 1950 17 1 1951 18 1 1952 19 1 1953 20 1 1954 21 2 1935 22 2 1936 23 2 1937 24 2 1938 25 2 1939 26 2 1940 27 2 1941 28 2 1942 29 2 1943 30 2 1944 31 2 1945 32 2 1946 33 2 1947 34 2 1948 35 2 1949 36 2 1950 37 2 1951 38 2 1952 39 2 1953 40 2 1954 41 3 1935 42 3 1936 43 3 1937 44 3 1938 45 3 1939 46 3 1940 47 3 1941 48 3 1942 49 3 1943 50 3 1944 51 3 1945 52 3 1946 53 3 1947 54 3 1948 55 3 1949 56 3 1950 57 3 1951 58 3 1952 59 3 1953 60 3 1954 61 4 1935 62 4 1936 63 4 1937 64 4 1938 65 4 1939 66 4 1940 67 4 1941 68 4 1942 69 4 1943 70 4 1944 71 4 1945 72 4 1946 73 4 1947 74 4 1948 75 4 1949 76 4 1950 77 4 1951 78 4 1952 79 4 1953 80 4 1954 81 5 1935 82 5 1936 83 5 1937 84 5 1938 85 5 1939 86 5 1940 87 5 1941 88 5 1942 89 5 1943 90 5 1944 91 5 1945 92 5 1946 93 5 1947 94 5 1948 95 5 1949 96 5 1950 97 5 1951 98 5 1952 99 5 1953 100 5 1954 101 6 1935 102 6 1936 103 6 1937 104 6 1938 105 6 1939 106 6 1940 107 6 1941 108 6 1942 109 6 1943 110 6 1944 111 6 1945 112 6 1946 113 6 1947 114 6 1948 115 6 1949 116 6 1950 117 6 1951 118 6 1952 119 6 1953 120 6 1954 121 7 1935 122 7 1936 123 7 1937 124 7 1938 125 7 1939 126 7 1940 127 7 1941 128 7 1942 129 7 1943 130 7 1944 131 7 1945 132 7 1946 133 7 1947 134 7 1948 135 7 1949 136 7 1950 137 7 1951 138 7 1952 139 7 1953 140 7 1954 141 8 1935 142 8 1936 143 8 1937 144 8 1938 145 8 1939 146 8 1940 147 8 1941 148 8 1942 149 8 1943 150 8 1944 151 8 1945 152 8 1946 153 8 1947 154 8 1948 155 8 1949 156 8 1950 157 8 1951 158 8 1952 159 8 1953 160 8 1954 161 9 1935 162 9 1936 163 9 1937 164 9 1938 165 9 1939 166 9 1940 167 9 1941 168 9 1942 169 9 1943 170 9 1944 171 9 1945 172 9 1946 173 9 1947 174 9 1948 175 9 1949 176 9 1950 177 9 1951 178 9 1952 179 9 1953 180 9 1954 181 10 1935 182 10 1936 183 10 1937 184 10 1938 185 10 1939 186 10 1940 187 10 1941 188 10 1942 189 10 1943 190 10 1944 191 10 1945 192 10 1946 193 10 1947 194 10 1948 195 10 1949 196 10 1950 197 10 1951 198 10 1952 199 10 1953 200 10 1954 > > #### "random" results in error > # model.matrix(fe2_unbal, model = "random") > > proc.time() user system elapsed 2.62 0.40 2.96 plm/inst/tests/test_pdata.frame_subsetting.R0000644000176200001440000003213414154734502021004 0ustar liggesusers# various test of subsetting ("indexing") a pdata.frame and a pseries (the latter currently commented), # e.g., that subsetting by rownames preserves the index # (pre rev. 187/189 all entries were set to NA) # (pre rev. 251 subsetting a pdata.frame added extra information due to coercing rules of "[.data.frame") # (pre rev. 668 subsetting a pdata.frame with [.pdata.frame such that a single column (pseries) is returned was lacking names) library(plm) data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) # subsetting with [] with rownames - works attr(pGrunfeld[c("1-1935"), ], which = "index") attr(pGrunfeld[c("1-1935", "1-1936"), ], which = "index") if (anyNA(attr(pGrunfeld[c("1-1935"), ], which = "index"))) stop("FAIL: NA in index") if (anyNA(attr(pGrunfeld[c("1-1935", "1-1936"), ], which = "index"))) stop("FAIL: NA in index") # subsetting with [] by line number works (indexes preserved) if (!all(attr(pGrunfeld[c(1), ], which = "index") == c(1, 1935))) stop("wrong index!") if (!all(attr(pGrunfeld[c(1,2), ], which = "index") == data.frame(firm = c(1,1), year = c(1935, 1936)))) stop("wrong index!") if (anyNA(attr(pGrunfeld[c(1), ], which = "index"))) stop("FAIL: NA in index") if (anyNA(attr(pGrunfeld[c(1,2), ], which = "index"))) stop("FAIL: NA in index") # subsetting with [[]] works (indexes preserved) attr(pGrunfeld[["inv"]], which = "index") attr(pGrunfeld[[3]], which = "index") if (anyNA(attr(pGrunfeld[["inv"]], which = "index"))) stop("FAIL: NA in index") if (anyNA(attr(pGrunfeld[[3]], which = "index"))) stop("FAIL: NA in index") # check that extracting a single column (which becomes a pseries) yield the same # result for the three extraction methods $.pdata.freme, [[.pdata.frame, and [.pdata.frame extr1 <- pGrunfeld$inv extr2 <- pGrunfeld[["inv"]] extr3 <- pGrunfeld[ , "inv"] if (!isTRUE(all.equal(extr1, extr2))) stop("extraction of single column (pseries) does not yield same results for $.pdata.frame and [[.pdata.frame") if (!isTRUE(all.equal(extr1, extr3))) stop("extraction of single column (pseries) does not yield same results for $.pdata.frame and [.pdata.frame") # check that row names are kept and subsetted by [.pdata.frame when a single column (pseries) is returned if (!isTRUE(all.equal(names(pGrunfeld[1:5 , "inv"]), row.names(pGrunfeld)[1:5]))) stop("row names not correctly subsetted by [.pdata.frame") ############ subsetting used to change the pdata.frame ########## since rev.252 this is fully fixed (rev. 251 already fixed large parts of this), ########## pre rev 251 a lot of unnecessary information was added to the pdata.frame by subsetting # this should yield a structurally identical pdata.frame as all rows are extracted: Grunfeld2 <- Grunfeld[1:nrow(Grunfeld), ] pGrunfeld2 <- pGrunfeld[1:nrow(pGrunfeld), ] identical(Grunfeld, Grunfeld2) # TRUE for data.frame identical(pGrunfeld, pGrunfeld2) # TRUE for pdata.frame (was FALSE pre rev. 252) if (!identical(pGrunfeld, pGrunfeld2)) stop("pdata.frame not identical after \"subsetting\" with all rows (which should actually not do any subsetting))") ### compare object sizes # object.size(pGrunfeld) # 37392 bytes # object.size(pGrunfeld2) # 37392 bytes since rev. 252 # (was: 83072 bytes in pre rev.251, considerably larger!) # (was: 26200 bytes in rev. 251) # if (!object.size(pGrunfeld) == object.size(pGrunfeld2)) # print("pdata.frame not same object size after \"subsetting\" with all rows (which should actually not do any subsetting))") # this is likely to be unnecessarily pedantic, because by default attrib.as.set is TRUE # and from ?attributes "Attributes are not stored internally as a list and should be # thought of as a set and not a vector." identical(Grunfeld, Grunfeld2, attrib.as.set = FALSE) # TRUE for data.frame identical(pGrunfeld, pGrunfeld2, attrib.as.set = FALSE) # TRUE for pdata.frame [but was false prior to rev. 1271] # display differences (if any) [with rev. 252 there should be no differences left] all.equal(pGrunfeld, pGrunfeld2) all.equal(pGrunfeld, pGrunfeld2, check.attributes = FALSE) # compare::compare(pGrunfeld, pGrunfeld2, allowAll = TRUE) # Unused levels from the index attribute of a pdata.frame shall be dropped # (NB: unused levels are not dropped from the variables of the pdata.frame as this is standard R behaviour) pGrunfeld_sub_id <- pGrunfeld[-c(1:20), ] # drop first individual (1st ind. is in first 20 rows) if (!isTRUE(all.equal(levels(attr(pGrunfeld_sub_id, "index")[[1]]), levels(factor(2:10))))) stop("unused levels from index (individual) not dropped") pGrunfeld_sub_year <- pGrunfeld[!pGrunfeld$year %in% "1936", ] # drop year 1936 if (!isTRUE(all.equal(levels(attr(pGrunfeld_sub_year, "index")[[2]]), levels(factor(c(1935, 1937:1954)))))) stop("unused levels from index (time) not dropped") #### test estimation by plm on a subsetted pdata.frame (failed pre rev. 251) pGrunfeld_sub <- pGrunfeld[c(23:99), ] plm(inv ~ value + capital, data = pGrunfeld[c(23:99), ]) # failed pre rev.251 # classes of index of pdata.frame and subsetted pdata.frame are the same 'pindex' and 'data.frame') class(attr(pGrunfeld, which="index")) class(attr(pGrunfeld$inv, which="index")) if (!all(class(attr(pGrunfeld, which="index")) == class(attr(pGrunfeld$inv, which="index")))) stop("classes differ!") # classes of index of columns of pdata.frame and subsetted pdata.frame must be the same 'pindex' and 'data.frame') class(attr(pGrunfeld$inv, which="index")) class(attr(pGrunfeld_sub$inv, which="index")) if (!all(class(attr(pGrunfeld$inv, which="index")) == class(attr(pGrunfeld_sub$inv, which="index")))) stop("classes differ!") ############ further testing subsetting of pdata.frame and its index # up to rev.254 subsetting by [i] (with missing j) did not mimic data.frame behavior in case of missing j (j as in [i, j]) # fixed in rev.255 data("Grunfeld", package = "plm") X <- Grunfeld pX <- pdata.frame(X) ###### test dimensions of subsetted pdata.frame if (!isTRUE(all.equal(dim(X[]), dim(pX[])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , ]), dim(pX[ ,])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , , ]), dim(pX[ , , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , , drop = TRUE]), dim(pX[ , , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , , drop = FALSE]), dim(pX[ , , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, 2:4]), dim(pX[1:10, 2:4])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, 2:4, drop = TRUE]), dim(pX[1:10, 2:4, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, 2:4, drop = FALSE]), dim(pX[1:10, 2:4, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, , ]), dim(pX[1:10, , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, , drop = TRUE]), dim(pX[1:10, , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, , drop = FALSE]), dim(pX[1:10, , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:10, ]), dim(pX[1:10, ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, ]), dim(pX[1, ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1]), dim(pX[1])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, drop = TRUE]), dim(pX[1, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, drop = FALSE]), dim(pX[1, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:2]), dim(pX[1:2])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:2, drop = TRUE]), dim(pX[1:2, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1:2, drop = FALSE]), dim(pX[1:2, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 2:4]), dim(pX[ , 2:4])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 2:4, drop = TRUE]), dim(pX[ , 2:4, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 2:4 ,drop = FALSE]), dim(pX[ , 2:4, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 3]), dim(pX[ , 3])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 3, drop = TRUE]), dim(pX[ , 3, drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[ , 3, drop = FALSE]), dim(pX[ , 3, drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, , ]), dim(pX[1, , ])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, , drop = TRUE]), dim(pX[1, , drop = TRUE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") if (!isTRUE(all.equal(dim(X[1, , drop = FALSE]), dim(pX[1, , drop = FALSE])))) stop("dimensions of data.frame and pdata.frame not equal after subsetting") ###### test dimensions of index of subsetted pdata.frame if (!all(c(dim(pX[1:10, 2:4])[1], 2L) == dim(attr(pX[1:10, 2:4], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[1:10, ])[1], 2L) == dim(attr(pX[1:10, ], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[ , 2:4])[1], 2L) == dim(attr(pX[ , 2:4], "index")))) stop("index has wrong dimension after subsetting") # NB: this is class c("pseries", "numeric), need length here if (!all(c(length(pX[ , 3]), 2L) == dim(attr(pX[ , 3], "index")))) stop("index has wrong dimension after subsetting") # NB: this is class c("pseries", "numeric), need length here if (!all(c(length(pX[ , 3, drop = TRUE]), 2L) == dim(attr(pX[ , 3, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") # need dim again here, because drop = FALSE if (!all(c(dim(pX[ , 3, drop = FALSE])[1], 2L) == dim(attr(pX[ , 3, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") # NB: this is a list! has no index anymore length(pX[1, , drop = TRUE]) # NB: this a a pdata.frame (drop = FALSE) if (!all(c(dim(pX[1, , drop = FALSE])[1], 2L) == dim(attr(pX[1, , drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") # case of [i]-indexing with missing j: index must be have full rows # dim of pdata.frame: 25, 3 if (!all(c(dim(pX[2:4])[1], 2L) == dim(attr(pX[2:4], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[2:4, drop = TRUE])[1], 2L) == dim(attr(pX[2:4, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[2:4, drop = FALSE])[1], 2L) == dim(attr(pX[2:4, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[1])[1], 2L) == dim(attr(pX[1], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[1, drop = TRUE])[1], 2L) == dim(attr(pX[1, drop = TRUE], "index")))) stop("index has wrong dimension after subsetting") if (!all(c(dim(pX[1, drop = FALSE])[1], 2L) == dim(attr(pX[1, drop = FALSE], "index")))) stop("index has wrong dimension after subsetting") ####### test return values (named) numeric(0) etc and especially NULL ## compare pdata.frame() to data.frame() in case of subsetting with non-existent return values # firm 31 is non-existent # valueNonExistent is non-existent pGrunfeld[pGrunfeld$firm == "31"] Grunfeld[Grunfeld$firm == "31"] pGrunfeld[pGrunfeld$firm == "31", "value"] Grunfeld[Grunfeld$firm == "31", "value"] #### since R 3.4.0 the following two cases gave a warning which was pacified in rev. 626 pGrunfeld[pGrunfeld$firm == "31", "valueNonExistent"] Grunfeld[Grunfeld$firm == "31", "valueNonExistent"] # with existent firm 19 pGrunfeld[pGrunfeld$firm == "19", "valueNonExistent"] Grunfeld[Grunfeld$firm == "19", "valueNonExistent"] plm/inst/tests/test_pdwtest.Rout.save0000644000176200001440000001056414126045024017526 0ustar liggesusers R version 4.1.1 (2021-08-10) -- "Kick Things" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## Test if pdwtest gives the same values for statistic and p-value for pooling and FE model > ## as lmtest::dwtest > ## > ## bug fixed in rev. 127 / 2015-08-14 > > library(plm) > library(lmtest) Loading required package: zoo Attaching package: 'zoo' The following objects are masked from 'package:base': as.Date, as.Date.numeric > data("Grunfeld", package = "plm") > > # Use lm() for pooled OLS and fixed effects > lm_pool <- lm(inv ~ value + capital, data = Grunfeld) > lm_fe <- lm(inv ~ value + capital + factor(firm), data = Grunfeld) > > # Use plm() for pooled OLS and fixed effects > plm_pool <- plm(inv ~ value + capital, data=Grunfeld, model = "pooling") > plm_fe <- plm(inv ~ value + capital, data=Grunfeld, model = "within") > > # pre-check: Are the residuals for the pooled OLS and fixed effects model by plm() and lm() the same? > if (!isTRUE(all.equal(as.numeric(residuals(plm_pool)), residuals(lm_pool), check.attributes = FALSE))) stop("pooling residuals not equal") > if (!isTRUE(all.equal(as.numeric(residuals(plm_fe)), residuals(lm_fe), check.attributes = FALSE))) stop("FE residuals not equal") > > # check if statistics and p-values match > res_dwtest_pool <- lmtest::dwtest(lm_pool) > res_dwtest_fe <- lmtest::dwtest(lm_fe) > res_pdwtest_pool <- pdwtest(plm_pool) > res_pdwtest_fe <- pdwtest(plm_fe) > > if (!isTRUE(all.equal(res_dwtest_pool$statistic, res_pdwtest_pool$statistic))) stop("statistics do not match!") > if (!isTRUE(all.equal(res_dwtest_pool$p.value, res_pdwtest_pool$p.value))) stop("p-values do not match!") > > if (!isTRUE(all.equal(res_dwtest_fe$statistic, res_pdwtest_fe$statistic))) stop("statistics do not match!") > if (!isTRUE(all.equal(res_dwtest_fe$p.value, res_pdwtest_fe$p.value))) stop("p-values do not match!") > > # test for passing of arguments in ellipsis (...) > res_dwtest_pool_alt2 <- lmtest::dwtest(lm_pool, alternative = "two.sided") > res_pdwtest_pool_alt2 <- pdwtest(plm_pool, alternative = "two.sided") > if (!isTRUE(all.equal(res_dwtest_pool_alt2$statistic, res_pdwtest_pool_alt2$statistic))) stop("statistics do not match! Arg 'alternative' likely not respected") > > # simple run tests > pdwtest(inv ~ value + capital, data = Grunfeld) Durbin-Watson test for serial correlation in panel models data: inv ~ value + capital DW = 0.35819, p-value < 2.2e-16 alternative hypothesis: serial correlation in idiosyncratic errors > pdwtest(inv ~ value + capital, data = Grunfeld, model = "random", effect = "twoways") Durbin-Watson test for serial correlation in panel models data: inv ~ value + capital DW = 0.99866, p-value = 3.189e-13 alternative hypothesis: serial correlation in idiosyncratic errors > pdwtest(inv ~ value + capital, data = Grunfeld, model = "random", effect = "twoways", alternative = "two.sided") Durbin-Watson test for serial correlation in panel models data: inv ~ value + capital DW = 0.99866, p-value = 6.378e-13 alternative hypothesis: serial correlation in idiosyncratic errors > # exact = T (but not exact = TRUE) fails up to at least rev. 408 > pdwtest(inv ~ value + capital, data = Grunfeld, model = "pooling", effect = "individual", alternative = "two.sided", exact = TRUE) Durbin-Watson test for serial correlation in panel models data: inv ~ value + capital DW = 0.35819, p-value < 2.2e-16 alternative hypothesis: serial correlation in idiosyncratic errors > # pdwtest(inv ~ value + capital, data = Grunfeld, model = "pooling", effect = "individual", alternative = "two.sided", exact = T) > # pdwtest(plm_pool, alternative = "two.sided", exact = T) > ## Error in if (exact) { : argument is not interpretable as logical > > proc.time() user system elapsed 4.20 0.39 4.78 plm/inst/tests/test_plmtest_unbalanced.Rout.save0000644000176200001440000006213614154734502021711 0ustar liggesusers R version 3.6.2 (2019-12-12) -- "Dark and Stormy Night" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # Test of new plmtest implementation (handling unbalanced panels) > # > # compare to grunfeld data example in Baltagi (2013), Econometric Analysis of Panel Data, 5th ed., p. 74-75 (Table 4.1/4.2) > # also Baltagi (2005), Econometric Analysis of Panel Data, 3rd ed., p. 65-66 (just Table 4.1, > # table 4.2 in Baltagi (2005) is only Stata's xttest0 > # for Breusch-Pagan with chi2(1) = 798.16, Prob > chi2 = 0.0000) > # > # => statistics and p-values match => implementation of balanced tests is ok. > # > # The text book only supplies examples for the balanced Grunfeld data > # Thus, there are no reference values for an _un_balanced data set. > # -> compare calculation of EViews on an unbalanced data set (grunfeld without last observation) > > # unbalanced formulas reduce in the case of a balanced panel to the formula for balanced panels: > # > # balanced panel: => test output as in the text book => implementation is ok. > # unbalanced panel: => test statistics for unbalanced panel differ from balanced panel > # => test matches calculation of EViews > > # Tables from Baltagi > # > # Table 4.1 > ############ [statistic (critical values at 5% level)] > ## note: SLM statistic is not implemented in plm > # ind time twoways > #--------------------------------- > # [...] > > ##### Grunfeld data set - balanced #### > # Table 4.2 [Output from EViews], similiar 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 > ##### In (at least) EViews 9, the LM tests are implemented, no need for add-in; > ##### SLM is not outputted anymore but std. Honda and std. KW > ##### and p-values for negative one-sided statistics are not > ##### printed anymore (see unbalanced example below). > ########### [statistic (p-values)] > # ind time twoways > #--------------------------------- > ## note: SLM statistic is not implemented in plm > # [...] > > ############ unbalanced ########################################## > ##### Grunfeld unbalanced data set [see below] > ##### (last observation deleted, i. e. first 199 obs) > # Own computation with EViews 9 > ##### In EViews 9, the LM tests are implemented, no need for add-in anymore; > ##### SLM is not outputted but std. Honda and std. KW > ##### p-values for the negative one-sided statistics > ##### [in this example (std.) Honda, KW] > ##### are not printed in EViews 9; from the help file: > > ########### [statistic (p-values)] > # ind time twoways > #--------------------------------- > # [...] > # > ## note: standardizised HO statistic is not implemented in plm > ## note: standardizised KW statistic is not implemented in plm > > > options(digits = 10) > Sys.setenv(LANG = "en") > require(plm) Loading required package: plm > data("Grunfeld", package = "plm") > Grunfeldpdata <- pdata.frame(Grunfeld, index = c("firm", "year"), drop.index = FALSE, row.names = TRUE) > > fe_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="within") > re_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="random") > pool_grunfeld <- plm(inv ~ value + capital, data=Grunfeldpdata, model="pooling") > > > > # Make an unbalanced data set > Grunfeldpdata_unbalanced <- Grunfeld[1:(nrow(Grunfeld)-1), ] > Grunfeldpdata_unbalanced <- pdata.frame(Grunfeldpdata_unbalanced, index=c("firm"), drop.index = F) > fe_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="within") > re_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="random") > pool_grunfeld_unbalanced <- plm(inv ~ value + capital, data=Grunfeldpdata_unbalanced, model="pooling") > > > # Produc > # data("Produc", package = "plm") > # form_produc <- formula(gsp ~ log(pc) + log(pcap) + log(emp) + unemp) > # produc_pool <- plm(form_produc, data = Produc, model="pooling") > > # Hedonic > # Stastics heavily differ for this unbalanced data, depending on one applies the > # balanced tests (v1.4-0) to this unbalanced data or the unbalanced test > # > # balanced test of v1.4-0: 849.45815 (individual effects) and 600.20821 (time effects) > # unbalanced test: 25.011274 (individual effects) and 1.5571417 (time effects) > data("Hedonic", package = "plm") > pHedonic <- pdata.frame(Hedonic, index = "townid", drop.index = F) > form_hedonic <- formula(mv ~ crim) > hedonic_pool <- plm(form_hedonic, data = pHedonic, model="pooling") > plmtest(hedonic_pool) Lagrange Multiplier Test - (Honda) for unbalanced panels data: form_hedonic normal = 25.011274, p-value < 2.2204e-16 alternative hypothesis: significant effects > plmtest(hedonic_pool, effect = "time") Lagrange Multiplier Test - time effects (Honda) for unbalanced panels data: form_hedonic normal = 1.5571417, p-value = 0.05971842 alternative hypothesis: significant effects > > > ### generalized version of plmtest() to handle also unbalanced panels > > # individual effect > print(honda_ind <- plmtest(pool_grunfeld, type="honda")) Lagrange Multiplier Test - (Honda) for balanced panels data: inv ~ value + capital normal = 28.251753, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(honda_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda")) Lagrange Multiplier Test - (Honda) for unbalanced panels data: inv ~ value + capital normal = 28.225193, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_ind <- plmtest(pool_grunfeld, type="bp")) Lagrange Multiplier Test - (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 798.16155, df = 1, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp")) Lagrange Multiplier Test - (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 796.66152, df = 1, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_ind <- plmtest(pool_grunfeld, type="kw")) Lagrange Multiplier Test - (King and Wu) for balanced panels data: inv ~ value + capital normal = 28.251753, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_ind_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw")) Lagrange Multiplier Test - (King and Wu) for unbalanced panels data: inv ~ value + capital normal = 28.225193, p-value < 2.2204e-16 alternative hypothesis: significant effects > # Note: ghm is only for twoways, hence not in this section > > # time effect > print(honda_time <- plmtest(pool_grunfeld, type="honda", effect="time")) Lagrange Multiplier Test - time effects (Honda) for balanced panels data: inv ~ value + capital normal = -2.5404491, p-value = 0.9944645 alternative hypothesis: significant effects > print(honda_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda", effect="time")) Lagrange Multiplier Test - time effects (Honda) for unbalanced panels data: inv ~ value + capital normal = -2.5405861, p-value = 0.9944667 alternative hypothesis: significant effects > print(bp_time <- plmtest(pool_grunfeld, type="bp", effect="time")) Lagrange Multiplier Test - time effects (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 6.4538816, df = 1, p-value = 0.01107102 alternative hypothesis: significant effects > print(bp_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp", effect="time")) Lagrange Multiplier Test - time effects (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 6.4545778, df = 1, p-value = 0.01106668 alternative hypothesis: significant effects > print(kw_time <- plmtest(pool_grunfeld, type="kw", effect="time")) Lagrange Multiplier Test - time effects (King and Wu) for balanced panels data: inv ~ value + capital normal = -2.5404491, p-value = 0.9944645 alternative hypothesis: significant effects > print(kw_time_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw", effect="time")) Lagrange Multiplier Test - time effects (King and Wu) for unbalanced panels data: inv ~ value + capital normal = -2.5405861, p-value = 0.9944667 alternative hypothesis: significant effects > # Note: ghm is only for twoways, hence not in this section > > # twoways effect > print(honda_tw <- plmtest(pool_grunfeld, type="honda", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Honda) for balanced panels data: inv ~ value + capital normal = 18.180637, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(honda_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="honda", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Honda) for unbalanced panels data: inv ~ value + capital normal = 18.16176, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_tw <- plmtest(pool_grunfeld, type="bp", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 804.61543, df = 2, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="bp", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 803.1161, df = 2, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_tw <- plmtest(pool_grunfeld, type="kw", effect="twoways")) Lagrange Multiplier Test - two-ways effects (King and Wu) for balanced panels data: inv ~ value + capital normal = 21.832209, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="kw", effect="twoways")) Lagrange Multiplier Test - two-ways effects (King and Wu) for unbalanced panels data: inv ~ value + capital normal = 21.810252, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(ghm_tw <- plmtest(pool_grunfeld, type="ghm", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Gourieroux, Holly and Monfort) for balanced panels data: inv ~ value + capital chibarsq = 798.16155, df0 = 0.00, df1 = 1.00, df2 = 2.00, w0 = 0.25, w1 = 0.50, w2 = 0.25, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(ghm_tw_unbalanced <- plmtest(pool_grunfeld_unbalanced, type="ghm", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Gourieroux, Holly and Monfort) for unbalanced panels data: inv ~ value + capital chibarsq = 796.66152, df0 = 0.00, df1 = 1.00, df2 = 2.00, w0 = 0.25, w1 = 0.50, w2 = 0.25, p-value < 2.2204e-16 alternative hypothesis: significant effects > > > > ### Test of formula interface > > # individual effect > print(honda_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda")) Lagrange Multiplier Test - (Honda) for balanced panels data: inv ~ value + capital normal = 28.251753, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(honda_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda")) Lagrange Multiplier Test - (Honda) for unbalanced panels data: inv ~ value + capital normal = 28.225193, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp")) Lagrange Multiplier Test - (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 798.16155, df = 1, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp")) Lagrange Multiplier Test - (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 796.66152, df = 1, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_ind_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw")) Lagrange Multiplier Test - (King and Wu) for balanced panels data: inv ~ value + capital normal = 28.251753, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_ind_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw")) Lagrange Multiplier Test - (King and Wu) for unbalanced panels data: inv ~ value + capital normal = 28.225193, p-value < 2.2204e-16 alternative hypothesis: significant effects > # Note: ghm is only for twoways, hence not in this section > > # time effect > print(honda_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda", effect="time")) Lagrange Multiplier Test - time effects (Honda) for balanced panels data: inv ~ value + capital normal = -2.5404491, p-value = 0.9944645 alternative hypothesis: significant effects > print(honda_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda", effect="time")) Lagrange Multiplier Test - time effects (Honda) for unbalanced panels data: inv ~ value + capital normal = -2.5405861, p-value = 0.9944667 alternative hypothesis: significant effects > print(bp_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp", effect="time")) Lagrange Multiplier Test - time effects (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 6.4538816, df = 1, p-value = 0.01107102 alternative hypothesis: significant effects > print(bp_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp", effect="time")) Lagrange Multiplier Test - time effects (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 6.4545778, df = 1, p-value = 0.01106668 alternative hypothesis: significant effects > print(kw_time_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw", effect="time")) Lagrange Multiplier Test - time effects (King and Wu) for balanced panels data: inv ~ value + capital normal = -2.5404491, p-value = 0.9944645 alternative hypothesis: significant effects > print(kw_time_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw", effect="time")) Lagrange Multiplier Test - time effects (King and Wu) for unbalanced panels data: inv ~ value + capital normal = -2.5405861, p-value = 0.9944667 alternative hypothesis: significant effects > # Note: ghm is only for twoways, hence not in this section > > # twoways effect > print(honda_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="honda", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Honda) for balanced panels data: inv ~ value + capital normal = 18.180637, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(honda_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="honda", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Honda) for unbalanced panels data: inv ~ value + capital normal = 18.16176, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="bp", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Breusch-Pagan) for balanced panels data: inv ~ value + capital chisq = 804.61543, df = 2, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(bp_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="bp", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Breusch-Pagan) for unbalanced panels data: inv ~ value + capital chisq = 803.1161, df = 2, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="kw", effect="twoways")) Lagrange Multiplier Test - two-ways effects (King and Wu) for balanced panels data: inv ~ value + capital normal = 21.832209, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(kw_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="kw", effect="twoways")) Lagrange Multiplier Test - two-ways effects (King and Wu) for unbalanced panels data: inv ~ value + capital normal = 21.810252, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(ghm_tw_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata, type="ghm", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Gourieroux, Holly and Monfort) for balanced panels data: inv ~ value + capital chibarsq = 798.16155, df0 = 0.00, df1 = 1.00, df2 = 2.00, w0 = 0.25, w1 = 0.50, w2 = 0.25, p-value < 2.2204e-16 alternative hypothesis: significant effects > print(ghm_tw_unbalanced_form <- plmtest(inv ~ value + capital, data=Grunfeldpdata_unbalanced, type="ghm", effect="twoways")) Lagrange Multiplier Test - two-ways effects (Gourieroux, Holly and Monfort) for unbalanced panels data: inv ~ value + capital chibarsq = 796.66152, df0 = 0.00, df1 = 1.00, df2 = 2.00, w0 = 0.25, w1 = 0.50, w2 = 0.25, p-value < 2.2204e-16 alternative hypothesis: significant effects > > # Should all be TRUE > if(!all( + identical(honda_ind, honda_ind_form), + identical(honda_ind_unbalanced, honda_ind_unbalanced_form), + identical(bp_ind, bp_ind_form), + identical(bp_ind_unbalanced, bp_ind_unbalanced_form), + identical(kw_ind, kw_ind_form), + identical(kw_ind_unbalanced, kw_ind_unbalanced_form), + + identical(honda_time, honda_time_form), + identical(honda_time_unbalanced, honda_time_unbalanced_form), + identical(bp_time, bp_time_form), + identical(bp_time_unbalanced, bp_time_unbalanced_form), + identical(kw_time, kw_time_form), + identical(kw_time_unbalanced, kw_time_unbalanced_form), + + identical(honda_tw, honda_tw_form), + identical(honda_tw_unbalanced, honda_tw_unbalanced_form), + identical(bp_tw, bp_tw_form), + identical(bp_tw_unbalanced, bp_tw_unbalanced_form), + identical(kw_tw, kw_tw_form), + identical(kw_tw_unbalanced, kw_tw_unbalanced_form), + identical(ghm_tw, ghm_tw_form), + identical(ghm_tw_unbalanced, ghm_tw_unbalanced_form))) stop("results of plm and formula interface differ!") > > > # Tests - unbalanced - statistics should be "sufficiently different" from balanced statistics, > # thus results should be TRUE > > # individual > abs(honda_ind_unbalanced$statistic - honda_ind$statistic) > 0.0001 normal TRUE > abs(bp_ind_unbalanced$statistic - bp_ind$statistic) > 0.0001 chisq TRUE > abs(kw_ind_unbalanced$statistic - kw_ind$statistic) > 0.0001 normal TRUE > > # time > abs(honda_time_unbalanced$statistic - honda_time$statistic) > 0.0001 normal TRUE > abs(bp_time_unbalanced$statistic - bp_time$statistic) > 0.0001 chisq TRUE > abs(kw_time_unbalanced$statistic - kw_time$statistic) > 0.0001 normal TRUE > > # twoways > abs(honda_tw_unbalanced$statistic - honda_tw$statistic) > 0.0001 normal TRUE > abs(bp_tw_unbalanced$statistic - bp_tw$statistic) > 0.0001 chisq TRUE > abs(kw_tw_unbalanced$statistic - kw_tw$statistic) > 0.0001 normal TRUE > abs(ghm_tw_unbalanced$statistic - ghm_tw$statistic) > 0.0001 chibarsq TRUE > > > > > > > ########## resamble critical values at alpha = 0.05 from Table 4.1 (Baltagi (2013), p. 74) > alpha <- 0.05 > > #### honda and kw oneway and twoway -> 1.645 > qnorm(alpha, lower.tail = F) [1] 1.644853627 > # => > pnorm(qnorm(alpha, lower.tail = F), lower.tail = F) [1] 0.05 > > # honda (kw) p-value implementation as in plm_v1.4-0 (CRAN as of 2015-11-08): > # leads to the 10% level (not 5%): > # see also above the table for the unbalanced Grunfeld data on how EViews handles negative statistics for Honda and KW > pnorm(abs(1.645), lower.tail = FALSE)*2 # CRAN v1.4-0 [1] 0.09996981108 > # correct is -> p=0.05 > pnorm(abs(1.645), lower.tail = FALSE) [1] 0.04998490554 > > > #### bp: df=1 (oneway) -> 3.841 > #### df=2 (twoway) -> 5.991 > qchisq(alpha, df=1, lower.tail = F) # H0_a, H0_b [1] 3.841458821 > qchisq(alpha, df=2, lower.tail = F) # H0_c [1] 5.991464547 > # => > pchisq(qchisq(alpha, df = 1, lower.tail = F), df=1, lower.tail = F) [1] 0.05 > pchisq(qchisq(alpha, df = 2, lower.tail = F), df=2, lower.tail = F) [1] 0.05 > > > > #### ghm test for p-value of mixed chi-square distribution (more often called chi-bar-square) > # as implemented in fixed version. > # (was simple chisquare in plm_v1.4-0 on CRAN -> wrong) > # > # Baltagi (2013), p. 88 (note 2), p. 209 (note 10) gives critical values for 0.01, 0.05, 0.10 levels > # 4.321 is a typo in the notes of Baltagi's textbook, should be 4.231 [confirmed by private email from Badi Baltagi] > crit <- c(7.289, 4.231, 2.952) # without typo > # crit <- c(7.289, 4.312, 2.952) # with typo from text book > p.vals <- (1/4)*pchisq(crit, df=0, lower.tail = F) + (1/2) * pchisq(crit, df=1, lower.tail = F) + (1/4) * pchisq(crit, df=2, lower.tail = F) > > > # Baltagi (2013), p. 73, 74 contains another example of the mixed chi-square (chi-bar-square) distibution of another statistic > # The p-values for that example is also reassembled here > crit_2 <- c(2.706) # for alpha=0.05 > p.val_2 <- (1/2)*pchisq(crit_2, df=0, lower.tail = F) + (1/2) * pchisq(crit_2, df=1, lower.tail = F) > > > > > ################# Replicate an example from Stata > ## example 1 in this manual: > ## http://www.stata.com/manuals/xtxtregpostestimation.pdf > ## It is an unbalanced panel > > # require(haven) # required to read Stata data file > # nlswork <- read_dta("http://www.stata-press.com/data/r14/nlswork.dta") > # nlswork$race <- factor(nlswork$race) # fix data > # nlswork$race2 <- factor(ifelse(nlswork$race == 2, 1, 0)) # need this variable for example > # pnlswork <- pdata.frame(nlswork, index=c("idcode", "year"), drop.index=F) > # > # # note STAT 14 uses by default a different method compared to plm's Swamy–Arora variance component estimator > # # This is why in comparison with web examples from Stata the random effects coefficients slightly differ > # plm_re_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south > # , data = pnlswork, model = "random") > # > # # reassembles the FE estimation by Stata in Example 2 of http://www.stata.com/manuals13/xtxtreg.pdf > # plm_fe_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south > # , data = pnlswork, model = "within") > # > # plm_pool_nlswork <- plm(ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + I(tenure^2) + race2 + not_smsa + south > # , data = pnlswork, model = "pooling") > # > # > # # Reassembles Exmaple 1 in http://www.stata.com/manuals14/xtxtregpostestimation.pdf > # # use modified plmtest() as a wrapper > # options(digits = 10) > # plmtest(plm_pool_nlswork, type="bp") > # > # # ## Lagrange Multiplier Test - individual effects - Breusch-Pagan Test for unbalanced Panels as in Baltagi/Li (1990) > # # ## data: ln_wage ~ grade + age + I(age^2) + ttl_exp + I(ttl_exp^2) + tenure + ... > # # ## BP_unbalanced = 14779.984, df = 1, p-value < 2.2204e-16 > # # ## alternative hypothesis: significant effects > > > > proc.time() user system elapsed 0.875 0.050 0.919 plm/inst/removed/0000755000176200001440000000000014165357232013470 5ustar liggesusersplm/inst/removed/pFormula.Rd0000644000176200001440000000323714124132276015543 0ustar liggesusers% model.frame and model.matrix documented separate file \name{pFormula} \alias{pFormula} \alias{as.Formula.pFormula} \title{pFormula: An extended Formula interface for panel data} \description{pFormula is a Formula object used in the plm package. } \usage{ pFormula(object) \S3method{as.Formula}{pFormula}(x, \dots) } \arguments{ \item{object}{an object of class \code{"formula"}, the formula to be coerced to class \code{"pFormula"},} \item{x}{an object of class \code{"pFormula"}, to be coerced to \code{class{"Formula"}},} \item{\dots}{further arguments.} } \value{ For \code{pFormula}, the return value is an object of class \code{c("pFormula", "Formula", "formula")}.\cr For \code{as.Formula}, the return value is an object of class \code{c("Formula", "formula")}.\cr } % \details{ % } % \references{ % } \seealso{ \code{plm}'s \code{\link[plm]{model.frame}} and \code{\link[plm]{model.matrix}} to create a model frame for panel data and a model matrix with data transformations applied, respectively.\cr \code{plm}'s \code{\link{pmodel.response}} for (transformed) response variable.\cr \code{\link[Formula]{Formula}} from package \code{Formula}. } \examples{ # First, make a pdata.frame data("Grunfeld", package = "plm") pGrunfeld <- pdata.frame(Grunfeld) # then make a model frame from a pFormula and a pdata.frame pform <- pFormula(inv ~ value + capital) mf <- model.frame(pform, data = pGrunfeld) # then construct the (transformed) model matrix (design matrix) # from formula and model frame modmat <- model.matrix(pform, data = mf, model = "within") } \author{Yves Croissant} \keyword{classes} plm/inst/removed/test_model.matrix_pmodel.response_NA.R0000644000176200001440000003662614124132276023037 0ustar liggesusers## 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 # 1) model.matrix[.pFormula|.plm] # 2) pmodel.response.[pFormula|.plm] library(plm) data("Grunfeld", package="plm") form <- formula(inv ~ value + capital) plm_pool <- plm(form, data=Grunfeld, model="pooling") plm_fe <- plm(form, data=Grunfeld, model="within") plm_fe_tw <- plm(form, data=Grunfeld, model="within", effect = "twoways") plm_re <- plm(form, data=Grunfeld, model="random") plm_re_time <- plm(form, data=Grunfeld, model="random", effect = "time") plm_re_nerlove <- plm(form, data=Grunfeld, model="random", random.method = "nerlove") plm_pool_pFormula <- plm(pFormula(form), data=Grunfeld, model="pooling") plm_fe_pFormula <- plm(pFormula(form), data=Grunfeld, model="within") plm_fe_tw_pFormula <- plm(pFormula(form), data=Grunfeld, model="within", effect = "twoways") plm_re_pFormula <- plm(pFormula(form), data=Grunfeld, model="random") plm_re_time_pFormula <- plm(pFormula(form), data=Grunfeld, model="random", effect = "time") plm_re_nerlove_pFormula <- plm(pFormula(form), data=Grunfeld, model="random", random.method = "nerlove") # create Grunfeld pdata.frame pGrunfeld <- pdata.frame(Grunfeld, index = c("firm", "year")) # generate dataset with NA in dependent variable Grunfeld_NA_dep_var <- Grunfeld Grunfeld_NA_dep_var[1, ]$inv <- NA pGrunfeld_NA_dep_var <- pdata.frame(Grunfeld_NA_dep_var) Grunfeld_NA_indep_var <- Grunfeld Grunfeld_NA_indep_var[1, ]$value <- NA pGrunfeld_NA_indep_var <- pdata.frame(Grunfeld_NA_indep_var) # generate dataset with NA row Grunfeld_NA_row <- Grunfeld Grunfeld_NA_row[1, c("inv", "value", "capital")] <- NA pGrunfeld_NA_row <- pdata.frame(Grunfeld_NA_row) # pdim on pdata.frame and plm object pdim(pGrunfeld_NA_row) # balanced - ok, because (p)data.frame pdim(plm_fe_NA_row <- plm(form, data=pGrunfeld_NA_row, model="within")) # unbalanced - ok pdim(plm_fe_NA_row_time <- plm(form, data=pGrunfeld_NA_row, model="within", effect = "time")) # unbalanced - ok pdim(plm_fe_NA_row_tw <- plm(form, data=pGrunfeld_NA_row, model="within", effect = "twoways")) # unbalanced - ok pdim(pGrunfeld_NA_dep_var) # balanced - ok, because (p)data.frame pdim(plm_fe_NA_dep_var <- plm(form, data=pGrunfeld_NA_dep_var, model="within")) # unbalanced - ok pdim(plm_fe_NA_dep_var_time <- plm(form, data=pGrunfeld_NA_dep_var, model="within", effect = "time")) # unbalanced - ok pdim(plm_fe_NA_dep_var_tw <- plm(form, data=pGrunfeld_NA_dep_var, model="within", effect = "twoways")) # unbalanced - ok pdim(pGrunfeld_NA_indep_var) # balanced, because (p)data.frame pdim(plm_fe_NA_indep_var <- plm(form, data=pGrunfeld_NA_indep_var, model="within")) # unbalanced - ok pdim(plm_fe_NA_indep_var_time <- plm(form, data=pGrunfeld_NA_indep_var, model="within", effect = "time")) # unbalanced - ok pdim(plm_fe_NA_indep_var_tw <- plm(form, data=pGrunfeld_NA_indep_var, model="within", effect = "twoways")) # unbalanced - ok ##### inspect row numbers in model.frame, model.matrix for various data with and without NAs #### if (nrow(plm:::model.matrix.plm(plm_fe_NA_row)) != 199) stop("NA not detected") # 199 rows - ok if (nrow(plm:::model.matrix.pFormula(form, data=pGrunfeld_NA_row, model="within")) != 199) stop("NA not detected") # 199 rows - ok if (nrow(plm:::model.matrix.pFormula(pFormula(form), data=pGrunfeld_NA_row, model="within")) != 199) stop("NA not detected") if (nrow(plm:::model.matrix.plm(plm_fe_NA_dep_var)) != 199) stop("NA not detected") # 199 - ok if (nrow(plm:::model.matrix.pFormula(form, data=pGrunfeld_NA_dep_var, model="within")) != 199) stop("NA not detected") # NOT OK: 200, but should be 199 if (nrow(model.matrix(pFormula(form), data=pGrunfeld_NA_dep_var, model="within")) != 199) stop("NA not detected") # NOT OK: 200, but should be 199 if (nrow(plm:::model.matrix.pFormula(form, data=pGrunfeld_NA_dep_var, model="pooling")) != 199) stop("NA not detected") # NOT OK: 200, but should be 199 if (nrow(model.matrix(pFormula(form), data=pGrunfeld_NA_dep_var, model="within")) != 199) stop("NA not detected") # NOT OK: 200, but should be 199 # ok - 199 if (nrow(plm:::model.matrix.pFormula(form, data=pGrunfeld_NA_dep_var, model="within", effect = "twoways")) != 199) stop("NA not detected") #MM if (nrow(plm:::model.matrix.pFormula(pFormula(form), data=pGrunfeld_NA_dep_var, model="within", effect = "twoways")) != 199) stop("NA not detected") if (!isTRUE(all.equal(plm:::model.matrix.pFormula(pFormula(form), data=pGrunfeld_NA_dep_var, model="within", effect = "twoways"), plm:::model.matrix.plm(plm_fe_NA_dep_var_tw), check.attributes = FALSE))) { stop("model matrices from estimated model and from formula interface not equal")} ########### 1) model.matrix[.pFormula|.plm] ########### # pooling and within models work if data is a pdata.frame modmat_pFormula_pdataframe_pool <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="pooling") # works modmat_pFormula_pdataframe_fe <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="within") # works modmat_pFormula_pdataframe_fe_time <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="within", effect = "time") # works modmat_pFormula_pdataframe_fe_tw <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="within", effect = "twoways") # works # RE fails due to theta = NULL in model.matrix.pFormula (also model.matrix.pFormula needs facilities for random.method (ercomp(, method))) # modmat_pFormula_pdataframe_re <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="random") # error # modmat_pFormula_pdataframe_re_time <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="random", effect = "time") # error # modmat_pFormula_pdataframe_fe_tw <- plm:::model.matrix.pFormula(form, data=pGrunfeld, model="random", effect = "twoway") # error # Error: # Error in plm:::model.matrix.pFormula(form, data = pGrunfeld, model = "random") : # dims [product 600] do not match the length of object [0] ####### Tests for removal of rows in model.matrix.pFormula if dependent var contains NAs # 200 rows resulting form model.matrix.default - ok for this data set if (nrow(model.matrix(inv ~ value + capital, data=Grunfeld)) != 200) stop("not correct") # 200 rows - ok for this data set if (nrow(plm:::model.matrix.pFormula(inv ~ value + capital, data=pdata.frame(Grunfeld))) != 200) stop("not correct") if (nrow(plm:::model.matrix.pFormula(pFormula(inv ~ value + capital), data=pdata.frame(Grunfeld))) != 200) stop("not correct") # 199 rows resulting from model.matrix.default - ok # NA in dependent variable detected and thus row in model.matrix dropped if (nrow(stats::model.matrix(inv ~ value + capital, data=Grunfeld_NA_dep_var)) != 199) stop("NA not detected") # 199 rows in model.frame of estimated plm_model$model - ok if (nrow(plm(inv ~ value + capital, data=pdata.frame(Grunfeld_NA_dep_var))$model) != 199) stop("NA not detected") # NOT OK: 200 returned, 199 rows should result from model.matrix.pFormula # NA in dependent variable _not_ detected and thus row in model.matrix _not_ dropped # This is due to the Formula package which is does not behave as stats::model.matrix.default does # for NA handling in dependent variable if (nrow(plm:::model.matrix.pFormula(pFormula(inv ~ value + capital), data=pdata.frame(Grunfeld_NA_dep_var))) != 199) stop("NA not detected") if (nrow(plm:::model.matrix.pFormula(inv ~ value + capital, data=pdata.frame(Grunfeld_NA_dep_var))) != 199) stop("NA not detected") # 199 returned - ok # NA in independent variable is detected and thus row in model.matrix is dropped if (nrow(plm:::model.matrix.pFormula(pFormula(inv ~ value + capital), data=pdata.frame(Grunfeld_NA_indep_var))) != 199) stop("NA not detected") # 199 returned - ok # NA row is detected and thus dropped if (nrow(plm:::model.matrix.pFormula(pFormula(inv ~ value + capital), data=pdata.frame(Grunfeld_NA_row))) != 199) stop("NA not detected") ####### some sanity checks - see if various interfaces yield the same result ###### modmat_plm_pool <- model.matrix(plm_pool) modmat_plm_fe <- model.matrix(plm_fe) modmat_plm_re <- model.matrix(plm_re) modmat_plm_re_time <- model.matrix(plm_re_time) modmat_plm_re_nerlove <- model.matrix(plm_re_nerlove) #### Tests # w/o any NAs ### interfaces: plm vs. pFormula if (!isTRUE(all.equal(modmat_plm_pool, modmat_pFormula_pdataframe_pool, check.attributes = FALSE))) stop("FAIL!") if (!isTRUE(all.equal(modmat_plm_fe, modmat_pFormula_pdataframe_fe, check.attributes = FALSE))) stop("FAIL!") #if (!isTRUE(all.equal(modmat_plm_re, modmat_pFormula_pdataframe_re, check.attributes = FALSE))) stop("FAIL!") #if (!isTRUE(all.equal(modmat_plm_re_time, modmat_pFormula_pdataframe_re_time, check.attributes = FALSE))) stop("FAIL!") #if (!isTRUE(all.equal(modmat_plm_re_nerlove, modmat_pFormula_pdataframe_re_nerlove, check.attributes = FALSE))) stop("FAIL!") ########### 2) pmodel.response.[pFormula|.plm] ########### # pmodel.response on regular data.frame (not pdata.frame) -> need to supply a pdata.frame! # plm:::pmodel.response.pFormula(form, data = Grunfeld, model = "pooling") # warning still in v1.5-14/rev. 175 # plm:::pmodel.response.pFormula(form, data = Grunfeld, model = "within") # fails # plm:::pmodel.response.pFormula(form, data = Grunfeld, model = "random") # fails # pooling and within models work on pdata.frame with fix in v1.5-14/rev. 175 resp_pFormula_pool <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "pooling") resp_pFormula_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within") resp_pFormula_fe_tw <- plm:::pmodel.response.formula(form, data = pGrunfeld, model = "within", effect = "twoways") # resp_pFormula_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld, model = "random") # error # still fails, likely due to theta = NULL in RE model # resp_pFormula_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld, model = "random") # # Error in model.matrix.pFormula(pFormula(formula), data = data, model = model, : # dims [product 200] do not match the length of object [0] resp_pFormula_NA_depvar_fe <- plm:::pmodel.response.formula(form, data = pGrunfeld_NA_dep_var, model = "within") # resp_pFormula_NA_depvar_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld_NA_dep_var, model = "random") # error # #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 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")) resp_plm_NA_depvar_re <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_dep_var, model = "random")) resp_plm_NA_indepvar_pool <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_indep_var, model = "pooling")) resp_plm_NA_indepvar_fe <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_indep_var, model = "within")) resp_plm_NA_indepvar_fe_tw <- plm:::pmodel.response.plm(plm(form, data = pGrunfeld_NA_indep_var, model = "within", effect = "twoways")) # correct transformation 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 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 # 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 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") # resp_pFormula_NA_indepvar_re <- plm:::pmodel.response.pFormula(form, data = pGrunfeld_NA_indep_var, model = "random") # error #### some sanity checks ### resp_plm_pool <- pmodel.response(plm_pool) resp_plm_fe <- pmodel.response(plm_fe) resp_plm_fe_tw <- pmodel.response(plm_fe_tw) resp_plm_re <- pmodel.response(plm_re) ##### interfaces: pFormula vs. plm if (!isTRUE(all.equal(resp_pFormula_pool, resp_plm_pool))) stop("Fail! resp_pFormula_pool != resp_plm_pool") if (!isTRUE(all.equal(resp_pFormula_fe, resp_plm_fe))) stop("Fail! resp_pFormula_fe != resp_plm_fe") if (!isTRUE(all.equal(resp_pFormula_fe_tw, resp_plm_fe_tw))) stop("Fail! resp_pFormula_fe_tw != resp_plm_fe_tw") #if (!isTRUE(all.equal(resp_pFormula_re, resp_plm_re))) stop("Fail! resp_pFormula_re != resp_plm_re") # with NA in dependent variable if (!isTRUE(all.equal(resp_plm_NA_depvar_pool, resp_pFormula_NA_depvar_pool, check.attributes = FALSE))) stop("Fail! resp_plm_NA_depvar_pool != resp_pFormula_NA_depvar_pool") if (!isTRUE(all.equal(resp_plm_NA_depvar_fe, resp_pFormula_NA_depvar_fe, check.attributes = FALSE))) stop("Fail! resp_plm_NA_depvar_fe != resp_pFormula_NA_depvar_fe") if (!isTRUE(all.equal(resp_plm_NA_depvar_fe_tw, resp_pFormula_NA_depvar_fe_tw, check.attributes = FALSE))) stop("Fail! resp_plm_NA_depvar_fe_tw != resp_pFormula_NA_depvar_fe_tw") #if (!isTRUE(all.equal(resp_plm_NA_depvar_re, resp_pFormula_NA_depvar_re, check.attributes = FALSE))) stop("Fail! resp_plm_NA_depvar_re != resp_pFormula_NA_depvar_re") # OK: with NA in _in_dependent variable if (!isTRUE(all.equal(resp_plm_NA_indepvar_pool, resp_pFormula_NA_indepvar_pool, check.attributes = FALSE))) stop("Fail! resp_plm_NA_indepvar_pool != resp_pFormula_NA_indepvar_pool") if (!isTRUE(all.equal(resp_plm_NA_indepvar_fe, resp_pFormula_NA_indepvar_fe, check.attributes = FALSE))) stop("Fail! resp_plm_NA_indepvar_fe != resp_pFormula_NA_indepvar_fe") if (!isTRUE(all.equal(resp_plm_NA_indepvar_fe_tw, resp_pFormula_NA_indepvar_fe_tw, check.attributes = FALSE))) stop("Fail! resp_plm_NA_indepvar_fe_tw != resp_pFormula_NA_indepvar_fe_tw") # if (!isTRUE(all.equal(resp_plm_NA_indepvar_re == resp_pFormula_NA_indepvar_re, check.attributes = FALSE))) stop("Fail! resp_plm_NA_indepvar_re != resp_pFormula_NA_indepvar_re") plm/inst/removed/unused.R0000644000176200001440000001774614165357232015135 0ustar liggesusers### convert data to plm format ### Author: ### Amendments by Ott Toomet plm.data_depr_orig <- function(x, indexes = NULL){ ## this is the original old full plm.data() function kept as reference for testing purposes (non-exported) if (is.null(indexes)){ id <- NULL time <- NULL } if (length(indexes) == 1){ id <- indexes time <- NULL } if (length(indexes) == 2){ id <- indexes[1] time <- indexes[2] } if (is.null(id) && is.null(time)){ id.name <- names(x)[1] time.name <- names(x)[2] } else{ id.name <- id time.name <- time } data.name <- paste(deparse(substitute(x))) # coerce character vectors to factors x.char <- names(x)[sapply(x,is.character)] for (i in x.char){ x[[i]] <- factor(x[[i]]) } # replace Inf by NA for (i in names(x)) x[[i]][!is.finite(x[[i]])] <- NA # check and remove complete NA series na.check <- sapply(x,function(x) sum(!is.na(x))==0) na.serie <- names(x)[na.check] if (length(na.serie)>0){ if (length(na.serie)==1){ cat(paste("series",na.serie,"is NA and has been removed\n")) } else{ cat(paste("series",paste(na.serie,collapse=", "),"are NA and have been removed\n")) } } x <- x[,!na.check] ## Which columns are constants? cst.check <- sapply(x, function(x) all(x[!is.na(x)] == (x[!is.na(x)])[1])) # any NA-component equal to the first non-NA component cst.serie <- names(x)[cst.check] if (length(cst.serie)>0){ if (length(cst.serie)==1){ cat(paste("series",cst.serie,"is constant and has been removed\n")) } else{ cat(paste("series",paste(cst.serie,collapse=", "),"are constants and have been removed\n")) } } # x <- x[,!cst.check] if(is.numeric(id.name)){ if(!is.null(time.name)){warning("The time argument will be ignored\n")} N <- nrow(x) if( (N%%id.name)!=0){ stop("unbalanced panel, the id variable should be indicated\n") } else{ T <- N%/%id.name n <- N%/%T time <- rep(1:T,n) id <- rep(seq(1:n),rep(T,n)) id.name <- "id" time.name <- "time" x[[id.name]] <- id <- as.factor(id) x[[time.name]] <- time <- as.factor(time) } } else{ if (!id.name %in% names(x)) stop(paste("variable ",id.name," does not exist",sep="") ) if (is.factor(x[[id.name]])){ id <- x[[id.name]] <- x[[id.name]][drop=TRUE] } else{ id <- x[[id.name]] <- as.factor(x[[id.name]]) } if (is.null(time.name)){ Ti <- table(id) n <- length(Ti) time <- c() for (i in 1:n){ time <- c(time,1:Ti[i]) } time.name <- "time" time <- x[[time.name]] <- time <- as.factor(time) } else{ if (!time.name %in% names(x)) stop(paste("variable ",time.name," does not exist",sep="") ) if (is.factor(x[[time.name]])){ time <- x[[time.name]] <- x[[time.name]][drop=TRUE] } else{ time <- x[[time.name]] <- as.factor(x[[time.name]]) } } } x <- x[order(id,time),] indexes <- list(id=id.name,time=time.name) class(indexes) <- "indexes" var.names <- names(x) for (i in names(x)){ if(is.factor(x[[i]])){ if (length(unique(x[[i]])) < length(levels(x[[i]]))){ x[[i]] <- x[[i]][,drop=TRUE] } } } posindexes <- match(c(id.name,time.name),names(x)) x <- data.frame(x[posindexes],x[-posindexes]) attr(x,"class") <- c("plm.dim","data.frame") x } data2plm.data <- function(data, indexes = NULL){ data <- plm.data(data, indexes) id.name <- names(data)[1L] time.name <- names(data)[2L] list(data = data, id.name = id.name, time.name = time.name) } indexes <- function(x){ if (!inherits(x, "pdata.frame")){ stop("indexes function only for pdata.frame\n") } attr(x,"index") } print.indexes <- function(x, ...){ cat(paste("Index: (individual=",x$id,") and (time=",x$time,")\n",sep="")) } sumsq <- function(x, ...){ xb <- mean(x, na.rm = TRUE) sum((na.omit(x)-xb)^2) } # suml(x) is replaced by Reduce("+", x) ## suml <- function(x){ ## n <- length(x) ## if (!is.null(dim(x[[1]]))){ ## d <- dim(x[[1]]) ## s <- matrix(0,d[1],d[2]) ## for (i in 1:n){ ## s <- s+x[[i]] ## } ## } ## else{ ## s <- rep(0,length(x[[n]])) ## for (i in 1:n){ ## s <- s+x[[i]] ## } ## } ## s ## } oppl <- function(x,y,func){ n <- length(x) z <- list() if (!is.list(y)){ for (i in 1:n){ t <- paste("\"",func,"\"","(x[[i]],y)",sep="") z[[i]] <- eval(parse(text=t)) } } else{ for (i in 1:n){ t <- paste("\"",func,"\"","(x[[i]],y[[i]])",sep="") z[[i]] <- eval(parse(text=t)) } } z } rbindl <- function(x){ n <- length(x) d <- dim(x[[1]]) s <- c() for (i in 1:n){ s <- rbind(s,x[[i]]) } } print.form <- function(x, length.line){ x <- deparse(x,width.cutoff=length.line) n <- length(x) cat(paste(x[1],"\n",sep="")) if (n>1){ for (i in 2:n){ cat(paste(x[i],"\n",sep="")) } } } ## pdiff is (only) used in model.matrix.pFormula to calculate the model.matrix for FD models, ## works for effect = "individual" and "time", see model.matrix on how to call pdiff. ## Result is in order (id, time) for both effects ## Performs row-wise shifting opdiff <- function(x, cond, effect = c("individual", "time"), has.intercept = FALSE){ effect <- match.arg(effect) cond <- as.numeric(cond) n <- if(is.matrix(x)) nrow(x) else length(x) # code below is written for effect="individual". If effect="time" is # requested, order x so that the code works and later restore original order of x if (effect == "time") { order_cond <- order(cond) if (!is.matrix(x)) { x <- x[order_cond]} else {x <- x[order_cond, ] } cond <- cond[order_cond] } cond <- c(NA, cond[2:n] - cond[1:(n-1)]) # this assumes a certain ordering cond[cond != 0] <- NA if (!is.matrix(x)){ result <- c(NA, x[2:n] - x[1:(n-1)]) result[is.na(cond)] <- NA # for effect = "time": restore original order of x: if (effect == "time") result <- result[match(seq_len(n), order_cond)] result <- na.omit(result) } else{ result <- rbind(NA, x[2:n, , drop=FALSE] - x[1:(n-1), , drop = FALSE]) result[is.na(cond), ] <- NA # for effect = "time": restore original order of x: if (effect == "time") result <- result[match(seq_len(n), order_cond), ] result <- na.omit(result) result <- result[ , apply(result, 2, var) > sqrt(.Machine$double.eps), drop = FALSE] if (has.intercept){ result <- cbind(1, result) colnames(result)[1] <- "(intercept)" } } attr(result, "na.action") <- NULL result } ## expand.formula <- function(x){ ## oclass <- class(x) ## if (! any(class(x) == "Formula")) stop("not a Formula object") ## if (length(x)[2] != 2) stop("not a two part formula") ## xs <- structure(x, class = "formula") ## has.response <- attr(terms(xs),"response") == 1 ## if (has.response){ ## y <- x[[2]] ## rhs <- x[[3]] ## } ## else{ ## y <- NULL ## rhs <- x[[2]] ## } ## firstpart <- rhs[[2]] ## secondpart <- rhs[[3]] ## if (has.response){ ## one <- do.call("~", list(y,firstpart)) ## two <- do.call("~", list(y,secondpart)) ## } ## else{ ## one <- do.call("~", list(firstpart)) ## two <- do.call("~", list(secondpart)) ## } ## two <- update(one, two) ## one <- paste(deparse(one), collapse = "") ## two <- paste(deparse(two[[3]]), collapse = "") ## result <- as.formula(paste(one, "|", two, collapse = "")); ## result <- as.Formula(result) ## #YC class(result) <- c("pFormula", class(result)) ## structure(result, class = oclass) ## } plm/inst/removed/dynformula.Rd0000644000176200001440000000431114124132276016130 0ustar liggesusers\name{dynformula} \alias{dynformula} \alias{print.dynformula} \alias{formula.dynformula} \title{Dynamic Formula} \description{ A function to easily create a formula with lags and differences (Deprecated) } \usage{ dynformula(formula, lag.form = NULL, diff.form = NULL, log.form = NULL) } \arguments{ \item{formula}{a formula,} \item{lag.form}{a list containing the lag structure of each variable in the formula,} \item{diff.form}{a vector (or a list) of logical values indicating whether variables should be differenced,} \item{log.form}{a vector (or a list) of logical values indicating whether variables should be in logarithms.} } \value{ An object of class \code{c("dynformula", "formula")}, which is a formula with four additional attributes: \code{var}, the names of the variables in the formula, \code{lag}, \code{diff}, and \code{log}, which store the information about lags, differences and logs, respectively. A \code{formula} method coerces the \code{dynformula} object to a standard \code{formula}. } \details{ The function was once used to easily create a formula with lots lags and differences. With the introduction of multi-part formulas, this function is deprecated. \code{lag.form} is a list, \code{diff.form} and \code{log.form} are vectors (or lists) that should be of length equal to the total number of variables. Each element of these lists/vectors is: \itemize{ \item either a vector of length 2 (\code{c(1,4)} means lags 1,2,3 and 4) or a scalar (\code{3} means lags 0,1,2,3 except for the left--hand side variable for which it is 1,2,3) for \code{lag.form}. \item logical values for \code{diff.form} and \code{log.form}. } It can also be an incomplete named list/vector (for example, to apply the transformation for only some variables) with eventually an unnamed element which then is the default value. } \author{Yves Croissant} \examples{ # all variables in log, x1, x2 and x3 laged twice, y laged once and x3 differenced z <- dynformula(y ~ x1 + x2 + x3, lag.form = list(2, y = 1), diff.form = c(x3 = TRUE), log.form = TRUE) formula(z) } \keyword{classes} plm/inst/removed/plm.data.Rd0000644000176200001440000000336714124132276015462 0ustar liggesusers\name{plm.data} \alias{plm.data} \title{Data Frame Special Format for Panel Data (Deprecated)} \description{ This function was once used to transform a data frame in a format suitable for using with the estimation functions of \code{plm}. New code should rather use the more versatile function \code{\link{pdata.frame}}. } \usage{ plm.data(x, indexes = NULL) } \arguments{ \item{x}{a \code{data.frame},} \item{indexes}{a vector (of length one or two) indicating the (individual and time) indexes (see Details).} } \value{ An object of class \code{c("plm.dim", "data.frame")}. } \details{ This function is kept due to backward compatibility of old code. New code should use the function \code{pdata.frame} instead. \code{indexes} can be: \itemize{ \item a character string which is the name of the individual index variable, in this case a new variable called ``time'' containing the time index is added, \item an integer, the number of individuals in the case of balanced panel, in this case two new variables ``time'' and ``id'' containing the individual and the time indexes are added, \item a vector of two character strings which contains the names of the individual and of the time indexes. } } \author{Yves Croissant} \examples{ # There are 595 individuals data("Wages", package = "plm") Wages <- plm.data(Wages, 595) # Gasoline contains two variables which are individual and time indexes # The pdata.frame is called gas data("Gasoline", package = "plm") Gasoline <- plm.data(Gasoline, c("country","year")) summary(Gasoline) # Hedonic is an unbalanced panel, townid is the individual index data("Hedonic", package = "plm") Hedonic <- plm.data(Hedonic, "townid") } \keyword{attribute}