27

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

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

Мы могли бы перебрать<i><code>rle(which(is.na(dat)))</code></i>, Не сказать, что это наиболее эффективно, но это улучшение. Смотрите также<a href="http://stackoverflow.com/questions/1502910/how-can-i-count-runs-in-r">&quot;How can I count runs in R?&quot;</a> который нуждается в настройке<i><code>rle.na()</code></i> обрабатывать NA.

от smci

вы смотрели на необязательные параметры для na.locf?<code>fromLast</code> похоже, он может делать то, что вы хотите.

от Chase

& apos; Не могли бы вы опубликовать свое решение? Мне было бы интересно посмотреть, что у вас есть.

от Jeff Allen

Это не так, поскольку оно просто принимает предыдущее значение в противоположном направлении. Он не найдет<i>nearest</i> не-NA значение

от geoffjentry

Просто понял, понял, что если ничего другого, то это может превратиться в то, как сделать то, что я делаю, лучше

от geoffjentry

6 ответов

2

Вот мой удар в этом. Мне никогда не нравилось видеть цикл for в R, но в случае вектора с разреженным 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 вектор).

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 в конце или в начале вектора.

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

6

Код ниже. Первоначальный вопрос не был полностью определен, я попросил дать разъяснения:

  1. Is it guaranteed that at least the first and/or last entries are non-NA? [No]
  2. What to do if all entries in a row are NA? [Leave as-is]
  3. 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]
  4. 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. (Это повлияет на разрыв связей между средними элементами в длинном промежутке АН, но вы говорите, что вам все равно.)

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

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

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

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