Вопрос по r – Замена NA в R с ближайшим значением

27

Я ищу что-то похожее наna.locf() вzoo пакет, но вместо того, чтобы всегда использоватьprevious не-NA значение, которое я хотел бы использоватьnearest не-NA значение. Некоторые примеры данных:

dat <- c(1, 3, NA, NA, 5, 7)

ЗаменаNA сna.locf (3 переносится вперед):

library(zoo)
na.locf(dat)
# 1 3 3 3 5 7

а такжеna.locf сfromLast установлен вTRUE (5 переносится в обратном направлении):

na.locf(dat, fromLast = TRUE)
# 1 3 5 5 5 7

Но я желаюnearest не-NA значение, которое будет использоваться. В моем примере это означает, что 3 должны быть перенесены на первыйNAи 5 следует перенести обратно ко второмуNA:

1 3 3 5 5 7

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

К вашему сведению, мой текущий код выглядит следующим образом. Возможно, если не что иное, кто-то может подсказать, как сделать его более эффективным. Я чувствую, что мне не хватает очевидного способа улучшить это:

  na.pos <- which(is.na(dat))
  if (length(na.pos) == length(dat)) {
    return(dat)
  }
  non.na.pos <- setdiff(seq_along(dat), na.pos)
  nearest.non.na.pos <- sapply(na.pos, function(x) {
    return(which.min(abs(non.na.pos - x)))
  })
  dat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]]

Чтобы ответить на следующие вопросы:

  1. No, any entry can be NA
  2. If all are NA, leave them as is
  3. No. My current solution defaults to the lefthand nearest value, but it doesn't matter
  4. These rows are a few hundred thousand elements typically, so in theory the upper bound would be a few hundred thousand. In reality it'd be no more than a few here & there, typically a single one.

Update Таким образом, оказывается, что мы вообще идем в другом направлении, но это все еще было интересным обсуждением. Спасибо всем!

Мы могли бы перебратьrle(which(is.na(dat))), Не сказать, что это наиболее эффективно, но это улучшение. Смотрите также"How can I count runs in R?" который нуждается в настройкеrle.na() обрабатывать NA. smci
Это не так, поскольку оно просто принимает предыдущее значение в противоположном направлении. Он не найдетnearest не-NA значение geoffjentry
& apos; Не могли бы вы опубликовать свое решение? Мне было бы интересно посмотреть, что у вас есть. Jeff Allen
Просто понял, понял, что если ничего другого, то это может превратиться в то, как сделать то, что я делаю, лучше geoffjentry
вы смотрели на необязательные параметры для na.locf?fromLast похоже, он может делать то, что вы хотите. Chase

Ваш Ответ

6   ответов
6

я попросил дать разъяснения:

Is it guaranteed that at least the first and/or last entries are non-NA? [No] What to do if all entries in a row are NA? [Leave as-is] Do you care how ties are split i.e. how to treat the middle NA in 1 3 NA NA NA 5 7? [Don't-care/ left] Do you have an upper-bound (S) on the longest contiguous span of NAs in a row? (I'm thinking a recursive solution if S is small. Or a dataframe solution with ifelse if S is large and number of rows and cols is large.) [worst-case S could be pathologically large, hence recursion should not be used]

Geoffjentry, ваше решение ваши узкие места будет последовательный расчетnearest.non.na.pos и серийное назначениеdat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]] Для большого промежутка длины G все, что нам действительно нужно вычислить, это то, что первые (G / 2, округление вверх) элементы заполняются слева, а остальные справа. (Я мог бы опубликовать ответ, используяifelse но это будет выглядеть похоже.) Ваши критерииruntime, эффективность big-O, временное использование памяти или разборчивость кода?

Возможно несколько настроек:

only need to compute N <- length(dat) once common-case speed enhance: if (length(na.pos) == 0) skip row, since it has no NAs if (length(na.pos) == length(dat)-1) the (rare) case where there is only one non-NA entry hence we fill entire row with it

Общее решение:

К сожалению, na.locf не работает на целом фрейме данных, вы должны использовать sapply построчно:

