Question

我正在尝试编写模拟代码，该代码生成数据并运行t检验选择（丢弃那些t检验p值超过0.05，保留其余的预测因子）。该模拟很大程度上是Kleiber和Zeileis对应用计量经济学与R的改编（2008，pp.183-189）。

运行代码时，通常会失败。然而，对于某些种子（例如1534），它产生合理的输出。如果它不产生输出（例如1911），则由于："Error in x[, ii] : subscript out of bounds"而失败，后者追溯到na.omit.data.frame()。因此，出于某种原因，我试图处理NAs的方式似乎失败了，但我无法弄清楚如何处理。

  coef <- rep(coef[,3], length.out = pdim+1)
  err <- as.vector(rnorm(nobs, sd = sd))
  uX <- c(rep(1, times = nobs))
  pX <- matrix(scale(rnorm(nobs)), byrow = TRUE, ncol = pdim, nrow = nobs)
  X <- cbind(uX, pX)
  y <- coef %*% t(X) + err
  y <- matrix(y)

  tTp <- (summary(lm(y ~ pX)))$coefficients[,4]  
  tTp <- tTp[2:length(tTp)]
  TTT <- matrix(c(tTp, rep(.7, ncol(pX)-length(tTp))))

  tX <- matrix(NA, ncol = ncol(pX), nrow = nrow(pX))
  for(i in 1:ncol(pX)) {ifelse(TTT[i,] < ALPHA, tX[,i] <- pX[,i], NA)}
  tX <- matrix(Filter(function(x)!all(is.na(x)), tX), nrow = nobs)
  TTR <- lm(y ~ tX)

第一个块不太可能是错误的原因。它只是生成数据，并且可以通过其他方法（如PCA）自行运行。第二个块从回归输出中提取p值;删除截距的p值（beta_0）;并根据需要用尽可能多的7来填充向量，使其长度与变量数相同，以确保矩阵计算的维度相同。七是任意的，可以是任何大于0.05的数字，以不通过循环测试。如果R由于多重共线性而丢弃预测因子，那么这变得 - 我相信 - 是必要的。

最后一个块创建一个原始尺寸的空矩阵;插入原始数据，如果t检验p值低于0.05，则保留NA;倒数第二行删除所有包含NAs的列（（此处为NA或一个NA在此处相同）取自mnel对Remove columns from dataframe where ALL values are NA的回答;最后，修改后的数据再次以线性回归的形式出现。

是否有人知道导致此行为的原因或其如何按预期工作？我希望它既可以工作也可以不工作，但两者都不一样。理想情况下，前者。

代码的工作版本是：

set.seed(1534)
Sim_TTS  <- function(nobs = c(1000, 15000), pdim = pdims, coef = coef100, 
    model = c("MLC", "MHC"), ...){
 DGP_TTS <- function(nobs = 1000, model = c("MLC", "MHC"), coef = coef100, 
     sd = 1, pdim = pdims, ALPHA = 0.05)
 {
  model <- match.arg(model)
  if(model == "MLC") {
   coef <- rep(coef[,1], length.out = pdim+1)
   err <- as.vector(rnorm(nobs, sd = sd))
   uX <- c(rep(1, times = nobs))
   pX <- matrix(scale(rnorm(nobs)), byrow = TRUE, ncol = pdim, nrow = nobs)
   X <- cbind(uX, pX)
   y <- coef %*% t(X) + err
   y <- matrix(y)

   tTp <- (summary(lm(y ~ pX)))$coefficients[,4]  
   tTp <- tTp[2:length(tTp)]
   TTT <- matrix(c(tTp, rep(.7, ncol(pX)-length(tTp)))) 

   tX <- matrix(NA, ncol = ncol(pX), nrow = nrow(pX)) 
   for(i in 1:ncol(pX)) {ifelse(TTT[i,] < ALPHA, tX[,i] <- pX[,i], NA)}
   tX <- matrix(Filter(function(x)!all(is.na(x)), tX), nrow = nobs) 
   TTR <- lm(y ~ tX) 
   } else {
   coef <- rep(coef[,2], length.out = pdim+1)
   err <- as.vector(rnorm(nobs, sd = sd))
   uX <- c(rep(1, times = nobs))
   pX <- matrix(scale(rnorm(nobs)), byrow = TRUE, ncol = pdim, nrow = nobs)
   X <- cbind(uX, pX)
   y <- coef %*% t(X) + err
   y <- matrix(y)

   tTp <- (summary(lm(y ~ pX)))$coefficients[,4]  
   tTp <- tTp[2:length(tTp)]
   TTT <- matrix(c(tTp, rep(.7, ncol(pX)-length(tTp))))

   tX <- matrix(NA, ncol = ncol(pX), nrow = nrow(pX))
   for(i in 1:ncol(pX)) {ifelse(TTT[i,] < ALPHA, tX[,i] <- pX[,i], NA)}
   tX <- matrix(Filter(function(x)!all(is.na(x)), tX), nrow = nobs)
   TTR <- lm(y ~ tX)
   }
  return(TTR)
  }
  PG_TTS <- function(nrep = 1, ...)
  {
   rsq <- matrix(rep(NA, nrep), ncol = 1)
   rsqad <- matrix(rep(NA, nrep), ncol = 1)
   pastr <- matrix(rep(NA, nrep), ncol = 1)
   vmat <- cbind(rsq, rsqad, pastr)
   colnames(vmat) <- c("R sq.", "adj. R sq.", "p*")
   for(i in 1:nrep) {
     vmat[i,1] <- summary(DGP_TTS(...))$r.squared
     vmat[i,2] <- summary(DGP_TTS(...))$adj.r.squared
     vmat[i,3] <- length(DGP_TTS(...)$coefficients)-1
     }
   return(c(mean(vmat[,1]), mean(vmat[,2]), round(mean(vmat[,3]))))
  }
  SIM_TTS <- function(...)
  {
   prs <- expand.grid(pdim = pdim, nobs = nobs, model = model)
   nprs <- nrow(prs)

   pow <- matrix(rep(NA, 3 * nprs), ncol = 3)
   for(i in 1:nprs) pow[i,] <- PG_TTS(pdim = prs[i,1],
       nobs = prs[i,2], model = as.character(prs[i,3]), ...)

   rval <- rbind(prs, prs, prs)
   rval$stat <- factor(rep(1:3, c(nprs, nprs, nprs)),
       labels = c("R sq.", "adj. R sq.", "p*"))
   rval$power <- c(pow[,1], pow[,2], pow[,3])
   rval$nobs <- factor(rval$nobs)
   return(rval)
  }

 psim_TTS <- SIM_TTS()
 tab_TTS <- xtabs(power ~ pdim + stat + model + nobs, data = psim_TTS)
 ftable(tab_TTS, row.vars = c("model", "nobs", "stat"), col.vars = "pdim")}

 FO_TTS <- Sim_TTS()
 FO_TTS
}

先于：

pdims <- seq(12, 100, 4)
coefLC12 <- c(0, rep(0.2, 4), rep(0.1, 4), rep(0, 4))/1.3
rtL <- c(0.2, rep(0, 3))/1.3
coefLC100 <- c(coefLC12, rep(rtL, 22))
coefHC12 <- c(0, rep(0.8, 4), rep(0.4, 4), rep(0, 4))/1.1
rtH <- c(0.8, rep(0, 3))/1.1
coefHC100 <- c(coefHC12, rep(rtH, 22))
coef100 <- cbind(coefLC100, coefHC100)

我知道不推荐通过个体预测因子的重要性进行模型选择，但这是重点 - 它应该与更复杂的方法进行比较。

手动执行t-Test选择

0 个答案: