[Gmm-commits] r59 - in pkg/gmm: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed May 30 20:38:41 CEST 2012


Author: chaussep
Date: 2012-05-30 20:38:41 +0200 (Wed, 30 May 2012)
New Revision: 59

Modified:
   pkg/gmm/DESCRIPTION
   pkg/gmm/NEWS
   pkg/gmm/R/Methods.gel.R
   pkg/gmm/R/getModel.R
   pkg/gmm/R/momentEstim.R
Log:
solve a bug in gel with smooth and added bw in print methods

Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION	2012-05-29 15:30:37 UTC (rev 58)
+++ pkg/gmm/DESCRIPTION	2012-05-30 18:38:41 UTC (rev 59)
@@ -1,6 +1,6 @@
 Package: gmm
-Version: 1.4-1
-Date: 2012-05-29
+Version: 1.4-2
+Date: 2012-05-30
 Title: Generalized Method of Moments and Generalized Empirical
         Likelihood
 Author: Pierre Chausse <pchausse at uwaterloo.ca>

Modified: pkg/gmm/NEWS
===================================================================
--- pkg/gmm/NEWS	2012-05-29 15:30:37 UTC (rev 58)
+++ pkg/gmm/NEWS	2012-05-30 18:38:41 UTC (rev 59)
@@ -1,3 +1,8 @@
+Changes in version 1.4-2
+
+o Bugs fixed when running gel() with smooth=T and g() begina nonlinear function
+o Now, print.gel() and print.summary.gel() repports the bandwidth when smooth=T
+
 Changes in version 1.4-0
 
 o The method for GMM-CUE has been modified. Before, the weights for the kernel estimation of the weighting matrix

Modified: pkg/gmm/R/Methods.gel.R
===================================================================
--- pkg/gmm/R/Methods.gel.R	2012-05-29 15:30:37 UTC (rev 58)
+++ pkg/gmm/R/Methods.gel.R	2012-05-30 18:38:41 UTC (rev 59)
@@ -61,9 +61,16 @@
 print.gel <- function(x, digits = 5, ...)
 	{
 	if (is.null(x$CGEL))
-		cat("Type de GEL: ", x$type, "\n\n")
+		cat("Type de GEL: ", x$type, "\n")
 	else
-		cat("CGEL of type: ", x$type, " (alpha = ", x$CGEL, ")\n\n")
+		cat("CGEL of type: ", x$type, " (alpha = ", x$CGEL, ")\n")
+	if (!is.null(attr(x$dat,"smooth")))
+		{
+		cat("Kernel: ", attr(x$dat,"smooth")$kernel," (bw=",
+		attr(x$dat,"smooth")$bw,")\n\n")
+		}
+	else
+		cat("\n")
 
 	cat("Coefficients:\n")
 	print.default(format(coef(x), digits = digits),
@@ -83,10 +90,17 @@
 	cat("\nCall:\n")
 	cat(paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n\n", sep = "")
 	if (is.null(x$CGEL))
-		cat("Type de GEL: ", x$type, "\n\n")
+		cat("Type of GEL: ", x$type, "\n")
 	else
-		cat("CGEL of type: ", x$type, " (alpha = ", x$CGEL, ")\n\n")
-	cat("Kernel: ", x$kernel, "\n\n")
+		cat("CGEL of type: ", x$type, " (alpha = ", x$CGEL, ")\n")
+
+	if (!is.null(x$smooth))
+		{
+		cat("Kernel: ", x$smooth$kernel," (bw=", x$smooth$bw,")\n\n")
+		}
+	else
+		cat("\n")
+
 	cat("Coefficients:\n")
 	print.default(format(x$coefficients, digits = digits),
                       print.gap = 2, quote = FALSE)
@@ -141,6 +155,8 @@
 	ans$conv_moment <- cbind(z$conv_moment)
 	ans$conv_lambda <- z$conv_lambda
 	ans$CGEL <- z$CGEL
+	if (!is.null(attr(object$dat,"smooth")))
+		ans$smooth <- attr(object$dat,"smooth")
 	names(ans$conv_pt) <- "Sum_of_pt"
 	dimnames(ans$conv_moment) <- list(names(z$gt), "Sample_moment_with_pt")
 	class(ans) <- "summary.gel"

Modified: pkg/gmm/R/getModel.R
===================================================================
--- pkg/gmm/R/getModel.R	2012-05-29 15:30:37 UTC (rev 58)
+++ pkg/gmm/R/getModel.R	2012-05-30 18:38:41 UTC (rev 59)
@@ -240,7 +240,7 @@
     P$typel <- P$type
     P$typet <- P$type
     }
-  if(P$optfct == "optim")
+  if(P$optfct == "optim" | P$optfct == "nlminb")
     P$k <- length(P$tet0)
   else
     P$k <- 1
@@ -312,6 +312,9 @@
     }
   if (P$smooth)
     {
+    if (is.function(object$gradv))
+	warning("Since you provided gradv, smooth does not apply to it. Do not provide it if you want it to be based on the smoothed g()",
+		call. = FALSE)		
     if(P$kernel == "Truncated")
         {
         P$wkernel <- "Bartlett"
@@ -336,7 +339,7 @@
 	    P$bwVal <- P$bw
 
     P$w <- smoothG(gt, bw = P$bwVal)$kern_weights
-    attr(P$dat,"smooth") <- list(bw=P$bwVal, w=P$w, g = P$g1)
+    attr(P$dat,"smooth") <- list(bw=P$bwVal, w=P$w, g = P$g1,kernel=P$kernel)
 
     P$g <- function(thet, x)
       {

Modified: pkg/gmm/R/momentEstim.R
===================================================================
--- pkg/gmm/R/momentEstim.R	2012-05-29 15:30:37 UTC (rev 58)
+++ pkg/gmm/R/momentEstim.R	2012-05-30 18:38:41 UTC (rev 59)
@@ -729,7 +729,7 @@
 momentEstim.baseGel.mod <- function(object, ...)
   {
   P <- object
-  x <- P$x
+  x <- P$dat
   n <- ifelse(is.null(dim(x)),length(x),nrow(x))
   l0Env <- new.env()
   assign("l0",rep(0,P$q),envir=l0Env)
@@ -774,12 +774,12 @@
   z$conv_moment <- colSums(as.numeric(z$pt)*z$gt)
   z$conv_pt <- sum(as.numeric(z$pt))
   z$objective <- sum(as.numeric(rhom) - .rho(1, 0, type = P$typet, k = P$k1/P$k2))/n
+
   if(P$gradvf)
     G <- P$gradv(z$coefficients, x)
   else
     G <- P$gradv(z$coefficients, x, g = P$g, z$pt)
-
-  
+ 
   khat <- crossprod(c(z$pt)*z$gt, z$gt)/(P$k2)*P$bwVal
   G <- G/P$k1 
 



More information about the Gmm-commits mailing list