将一行中的值替换为行前后最接近匹配的值,并对多列执行此操作

  • 本文关键字:操作 执行 一行 替换 最接近 r
  • 更新时间 :
  • 英文 :


我已经找到了解决问题的方法(替换多列中的某些值),但该解决方案的计算成本很高,并且在包含 140 万行数据的数据集上运行需要很长时间。

我有从一个时间戳插值到另一个时间戳的数据。这意味着新插值的数据现在具有一些包含小数的值,并且不能真实反映它们应该的值。

例如,在以下数据中:

G4<- data.frame(aX = c(0.968750, 0.970703, 0.980469, 0.949219, 0.960938, 0.966797, 0.935547, 0.875000, 0.882812, 0.871094, 0.871094),
aY = c(0.0468750, 0.0468750, 0.0410156, 0.0332031, 0.0585938, 0.1152340, 0.0996094, 0.0820312, 0.0781250, 0.0742188, 0.0859375),
aZ = c(0.234375, 0.234375, 0.242188, 0.236328, 0.234375, 0.246094, 0.236328, 0.228516, 0.236328, 0.287109, 0.289062),
Time = c("12/7/2013 15:04:30.496", "12/7/2013 15:04:30.536", "12/7/2013 15:04:30.577", "12/7/2013 15:04:30.617", "12/7/2013 15:04:30.657", "12/7/2013 15:04:30.697", "12/7/2013 15:04:30.736", "12/7/2013 15:04:30.776", "12/7/2013 15:04:30.815", "12/7/2013 15:04:30.855", "12/7/2013 15:04:30.895"),
Position = c(6.00000, 6.00000, 6.00000, 6.00000, 6.00000, 4.05629, 3.00000, 3.00000, 3.00000, 3.00000, 3.00000),
PreyEvent = c(0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.647905, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000),
PreyEventDetail = c(0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 1.29581, 2.00000, 2.00000, 2.00000, 2.00000, 2.00000),
Capture = c(0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 1.94371, 3.00000, 3.00000, 3.00000, 3.00000, 3.00000),
LikelyPrey = c(0.00000, 0.00000, 0.00000, 0.00000, 0.00000,   1.29581, 2.00000, 2.00000, 2.00000, 2.00000, 2.00000),
Video = c( 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2))

您将看到,对于包含动物行为类的列,从插值中产生的某些值包含小数,并且需要与上方或下方行中最接近的整数匹配。

下面的示例代码遍历感兴趣的每一行,并选择最接近匹配的必要值,然后替换它。

temp.dat <- data.frame()
for(i in 1:nrow(G4)){
print(i)
t1 <- G4[i,]
t1before <- G4[i-1,]
t1after <- G4[i+1,]
##Position
x1 <- c(t1before$Position,t1after$Position)
replace.value.pos <- x1[which.min(abs(x1 - t1$Position))]
t1$Position <- replace.value.pos
##PreyEvent
x2 <- c(t1before$PreyEvent,t1after$PreyEvent)
replace.value.pe <- x2[which.min(abs(x2 - t1$PreyEvent))]
t1$PreyEvent <- replace.value.pe
##PreyEventDetail
x3 <- c(t1before$PreyEventDetail,t1after$PreyEventDetail)
replace.value.pdet <- x3[which.min(abs(x3 - t1$PreyEventDetail))]
t1$PreyEventDetail <- replace.value.pdet
##Capture
x4 <- c(t1before$Capture,t1after$Capture)
replace.value.c <- x4[which.min(abs(x4 - t1$Capture))]
t1$Capture <- replace.value.c
##LikelyPrey
x5 <- c(t1before$LikelyPrey,t1after$LikelyPrey)
replace.value.lp <- x5[which.min(abs(x5 - t1$LikelyPrey))]
t1$LikelyPrey <- replace.value.lp
##Video
x6 <- c(t1before$Video,t1after$Video)
replace.value.vid <- x6[which.min(abs(x6 - t1$Video))]
t1$Video <- replace.value.vid
temp.dat <- rbind(temp.dat,t1)
}
## Compare new data frame with original
temp.dat
G4

但是,此代码效率低下,我正在努力寻找更快的替代方案。

任何建议将不胜感激!