na.fill_from_nn <- function(x) {
  row.na <- is.na(x)
  fillFromLeft <- na.locf(x, na.rm=FALSE) 
  fillFromRight <- na.locf(x, fromLast=TRUE, na.rm=FALSE)

  disagree <- rle(fillFromLeft!=fillFromRight)
  for (loc in (disagree)) { ...  resolve conflicts, row-wise }
}

sapply(dat, na.fill_from_nn)

В качестве альтернативы, так как, как вы говорите, смежные НС встречаются редко, сделайте быстрый и тупойifelse заполнить отдельные НС слева. Это будет работать с фреймом данных = & gt; делает общее дело быстро. Затем обработайте все остальные случаи с помощью цикла for-row. (Это повлияет на разрыв связей между средними элементами в длинном промежутке АН, но вы говорите, что вам все равно.)

Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded geoffjentry
Error: User Rate Limit Exceeded geoffjentry
Error: User Rate Limit Exceededif (length(na.pos) == 0)Error: User Rate Limit Exceeded
2

но в случае вектора с разреженным NA, похоже, что он на самом деле будет более эффективным (показатели производительности приведены ниже). Суть кода ниже.

  #get the index of all NA values
  nas <- which(is.na(dat))

  #get the Boolean map of which are NAs, used later to determine which values can be used as a replacement, and which are just filled-in NA values
  namask <- is.na(dat)

  #calculate the maximum size of a run of NAs
  length <- getLengthNAs(dat);

  #the furthest away an NA value could be is half of the length of the maximum NA run
  windowSize <- ceiling(length/2)

  #loop through all NAs
  for (thisIndex in nas){
    #extract the neighborhood of this NA
    neighborhood <- dat[(thisIndex-windowSize):(thisIndex+windowSize)]
    #any already-filled-in values which were NA can be replaced with NAs
    neighborhood[namask[(thisIndex-windowSize):(thisIndex+windowSize)]] <- NA

    #the center of this neighborhood
    center <- windowSize + 1

    #compute the difference within this neighborhood to find the nearest non-NA value
    delta <- center - which(!is.na(neighborhood))

    #find the closest replacement
    replacement <- delta[abs(delta) == min(abs(delta))]
    #in case length > 1, just pick the first
    replacement <- replacement[1]

    #replace with the nearest non-NA value.
    dat[thisIndex] <- dat[(thisIndex - (replacement))]
  }

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

Таким образом, производительность линейно зависит от количества NA и размера окна, где размер окна (потолок) равен половине длины максимального прогона NA. Чтобы рассчитать длину максимального прогона NA, вы можете использовать следующую функцию:

getLengthNAs <- function(dat){
  nas <- which(is.na(dat))
  spacing <- diff(nas)
  length <- 1;
  while (any(spacing == 1)){        
    length <- length + 1;
    spacing <- diff(which(spacing == 1))
  }
    length
}
Performance Comparison
#create a test vector with 10% NAs and length 50,000.
dat <- as.integer(runif(50000, min=0, max=10))
dat[dat==0] <- NA

#the a() function is the code posted in the question
a <- function(dat){
  na.pos <- which(is.na(dat))
    if (length(na.pos) == length(dat)) {
        return(dat)
    }
    non.na.pos <- setdiff(seq_along(dat), na.pos)
    nearest.non.na.pos <- sapply(na.pos, function(x) {
        return(which.min(abs(non.na.pos - x)))
    })
    dat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]]
    dat
}

