Nothing
inst/doc/gmm_with_R.R
In gmm: Generalized Method of Moments and Generalized Empirical Likelihood
## ----echo=FALSE---------------------------------------------------------------
library(knitr)
opts_chunk$set(size='footnotesize', fig.height=5, out.width='70%')
## -----------------------------------------------------------------------------
library(gmm)
## -----------------------------------------------------------------------------
g1 <- function(tet,x)
{
m1 <- (tet[1]-x)
m2 <- (tet[2]^2 - (x - tet[1])^2)
m3 <- x^3-tet[1]*(tet[1]^2+3*tet[2]^2)
f <- cbind(m1,m2,m3)
return(f)
}
## -----------------------------------------------------------------------------
Dg <- function(tet,x)
{
G <- matrix(c( 1,
2*(-tet[1]+mean(x)),
-3*tet[1]^2-3*tet[2]^2,0,
2*tet[2],-6*tet[1]*tet[2]),
nrow=3,ncol=2)
return(G)
}
## -----------------------------------------------------------------------------
set.seed(123)
n <- 200
x1 <- rnorm(n, mean = 4, sd = 2)
## -----------------------------------------------------------------------------
print(res <- gmm(g1,x1,c(mu = 0, sig = 0), grad = Dg))
## -----------------------------------------------------------------------------
summary(res)
## -----------------------------------------------------------------------------
specTest(res)
## -----------------------------------------------------------------------------
sim_ex <- function(n,iter)
{
tet1 <- matrix(0,iter,2)
tet2 <- tet1
for(i in 1:iter)
{
x1 <- rnorm(n, mean = 4, sd = 2)
tet1[i,1] <- mean(x1)
tet1[i,2] <- sqrt(var(x1)*(n-1)/n)
tet2[i,] <- gmm(g1,x1,c(0,0),grad=Dg)$coefficients
}
bias <- cbind(rowMeans(t(tet1)-c(4,2)),rowMeans(t(tet2)-c(4,2)))
dimnames(bias)<-list(c("mu","sigma"),c("ML","GMM"))
Var <- cbind(diag(var(tet1)),diag(var(tet2)))
dimnames(Var)<-list(c("mu","sigma"),c("ML","GMM"))
MSE <- cbind(rowMeans((t(tet1)-c(4,2))^2),rowMeans((t(tet2)-c(4,2))^2))
dimnames(MSE)<-list(c("mu","sigma"),c("ML","GMM"))
return(list(bias=bias,Variance=Var,MSE=MSE))
}
## -----------------------------------------------------------------------------
g2 <- function(theta,x)
{
tau <- seq(1,5,length.out=10)
pm <- 1
x <- matrix(c(x),ncol=1)
x_comp <- x%*%matrix(tau,nrow=1)
x_comp <- matrix(complex(ima=x_comp),ncol=length(tau))
emp_car <- exp(x_comp)
the_car <- charStable(theta,tau,pm)
gt <- t(t(emp_car) - the_car)
gt <- cbind(Im(gt),Re(gt))
return(gt)
}
## -----------------------------------------------------------------------------
library(stabledist)
set.seed(345)
x2 <- rstable(500,1.5,.5,pm=1)
t0 <- c(alpha = 2, beta = 0, gamma = sd(x2)/sqrt(2), delta = 0)
print(res <- gmm(g2,x2,t0))
## -----------------------------------------------------------------------------
summary(res)
## -----------------------------------------------------------------------------
res2 <- gmm(g2,x2,t0,optfct="nlminb",lower=c(0,-1,0,-Inf),upper=c(2,1,Inf,Inf))
summary(res2)
## ----warning=FALSE------------------------------------------------------------
data(Finance)
x3 <- Finance[1:1500,"WMK"]
t0<-c(alpha = 1.8, beta = 0.1, gamma = sd(x3)/sqrt(2),delta = 0)
res3 <- gmm(g2,x3,t0,optfct="nlminb")
summary(res3)
## -----------------------------------------------------------------------------
library(car)
linearHypothesis(res3,cbind(diag(2),c(0,0),c(0,0)),c(2,0))
## -----------------------------------------------------------------------------
library(mvtnorm)
set.seed(112233)
sig <- matrix(c(1,.5,.5,1),2,2)
n <- 400
e <- rmvnorm(n,sigma=sig)
x4 <- rnorm(n)
w <- exp(-x4^2) + e[,1]
y <- 0.1*w + e[,2]
## -----------------------------------------------------------------------------
h <- cbind(x4, x4^2, x4^3)
g3 <- y~w
## -----------------------------------------------------------------------------
summary(res <- gmm(g3,x=h))
## -----------------------------------------------------------------------------
res2 <- gmm(g3,x=h,type='iterative',crit=1e-8,itermax=200)
coef(res2)
## -----------------------------------------------------------------------------
res3 <- gmm(g3,x=h,res2$coef,type='cue')
coef(res3)
## -----------------------------------------------------------------------------
confint(res3,level=.90)
## -----------------------------------------------------------------------------
plot(w,y,main="LS vs GMM estimation")
lines(w,fitted(res),col=2)
lines(w,fitted(lm(y~w)),col=3,lty=2)
lines(w,.1*w,col=4,lty=3)
legend("topleft",c("Data","Fitted GMM","Fitted LS","True line"),pch=c(1,NA,NA,NA),col=1:3,lty=c(NA,1,2,3))
## -----------------------------------------------------------------------------
t <- 400
set.seed(345)
x5 <- arima.sim(n=t,list(ar=c(1.4,-0.6),ma=c(0.6,-0.3)))
x5t<-cbind(x5)
for (i in 1:6) x5t<-cbind(x5t,lag(x5,-i))
x5t<-na.omit(x5t)
g4<-x5t[,1]~x5t[,2]+x5t[,3]
res<-gmm(g4,x5t[,4:7])
summary(res)
## -----------------------------------------------------------------------------
res2 <- gmm(g4,x=x5t[,4:7],kernel="Truncated")
coef(res2)
res3 <- gmm(g4,x=x5t[,4:7],kernel="Bartlett")
coef(res3)
res4 <- gmm(g4,x=x5t[,4:7],kernel="Parzen")
coef(res4)
res5<- gmm(g4,x=x5t[,4:7],kernel="Tukey-Hanning")
coef(res5)
## -----------------------------------------------------------------------------
diag(vcov(res2))^.5
diag(vcov(res3))^.5
diag(vcov(res4))^.5
diag(vcov(res5))^.5
## -----------------------------------------------------------------------------
plot(res,which=2)
## -----------------------------------------------------------------------------
plot(res,which=3)
## -----------------------------------------------------------------------------
data(Finance)
r <- Finance[1:500,1:5]
rm <- Finance[1:500,"rm"]
rf <- Finance[1:500,"rf"]
z <- as.matrix(r-rf)
zm <- as.matrix(rm-rf)
res <- gmm(z~zm,x=zm)
coef(res)
R <- cbind(diag(5),matrix(0,5,5))
c <- rep(0,5)
linearHypothesis(res,R,c,test = "Chisq")
## ----eval=FALSE---------------------------------------------------------------
# test <- paste(names(coef(res)[1:5])," = 0",sep="")
# linearHypothesis(res,test)
## -----------------------------------------------------------------------------
res2<-gmm(z~zm-1,cbind(1,zm))
specTest(res2)
## -----------------------------------------------------------------------------
g5 <- function(tet, x) {
gmat <- (tet[1] + tet[2] * (1 + c(x[, 1]))) * (1 + x[, 2:6]) - 1
return(gmat)
}
res_sdf <- gmm(g5, x = as.matrix(cbind(rm, r)), c(0, 0))
specTest(res_sdf)
## -----------------------------------------------------------------------------
g6 <- function(theta, x) {
t <- length(x)
et1 <- diff(x) - theta[1] - theta[2] * x[-t]
ht <- et1^2 - theta[3] * x[-t]^(2 * theta[4])
g <- cbind(et1, et1 * x[-t], ht, ht * x[-t])
return(g)
}
## -----------------------------------------------------------------------------
rf <- Finance[,"rf"]
rf <- ((1 + rf/100)^(365) - 1) * 100
dr <- diff(rf)
res_0 <- lm(dr ~ rf[-length(rf)])
tet0 <- c(res_0$coef, var(residuals(res_0)), 0)
names(tet0) <- c("alpha", "beta", "sigma^2", "gamma")
res_rf <- gmm(g6, rf, tet0, control = list(maxit = 1000, reltol = 1e-10))
coef(res_rf)
## ----eval=FALSE---------------------------------------------------------------
# y <- rbind(y1-mean(y1),y2-mean(y2),y3-mean(y3))
# x <- rbind(x1-mean(x1),x2-mean(x2),x3-mean(x3))
# res <- gmm(y~x,h)
## ----eval=FALSE---------------------------------------------------------------
# y <- rbind(y1,y2,y3)
# x <- rbind(x1,x2,x3)
# res <- gmm(y~x,h)
## ----eval=FALSE---------------------------------------------------------------
# gt <- g(t0, x)
# V <- kernHAC(lm(gt~1),sandwich = FALSE)
# W <- solve(V)
## -----------------------------------------------------------------------------
print(res<-gmm(g4,x5t[,4:7],wmatrix="ident"))
diag(vcovHAC(res))^.5
## -----------------------------------------------------------------------------
diag(vcov(res))^.5
## -----------------------------------------------------------------------------
print(res<-gmm(g4,x5t[,4:7], weightsMatrix = diag(5)))
## -----------------------------------------------------------------------------
tet0 <- c(mu = mean(x1), sig = sd(x1))
res_el <- gel(g1,x1,tet0)
summary(res_el)
## -----------------------------------------------------------------------------
res_et <- gel(g1,x1,tet0,type="ET")
coef(res_et)
## -----------------------------------------------------------------------------
res_cue <- gel(g1,x1,tet0,type="CUE")
coef(res_cue)
## -----------------------------------------------------------------------------
res_etel <- gel(g1,x1,c(mu=1,sig=1),type="ETEL")
coef(res_etel)
## ----warning=FALSE------------------------------------------------------------
tet0 <- gmm(g4,x=x5t[,4:7],wmatrix="ident")$coef
res <- gel(g4,x=x5t[,4:7],tet0,smooth=TRUE,kernel="Truncated")
summary(res)
## -----------------------------------------------------------------------------
specTest(res)
## -----------------------------------------------------------------------------
plot(res,which=4)
## ----eval=FALSE---------------------------------------------------------------
# ui=cbind(0,-1,-1)
# ci <- -1
## ----eval=FALSE---------------------------------------------------------------
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE,kernel="Truncated",
# constraint=TRUE, ui=ui,ci=ci)
## ----eval=FALSE---------------------------------------------------------------
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE, optlam="optim")
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE, optlam="optim",
# LambdaControl=list(trace=TRUE, parscale=rep(.1,5)))
Try the gmm package in your browser
Any scripts or data that you put into this service are public.
gmm documentation built on June 7, 2023, 6:05 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## ----echo=FALSE---------------------------------------------------------------
library(knitr)
opts_chunk$set(size='footnotesize', fig.height=5, out.width='70%')
## -----------------------------------------------------------------------------
library(gmm)
## -----------------------------------------------------------------------------
g1 <- function(tet,x)
{
m1 <- (tet[1]-x)
m2 <- (tet[2]^2 - (x - tet[1])^2)
m3 <- x^3-tet[1]*(tet[1]^2+3*tet[2]^2)
f <- cbind(m1,m2,m3)
return(f)
}
## -----------------------------------------------------------------------------
Dg <- function(tet,x)
{
G <- matrix(c( 1,
2*(-tet[1]+mean(x)),
-3*tet[1]^2-3*tet[2]^2,0,
2*tet[2],-6*tet[1]*tet[2]),
nrow=3,ncol=2)
return(G)
}
## -----------------------------------------------------------------------------
set.seed(123)
n <- 200
x1 <- rnorm(n, mean = 4, sd = 2)
## -----------------------------------------------------------------------------
print(res <- gmm(g1,x1,c(mu = 0, sig = 0), grad = Dg))
## -----------------------------------------------------------------------------
summary(res)
## -----------------------------------------------------------------------------
specTest(res)
## -----------------------------------------------------------------------------
sim_ex <- function(n,iter)
{
tet1 <- matrix(0,iter,2)
tet2 <- tet1
for(i in 1:iter)
{
x1 <- rnorm(n, mean = 4, sd = 2)
tet1[i,1] <- mean(x1)
tet1[i,2] <- sqrt(var(x1)*(n-1)/n)
tet2[i,] <- gmm(g1,x1,c(0,0),grad=Dg)$coefficients
}
bias <- cbind(rowMeans(t(tet1)-c(4,2)),rowMeans(t(tet2)-c(4,2)))
dimnames(bias)<-list(c("mu","sigma"),c("ML","GMM"))
Var <- cbind(diag(var(tet1)),diag(var(tet2)))
dimnames(Var)<-list(c("mu","sigma"),c("ML","GMM"))
MSE <- cbind(rowMeans((t(tet1)-c(4,2))^2),rowMeans((t(tet2)-c(4,2))^2))
dimnames(MSE)<-list(c("mu","sigma"),c("ML","GMM"))
return(list(bias=bias,Variance=Var,MSE=MSE))
}
## -----------------------------------------------------------------------------
g2 <- function(theta,x)
{
tau <- seq(1,5,length.out=10)
pm <- 1
x <- matrix(c(x),ncol=1)
x_comp <- x%*%matrix(tau,nrow=1)
x_comp <- matrix(complex(ima=x_comp),ncol=length(tau))
emp_car <- exp(x_comp)
the_car <- charStable(theta,tau,pm)
gt <- t(t(emp_car) - the_car)
gt <- cbind(Im(gt),Re(gt))
return(gt)
}
## -----------------------------------------------------------------------------
library(stabledist)
set.seed(345)
x2 <- rstable(500,1.5,.5,pm=1)
t0 <- c(alpha = 2, beta = 0, gamma = sd(x2)/sqrt(2), delta = 0)
print(res <- gmm(g2,x2,t0))
## -----------------------------------------------------------------------------
summary(res)
## -----------------------------------------------------------------------------
res2 <- gmm(g2,x2,t0,optfct="nlminb",lower=c(0,-1,0,-Inf),upper=c(2,1,Inf,Inf))
summary(res2)
## ----warning=FALSE------------------------------------------------------------
data(Finance)
x3 <- Finance[1:1500,"WMK"]
t0<-c(alpha = 1.8, beta = 0.1, gamma = sd(x3)/sqrt(2),delta = 0)
res3 <- gmm(g2,x3,t0,optfct="nlminb")
summary(res3)
## -----------------------------------------------------------------------------
library(car)
linearHypothesis(res3,cbind(diag(2),c(0,0),c(0,0)),c(2,0))
## -----------------------------------------------------------------------------
library(mvtnorm)
set.seed(112233)
sig <- matrix(c(1,.5,.5,1),2,2)
n <- 400
e <- rmvnorm(n,sigma=sig)
x4 <- rnorm(n)
w <- exp(-x4^2) + e[,1]
y <- 0.1*w + e[,2]
## -----------------------------------------------------------------------------
h <- cbind(x4, x4^2, x4^3)
g3 <- y~w
## -----------------------------------------------------------------------------
summary(res <- gmm(g3,x=h))
## -----------------------------------------------------------------------------
res2 <- gmm(g3,x=h,type='iterative',crit=1e-8,itermax=200)
coef(res2)
## -----------------------------------------------------------------------------
res3 <- gmm(g3,x=h,res2$coef,type='cue')
coef(res3)
## -----------------------------------------------------------------------------
confint(res3,level=.90)
## -----------------------------------------------------------------------------
plot(w,y,main="LS vs GMM estimation")
lines(w,fitted(res),col=2)
lines(w,fitted(lm(y~w)),col=3,lty=2)
lines(w,.1*w,col=4,lty=3)
legend("topleft",c("Data","Fitted GMM","Fitted LS","True line"),pch=c(1,NA,NA,NA),col=1:3,lty=c(NA,1,2,3))
## -----------------------------------------------------------------------------
t <- 400
set.seed(345)
x5 <- arima.sim(n=t,list(ar=c(1.4,-0.6),ma=c(0.6,-0.3)))
x5t<-cbind(x5)
for (i in 1:6) x5t<-cbind(x5t,lag(x5,-i))
x5t<-na.omit(x5t)
g4<-x5t[,1]~x5t[,2]+x5t[,3]
res<-gmm(g4,x5t[,4:7])
summary(res)
## -----------------------------------------------------------------------------
res2 <- gmm(g4,x=x5t[,4:7],kernel="Truncated")
coef(res2)
res3 <- gmm(g4,x=x5t[,4:7],kernel="Bartlett")
coef(res3)
res4 <- gmm(g4,x=x5t[,4:7],kernel="Parzen")
coef(res4)
res5<- gmm(g4,x=x5t[,4:7],kernel="Tukey-Hanning")
coef(res5)
## -----------------------------------------------------------------------------
diag(vcov(res2))^.5
diag(vcov(res3))^.5
diag(vcov(res4))^.5
diag(vcov(res5))^.5
## -----------------------------------------------------------------------------
plot(res,which=2)
## -----------------------------------------------------------------------------
plot(res,which=3)
## -----------------------------------------------------------------------------
data(Finance)
r <- Finance[1:500,1:5]
rm <- Finance[1:500,"rm"]
rf <- Finance[1:500,"rf"]
z <- as.matrix(r-rf)
zm <- as.matrix(rm-rf)
res <- gmm(z~zm,x=zm)
coef(res)
R <- cbind(diag(5),matrix(0,5,5))
c <- rep(0,5)
linearHypothesis(res,R,c,test = "Chisq")
## ----eval=FALSE---------------------------------------------------------------
# test <- paste(names(coef(res)[1:5])," = 0",sep="")
# linearHypothesis(res,test)
## -----------------------------------------------------------------------------
res2<-gmm(z~zm-1,cbind(1,zm))
specTest(res2)
## -----------------------------------------------------------------------------
g5 <- function(tet, x) {
gmat <- (tet[1] + tet[2] * (1 + c(x[, 1]))) * (1 + x[, 2:6]) - 1
return(gmat)
}
res_sdf <- gmm(g5, x = as.matrix(cbind(rm, r)), c(0, 0))
specTest(res_sdf)
## -----------------------------------------------------------------------------
g6 <- function(theta, x) {
t <- length(x)
et1 <- diff(x) - theta[1] - theta[2] * x[-t]
ht <- et1^2 - theta[3] * x[-t]^(2 * theta[4])
g <- cbind(et1, et1 * x[-t], ht, ht * x[-t])
return(g)
}
## -----------------------------------------------------------------------------
rf <- Finance[,"rf"]
rf <- ((1 + rf/100)^(365) - 1) * 100
dr <- diff(rf)
res_0 <- lm(dr ~ rf[-length(rf)])
tet0 <- c(res_0$coef, var(residuals(res_0)), 0)
names(tet0) <- c("alpha", "beta", "sigma^2", "gamma")
res_rf <- gmm(g6, rf, tet0, control = list(maxit = 1000, reltol = 1e-10))
coef(res_rf)
## ----eval=FALSE---------------------------------------------------------------
# y <- rbind(y1-mean(y1),y2-mean(y2),y3-mean(y3))
# x <- rbind(x1-mean(x1),x2-mean(x2),x3-mean(x3))
# res <- gmm(y~x,h)
## ----eval=FALSE---------------------------------------------------------------
# y <- rbind(y1,y2,y3)
# x <- rbind(x1,x2,x3)
# res <- gmm(y~x,h)
## ----eval=FALSE---------------------------------------------------------------
# gt <- g(t0, x)
# V <- kernHAC(lm(gt~1),sandwich = FALSE)
# W <- solve(V)
## -----------------------------------------------------------------------------
print(res<-gmm(g4,x5t[,4:7],wmatrix="ident"))
diag(vcovHAC(res))^.5
## -----------------------------------------------------------------------------
diag(vcov(res))^.5
## -----------------------------------------------------------------------------
print(res<-gmm(g4,x5t[,4:7], weightsMatrix = diag(5)))
## -----------------------------------------------------------------------------
tet0 <- c(mu = mean(x1), sig = sd(x1))
res_el <- gel(g1,x1,tet0)
summary(res_el)
## -----------------------------------------------------------------------------
res_et <- gel(g1,x1,tet0,type="ET")
coef(res_et)
## -----------------------------------------------------------------------------
res_cue <- gel(g1,x1,tet0,type="CUE")
coef(res_cue)
## -----------------------------------------------------------------------------
res_etel <- gel(g1,x1,c(mu=1,sig=1),type="ETEL")
coef(res_etel)
## ----warning=FALSE------------------------------------------------------------
tet0 <- gmm(g4,x=x5t[,4:7],wmatrix="ident")$coef
res <- gel(g4,x=x5t[,4:7],tet0,smooth=TRUE,kernel="Truncated")
summary(res)
## -----------------------------------------------------------------------------
specTest(res)
## -----------------------------------------------------------------------------
plot(res,which=4)
## ----eval=FALSE---------------------------------------------------------------
# ui=cbind(0,-1,-1)
# ci <- -1
## ----eval=FALSE---------------------------------------------------------------
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE,kernel="Truncated",
# constraint=TRUE, ui=ui,ci=ci)
## ----eval=FALSE---------------------------------------------------------------
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE, optlam="optim")
# res <- gel(g4,x=dat5[,4:7],tet0,smooth=TRUE, optlam="optim",
# LambdaControl=list(trace=TRUE, parscale=rep(.1,5)))
Try the gmm package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.