代码效率低下的主要原因是循环访问行而不是列。在R中,效率往往需要矢量化,这意味着在一次拍摄中处理整个矢量。代码一次有效地处理表的一个单元格。在 R 中,data.frame 在内部实现为向量列表,其中每个内部向量表示表的一列。我们需要一次性处理每个列向量。


正如我在评论中提到的,您的示例输入并未公开我们需要考虑的所有情况,以便传达所需行为的所有方面,或者等效地验证解决方案的正确性。

这是一个更好的测试用例,它由 6 列随机双精度组成,四舍五入到最接近的十分之一(所以有些是积分的,大多数是非积分的),每列夹在两个整数(上方和下方)之间,保证它们将是有效的替换值:

set.seed(2L);
cns <- c('Position','PreyEvent','PreyEventDetail','Capture','LikelyPrey','Video');
NR <- 11L; NC <- length(cns);
input <- setNames(nm=cns,as.data.frame(replicate(NC,ifelse(1:NR%%2L,round(dig=1L,runif(NR,1,9)),sample(1:9,NR,T)))));
input;
##    Position PreyEvent PreyEventDetail Capture LikelyPrey Video
## 1       2.5       7.7             8.6     4.1        6.9   1.2
## 2       7.0       5.0             8.0     4.0        2.0   9.0
## 3       5.6       3.8             8.8     2.7        8.8   4.0
## 4       4.0       8.0             6.0     4.0        9.0   3.0
## 5       8.6       2.2             5.0     3.2        4.0   7.6
## 6       9.0       7.0             7.0     1.0        3.0   6.0
## 7       2.0       8.7             1.1     1.3        4.7   8.0
## 8       5.0       9.0             6.0     2.0        9.0   7.0
## 9       4.7       1.1             6.5     2.5        4.4   8.6
## 10      6.0       2.0             8.0     9.0        2.0   2.0
## 11      5.4       7.5             3.2     3.3        1.9   1.3

这是我的解决方案:

output <- input;
for (cn in cns) {
isBelowCloser <- c(T,diff(abs(diff(output[[cn]])))<0,F);
nonIntegralIndexes <- which(abs(output[[cn]]-round(output[[cn]]))>=1e-8);
output[[cn]][nonIntegralIndexes] <- output[[cn]][nonIntegralIndexes+isBelowCloser[nonIntegralIndexes]*2L-1L];
}; ## end for
output;
##    Position PreyEvent PreyEventDetail Capture LikelyPrey Video
## 1         7         5               8       4          2     9
## 2         7         5               8       4          2     9
## 3         7         5               8       4          9     4
## 4         4         8               6       4          9     3
## 5         9         7               5       4          4     6
## 6         9         7               7       1          3     6
## 7         2         9               6       1          3     8
## 8         5         9               6       2          9     7
## 9         5         2               6       2          2     7
## 10        6         2               8       9          2     2
## 11        6         2               8       9          2     2

我的解决方案循环访问表的每个目标列,按名称cn标识它。或者,如果需要,可以使用整数列索引。

请注意,我不会将列向量存储在临时局部变量中;我总是直接访问它。这可以节省处理时间,因为它允许我们就地修改向量,而不是修改副本,然后必须将其写回原始 data.frame 中。另请注意,由于这种就地修改,将输入对象复制到新的输出对象是有意义的,这样我们就可以保留原始输入以进行比较(当然,在最终实现中不需要这样做)。

我的解决方案中有三个重要的陈述,我将在下面描述。


isBelowCloser计算

首先,也许也是最关键的一步,是确定向量中的所有值的上述值是否更接近当前值,或者以下值是否更接近当前值。重要的是要认识到这将是一个矢量化操作,因此没有"单一"当前值;矢量化操作将贯穿整个列向量,并生成一个向量作为结果值。

让我们从内到外看一下声明的每一部分:


output[[cn]]

这只是索引出列向量。


diff(output[[cn]]))

这将在向量中的每对相邻元素之间执行减法。因此,它在单个操作中计算整个色谱柱向量的所有替换决策所需的所有差异。

请注意,差分向量将比列向量短一个元素。这是因为它为每输入向量元素生成一个差异元素。

请记住差分向量的索引与列向量的索引之间的对应关系。例如,对于

