[Splm-commits] r255 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 17 10:39:43 CEST 2023
Author: gpiras
Date: 2023-07-17 10:39:42 +0200 (Mon, 17 Jul 2023)
New Revision: 255
Modified:
pkg/NAMESPACE
pkg/R/impacts.splm.R
pkg/R/spfeml.R
pkg/R/spml.R
Log:
impacts fixed ML
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2023-07-17 07:01:14 UTC (rev 254)
+++ pkg/NAMESPACE 2023-07-17 08:39:42 UTC (rev 255)
@@ -67,7 +67,7 @@
S3method(summary, splm)
S3method(sphtest, formula)
S3method(sphtest, splm)
-#S3method(impacts, splm)
+S3method(impacts, splm_ML)
S3method(impacts, splm_GM)
S3method(slag, pseries)
S3method(rwtest, formula)
Modified: pkg/R/impacts.splm.R
===================================================================
--- pkg/R/impacts.splm.R 2023-07-17 07:01:14 UTC (rev 254)
+++ pkg/R/impacts.splm.R 2023-07-17 08:39:42 UTC (rev 255)
@@ -3,6 +3,146 @@
UseMethod("impacts", obj)
}
+impacts.splm_ML <- function(obj, listw = NULL,
+ time = NULL, ...,
+ tr = NULL, R = 200,
+ type = "mult",
+ empirical = FALSE, Q = NULL){
+
+ if(is.null(listw) && is.null(tr)) stop("either listw or tr should be provided")
+
+
+ if(!is.null(listw) ){
+ if(listw$style != "W") stop("Only row-standardised weights supported")
+ if(is.null(time) && is.null(tr)) stop("time periods should be provided")
+ }
+
+
+ if(is.null(tr)){
+
+ sparse.W <- listw2dgCMatrix(listw)
+ s.lws <- kronecker(Diagonal(time) , sparse.W)
+ tr <- trW(s.lws, type= type)
+
+ }
+
+ if(is.na(match(obj$type, c("fixed effects lag","fixed effects sarar",
+ "random effects ML", "fixed effects GM","lag GM",
+ "fixed effects GM")))) stop("object type not recognized")
+
+ if(obj$type == "fixed effects lag"){
+
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+ obj$secstep_var <- obj$vcov
+ imp <- spatialreg::impacts(obj, tr=tr, R=R, ...)
+
+ }
+
+ if(obj$type == "fixed effects sarar"){
+
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+ rho <- obj$coefficients[2]
+ obj$coefficients <- obj$coefficients[-2]
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+ obj$secstep_var <- obj$vcov[-2,-2]
+ imp <- spatialreg::impacts(obj, tr=tr, R=R,...)
+
+ }
+
+ if(obj$type == "fixed effects error") stop("Impacts Estimates are not available for Error Model")
+
+ if(obj$type == "random effects ML") {
+
+ if(!is.null(obj$arcoef)) {
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+
+ obj$coefficients <- c(obj$arcoef, obj$coefficients)
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+ obj$secstep_var <- matrix(0,nrow(obj$vcov)+1,nrow(obj$vcov)+1)
+ obj$secstep_var[1,1] <- obj$vcov.arcoef
+ obj$secstep_var[(2:(nrow(obj$vcov)+1)),(2:(nrow(obj$vcov)+1))] <- obj$vcov
+ imp <- spatialreg::impacts(obj, tr=tr, R=R, ...)
+ }
+ else stop("Impacts Estimates are not available for Error Model")
+
+ }
+
+
+ if(obj$type == "fixed effects GM"){
+
+ if(is.null(obj$endog)) {
+ obj$secstep_var <- vcov(obj)
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+
+ imp <- impacts(obj, tr=tr, R=R, ...)
+
+
+ }
+
+ else stop("No impacts estimates when endogenous variables are present in the system")
+
+ }
+
+ if(obj$type == "lag GM") {
+
+ if(is.null(obj$endog)) {
+
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+ obj$secstep_var <- obj$var
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+
+ imp <- impacts(obj, tr=tr, R=R, ...)
+
+
+ }
+
+ else stop("No impacts estimates when endogenous variables are present in the system")
+
+
+
+ }
+
+
+ if(obj$type == "random effects GM") {
+
+ if(is.null(obj$endog)) {
+
+ class(obj)<- "Gmsar"
+ obj$type <- "SARAR"
+ obj$secstep_var <- obj$vcov
+ obj$data <- as.vector(obj$model)
+ obj$s2 <- obj$sigma2
+
+ imp <- impacts(obj, tr=tr, R=R, ...)
+
+
+ }
+
+ else stop("No impacts estimates when endogenous variables are present in the system")
+
+
+
+ }
+
+
+
+
+
+ return(imp)
+
+}
impacts.splm_GM <- function(obj, ..., tr=NULL,
@@ -284,143 +424,3 @@
-# impacts.splm <- function(obj, listw = NULL,
-# time = NULL, ...,
-# tr = NULL, R = 200,
-# type = "mult",
-# empirical = FALSE, Q = NULL){
-#
-# if(is.null(listw) && is.null(tr)) stop("either listw or tr should be provided")
-#
-#
-# if(!is.null(listw) ){
-# if(listw$style != "W") stop("Only row-standardised weights supported")
-# if(is.null(time) && is.null(tr)) stop("time periods should be provided")
-# }
-#
-#
-# if(is.null(tr)){
-#
-# sparse.W <- listw2dgCMatrix(listw)
-# s.lws <- kronecker(Diagonal(time) , sparse.W)
-# tr <- trW(s.lws, type= type)
-#
-# }
-#
-# if(is.na(match(obj$type, c("fixed effects lag","fixed effects sarar",
-# "random effects ML", "fixed effects GM","lag GM",
-# "fixed effects GM")))) stop("object type not recognized")
-#
-# if(obj$type == "fixed effects lag"){
-#
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-# obj$secstep_var <- obj$vcov
-# imp <- spatialreg::impacts(obj, tr=tr, R=R, ...)
-#
-# }
-#
-# if(obj$type == "fixed effects sarar"){
-#
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-# rho <- obj$coefficients[2]
-# obj$coefficients <- obj$coefficients[-2]
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-# obj$secstep_var <- obj$vcov[-2,-2]
-# imp <- spatialreg::impacts(obj, tr=tr, R=R,...)
-#
-# }
-#
-# if(obj$type == "fixed effects error") stop("Impacts Estimates are not available for Error Model")
-#
-# if(obj$type == "random effects ML") {
-#
-# if(!is.null(obj$arcoef)) {
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-#
-# obj$coefficients <- c(obj$arcoef, obj$coefficients)
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-# obj$secstep_var <- matrix(0,nrow(obj$vcov)+1,nrow(obj$vcov)+1)
-# obj$secstep_var[1,1] <- obj$vcov.arcoef
-# obj$secstep_var[(2:(nrow(obj$vcov)+1)),(2:(nrow(obj$vcov)+1))] <- obj$vcov
-# imp <- spatialreg::impacts(obj, tr=tr, R=R, ...)
-# }
-# else stop("Impacts Estimates are not available for Error Model")
-#
-# }
-#
-#
-# if(obj$type == "fixed effects GM"){
-#
-# if(is.null(obj$endog)) {
-# obj$secstep_var <- vcov(obj)
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-#
-# imp <- impacts(obj, tr=tr, R=R, ...)
-#
-#
-# }
-#
-# else stop("No impacts estimates when endogenous variables are present in the system")
-#
-# }
-#
-# if(obj$type == "lag GM") {
-#
-# if(is.null(obj$endog)) {
-#
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-# obj$secstep_var <- obj$var
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-#
-# imp <- impacts(obj, tr=tr, R=R, ...)
-#
-#
-# }
-#
-# else stop("No impacts estimates when endogenous variables are present in the system")
-#
-#
-#
-# }
-#
-#
-# if(obj$type == "random effects GM") {
-#
-# if(is.null(obj$endog)) {
-#
-# class(obj)<- "Gmsar"
-# obj$type <- "SARAR"
-# obj$secstep_var <- obj$vcov
-# obj$data <- as.vector(obj$model)
-# obj$s2 <- obj$sigma2
-#
-# imp <- impacts(obj, tr=tr, R=R, ...)
-#
-#
-# }
-#
-# else stop("No impacts estimates when endogenous variables are present in the system")
-#
-#
-#
-# }
-#
-#
-#
-#
-#
-# return(imp)
-#
-# }
Modified: pkg/R/spfeml.R
===================================================================
--- pkg/R/spfeml.R 2023-07-17 07:01:14 UTC (rev 254)
+++ pkg/R/spfeml.R 2023-07-17 08:39:42 UTC (rev 255)
@@ -502,7 +502,7 @@
if (!is.null(na.act))
spmod$na.action <- na.act
- class(spmod) <- "splm"
+ class(spmod) <- c("splm_ML","splm")
return(spmod)
}
Modified: pkg/R/spml.R
===================================================================
--- pkg/R/spml.R 2023-07-17 07:01:14 UTC (rev 254)
+++ pkg/R/spml.R 2023-07-17 08:39:42 UTC (rev 255)
@@ -83,6 +83,9 @@
})
#}
+ #print(class(res))
+ class(res) <- c(class(res), "splm_ML")
+ #print(class(res))
return(res)
}
More information about the Splm-commits
mailing list