enlever la partie contraintes, va refaire d'autres fonctions plus tard

pour ça
This commit is contained in:
François Pelletier 2014-03-08 00:37:30 -05:00
parent ca602c5f75
commit 445e334b28
8 changed files with 40 additions and 49 deletions

View file

@ -9,7 +9,7 @@
#'
#' @param start Starting values for the parameters and lagrangian
#' @param conditions.vector Vector of moment conditions
#' @param sample Individual data sample
#' @param data Individual data sample
#' @param ... Functions of the vector of moment conditions
#' @param W Weighting matrix
#' @param R Linear constraint matrix of coefficients
@ -19,15 +19,15 @@
#' @return A list containing the optimized vector of parameter and corresponding covariance matrix
#' @export iterative.GMM
#' @author François Pelletier
iterative.GMM <- function(start,conditions.vector,sample,...,
W,R,r,max.iter=50,epsilon=1E-6)
iterative.GMM <- function(start,conditions.vector,data,...,
W=diag(length(conditions.vector)),R=0,r=0,lagrangian.start=rep(0,length(conditions.vector)),max.iter=50,epsilon=1E-6)
{
theta1 <- optim.GMM(start,conditions.vector,sample,...,W,R,r)
theta1 <- optim.GMM(start,conditions.vector,data,...,W,R,r,lagrangian.start)
i <- 1
repeat
{
theta2 <- optim.GMM(theta1,conditions.vector,sample,...,W,R,r)
S <- covariance.GMM(conditions.vector,param,sample,...)
theta2 <- optim.GMM(theta1,conditions.vector,data,...,W,R,r,lagrangian.start)
S <- covariance.GMM(conditions.vector,param,data,...)
if(sqrt(sum((theta1-theta2)^2))<epsilon)
return(list(par=theta2,cov=S))
else if (i>max.iter)

View file

@ -8,13 +8,13 @@
#' GMM vector for mean and variance moment conditions
#' @param param Estimated parameters
#' @param sample Data Sample
#' @param X Data Sample
#' @param meanf Mean function
#' @param variancef Variance function
#' @return A two column matrix of differences
#' @export meanvariance.gmm.vector
#' @author François Pelletier
meanvariance.gmm.vector <- function(param,sample,meanf,variancef)
meanvariance.gmm.vector <- function(param,X,meanf,variancef)
{
cbind(X-meanf(param),(X-meanf(param))^2 - variancef(param))
}

View file

@ -6,20 +6,15 @@
###############################################################################
#' Objective function for the GMM method
#' @param param.lagrangian Vector of parameters and Lagrangian to optimize
#' @param param Vector of parameters
#' @param conditions.vector Vector of moment conditions
#' @param sample Individual data sample
#' @param data Individual data sample
#' @param ... Functions of the vector of moment conditions
#' @param W Weighting matrix
#' @param R Linear constraint matrix of coefficients
#' @param r Linear constraint constants
#' @return A scalar value
#' @export objective.GMM
#' @author François Pelletier
objective.GMM <- function(param.lagrangian,conditions.vector,sample,...,
W=diag(length(conditions.vector)),R=0,r=0)
objective.GMM <- function(param,conditions.vector,data,W,...)
{
param <- param.lagrangian[1:num.param]
lagrangian <- param.lagrangian[num.param+1:length(param.lagrangian)]
colMeans(conditions.vector(param,sample,...)) %*% ginv(W) %*% colMeans(conditions.vector(param,sample,...))+ abs(t(R %*% param - r) %*% lagrangian)
as.vector(colMeans(conditions.vector(param,data,...)) %*% ginv(W) %*% colMeans(conditions.vector(param,data,...)))
}

View file

@ -1,16 +1,21 @@
#' Optimization with constraints for GMM methos
# Optimization for GMM method
#
# Author: Francois Pelletier
#
# LGPL-3.0
###############################################################################
#' Optimization for GMM method
#'
#' @param start Starting values for the parameters and lagrangian
#' @param start Starting values for the parameters
#' @param conditions.vector Vector of moment conditions
#' @param sample Individual data sample
#' @param data Individual data sample
#' @param ... Functions of the vector of moment conditions
#' @param W Weighting matrix
#' @param R Linear constraint matrix of coefficients
#' @param r Linear constraint constants
#' @return une liste contenant le résultat de l'optimisation
#' @return a list with optimization results
#' @export optim.GMM
#' @author François Pelletier
optim.GMM <- function(start,conditions.vector,sample,...,W,R,r)
optim.GMM <- function(start,conditions.vector,data,W,...)
{
optim(start,objective.GMM,conditions.vector,sample,...,W,R,r)
optim(start,objective.GMM,conditions.vector,data,W,...)
}