列元素 2,差异元素 1 表示列元素 2 与其"上方"元素之间的差异,差异元素 2 表示列元素 2 与其"下方"元素之间的差异。
abs(diff(output[[cn]]))

由于我们只对两个候选替换值之间的绝对距离感兴趣,因此我们必须忽略差分元素中的任何符号,因此必须取差向量的绝对值。


diff(abs(diff(output[[cn]])))

此二级差异比较了两个候选距离。因此,它告诉我们哪个更接近原始列元素。

请注意,现在这将比原始列向量短两个元素。


diff(abs(diff(output[[cn]])))<0

上面生成了一个逻辑向量,告诉我们哪些列元素的"低于"值比"上面"值更接近。如果秒级差值小于零,则意味着到"下面"元素的距离小于到"上面"元素的距离。


c(T,diff(abs(diff(output[[cn]])))<0,F)

必须将逻辑向量包装在前面的 true 和后面的 false 值中,才能处理第一行和最后一行。对于这些行,替换值只能来自存在值的一侧。因此,顶行必须从"下面"元素中获取其替换值,而底行必须从"上面"元素中获取替换值。

此换行将此中间向量的长度恢复为原始列向量的长度。因此,它的索引现在对应于原始列向量。换句话说,此中间向量的第 n 个元素表示列向量的第 n 个元素是否应从其"下面"元素 (true) 或 "上面" 元素 (false) 中获取其替换值。

上面的表达式被分配给isBelowCloser局部变量,以便在 final 语句中使用。


nonIntegralIndexes计算

由于您的问题暗示您只想用它们最接近的相邻(高于或低于)值替换非整数值,因此我们必须计算列向量的哪些元素是非积分的,因此我们可以有选择地仅修改这些元素。


output[[cn]]

同样,我们必须就地提取目标列向量。


round(output[[cn]])

为了跳到前面,我们将比较列元素与其最近的整数之间的距离,以确定它是否足够远离其最接近的整数以被视为"非积分"。因此,我们需要使用round()计算最接近的整数。


abs(output[[cn]]-round(output[[cn]]))

这将计算上述距离。


abs(output[[cn]]-round(output[[cn]]))>=1e-8

这会将距离与较小的容差进行比较,这样,只有比容差更接近其最接近整数的值才会被视为整数。


which(abs(output[[cn]]-round(output[[cn]]))>=1e-8)

在最后的语句中,拥有非整数元素的整数索引而不是逻辑向量会很有用,因此在此处运行which()来执行该转换会很有帮助。

上述结果将分配给nonIntegralIndexes以在最终语句中使用。


替换声明

列循环中的最后一条语句实际上应用了替换。


isBelowCloser[nonIntegralIndexes]

我们首先提取,仅对于非整数元素,表示其"下面"元素是否更接近它(true)或它的"上面"元素更接近它(false)。


isBelowCloser[nonIntegralIndexes]*2L-1L

通过乘以 2 并减去 1,我们将假逻辑值和真逻辑值分别转换为 -1 和 1。


nonIntegralIndexes+isBelowCloser[nonIntegralIndexes]*2L-1L

将 -1 和 1 值添加到nonIntegralIndexes会将索引移动到其入选替换索引。


output[[cn]][nonIntegralIndexes+isBelowCloser[nonIntegralIndexes]*2L-1L]

然后,我们从原始列向量中索引出获胜的替换元素。


output[[cn]][nonIntegralIndexes] <- ...

最后,我们将获胜的替换元素分配给非积分违规元素来替换它们。

我不确定这是否更快,但我确定了哪些行需要先更改,然后替换它们,这样您就不会遍历所有行。让我知道速度是如何工作的

some <- function(column){
x <- column
t.up.down <- cbind(c(x[-1], NA), c(NA, x[-length(x)]))
rrows <- which(t.up.down[,1] != t.up.down[,2])
change <- rep(NA, length(rrows))
for(i in rrows){
change[which(rrows == i)] <- t.up.down[i,][which.min(abs(t.up.down[i,] - x[i]))]
}
x[rrows] <- change
x
}
apply(G4[,6:10], 2, some)

您的另一个选择是将其应用于 data.table 包。

最新更新