R/stepNdel_combo.R

In lluo0/MIIVstepwiseDel:

stepNdel_combo <- function(model, data, setup, stepPrevious_final){
  probVs <- setup$probVs
  badmiivs <- setup$badmiivs
  goodmiivs <- setup$goodmiivs
  badmiivs_int <- setup$badmiivs_int
  sig_sargantable_int <- setup$sig_sargantable_int

  badmiivs_new <- stepPrevious_final$badmiivs_nextstep
  ##first set up the new combos of miivs to be deleted/retained
  for (p in 1:length(badmiivs_int)){
    new_colnum <- length(badmiivs_new[[p]])
    new_rownum <- length(badmiivs_int[[p]])-length(badmiivs_new[[p]])+1
    badmiivs[[p]] <- matrix(NA, nrow = new_rownum, ncol = new_colnum)
    for (i in 1:new_rownum){
      badmiivs[[p]][i,] <- setdiff(badmiivs_int[[p]],badmiivs_new[[p]])[i]
    }
    for (q in 1:new_colnum){
      badmiivs[[p]][new_rownum,q] <- badmiivs_new[[p]][q]
    }
  }

  ##then repeat the steps in step1del_combo
  fit_del1 <- list()
  newmiivs <- list()
  delMiivsSargan <- list()
  for (p in 1:length(probVs)){
    ##p is the name of the problematic variable
    fit_del1[[p]] <- list()
    newmiivs[[p]] <- list()
    delMiivsSargan[[p]] <- as.data.frame(matrix(NA, nrow = 2, ncol = ncol(badmiivs[[p]])) )
    names(delMiivsSargan)[p] <- probVs[p]
    rownames(delMiivsSargan[[p]]) <- c("sargandef", "newsargan")
    for (i in 1:ncol(badmiivs[[p]])){
      ##i for each deleted MIIV
      ##then get the list of MIIVs
      newmiivs[[p]][[i]] <- paste0(goodmiivs[[p]], sep = "\n",
                                   paste0(names(badmiivs)[p], sep = "~",
                                          paste0(paste0(badmiivs[[p]][,i]), collapse = "+")))
      ##get the fit for each MIIV deletion
      fit_del1[[p]][[i]] <- miive(model = model, data = data, var.cov = T, miiv.check = F,
                                  instruments = newmiivs[[p]][[i]])
      colnames(delMiivsSargan[[p]])[i] <- paste0(setdiff(badmiivs_int[[p]], paste0(badmiivs[[p]][,i])), collapse = "+")
      #paste0(paste0(badmiivs[[p]][,i]), collapse = "+")
      #paste0(setdiff(badmiivs_int[[p]], paste0(badmiivs[[p]][,i])), collapse = "+")

      ##then get the sargan for each miiv deletion
      delMiivsSargan[[p]][1,i] <- sig_sargantable_int[1,p] - fit_del1[[p]][[i]]$eqn[[sig_sargantable_int[3,p]]]$sargan
      delMiivsSargan[[p]][2,i] <- fit_del1[[p]][[i]]$eqn[[sig_sargantable_int[3,p]]]$sargan
    }
  }
  # df1 <- qchisq(.95, df = 1)
  # #store the max chi square drop
  # maxdiff <- sapply(delMiivsSargan, function(i) max(i[1,]))
  # #max needs to be greater than df1
  # maxdiff <- maxdiff[maxdiff>df1]
  # #find list name
  # drop_location <- names(delMiivsSargan)[sapply(seq_along(delMiivsSargan),
  #                                               function(x) {any(delMiivsSargan[[x]]==maxdiff[x])})]
  # drop_location_num <- sapply(drop_location, function(x) match(x, names(delMiivsSargan)))
  #
  # drop_MIIV <- sapply(drop_location_num, function(i)
  #   colnames(delMiivsSargan[[i]])[delMiivsSargan[[i]][1,] == maxdiff[i]])
  # ##get the equation order for these variables (the fit$eqn[[p]])
  # sargan_eqnorder <- as.numeric(sig_sargantable_int[3,])
  #
  # badmiivs_candidate <- list()
  # for (p in 1:length(drop_MIIV)){
  #   badmiivs_candidate[[p]] <- strsplit(drop_MIIV[p],split ='+', fixed = T)[[1]]
  #   names(badmiivs_candidate)[p] <- probVs[p]
  # }
  drop_MIIV <- lapply(delMiivsSargan, function(i) i[which(i[2,]==min(i[2,]))])

  # badmiivs_nextstep <- list()
  # for(p in 1:length(drop_MIIV)){
  #   badmiivs_nextstep[[p]] <- list()
  #   names(badmiivs_nextstep)[p] <- names(drop_MIIV)[p]
  #   if(grepl("+", colnames(drop_MIIV[[p]]))){
  #     badmiivs_nextstep[[p]] <- strsplit(colnames(drop_MIIV[[p]]), split = "+", fixed = T)[[1]]
  #   }
  #   if(!grepl("+", colnames(drop_MIIV[[p]]))){
  #     badmiivs_nextstep[[p]] <- colnames(drop_MIIV[[p]]
  #   }
  # }

  badmiivs_nextstep <- list()
  for(p in 1:length(drop_MIIV)){
    badmiivs_nextstep[[p]] <- list()
    names(badmiivs_nextstep)[p] <- names(drop_MIIV)[p]
    if(grepl("+", colnames(drop_MIIV[[p]]))){
      badmiivs_nextstep[[p]] <- strsplit(colnames(drop_MIIV[[p]]), split = "+", fixed = T)[[1]]
    }
    if(!grepl("+", colnames(drop_MIIV[[p]]))){
      badmiivs_nextstep[[p]] <- colnames(drop_MIIV[[p]])
      }
  }

  finalobj <- list(drop_MIIV = drop_MIIV,
                   delMiivsSargan = delMiivsSargan,
                   badmiivs = badmiivs,
                   badmiivs_nextstep = badmiivs_nextstep
  )
  return(finalobj)

}