Модифицированная начальная загрузка

Question

Я заинтересован в разработке модифицированного загрузчика, который выбирает некоторый вектор длины x с заменой, но должен соответствовать ряду критериев, прежде чем остановить выборку.Я пытаюсь вычислить доверительные интервалы для лямбда-коэффициента прироста населения, 10000 итераций, но в некоторых группах людей, например, в векторе 13, из группы очень мало людей, растущих.Типичная начальная загрузка привела бы к значительному числу случаев, когда рост в этом векторе не происходит, и, следовательно, модель разваливается.Каждый вектор состоит из определенного числа 1, 2 и 3, где 1 обозначает пребывание в группе, 2 - из группы и 3 смерти.Вот то, что я имею до сих пор без модификации, это, вероятно, не лучший подход во времени, но я новичок в R.

st13 <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,  
          1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,3,3)
#runs
n <- 10000
stage <- st13
stagestay <- vector()
stagemoved <- vector()
stagedead <- vector()
for(i in 1:n){
      index <- sample(stage, replace=T)
      stay <- ((length(index[index==1]))/(length(index)))
      moved <- ((length(index[index==2]))/(length(index)))
      stagestay <- rbind(stagestay,stay)
      stagemoved <- rbind(stagemoved,moved)
}

В настоящее время это образцы Мой вопрос тогда: каким образом можноЯ изменяю функцию выборки, чтобы продолжить выборку этих чисел до тех пор, пока длина индекса не станет, по крайней мере, такой же, как у st13, и пока в индексе не появится хотя бы 1 экземпляр 2?

Большое спасибоКристофер Хенниг, магистр, Университет Миссисипи, Оксфорд, MS, 38677

Answer 1

Обновление: Ответ от @lselzer напомнил мне, что требовалось, чтобы длина образца составляла минимум до st13. Мой код выше просто продолжает выборку, пока не найдет пример начальной загрузки, который содержит 2. Код @lselzer увеличивает выборку, 1 новый индекс за раз, пока выборка не содержит 2. Это довольно неэффективно, так как вам, возможно, придется звонить sample() много раз, пока не получите 2. Мой код может повторяться долгое время, прежде чем в образце будет возвращено 2. Так что же мы можем сделать лучше?

Одним из способов будет выборка большой выборки с заменой с использованием одного вызова sample(). Проверьте, какие из них 2 s, и посмотрите, есть ли 2 в первых length(st13) записях. Если есть, верните эти записи, если нет, найдите первый 2 в большой выборке и верните все записи, включая эту. Если нет 2 с, добавьте еще один большой образец и повторите. Вот некоторый код:

#runs
n <- 100 #00
stage <- st13
stagedead <- stagemoved <- stagestay <- Size <- vector()
sampSize <- 100 * (len <- length(stage)) ## sample size to try
for(i in seq_len(n)){
    ## take a large sample
    samp <- sample(stage, size = sampSize, replace = TRUE)
    ## check if there are any `2`s and which they are
    ## and if no 2s expand the sample
    while(length((twos <- which(samp == 2))) < 1) {
        samp <- c(samp, sample(stage, size = sampSize, replace = TRUE))
    }
    ## now we have a sample containing at least one 2
    ## so set index to the required set of elements
    if((min.two <- min(twos)) <= len) {
        index <- samp[seq_len(len)]
    } else {
        index <- samp[seq_len(min.two)]
    }
    stay <- length(index[index==1]) / length(index)
    moved <- length(index[index==2]) / length(index)
    stagestay[i] <- stay
    stagemoved[i] <- moved
    Size[i] <- length(index)
}

Вот действительно вырожденный вектор только с двумя из 46 записей:

R> st14 <- sample(c(rep(1, 45), 2))
R> st14
 [1] 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[39] 1 1 1 1 1 1 1 1

Если я использую вышеуказанный цикл вместо st13, я получаю следующее для минимального размера выборки, необходимого для получения 2 на каждом из 100 прогонов:

R> Size
  [1]  65  46  46  46  75  46  46  57  46 106  46  46  46  66  46  46  46  46
 [19]  46  46  46  46  46 279  52  46  63  70  46  46  90 107  46  46  46  87
 [37] 130  46  46  46  46  46  46  60  46 167  46  46  46  71  77  46  46  84
 [55]  58  90 112  52  46  53  85  46  59 302 108  46  46  46  46  46 174  46
 [73] 165 103  46 110  46  80  46 166  46  46  46  65  46  46  46 286  71  46
 [91] 131  61  46  46 141  46  46  53  47  83

Таким образом, можно предположить, что sampSize, который я выбрал (100 * length(stage)), здесь немного избыточно, но, поскольку все операторы, которые мы используем, векторизованы, мы, вероятно, не понесем больших штрафов за слишком длинную начальную выборку размера, и мы, конечно, не несем никаких дополнительных sample() звонков.

---

Оригинал: Если я вас правильно понимаю, проблема в том, что sample() может вообще не возвращать никаких признаков 2. Если это так, мы можем продолжить выборку до тех пор, пока она не будет выполнена с использованием конструкции потока управления repeat.

Я соответствующим образом изменил ваш код и немного его оптимизировал, потому что вы никогда не выращиваете объекты в цикле, как это делали вы. Есть и другие способы, которые можно улучшить, но сейчас я буду придерживаться цикла. Объяснение приведено ниже.

st13 <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,  
          1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,3,3)
#runs
n <- 10000
stage <- st13
stagedead <- stagemoved <- stagestay <- vector()
for(i in seq_len(n)){
    repeat {
        index <- sample(stage, replace = TRUE)
        if(any(index == 2)) {
            break
        }
    }
    stay <- length(index[index==1]) / length(index)
    moved <- length(index[index==2]) / length(index)
    stagestay[i] <- stay
    stagemoved[i] <- moved
}

Это главное изменение, касающееся вашего Q:

    repeat {
        index <- sample(stage, replace = TRUE)
        if(any(index == 2)) {
            break
        }
    }

повторяет код, содержащийся в фигурных скобках, до тех пор, пока не будет запущен break, чтобы вывести нас из цикла repeat. Итак, что происходит, мы берем образец начальной загрузки, а затем проверяем, содержит ли какой-либо из образцов индекс 2. Если есть какие-либо 2 s, то мы отключаемся и продолжаем с остальной частью тока для итерации цикла. Если сэмпл не содержит 2 с, перерыв не сработает, и мы снова обходим, беря другой сэмпл. Это будет происходить до тех пор, пока мы не получим образец с 2.

Answer 2

Для начала, sample имеет аргумент size, который вы можете использовать, чтобы соответствовать длине st13.Вторая часть вашего вопроса может быть решена с помощью цикла while.

st13 <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,  
          1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,3,3)
    #runs
    n <- 10000
    stage <- st13
    stagestay <- vector()
    stagemoved <- vector()
    stagedead <- vector()
    for(i in 1:n){
          index <- sample(stage, length(stage), replace=T)
          while(!any(index == 2)) {
            index <- c(index, sample(stage, 1, replace = T))
          }
          stay <- ((length(index[index==1]))/(length(index)))
          moved <- ((length(index[index==2]))/(length(index)))
          stagestay[i] <- stay
          stagemoved[i] <- moved
    }

Когда я писал это, Гевин опубликовал свой ответ, который похож на мой, но я добавил аргумент размера, чтобы быть уверенным, что индексимеет длину не менее st13