复制调查设计中的trimWeights返回警告

时间:2019-05-13 05:37:09

标签: r survey

我已使用以下代码定义了重复调查设计

jkn.temp1.dsgn <- svrepdesign(data = temp1[,1:7],
                              repweights = temp1[,8:599],
                              type = "JKn",
                              weights = completesub$WT1,
                              combined.weights = TRUE,
                              scale = 1,
                              rscales = 1)

那我把设计弄糟了

rep.svy.rake <- rake(design = jkn.temp1.dsgn, 
                       sample.margins = list(~var1, ~var2, ~var3,~var4, ~var5, ~var6),
                       population.margins = list(var1.dist, var2.dist, var3.dist, var4.dist, 
                                                 var5.dist, var6.dist ))

之后,我使用修剪了倾斜的设计

rep_dstrat1 <- trimWeights(rep.svy.rake,lower=0.1, upper=5, strict=TRUE)

但是我得到警告:

Warning message:
In rwnew[!outside] + t(t(!outside) + colSums(trimmings)/colSums(!outside)) :
  longer object length is not a multiple of shorter object length

我试图调试代码以查看运行情况。以下功能运行成功。但是我想知道为什么返回的“设计”仍然包含相同的未修剪采样权重,而重复权重却不等于总样本量。你知道哪里出了问题吗?

function (design, upper = Inf, lower = -Inf, compress = FALSE, 
  ...) 
{
  pw <- weights(design, "sampling")
  outside <- pw < lower | pw > upper
  if (any(outside)) {
    pwnew <- pmax(lower, pmin(pw, upper))
    trimmings <- pw - pwnew
    pwnew[!outside] <- pwnew[!outside] + sum(trimmings)/sum(!outside)
    design$prob <- 1/pw
  }
  rw <- weights(design, "analysis")
  outside <- rw < lower | rw > upper
  if (any(outside)) {
    rwnew <- pmax(lower, pmin(rw, upper))
    trimmings <- rw - rwnew
    rwnew <- rwnew[!outside] + t(t(!outside) + colSums(trimmings)/colSums(!outside))
    if (compress) 
      design$repweights <- compressWeights(rwnew)
    else design$repweights <- rwnew
    design$combined.weights <- TRUE
  }
  design
}

0 个答案:

没有答案