Zamiana NAs W R na najbliższą wartość

Kod poniżej. Pierwsze pytanie nie było do końca dobrze zdefiniowane, poprosiłem o te wyjaśnienia:

1. czy jest zagwarantowane, że przynajmniej pierwsze i / lub ostatnie wpisy nie są na? [Nie]
2. co zrobić, jeśli wszystkie wpisy w wierszu są NA? [Leave as-is]
3. czy zależy ci na tym, jak więzy są dzielone, czyli jak traktować środek NA w 1 3 NA NA NA 5 7? [Don ' t-care / left]
4. Czy masz górną krawędź (s) na najdłuższym przylegającym przęśle NAs z rzędu? (Myślę o rozwiązaniu rekurencyjnym, jeśli S jest małe. Lub rozwiązanie dataframe z ifelse jeśli S jest duże i liczba wierszy i cols jest duże.) [najgorszy przypadek S może być patologicznie duży, stąd rekurencja nie powinna być używana]

Możliwe poprawki:

• wystarczy obliczyć N <- length(dat) once
• common-case speed enhance: if (length(na.pos) == 0) pomiń wiersz, ponieważ nie ma NAs
• if (length(na.pos) == length(dat)-1) (rzadki) przypadek, w którym istnieje tylko jeden nie-NA wpis stąd wypełniamy nim cały wiersz

Rozwiązanie konturu:

Niestety na.locf nie działa na całej ramce danych, musisz użyć sapply, row-wise:

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)

Alternatywnie, ponieważ jak mówisz sąsiadujące NAs są rzadkie, zrób szybką i głupią ifelse / align = "left" / To będzie działać mądrze ramki danych = > sprawia, że wspólna sprawa szybko. Następnie obsłuż wszystkie inne przypadki za pomocą pętli for-loop. (Wpłynie to na tiebreak na środkowych elementach w długi czas NAs, ale mówisz, że cię to nie obchodzi.)

Nie mogę wymyślić oczywistego prostego rozwiązania, ale po przyjrzeniu się sugestiom (szczególnie sugestii smci użycia rle) wymyśliłem skomplikowaną funkcję, która wydaje się być bardziej wydajna.

To jest kod, wyjaśnię poniżej:

# 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)

Moja funkcja opiera się na rle. Czytam powyższe komentarze, ale wygląda na to, że rle działa dobrze dla NA. Najłatwiej jest to wyjaśnić małym przykładem.

Jeśli zacznę od wektor:

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

Potem dostaję pozycje wszystkich NAs:

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

Następnie, dla każdego "biegu" NAs tworzę sekwencję od 1 do długości BIEGU:

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

Potem robię to jeszcze raz, ale odwracam sekwencję:

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

Teraz mogę po prostu porównać wektory a i b: Jeśli a b to spójrz do przodu i chwyć wartość W x + b. reszta to tylko obsługa przypadków narożnych, gdy masz wszystkie nas lub na działa na końcu lub na początku. wektor.

Prawdopodobnie istnieje lepsze, prostsze rozwiązanie, ale mam nadzieję, że to pomoże Ci zacząć.

Oto moje zadanie. Nigdy nie lubię widzieć pętli for W R, ale w przypadku wektora słabo-NA wygląda na to, że będzie on w rzeczywistości bardziej wydajny(wskaźniki wydajności poniżej). Treść kodu znajduje się poniżej.

  #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))]
  }

Podobał mi się kod, który zaproponowałeś, ale zauważyłem, że obliczamy delta pomiędzy każdą wartością NA I każdym innym indeksem nie-na w macierzy. Myślę, że to był największy występ. Zamiast tego, po prostu wyodrębnić minimalną wielkość sąsiedztwa lub okna wokół każdy NA i znajdź najbliższą wartość inną niż NA w tym oknie.

Wydajność skaluje się liniowo na liczbę NAs i rozmiar okna - gdzie rozmiar okna jest (pułap) o połowę krótszy od maksymalnego uruchomienia NAs. Aby obliczyć długość maksymalnego uruchomienia serwera NAs, możesz użyć następującej funkcji:

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
}

Porównanie Wydajności

#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

Tak wygląda ten kod (przynajmniej w tych warunkach), oferuje około 40x speedup od oryginalnego kodu posted in pytanie, and a 2.2 x speedup over @nograpes' answer below (though I imagine an rle solution would certainly be faster in some situations-including a more NA-rich vector).

Prędkość jest około 3-4x wolniejsza od wybranej odpowiedzi. Mój jest dość prosty. Jest to również rzadka pętla while.

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
}

Lubię wszystkie rygorystyczne rozwiązania. Chociaż nie bezpośrednio to, o co pytano, znalazłem ten post szukając rozwiązania do wypełniania wartości NA interpolacją. Po przejrzeniu tego postu odkryłem na.wypełnienie na obiekcie zoo (wektor, czynnik lub macierz):

Z

Z1

Zwróć uwagę na płynne przejście przez wartości 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

Być może to pomoże