Remplacer NAs dans R par la valeur la plus proche

Je cherche quelque chose de similaire à na.locf() dans le paquet zoo, mais au lieu d'utiliser toujours la valeur précédente non-NA, je voudrais utiliser la valeur la plus proche non-NA. Quelques exemples de données: 

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

Remplacer NA par na.locf (3 est reporté): 

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

Et na.locf avec fromLast réglé sur TRUE (5 est reporté en arrière): 

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

Mais je souhaite que la valeurla plus proche non-NA soit utilisée. Dans mon exemple, cela signifie que le 3 devrait être reporté vers le premier NA, et le 5 devrait être reporté vers le second NA: 

1 3 3 5 5 7

J'ai une solution codée, mais je voulais m'assurer que je ne réinventais pas la roue. Y a-t-il quelque chose qui flotte déjà?

Pour info, mon code actuel est le suivant. Peut-être que si rien d'autre, quelqu'un peut suggérer comment le rendre plus efficace. J'ai l'impression de manquer un moyen évident d'améliorer ceci: 

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

Pour répondre aux questions de smci ci-dessous:

  1. Non, toute entrée peut être NA
  2. Si Tous sont NA, laissez-les tels quels
  3. Non. Ma solution actuelle par défaut à la valeur la plus proche de gauche, mais cela n'a pas d'importance
  4. Ces lignes sont quelques centaines de milliers d'éléments généralement, donc, en théorie, la limite supérieure serait de quelques centaines de milliers. En réalité, ce ne serait pas plus que quelques-uns ici et là, généralement un seul.

Update Il s'avère donc que nous allons dans une direction différente au total, mais ce fut encore une discussion intéressante. Merci à tous!

26
demandé sur Henrik 2012-04-09 21:53:30

6 réponses

En voici un très rapide. Il utilise findInterval pour trouver les deux positions à considérer pour chaque NA dans vos données d'origine: 

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

Et ici je le teste: 

# 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
21
répondu flodel 2013-01-10 13:06:20

Code ci-dessous. La question initiale n'était pas tout à fait bien définie, j'avais demandé ces éclaircissements:

  1. est-il garanti qu'au moins les premières et / ou dernières entrées sont non-NA? [N]
  2. Que faire si toutes les entrées dans une rangée sont NA? [laisser tel quel]
  3. vous souciez-vous de la façon dont les liens sont divisés, c'est-à-dire comment traiter le NA moyen dans 1 3 NA NA NA 5 7? [Ne pas-soins / gauche]
  4. avez-vous une limite supérieure (S) sur la plus longue contiguë durée de NAs dans une rangée? (Je pense à une solution récursive si S est petit. Ou une solution dataframe avec ifelse si S est grand et le nombre de lignes et cols est grand.) [le pire des cas pourrait être pathologiquement grand, par conséquent la récursivité ne devrait pas être utilisée]

Geoffjentry, re votre solution vos goulots d'étranglement seront le calcul en série de nearest.non.na.pos et l'affectation en sériedat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]] Pour un grand écart de longueur G tout ce que nous avons vraiment besoin de calculer est que le premier (G/2, arrondir) les éléments remplissent-de-gauche, le reste de droite. (Je pourrais poster une réponse en utilisant ifelse mais cela ressemblerait.) Vos critères runtime, l'efficacité big-O, l'utilisation de la mémoire temporaire ou la lisibilité du code?

Coupla réglages possibles:

  • seulement besoin de calculer N <- length(dat) une fois
  • amélioration de la vitesse du boîtier commun: if (length(na.pos) == 0) ignorer la ligne, car il n'a pas de NAs
  • if (length(na.pos) == length(dat)-1) le (rare) cas où il n'y a qu'un seul non-NA entrée par conséquent, nous remplissons la ligne entière avec elle

Solution de contour:

Malheureusement na.locf ne fonctionne pas sur un dataframe entier, vous devez utiliser sapply, en ligne: 

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)

Sinon, comme vous dites que les NAs contigus sont rares, faites un rapide et stupide ifelse pour remplir NAs isolé à partir de la gauche. Cela fonctionnera data-frame Sage = > rend le common-case rapide. Ensuite, gérez tous les autres cas avec une boucle For-Loop en ligne. (Cela affectera le tiebreak sur les éléments du milieu dans un longue durée de NAs, mais vous dites que vous vous en fichez.)

5
répondu smci 2012-04-09 22:10:31

Je ne peux pas penser à une solution simple évidente, mais, après avoir regardé les suggestions (en particulier la suggestion de smci d'utiliser rle), j'ai trouvé une fonction compliquée qui semble être plus efficace.

C'est le code, je vais vous expliquer ci-dessous:

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

Ma fonction repose sur rle. Je lis les commentaires ci-dessus, mais il me semble que rle fonctionne très bien pour NA. Il est plus facile d'expliquer avec un petit exemple.

Si je commence par un vecteur:

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

Je reçois alors les positions de tous les NAs: 

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

Ensuite, pour chaque "course" de NAs, je crée une séquence de 1 à la longueur de la course: 

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

Ensuite, je le refais, mais j'inverse la séquence: 

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

Maintenant, je peux simplement comparer les vecteurs A et b: Si AB alors regardez en avant et prenez la valeur à x + B. le reste ne fait que Gérer les cas de coin lorsque vous avez tous les NAS ou NA à la fin ou au début de vecteur.

Il y a probablement une meilleure solution, plus simple, mais j'espère que cela vous aidera à démarrer.

3
répondu nograpes 2017-05-23 12:18:06

Voici mon coup de couteau. Je n'aime jamais voir une boucle for dans R, mais dans le cas d'un vecteur faiblement NA, il semble que ce soit plus efficace (mesures de performance ci-dessous). L'essentiel du code est ci-dessous.

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

J'ai aimé le code que vous avez proposé, mais j'ai remarqué que nous calculions le delta entre chaque valeur NA et chaque autre indice non NA dans la matrice. Je pense que c'était le plus gros porc de performance. Au lieu de cela, je viens d'extraire le quartier ou la fenêtre de taille minimale chaque NA et trouver la valeur non-NA la plus proche dans cette fenêtre.

Donc, la performance s'adapte linéairement au nombre de NAs et à la taille de la fenêtre-où la taille de la fenêtre est (le plafond de) la moitié de la longueur de L'exécution maximale du NAs. Pour calculer la longueur de l'exécution maximale du NAs, vous pouvez utiliser la fonction suivante: 

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
}

Comparaison Des Performances

#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

Donc, il ressemble à ce code (au moins dans ces conditions), offre environ une accélération 40X du code original posté dans la question, et une accélération 2.2 X sur la réponse de @nograpes ci-dessous (bien que j'imagine une solution rle serait certainement plus rapide dans certaines situations-y compris un vecteur plus riche en NA).

2
répondu Jeff Allen 2012-04-10 01:06:34

La vitesse est environ 3-4x plus lente que celle de la réponse choisie. Le mien est assez simple. C'est aussi une boucle while rare.

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
}
1
répondu ARobertson 2015-08-05 05:09:32

J'aime toutes les solutions rigoureuses. Bien que pas directement ce qui a été demandé, j'ai trouvé ce post à la recherche d'une solution pour remplir les valeurs NA avec une interpolation. Après avoir examiné ce post, j'ai découvert na.remplir sur un objet zoo (vecteur, facteur ou matrice):

Z

I1

Notez la transition en douceur entre les valeurs 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

Peut-être que cela pourrait aider

1
répondu DHEFA49 2017-04-13 09:11:51