Генерировать случайные последовательности NA случайных длин в векторе

Я хочу генерировать отсутствующие значения в векторе, чтобы отсутствующее значение сгруппировалось в последовательности, чтобы имитировать периоды отсутствующих данных разной длины.

Скажем, у меня есть вектор из 10 000 значений, и я хочу генерировать 12 последовательностей NA в случайных местоположениях в векторе, причем каждая последовательность имеет случайную длину L между 1 и 144 (144 имитирует 2 дня отсутствующих значений по истечении 10 минут). Последовательности должны не перекрываться.

Как я могу это сделать? Спасибо.

Я пробовал комбинировать lapply и seq без успеха.

Пример ожидаемого вывода с 3 различными последовательностями:

# 1 2 3 5 2 NA NA 5 4 6 8 9 10 11 NA NA NA NA NA NA 5 2 NA NA NA...

ИЗМЕНИТЬ

Я имею дело с сезонным временным рядом, поэтому NA должен перезаписать значения и не вставляться в качестве новых элементов.

ОТВЕТЫ

Ответ 1

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

Поэтому я предлагаю следующее решение, которое выполняется до ограниченного числа раз (max_iter), чтобы найти подходящую комбинацию начальных позиций и длины выполнения NA. Если он найден, он возвращается, если ни один не найден в пределах определенного максимального количества итераций, вы просто получите уведомление.

x = 1:1000
n = 3
m = 1:144

f <- function(x, n, m, max_iter = 100) {
  i = 0
  repeat {
    i = i+1
    idx <- sort(sample(seq_along(x), n))        # starting positions
    dist <- diff(c(idx, length(x)))             # check distance inbetween 
    na_len <- sample(m, n, replace = TRUE) - 1L # lengths of NA-runs
    ok <- all(na_len < dist)                    # check overlap
    if(ok | i == max_iter) break 
  }

  if(ok) {
    replace(x, unlist(Map(":", idx, idx+na_len)), NA)
  } else {
      cat("no solution found in", max_iter, "iterations")
    }
}

f(x, n, m, max_iter = 20)

Конечно, вы можете легко увеличить количество итераций, и вы должны заметить, что с большим n все труднее (требуется больше итераций), чтобы найти решение.

Ответ 2

Все остальные ответы более или менее соответствуют "условной спецификации", где имитируются начальный индекс и длина выполнения блоков NA. Однако, поскольку условие неперекрывающегося состояния должно быть выполнено, эти куски должны определяться один за другим. Такая зависимость запрещает векторизация, и должен использоваться либо цикл for, либо lapply / sapply.

Однако эта проблема является еще одной проблемой длины прогона. 12 неперекрывающихся фрагментов NA разделили бы всю последовательность на 13 не пропущенных кусков (да, я думаю, это то, что OP хочет, поскольку пропавшие куски происходят, когда первый фрагмент или последний фрагмент не интересны). Так почему бы не подумать о следующем:

  • генерировать длину пробега в 12 пропавших кусков;
  • генерировать длину выполнения из 13 непропущенных фрагментов;
  • перемежать эти два типа кусков.

Второй шаг выглядит сложным, так как он должен удовлетворять этой сумме всех сумм сумм до фиксированного числа. Ну, многочленное распределение для этого.

Итак, вот полностью векторизованное решение:

# run length of 12 missing chunks, with feasible length between 1 and 144
k <- sample.int(144, 12, TRUE)

# run length of 13 non-missing chunks, summing up to `10000 - sum(k)`
# equal probability is used as an example, you may try something else
m <- c(rmultinom(1, 10000 - sum(k), prob = rep.int(1, 13)))

# interleave `m` and `k`
n <- c(rbind(m[1:12], k), m[13])

# reference value: 1 for non-missing and NA for missing, and interleave them
ref <- c(rep.int(c(1, NA), 12), 1)

# an initial vector
vec <- rep.int(ref, n)

# missing index
miss <- is.na(vec)

Мы можем проверить, что sum(n) равно 10000. Что дальше? Не можете заполнить незаметные записи случайными целыми числами?

Мой первоначальный ответ может быть слишком коротким, чтобы следовать, поэтому приведенное выше расширение выполнено.

Прямо написать функцию, реализующую выше, с пользовательским вводом вместо примеров значений параметров 12, 144, 10000.

Обратите внимание, единственная потенциальная проблема многочлена - это то, что при некотором плохом prob он может генерировать некоторые нули. Таким образом, некоторые кусочки NA фактически объединятся. Чтобы обойти это, надежная проверка такова: замените все 0 на 1 и вычтите инфляцию такого изменения из max(m).

Ответ 3

РЕДАКТИРОВАТЬ: Просто для развлечения здесь более короткая рекурсивная версия моего решения ниже

add_nas <- function(v,n_seq = 12,min_l_seq = 1,max_l_seq = 144){
  insert_length  <- sample(min_l_seq:max_l_seq,1)
  insert_pos     <- sample(length(v)-insert_length,1)
  v <- v[-(insert_pos+(1:insert_length)-1)]
  if(n_seq > 1){v <- add_nas(v,n_seq-1,min_l_seq,max_l_seq)}
  append(v,rep(NA,insert_length),insert_pos-1)
}

Старый ответ:

