[Splm-commits] r155 - pkg/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Mar 26 17:14:07 CET 2013


Author: gpiras
Date: 2013-03-26 17:14:07 +0100 (Tue, 26 Mar 2013)
New Revision: 155

Modified:
   pkg/R/likelihoodsFE.R
   pkg/R/spfeml.R
   pkg/R/spml.R
Log:
updated spfeml

Modified: pkg/R/likelihoodsFE.R
===================================================================
--- pkg/R/likelihoodsFE.R	2013-03-25 22:24:28 UTC (rev 154)
+++ pkg/R/likelihoodsFE.R	2013-03-26 16:14:07 UTC (rev 155)
@@ -54,7 +54,7 @@
 #opt <- nlminb(0.02138744, conclikpan,  lower = interval[1], upper= interval[2],  env = env)
 
         lambda <- opt$maximum
-		print(lambda)
+		
     if (isTRUE(all.equal(lambda, interval[1])) || isTRUE(all.equal(lambda,interval[2]))) 
         warning("lambda on interval bound - results should not be used")
 
@@ -232,6 +232,8 @@
         names(rho) <- "rho"
         LL <- opt$objective
 
+    if (isTRUE(all.equal(rho, interval[1])) || isTRUE(all.equal(rho,interval[2]))) 
+        warning("rho on interval bound - results should not be used")
 
     lm.target <- lm(I(yt - rho * wyt) ~ I(xt - rho * wxt) - 
         1)
@@ -302,7 +304,7 @@
 	 
      yco <- yt - rho * wyt
      xco <- xt - rho * wxt
-     bb<- solve(crossprod(xco),crossprod(xco, yco) )
+     # bb<- solve(crossprod(xco),crossprod(xco, yco) )
 
      ehat<- yco - xco %*% bb
     SSE <- crossprod(ehat)

Modified: pkg/R/spfeml.R
===================================================================
--- pkg/R/spfeml.R	2013-03-25 22:24:28 UTC (rev 154)
+++ pkg/R/spfeml.R	2013-03-26 16:14:07 UTC (rev 155)
@@ -1,4 +1,4 @@
-spfeml<-function(formula, data=list(), index=NULL, listw, listw2 = NULL, na.action, model = c("lag","error", "sarar"),effects = c('pooled','spfe','tpfe','sptpfe'), method="eigen", quiet = TRUE, zero.policy = NULL, interval1 = NULL, interval2 = NULL, trs1 = NULL, trs2 = NULL, tol.solve = 1e-10, control = list(), legacy = FALSE, llprof = NULL, cl = NULL, Hess = TRUE, LeeYu = FALSE, ...){
+spfeml<-function(formula, data=list(), index=NULL, listw, listw2 = NULL, na.action, model = c("lag","error", "sarar"),effects = c('spfe','tpfe','sptpfe'), method="eigen", quiet = TRUE, zero.policy = NULL, interval1 = NULL, interval2 = NULL, trs1 = NULL, trs2 = NULL, tol.solve = 1e-10, control = list(), legacy = FALSE, llprof = NULL, cl = NULL, Hess = TRUE, LeeYu = FALSE, ...){
 
 	  
         # timings <- list()
@@ -69,7 +69,7 @@
   clnames<-colnames(x)
   rwnames<-rownames(x)
   #make sure that the model has no intercept if effects !=pooled
-  if (effects !="pooled" && colnames(x)[1]=="(Intercept)") {
+  if (colnames(x)[1]=="(Intercept)") {
   	x<-x[,-1]
   	#cat('\n Warning: x may not contain an intercept if fixed effects are specified \n')
 	}
@@ -151,30 +151,6 @@
 	}
 
 
-###specific checks for the LAG (to be added)
-# if(model == "lag"){
-	
-        
-  # stopifnot(is.logical(con$small_asy))
-    # if (method != "eigen") {
-        # if (con$small >= n && con$small_asy) 
-            # do_asy <- TRUE
-        # else do_asy <- FALSE
-    # }
-    # else do_asy <- TRUE
-    # if (is.null(con$fdHess)) {
-        # con$fdHess <- method != "eigen" && !do_asy
-        # fdHess <- NULL
-    # }
-    # stopifnot(is.logical(con$fdHess))
-
-    # }
-	
-# }
-
-###specific checks for the error 
-
-
 switch(model, lag = if (!quiet) cat("\n Spatial Lag Fixed Effects Model \n"),
 	    error = if (!quiet) cat("\n Spatial Error Fixed Effects Model\n"),
 	    sarar = if (!quiet) cat("\n Spatial SARAR Fixed Effects Model\n"),
@@ -286,10 +262,10 @@
 	}
 	
 	
-if (effects=='pooled'){
-	yt<-y  	###keep the variables with no transformation
-	xt<-x
-	}
+# if (effects=='pooled'){
+	# yt<-y  	###keep the variables with no transformation
+	# xt<-x
+	# }
 
 
 if (effects=="tpfe"){ ####generate the demeaned variables for tpfe
@@ -382,7 +358,7 @@
 # .ptime_start <- proc.time()
 
     if (!quiet) 
-        cat(paste("\nSpatial autoregressive error model\n", "Jacobian calculated using "))
+        cat(paste("\nSpatial fixed effects model\n", "Jacobian calculated using "))
 
 if(model == "lag"){
     interval1 <- spdep:::jacobianSetup(method, env, con, pre_eig = con$pre_eig, trs = trs1, interval = interval1)
@@ -463,7 +439,7 @@
 if (model == "error") spat.coef<-RES$rho
 if (model == "sarar") spat.coef <- c(RES$lambda, RES$rho)
 
- # if (is.null(RES$lambda.se) && model=="error") Coeff<-RES$coeff
+
 Coeff<-c(spat.coef, RES$coeff)
 
 type <- paste("fixed effects", model)

Modified: pkg/R/spml.R
===================================================================
--- pkg/R/spml.R	2013-03-25 22:24:28 UTC (rev 154)
+++ pkg/R/spml.R	2013-03-26 16:14:07 UTC (rev 155)
@@ -30,7 +30,10 @@
       model <- switch(match.arg(spatial.error), b="sarar",
                       kkp="sarar", none="lag")
     } else {
-      model <- "error"
+    	model <- switch(match.arg(spatial.error), b="error",
+                      kkp="error", none="plm")
+                      
+      if(model == "plm") stop("No spatial component, use plm instead") 
     }
     effects <- switch(match.arg(effect), individual="spfe",
                       time="tpfe", twoways="sptpfe")



More information about the Splm-commits mailing list