[Gmm-commits] r56 - in pkg: . gmm gmm/R gmm/man gmmExtra gmmExtra/R gmmExtra/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 24 16:16:03 CEST 2012
Author: chaussep
Date: 2012-05-24 16:16:03 +0200 (Thu, 24 May 2012)
New Revision: 56
Added:
pkg/gmmExtra/
pkg/gmmExtra/DESCRIPTION
pkg/gmmExtra/NAMESPACE
pkg/gmmExtra/NEWS
pkg/gmmExtra/R/
pkg/gmmExtra/R/KConfig.R
pkg/gmmExtra/licence
pkg/gmmExtra/man/
pkg/gmmExtra/man/KConfid.Rd
Removed:
pkg/gmm/man/KConfid.Rd
Modified:
pkg/gmm/DESCRIPTION
pkg/gmm/NAMESPACE
pkg/gmm/R/gmmTests.R
Log:
Removed the dependency on multicore that fails to load on windows and created another package gmmExtra instead
Modified: pkg/gmm/DESCRIPTION
===================================================================
--- pkg/gmm/DESCRIPTION 2012-05-24 03:18:08 UTC (rev 55)
+++ pkg/gmm/DESCRIPTION 2012-05-24 14:16:03 UTC (rev 56)
@@ -1,6 +1,6 @@
Package: gmm
Version: 1.4-0
-Date: 2012-04-16
+Date: 2012-05-24
Title: Generalized Method of Moments and Generalized Empirical
Likelihood
Author: Pierre Chausse <pchausse at uwaterloo.ca>
@@ -12,8 +12,8 @@
methods that belong to the Generalized Empirical Likelihood
(GEL) family of estimators, as presented by Smith(1997),
Kitamura(1997), Newey-Smith(2004) and Anatolyev(2005).
-Depends: R (>= 2.10.0), sandwich, multicore
-Suggests: mvtnorm, car, fBasics, MASS, timeDate, timeSeries
+Depends: R (>= 2.10.0), sandwich
+Suggests: mvtnorm, car, fBasics, MASS, timeDate, timeSeries, gmmExtra
Imports: stats
License: GPL (>= 2)
Modified: pkg/gmm/NAMESPACE
===================================================================
--- pkg/gmm/NAMESPACE 2012-05-24 03:18:08 UTC (rev 55)
+++ pkg/gmm/NAMESPACE 2012-05-24 14:16:03 UTC (rev 56)
@@ -8,7 +8,7 @@
specTest.gmm, specTest.gel, print.specTest, momentEstim.baseGmm.twoStep, momentEstim.baseGmm.twoStep.formula,
momentEstim.baseGmm.iterative.formula, momentEstim.baseGmm.iterative, momentEstim.baseGmm.cue.formula,
momentEstim.baseGmm.cue, getModel.baseGmm, getModel.baseGel, getModel.constGmm, FinRes.baseGmm.res, momentEstim.baseGel.mod,
- momentEstim.baseGel.modFormula,tsls,summary.tsls, print.summary.tsls, KTest, print.gmmTests, KConfid, gmmWithConst)
+ momentEstim.baseGel.modFormula,tsls,summary.tsls, print.summary.tsls, KTest, print.gmmTests, gmmWithConst)
S3method(summary, gmm)
S3method(summary, tsls)
Modified: pkg/gmm/R/gmmTests.R
===================================================================
--- pkg/gmm/R/gmmTests.R 2012-05-24 03:18:08 UTC (rev 55)
+++ pkg/gmm/R/gmmTests.R 2012-05-24 14:16:03 UTC (rev 56)
@@ -213,147 +213,4 @@
return(res)
}
-KConfid <- function(obj, which, type = c("K", "KJ"), alpha = 0.05, alphaJ = 0.01, n = 4)
- {
- if (is.element("multicore", installed.packages()[,1]))
- theApply <- mclapply
- else
- theApply <- lapply
- type <- match.arg(type)
- if ( (obj$df == 0) & (type == "KJ"))
- stop("Only K type is available for just identified models")
-
- if ( (alphaJ >= alpha) | (alphaJ <= 0) )
- stop("We must have 0 < alphaJ < alpha")
- if ( (alpha <= 0) | (alpha >=1) )
- stop("We must have 0 < alpha < 1")
- alphaK <- alpha-alphaJ
-
- if (!is.null(attr(obj$dat,"eqConst")))
- stop("Confidence intervals are constructed from unrestricted models")
- if (length(which) > 2)
- stop("This function computes confidence intervals for 1 or 2 coefficients only")
- if (length(which)>length(obj$coefficients))
- stop("length(which) must not exceed length(coefficients)")
- if (is.character(which))
- {
- if (any(!(which %in% names(obj$coef))))
- stop("names in which do not match names in coefficients")
- else
- which <- sort(which(which %in% names(obj$coef)))
- } else {
- if (any(which>length(obj$coefficients)) | any(which<=0))
- stop("indices in which are not valid")
- }
- getUniInt <- function(tetx, obj, which, value=NULL, type , alpha, alphaJ, alphaK)
- {
- # value is the value of the other coefficient when we have 2 restrictions
- # tetx is coef(obj)[which[1]] when we have two restrictions
-
- if (is.null(value))
- value <- tetx
- else
- value <- c(tetx,value)
- res <- gmmWithConst(obj, which = which, value = value)
- test <- KTest(res)
- if (type == "K")
- {
- ifelse(alpha > test$test[1,2], 1, -1)
- } else {
- if (test$test[2,2]<alphaJ)
- {
- return(1)
- } else {
- ifelse(test$test[1,2]<alphaK, 1, -1)
- }
- }
- }
- gForMulti <- function(theta, obj, which, type , alpha, alphaJ, alphaK)
- getUniInt(theta[1], obj, which, theta[2], type , alpha, alphaJ, alphaK)
-
- if (length(which) == 1)
- {
- step <- 5*sqrt(diag(vcov(obj)))[which]
- X0 <- obj$coef[which]
- getBoth <- function(d)
- {
- res <- try(uniroot(getUniInt,c(X0,X0+d*step), obj = obj, which = which, type = type,
- alpha = alpha, alphaJ = alphaJ, alphaK = alphaK, tol=1e-4), silent=TRUE)
- if (class(res) == "try-error")
- return(NA)
- else
- return(res$root)
- }
- res <- theApply(c(-1,1), getBoth)
- c(res[[1]],res[[2]])
- } else {
- step <- 5*sqrt(diag(vcov(obj)))[which]
- sol <- .getCircle(obj$coef[which][1],obj$coef[which][2],gForMulti,n , step, obj=obj,
- which=which, type=type, alpha=alpha, alphaJ=alphaJ, alphaK=alphaK)
- colnames(sol) <- names(obj$coef)[which]
- sol
- }
- }
-
-.getCircle <- function(x0,y0,g,n,b, trace=FALSE, ...)
- {
- if (is.element("multicore", installed.packages()[,1]))
- theApply <- mclapply
- else
- theApply <- lapply
- tol=1e-4
- if (any(b<=0))
- stop("b must be strictly positive")
-
-
- lambda <- seq(1,0,length=n)[-c(1,n)]
- f <- function(x, y0, x0 = NULL, xi = NULL, yi = NULL)
- {
- if (is.null(xi))
- y <- y0
- else
- y <- y0 + (yi-y0)/(xi-x0)*(x-x0)
- g(c(x,y), ...)
- }
- f2 <- function(y, y0)
- g(c(y0,y), ...)
- f3 <- function(x)
- ifelse(class(x)=="try-error",NA,x)
-
- # get the four points of the cross
- selectf <- list(f,f,f2,f2)
- selectd <- c(1,-1,1,-1)
- xy12 <- theApply(1:4, function(i) try(uniroot(selectf[[i]],c(x0,x0+selectd[i]*b[1]),y0=y0,tol=tol)$root,silent=TRUE))
-
- x1 <- xy12[[1]]
- x2 <- xy12[[2]]
- y1 <- xy12[[3]]
- y2 <- xy12[[4]]
-
- getAll <- function(lambda, dir=1, x)
- {
- yi <- y1*lambda + y0*(1-lambda)
- xi <- x0*lambda + x*(1-lambda)
- xt <- try(uniroot(f,c(x0,x0+dir*b[1]),y0=y0, x0=x0, xi=xi, yi=yi,tol=tol)$root,silent=TRUE)
- xt <- f3(xt)
- yt <- y0 + (yi-y0)/(xi-x0)*(xt-x0)
- return(c(xt,yt))
- }
-
- res1 <- theApply(lambda,getAll,dir=1,x=x1)
- res2 <- theApply(lambda,getAll,dir=-1,x=x2)
- res1 <- t(simplify2array(res1))
- res2 <- t(simplify2array(res2))
- solU <- rbind(c(x2,y0),res2[length(lambda):1,],c(f3(x0), f3(y1)),res1,c(x1,y0))
-
- res1 <- theApply(lambda,getAll,dir=-1,x=x1)
- res2 <- theApply(lambda,getAll,dir=1,x=x2)
- res1 <- t(simplify2array(res1))
- res2 <- t(simplify2array(res2))
- solD <- rbind(res2[length(lambda):1,],c(f3(x0), f3(y2)),res1)
-
- sol <- rbind(solU,solD)
- return(sol)
- }
-
Deleted: pkg/gmm/man/KConfid.Rd
===================================================================
--- pkg/gmm/man/KConfid.Rd 2012-05-24 03:18:08 UTC (rev 55)
+++ pkg/gmm/man/KConfid.Rd 2012-05-24 14:16:03 UTC (rev 56)
@@ -1,51 +0,0 @@
-\name{KConfid}
-\alias{KConfid}
-
-\title{Confidence interval using the K statistics of Kleibergen}
-\description{The confidence is either an interval or an ellipse.
-}
-\usage{
-KConfid(obj, which, type = c("K", "KJ"), alpha = 0.05, alphaJ = 0.01, n = 4)
-}
-\arguments{
- \item{obj}{Object of class "gmm" returned by \code{\link{gmm}} (not restricted)}
- \item{type}{Should we base the confidence interval on the K or K-J statistics.}
- \item{which}{A 2x1 vector or a scalar. The interval is computed for \code{coef(obj)[which]}. }
- \item{alpha, alphaJ}{The overall size and the size for the J-test when type is "KS".}
- \item{n}{The number of points to compute the confidence region is 4(n-1). It must be greater than 2.}
-}
-
-
-\value{
-Interval for \code{lenght(which)=1} or a series of points if \code{lenght(which)>1}.
-}
-
-\references{
-
- Kleibergen, F. (2005),
- Testing Parameters in GMM without assuming that they are identified.
- \emph{Econometrica}, \bold{73},
- 1103-1123,
-
-}
-
-\examples{
-
-data(Finance)
-r <- Finance[1:300, 1]
-rf <- Finance[1:300, "rf"]
-z <- as.matrix(r-rf)
-zm <- Finance[1:300, "rm"]-rf
-f1 <- zm
-f2 <- Finance[1:300, "hml"] - rf
-f3 <- Finance[1:300, "smb"] - rf
-res <- gmm(z ~ f1 + f2 + f3, ~ f1 + f2 + f3)
-
-KConfid(res,2)
-sol <- KConfid(res,c(2,3))
-plot(sol, main="Confidence Region")
-polygon(sol,col="grey")
-points(res$coef[2],res$coef[3],pch=21,bg=1)
-text(res$coef[2],res$coef[3],expression(hat(theta)),pos=3)
-
-}
Added: pkg/gmmExtra/DESCRIPTION
===================================================================
--- pkg/gmmExtra/DESCRIPTION (rev 0)
+++ pkg/gmmExtra/DESCRIPTION 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,12 @@
+Package: gmmExtra
+Version: 0.0-1
+Date: 2012-05-24
+Title: Extra tools for GMM estimation
+Author: Pierre Chausse <pchausse at uwaterloo.ca>
+Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>
+Description: Tools for GMM such as additional tests or robust confidence regions. They only apply to gmm class object for the gmm package.
+Depends: R (>= 2.10.0), gmm (>= 1.4), multicore
+Suggests: mvtnorm, car, fBasics, MASS, timeDate, timeSeries
+Imports: stats
+License: GPL (>= 2)
+
Added: pkg/gmmExtra/NAMESPACE
===================================================================
--- pkg/gmmExtra/NAMESPACE (rev 0)
+++ pkg/gmmExtra/NAMESPACE 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,5 @@
+import(stats)
+
+export(KConfid)
+
+
Added: pkg/gmmExtra/NEWS
===================================================================
--- pkg/gmmExtra/NEWS (rev 0)
+++ pkg/gmmExtra/NEWS 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,4 @@
+Starting version 0.0-1
+
+o The package only include KConf for now. It has been removed from the gmm package because of the dependency on multicore which is not available on Windows.
+ It is very experimental for now.
Added: pkg/gmmExtra/R/KConfig.R
===================================================================
--- pkg/gmmExtra/R/KConfig.R (rev 0)
+++ pkg/gmmExtra/R/KConfig.R 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,144 @@
+KConfid <- function(obj, which, type = c("K", "KJ"), alpha = 0.05, alphaJ = 0.01, n = 4)
+ {
+ if (is.element("multicore", installed.packages()[,1]))
+ theApply <- mclapply
+ else
+ theApply <- lapply
+
+ type <- match.arg(type)
+ if ( (obj$df == 0) & (type == "KJ"))
+ stop("Only K type is available for just identified models")
+
+ if ( (alphaJ >= alpha) | (alphaJ <= 0) )
+ stop("We must have 0 < alphaJ < alpha")
+ if ( (alpha <= 0) | (alpha >=1) )
+ stop("We must have 0 < alpha < 1")
+ alphaK <- alpha-alphaJ
+
+ if (!is.null(attr(obj$dat,"eqConst")))
+ stop("Confidence intervals are constructed from unrestricted models")
+ if (length(which) > 2)
+ stop("This function computes confidence intervals for 1 or 2 coefficients only")
+ if (length(which)>length(obj$coefficients))
+ stop("length(which) must not exceed length(coefficients)")
+ if (is.character(which))
+ {
+ if (any(!(which %in% names(obj$coef))))
+ stop("names in which do not match names in coefficients")
+ else
+ which <- sort(which(which %in% names(obj$coef)))
+ } else {
+ if (any(which>length(obj$coefficients)) | any(which<=0))
+ stop("indices in which are not valid")
+ }
+ getUniInt <- function(tetx, obj, which, value=NULL, type , alpha, alphaJ, alphaK)
+ {
+ # value is the value of the other coefficient when we have 2 restrictions
+ # tetx is coef(obj)[which[1]] when we have two restrictions
+
+ if (is.null(value))
+ value <- tetx
+ else
+ value <- c(tetx,value)
+ res <- gmmWithConst(obj, which = which, value = value)
+ test <- KTest(res)
+ if (type == "K")
+ {
+ ifelse(alpha > test$test[1,2], 1, -1)
+ } else {
+ if (test$test[2,2]<alphaJ)
+ {
+ return(1)
+ } else {
+ ifelse(test$test[1,2]<alphaK, 1, -1)
+ }
+ }
+ }
+ gForMulti <- function(theta, obj, which, type , alpha, alphaJ, alphaK)
+ getUniInt(theta[1], obj, which, theta[2], type , alpha, alphaJ, alphaK)
+
+ if (length(which) == 1)
+ {
+ step <- 5*sqrt(diag(vcov(obj)))[which]
+ X0 <- obj$coef[which]
+ getBoth <- function(d)
+ {
+ res <- try(uniroot(getUniInt,c(X0,X0+d*step), obj = obj, which = which, type = type,
+ alpha = alpha, alphaJ = alphaJ, alphaK = alphaK, tol=1e-4), silent=TRUE)
+ if (class(res) == "try-error")
+ return(NA)
+ else
+ return(res$root)
+ }
+ res <- theApply(c(-1,1), getBoth)
+ c(res[[1]],res[[2]])
+ } else {
+ step <- 5*sqrt(diag(vcov(obj)))[which]
+ sol <- .getCircle(obj$coef[which][1],obj$coef[which][2],gForMulti,n , step, obj=obj,
+ which=which, type=type, alpha=alpha, alphaJ=alphaJ, alphaK=alphaK)
+ colnames(sol) <- names(obj$coef)[which]
+ sol
+ }
+ }
+
+.getCircle <- function(x0,y0,g,n,b, trace=FALSE, ...)
+ {
+ if (is.element("multicore", installed.packages()[,1]))
+ theApply <- mclapply
+ else
+ theApply <- lapply
+ tol=1e-4
+ if (any(b<=0))
+ stop("b must be strictly positive")
+
+
+ lambda <- seq(1,0,length=n)[-c(1,n)]
+ f <- function(x, y0, x0 = NULL, xi = NULL, yi = NULL)
+ {
+ if (is.null(xi))
+ y <- y0
+ else
+ y <- y0 + (yi-y0)/(xi-x0)*(x-x0)
+ g(c(x,y), ...)
+ }
+ f2 <- function(y, y0)
+ g(c(y0,y), ...)
+ f3 <- function(x)
+ ifelse(class(x)=="try-error",NA,x)
+
+ # get the four points of the cross
+ selectf <- list(f,f,f2,f2)
+ selectd <- c(1,-1,1,-1)
+ xy12 <- theApply(1:4, function(i) try(uniroot(selectf[[i]],c(x0,x0+selectd[i]*b[1]),y0=y0,tol=tol)$root,silent=TRUE))
+
+ x1 <- xy12[[1]]
+ x2 <- xy12[[2]]
+ y1 <- xy12[[3]]
+ y2 <- xy12[[4]]
+
+ getAll <- function(lambda, dir=1, x)
+ {
+ yi <- y1*lambda + y0*(1-lambda)
+ xi <- x0*lambda + x*(1-lambda)
+ xt <- try(uniroot(f,c(x0,x0+dir*b[1]),y0=y0, x0=x0, xi=xi, yi=yi,tol=tol)$root,silent=TRUE)
+ xt <- f3(xt)
+ yt <- y0 + (yi-y0)/(xi-x0)*(xt-x0)
+ return(c(xt,yt))
+ }
+
+ res1 <- theApply(lambda,getAll,dir=1,x=x1)
+ res2 <- theApply(lambda,getAll,dir=-1,x=x2)
+ res1 <- t(simplify2array(res1))
+ res2 <- t(simplify2array(res2))
+ solU <- rbind(c(x2,y0),res2[length(lambda):1,],c(f3(x0), f3(y1)),res1,c(x1,y0))
+
+ res1 <- theApply(lambda,getAll,dir=-1,x=x1)
+ res2 <- theApply(lambda,getAll,dir=1,x=x2)
+ res1 <- t(simplify2array(res1))
+ res2 <- t(simplify2array(res2))
+ solD <- rbind(res2[length(lambda):1,],c(f3(x0), f3(y2)),res1)
+
+ sol <- rbind(solU,solD)
+ return(sol)
+ }
+
Added: pkg/gmmExtra/licence
===================================================================
--- pkg/gmmExtra/licence (rev 0)
+++ pkg/gmmExtra/licence 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,7 @@
+This software is distributed under the terms of the GNU General Public
+License as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version.
+
+A copy of the GNU General Public License is in file COPYING in the
+sources of this package, and is also available at
+http://www.r-project.org/Licenses/
Property changes on: pkg/gmmExtra/licence
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/gmmExtra/man/KConfid.Rd
===================================================================
--- pkg/gmmExtra/man/KConfid.Rd (rev 0)
+++ pkg/gmmExtra/man/KConfid.Rd 2012-05-24 14:16:03 UTC (rev 56)
@@ -0,0 +1,51 @@
+\name{KConfid}
+\alias{KConfid}
+
+\title{Confidence interval using the K statistics of Kleibergen}
+\description{The confidence is either an interval or an ellipse.
+}
+\usage{
+KConfid(obj, which, type = c("K", "KJ"), alpha = 0.05, alphaJ = 0.01, n = 4)
+}
+\arguments{
+ \item{obj}{Object of class "gmm" returned by \code{\link{gmm}} (not restricted)}
+ \item{type}{Should we base the confidence interval on the K or K-J statistics.}
+ \item{which}{A 2x1 vector or a scalar. The interval is computed for \code{coef(obj)[which]}. }
+ \item{alpha, alphaJ}{The overall size and the size for the J-test when type is "KS".}
+ \item{n}{The number of points to compute the confidence region is 4(n-1). It must be greater than 2.}
+}
+
+
+\value{
+Interval for \code{lenght(which)=1} or a series of points if \code{lenght(which)>1}.
+}
+
+\references{
+
+ Kleibergen, F. (2005),
+ Testing Parameters in GMM without assuming that they are identified.
+ \emph{Econometrica}, \bold{73},
+ 1103-1123,
+
+}
+
+\examples{
+
+data(Finance)
+r <- Finance[1:300, 1]
+rf <- Finance[1:300, "rf"]
+z <- as.matrix(r-rf)
+zm <- Finance[1:300, "rm"]-rf
+f1 <- zm
+f2 <- Finance[1:300, "hml"] - rf
+f3 <- Finance[1:300, "smb"] - rf
+res <- gmm(z ~ f1 + f2 + f3, ~ f1 + f2 + f3)
+
+KConfid(res,2)
+sol <- KConfid(res,c(2,3))
+plot(sol, main="Confidence Region")
+polygon(sol,col="grey")
+points(res$coef[2],res$coef[3],pch=21,bg=1)
+text(res$coef[2],res$coef[3],expression(hat(theta)),pos=3)
+
+}
More information about the Gmm-commits
mailing list