#my code
b <- function(dat){
    #the same code posted above, but with some additional helper code to sanitize the input
    if(is.null(dat)){
      return(NULL);
    }

    if (all(is.na(dat))){
      stop("Can't impute NAs if there are no non-NA values.")
    }

    if (!any(is.na(dat))){
      return(dat);
    }

    #starts with an NA (or multiple), handle these
    if (is.na(dat[1])){
      firstNonNA <- which(!is.na(dat))[1]
      dat[1:(firstNonNA-1)] <- dat[firstNonNA]
    }

    #ends with an NA (or multiple), handle these
    if (is.na(dat[length(dat)])){
      lastNonNA <- which(!is.na(dat))
      lastNonNA <- lastNonNA[length(lastNonNA)]
      dat[(lastNonNA+1):length(dat)] <- dat[lastNonNA]
    }

    #get the index of all NA values
    nas <- which(is.na(dat))

    #get the Boolean map of which are NAs, used later to determine which values can be used as a replacement, and which are just filled-in NA values
    namask <- is.na(dat)

    #calculate the maximum size of a run of NAs
    length <- getLengthNAs(dat);

    #the furthest away an NA value could be is half of the length of the maximum NA run
    #if there's a run at the beginning or end, then the nearest non-NA value could possibly be `length` away, so we need to keep the window large for that case.
    windowSize <- ceiling(length/2)

    #loop through all NAs
    for (thisIndex in nas){
      #extract the neighborhood of this NA
      neighborhood <- dat[(thisIndex-windowSize):(thisIndex+windowSize)]
      #any already-filled-in values which were NA can be replaced with NAs
      neighborhood[namask[(thisIndex-windowSize):(thisIndex+windowSize)]] <- NA

      #the center of this neighborhood
      center <- windowSize + 1

      #compute the difference within this neighborhood to find the nearest non-NA value
      delta <- center - which(!is.na(neighborhood))

      #find the closest replacement
      replacement <- delta[abs(delta) == min(abs(delta))]
      #in case length > 1, just pick the first
      replacement <- replacement[1]

      #replace with the nearest non-NA value.
      dat[thisIndex] <- dat[(thisIndex - (replacement))]
    }
    dat
}

#nograpes' answer on this question
c <- function(dat){
  nas=is.na(dat)
  if (!any(!nas)) return (dat)
  t=rle(nas)
  f=sapply(t$lengths[t$values],seq)
  a=unlist(f)
  b=unlist(lapply(f,rev))
  x=which(nas)
  l=length(dat)
  dat[nas]=ifelse(a>b,dat[ ifelse((x+b)>l,x-a,x+b) ],dat[ifelse((x-a)<1,x+b,x-a)])
  dat
}

#run 10 times each to get average performance.
sum <- 0; for (i in 1:10){ sum <- sum + system.time(a(dat))["elapsed"];}; cat ("A: ", sum/10)
A:  5.059
sum <- 0; for (i in 1:10){ sum <- sum + system.time(b(dat))["elapsed"];}; cat ("B: ", sum/10)
B:  0.126
sum <- 0; for (i in 1:10){ sum <- sum + system.time(c(dat))["elapsed"];}; cat ("C: ", sum/10)
C:  0.287

Таким образом, похоже, что этот код (по крайней мере в этих условиях) предлагает ускорение примерно в 40 раз по сравнению с исходным кодом, опубликованным в вопросе, и ускорение в 2,2 раза по сравнению с @ nograpes & apos; ответ ниже (хотя я представляюrle решение, конечно, будет быстрее в некоторых ситуациях - включая более богатый NA вектор).

Error: User Rate Limit Exceededgithub.com/trestletech/R-Utils
4

но, посмотрев на предложения (особенноSMCIпредложение об использованииrleЯ придумал сложную функцию, которая кажется более эффективной.

Этот код я объясню ниже:

# Your function
your.func = function(dat) {
  na.pos <- which(is.na(dat))
  if (length(na.pos) == length(dat)) {
    return(dat)
  }
  non.na.pos <- setdiff(seq_along(dat), na.pos)
  nearest.non.na.pos <- sapply(na.pos, function(x) which.min(abs(non.na.pos - x)))
  dat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]]
  dat
}

# My function
my.func = function(dat) {
    nas=is.na(dat)
    if (!any(!nas)) return (dat)
    t=rle(nas)
    f=sapply(t$lengths[t$values],seq)
    a=unlist(f)
    b=unlist(lapply(f,rev))
    x=which(nas)
    l=length(dat)
    dat[nas]=ifelse(a>b,dat[ ifelse((x+b)>l,x-a,x+b) ],dat[ifelse((x-a)<1,x+b,x-a)])
    dat
}


