我在na.locf()
包中寻找与zoo
类似的内容,但不是总是使用之前的非NA
值。喜欢使用最近的非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
但我希望使用最近的非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]]
回答以下smci的问题:
更新所以事实证明我们正朝着不同的方向前进,但这仍然是一个有趣的讨论。谢谢大家!
答案 0 :(得分: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
答案 1 :(得分:6)
以下代码。最初的问题并没有完全明确,我曾要求做出这些澄清:
1 3 NA NA NA 5 7
中的中间NA? [不关心/离开] ifelse
的数据帧解决方案。) [最差 - 案例S可能在病理上很大,因此不应使用递归] geoffjentry,重新解决您的问题,您的瓶颈将是 nearest.non.na.pos
的串行计算和序列分配 dat[na.pos] <- dat[non.na.pos[nearest.non.na.pos]]
对于长度G的大间隙,我们真正需要计算的是第一个(G / 2,向上舍入)项目从左侧填充,其余项目从右侧填充。 (我可以使用 ifelse
发布答案,但看起来很相似。)
您的标准是运行时,大O效率,临时内存使用或代码易读性?
Coupla可能的调整:
N <- length(dat)
一次if (length(na.pos) == 0)
跳过行,因为它没有NAs if (length(na.pos) == length(dat)-1)
(罕见)只存在一个非NA条目的情况,因此我们用它填充整行大纲解决方案:
可悲的是na.locf不适用于整个数据帧,你必须使用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)
或者,因为正如你所说的连续的NAs很少见,所以要做一个快速且愚蠢的 ifelse
来从左边填充孤立的NA。这将以数据框架方式操作=&gt;使常见的情况更快。然后使用行方式for循环处理所有其他情况。 (这会影响很长一段时间内中间元素的抢七,但你说你不在乎。)
答案 2 :(得分: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)
然后我获得所有NAs的职位:
x=c(5,6,7,8,13,14,15,16,17)
然后,对于NAs的每次“运行”,我创建一个从1到运行长度的序列:
a=c(1,2,3,1,1,2,3,4,5)
然后我再次这样做,但我颠倒了序列:
b=c(3,2,1,1,5,4,3,2,1)
现在,我可以比较矢量a和b:如果a&lt; = b然后回头并抓住x-a处的值。如果a> b则向前看并抓住x + b处的值。其余的只是在向量或向量的开始处运行所有NA或NA运行时处理极端情况。
可能有一个更好,更简单的解决方案,但我希望这能让你开始。
答案 3 :(得分:2)
这是我对它的刺痛。我从不喜欢在R中看到for循环,但是在稀疏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的一半长度。要计算最大运行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
}
#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倍的加速,以及@nograpes在下面的答案加速2.2倍(尽管我想象{{1在某些情况下,解决方案肯定会更快 - 包括更富含NA的矢量。)
答案 4 :(得分:1)
速度比所选答案慢约3-4倍。我的很简单。这也是一个罕见的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
}
答案 5 :(得分: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,&#34; extend&#34;)
注意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
也许这可以帮助