# we build a vextor of 20 values
v <- sample(1:100,20,replace=TRUE) # your vector
# your parameters
n_seq <- 3     # you put 12 here
min_l_seq <- 1 #
max_l_seq <- 5 # you put 144 here

# first we will delete items, then we add NAs where we deleted instead
insert_lengths <- sample(min_l_seq:max_l_seq,n_seq,replace=TRUE)
lengths_before_deletion <- length(v)- c(0,insert_lengths[-length(insert_lengths)])
insert_pos <- sapply(lengths_before_deletion-insert_lengths+1,function(x){sample(1:x,1)})

v2 <- v
print(v)
for (i in 1:n_seq){
  v2 <- v2[-(insert_pos[i]:(insert_pos[i]+insert_lengths[i]-1))]
  print(v2)
}

for (i in n_seq:1){
  v2 <- c(v2[1:(insert_pos[i]-1)],rep(NA,insert_lengths[i]),v2[insert_pos[i]:length(v2)])
  print(v2)
}

здесь log

> print(v)
 [1] 75 11  4 19 55 20 65 48 85 20 61 16 75 31 50 10 30 61  4 32
> for (i in 1:n_seq){
+   v2 <- v2[-(insert_pos[i]:(insert_pos[i]+insert_lengths[i]-1))]
+   print(v2)
+ }
 [1] 75 11 55 20 65 48 85 20 61 16 75 31 50 10 30 61  4 32
 [1] 75 11 55 20 65 48 85 20 61 16 75 50 10 30 61  4 32
 [1] 75 11 55 20 65 48 85 20 61 16 75 50 10 30 32
> 
> for (i in n_seq:1){
+   v2 <- c(v2[1:(insert_pos[i]-1)],rep(NA,insert_lengths[i]),v2[insert_pos[i]:length(v2)])
+   print(v2)
+ }
 [1] 75 11 55 20 65 48 85 20 61 16 75 50 10 30 NA NA 32
 [1] 75 11 55 20 65 48 85 20 61 16 75 NA 50 10 30 NA NA 32
 [1] 75 11 NA NA 55 20 65 48 85 20 61 16 75 NA 50 10 30 NA NA 32

Ответ 4

Вот моя пересмотренная версия:

while(1){
  na_span_vec <- sample((10000-143), 12) %>% sort 
  if(min(na_span_vec - lag(na_span_vec), na.rm = T) > 144) break
}
na_idx <- na_span_vec %>% as.list %>% 
  lapply(function(x) seq(x, x + sample(143, 1))) %>% unlist
original_vec[na_idx] <- NA

Ответ 5

Вы можете использовать эту функцию:

genVecLength<-function(vec,namin,namax,nanumber) {
    nalengths<-sample(namin:namax,nanumber,replace=TRUE)
    vec[sort(sample(nanumber*2+1,length(vec),replace=TRUE))%%2==0]<-NA
    vec
}

где vec - ваш исходный вектор, namin и namax - это минимальная и максимальная длина последовательности NA, а nanumber - количество последовательностей.

Пример:

set.seed(1)
genVecLength(1:30,namin=1,namax=5,nanumber=3)
#[1]  1  2  3 NA NA NA NA NA  9 10 11 12 13 NA NA NA 17 18 19 20 21 NA NA NA 25
#[26] 26 27 28 29 30

В вашем примере, если vec<-runif(10000), вы можете попробовать:

genVecLength(vec,1,144,12)

Ответ 6

Вот простая идея. Случайно разрезайте не-na часть на 13 частей (у некоторой части может быть 0 длины, все в порядке, так как мы можем зарезервировать одну не-na-позицию в конце для каждой последовательности 11 NA) и вставить сгенерированную последовательность из 12 NA между ними. Таким образом, 12 NA seq без перекрытия в векторе длины 10000 означает, что существует 10000 - sum(length(NA.seq)) - 11 не-na-позиция (11 является зарезервированной не-na-позицией в конце последовательности 11 NA.

orig.seq = 1:10000
na.len = sapply(1:12, function(x) sample(1:144, 1)) # na sequence length
na.len[1:11] = na.len[1:11] + 1 #reserve one non-na position for first 11 NA seq
avail.space = 10000 - sum(na.len) # number of non-na position to cut (sum(na.len) includes the reserved one non-na position)
avail.space.loc = sample(0:avail.space, 12) %>% sort # find 12 cut point to split it into 13 piece
end = avail.space.loc + cumsum(na.len)
start = end - na.len
for (i in 1:12) {
    if (i != 12) {
        orig.seq[start[i]:end[i]-1] <- NA # recover the reserved non-na position
    } else orig.seq[start[i]:end[i]] <- NA
}

Ответ 7

 #just a vector of 10000 values (uniform distribution)
 initVec <- runif(10000)

 #12 sequences of NA with length 1:144 (randomly picked)
 naVecList<-lapply(sample(c(1:144),12,replace = T),function(x) rep(NA,x))

 #random positions (along the whole length of initVec)
 (randomPositions<-sort(unlist(lapply(seq_along(1:length(naVecList)), function(x) sample(c(1:(length(initVec)-144)),x,replace = T)[1]))))#added safenet


 #insert the NA elements at random places.
  for(i in 1:length(randomPositions))
    initVec[randomPositions[i]:(randomPositions[i]+length(naVecList[[i]]))]<-naVecList[[i]]