trimWeights в дублированном дизайне опроса, возвращающем предупреждение - PullRequest
Новая
       15

trimWeights в дублированном дизайне опроса, возвращающем предупреждение

0 голосов
/ 13 мая 2019

Я определил повторяющийся дизайн опроса, используя следующий код 

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
}
...