[Splm-commits] r152 - pkg/R

[noreply at r-forge.r-project.org]

Author: gpiras
Date: 2013-03-22 17:20:35 +0100 (Fri, 22 Mar 2013)
New Revision: 152

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

Modified: pkg/R/fixed_effects.R
===================================================================
--- pkg/R/fixed_effects.R	2013-03-22 15:50:20 UTC (rev 151)
+++ pkg/R/fixed_effects.R	2013-03-22 16:20:35 UTC (rev 152)
@@ -1,4 +1,4 @@
-feerror<-function(env, beta,sige, effects, method,lambda, legacy){
+feerror<-function(env, beta,sige, effects, method,rho, legacy){
 
 	y<-get("y", envir = env)
 	x<-get("x", envir = env)

Modified: pkg/R/likelihoodsFE.R
===================================================================
--- pkg/R/likelihoodsFE.R	2013-03-22 15:50:20 UTC (rev 151)
+++ pkg/R/likelihoodsFE.R	2013-03-22 16:20:35 UTC (rev 152)
@@ -228,12 +228,12 @@
 #opt <- nlminb(0.5,sarpanelerror,lower = interval[1], upper= interval[2], env = env)
 #print(opt)
 
-        lambda <- opt$maximum
-        names(lambda) <- "rho"
+        rho <- opt$maximum
+        names(rho) <- "rho"
         LL <- opt$objective
 
 
-    lm.target <- lm(I(yt - lambda * wyt) ~ I(xt - lambda * wxt) - 
+    lm.target <- lm(I(yt - rho * wyt) ~ I(xt - rho * wxt) - 
         1)
     r <- as.vector(residuals(lm.target))
     p <- lm.target$rank
@@ -241,41 +241,41 @@
     rest.se <- (summary(lm.target)$coefficients[, 2]) * sqrt((NT - p)/NT)     
     betas <- coefficients(lm.target)
     names(betas) <- colnames(xt)  
-     coefsl <- c(s2, lambda, betas) 
+     coefs <- c(rho, betas) 
 
 
 if(!Hess){
 	
-	        fd <- fdHess(coefsl, sarpanelerror_hess, env)
+	        fd <- fdHess(coefs, sarpanelerror_hess, env)
         mat <- fd$Hessian
 		  fdHess<- solve(-(mat), tol.solve = tol.solve)
-        rownames(fdHess) <- colnames(fdHess) <- c("s2", "rho",colnames(xt))
+        rownames(fdHess) <- colnames(fdHess) <- c("rho",colnames(xt))
 
-            rho.se <- fdHess[2, 2]
-            s2.se <- fdHess[1, 1]
-
+            rho.se <- fdHess[1, 1]
+            s2.se <- NULL
+            rest.se <- vcov(lm.target)
 }
 else{
     
         tr <- function(A) sum(diag(A))
         W <- listw2dgCMatrix(listw, zero.policy = zero.policy)
-        A <- solve(Diagonal(NT/T) - lambda * W)
+        A <- solve(sparseMatrix(i=1:(NT/T), j=1:(NT/T), x=1)  - rho * W)
         WA <- W %*% A
         asyvar <- matrix(0, nrow = 2 + p, ncol = 2 + p)
         asyvar[1, 1] <- NT/(2 * (s2^2))
         asyvar[2, 1] <- asyvar[1, 2] <- T*tr(WA)/s2
         asyvar[2, 2] <- T*(tr(WA %*% WA) + tr(t(WA) %*% WA))
-        asyvar[3:(p + 2), 3:(p + 2)] <- 1/as.numeric(s2) * (t(xt - lambda *wxt) %*% (xt - lambda * wxt)) 
+        asyvar[3:(p + 2), 3:(p + 2)] <- 1/as.numeric(s2) * (t(xt - rho *wxt) %*% (xt - rho * wxt)) 
         asyv <- solve(asyvar, tol = con$tol.solve)
         rownames(asyv) <- colnames(asyv) <- c("sigma","rho", colnames(xt))
         s2.se <- sqrt(asyv[1, 1])
-        lambda.se <- sqrt(asyv[2, 2])
+        rho.se <- sqrt(asyv[2, 2])
         asyvar1 <- asyv[-1,-1]
         rownames(asyvar1) <- colnames(asyvar1) <- c("rho", colnames(xt))
 
 }
 
-	return<-list(coeff=betas,lambda=lambda,s2=s2, rest.se=rest.se, lambda.se=lambda.se, s2.se = s2.se, asyvar1=asyvar1)
+	return<-list(coeff=betas, rho = rho, s2 = s2, rest.se = rest.se, rho.se = rho.se, s2.se = s2.se, asyvar1=asyvar1)
 }
 
 
@@ -296,22 +296,23 @@
 
 # coefsl <- c(s2, lambda, betas) 
 
-	s2 <-  coef[1]
-	lambda <- coef[2]
-	bb <- coef[-c(1,2)]
+	# s2 <-  coef[1]
+	rho <- coef[1]
+	bb <- coef[-1]
 	 
-    # yco <- yt - lambda * wyt
-    # xco <- xt - lambda * wxt
-    # bb<- solve(crossprod(xco),crossprod(xco, yco) )
+     yco <- yt - rho * wyt
+     xco <- xt - rho * wxt
+     bb<- solve(crossprod(xco),crossprod(xco, yco) )
 
-    # ehat<- yco - xco %*% bb
-    SSE <- s2 * NT
-  ldet <- do_ldet(lambda, env)
+     ehat<- yco - xco %*% bb
+    SSE <- crossprod(ehat)
 
+  ldet <- do_ldet(rho, env)
+
     ret <- T*ldet - (NT/2) * log(SSE) 
 
 if (get("verbose", envir = env)) 
-        cat("rho:", lambda, " function:", ret, " Jacobian:", ldet, " SSE:", SSE, "\n")
+        cat("rho:", rho, " function:", ret, " Jacobian:", ldet, " SSE:", SSE, "\n")
  ret
 }
 

Modified: pkg/R/spfeml.R
===================================================================
--- pkg/R/spfeml.R	2013-03-22 15:50:20 UTC (rev 151)
+++ pkg/R/spfeml.R	2013-03-22 16:20:35 UTC (rev 152)
@@ -426,7 +426,7 @@
     # .ptime_start <- proc.time()	
 
   RES<- sperrorlm(env = env, zero.policy = zero.policy, interval = interval1, Hess = Hess)	
-    	res.eff<-feerror(env = env, beta=RES$coeff, sige=RES$s2, effects = effects ,method =method, lambda=RES$lambda, legacy = legacy)
+    	res.eff<-feerror(env = env, beta=RES$coeff, sige=RES$s2, effects = effects ,method =method, rho=RES$rho, legacy = legacy)
     	
     }