系统适配3 3SLS测试过识别限制

Question

目前，我很难找到一种很好的方法来执行Hansen/Sargan测试，在三阶段最小二乘模型(3 3SLS)中，在面板数据中使用R.I在不同的网络中进行一整天的挖掘，并且无法找到一种方法来描述R中的测试，使用众所周知的systemfit包。

目前，我的代码很简单。

violence_c_3sls <- Crime ~ ln_GDP +I(ln_GDP^2) + ln_Gini 
income_c_3sls  <-ln_GDP  ~ Crime + ln_Gini 
gini_c_3sls <- ln_Gini ~ ln_GDP + I(ln_GDP^2) + Crime 

inst <- ~ Educ_Gvmnt_Exp + I(Educ_Gvmnt_Exp^2)+ Health_Exp + Pov_Head_Count_1.9 

system_c_3sls <- list(violence_c_3sls, income_c_3sls, gini_c_3sls)

fitsur_c_3sls <-systemfit(system_c_3sls, "3SLS",inst=inst, data=df_new, methodResidCov = "noDfCor" )
summary(fitsur_c_3sls)

但是，添加更多的工具来创建一个标识过高的系统并不能在Hansen/Sargan测试的输出中产生结果，因此我假设测试应该在输出之外执行，并且可能与systemfit类对象相关联。

提前谢谢。

Answer 1

利用g方程、l外生变量和k回归方程，对3 3SLS进行了Sargan检验。

​

其中u是叠加残差，\Sigma是估计的剩余协方差，P_W是外生变量上的投影矩阵。参见戴维森& MacKinnon ETM的CH12.4。

从systemfit中计算Sargan测试应该如下所示：

sargan.systemfit=function(results3sls){
  result <- list()

  u=as.matrix(resid(results3sls)) #model residuals, n x n_eq
  n_eq=length(results3sls$eq) # number of equations
  n=nrow(u) #number of observations
  n_reg=length(coef(results3sls)) # total number of regressors
  
  w=model.matrix(results3sls,which='z') #Matrix of instruments, in block diagonal form with one block per equation
  
  #Need to aggregate into a single block (in case different instruments used per equation)
  w_list=lapply(X = 1:n_eq,FUN = function(eq_i){
    this_eq_label=results3sls$eq[[eq_i]]$eqnLabel
    this_w=w[str_detect(rownames(w),this_eq_label),str_detect(colnames(w),this_eq_label)]
    colnames(this_w)=str_remove(colnames(this_w),paste0(this_eq_label,'_'))
    return(this_w)
  })
  w=do.call(cbind,w_list)
  w=w[,!duplicated(colnames(w))]
  n_inst=ncol(w) #w is n x n_inst, where n_inst is the number of unique instruments/exogenous variables
  
  #estimate residual variance (or use residCov, should be asymptotically equivalent)
  var_u=crossprod(u)/n #var_u=results3sls$residCov
  
  P_w=w%*%solve(crossprod(w))%*%t(w) #Projection matrix on instruments w
  

  #as.numeric(u) vectorizes the residuals into a n_eq*n x 1 vector.
  
  result$statistic <- as.numeric(t(as.numeric(u))%*%kronecker(solve(var_u),P_w)%*%as.numeric(u))

  result$df <- n_inst*n_eq-n_reg
  
  result$p.value <- 1 - pchisq(result$statistic, result$df)
  result$method = paste("Sargan over-identifying restrictions test")

  return(result)
  
  
}