# Test
n = 100000
test.vec = 1:n
set.seed(1)
test.vec[sample(test.vec,n/4)]=NA

system.time(t1<-my.func(test.vec))
system.time(t2<-your.func(test.vec)) # 10 times speed improvement on my machine

# Verify
any(t1!=t2)

Моя функция опирается наrle, Я читаю комментарии выше, но это выглядит для меня какrle работает просто отлично дляNA, Это проще всего объяснить на небольшом примере.

Если я начну с вектора:

dat=c(1,2,3,4,NA,NA,NA,8,NA,10,11,12,NA,NA,NA,NA,NA,18)

Затем я получаю позиции всех НС:

x=c(5,6,7,8,13,14,15,16,17)

Затем для каждого & quot; запуска & quot; из НС я создаю последовательность от 1 до длины пробега:

a=c(1,2,3,1,1,2,3,4,5)

Затем я делаю это снова, но я изменяю последовательность:

b=c(3,2,1,1,5,4,3,2,1)

Теперь я могу просто сравнить vect, ors a и b: если a & lt; = b, оглянемся назад и возьмем значение в x-a. Если a & gt; b, посмотрите в будущее и возьмите значение в x + b. Остальное - это просто обработка угловых случаев, когда у вас есть все NA или прогоны NA в конце или в начале вектора.

Возможно, есть лучшее, более простое решение, но я надеюсь, что это поможет вам начать.

Error: User Rate Limit Exceededopen-square-bracketError: User Rate Limit Exceededclose-square-bracketError: User Rate Limit Exceeded
Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded
21

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

f1 <- function(dat) {
  N <- length(dat)
  na.pos <- which(is.na(dat))
  if (length(na.pos) %in% c(0, N)) {
    return(dat)
  }
  non.na.pos <- which(!is.na(dat))
  intervals  <- findInterval(na.pos, non.na.pos,
                             all.inside = TRUE)
  left.pos   <- non.na.pos[pmax(1, intervals)]
  right.pos  <- non.na.pos[pmin(N, intervals+1)]
  left.dist  <- na.pos - left.pos
  right.dist <- right.pos - na.pos

  dat[na.pos] <- ifelse(left.dist <= right.dist,
                        dat[left.pos], dat[right.pos])
  return(dat)
}

И вот я проверяю это:

# sample data, suggested by @JeffAllen
dat <- as.integer(runif(50000, min=0, max=10))
dat[dat==0] <- NA

# computation times
system.time(r0 <- f0(dat))    # your function
# user  system elapsed 
# 5.52    0.00    5.52
system.time(r1 <- f1(dat))    # this function
# user  system elapsed 
# 0.01    0.00    0.03
identical(r0, r1)
# [1] TRUE
Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded
1

что было задано, я обнаружил, что этот пост ищет решение для заполнения значений NA интерполяцией. После просмотра этого поста я обнаружил na.fill на объекте зоопарка (вектор, фактор или матрица):

z & lt; - zoo (c (1,2,3,4,5,6, NA, NA, NA, 2,3,4,5,6, NA, NA, 4,6,7, NA))

z1 & lt; - na.fill (z, "удлинить")

Обратите внимание на плавный переход через значения NA

1.0 2.0 3.0 4.0 5.0 6.0 5.0 4.0 3.0 2.0 3.0 4.0 5.0 6.0 5.3 4.6 4.0 6.0 7.0 7.0

Возможно, это могло бы помочь

1

чем у выбранного ответа. Мой довольно простой, хотя. Это тоже редкий цикл.

f2 <- function(x){

  # check if all are NA to skip loop
  if(!all(is.na(x))){

    # replace NA's until they are gone
    while(anyNA(x)){

      # replace from the left
      x[is.na(x)] <- c(NA,x[1:(length(x)-1)])[is.na(x)]

      # replace from the right
      x[is.na(x)] <- c(x[-1],NA)[is.na(x)]
    }
  }

  # return original or fixed x
  x
}

Похожие вопросы