当需要线路上的特定条件时，如何替换R中的双环路?

Question

我目前正在处理一个巨大的文件，其中包含长时间(超过 60000 行)的几个机械师(大约 60个)的停止/去。 我已经按1设备是否working或0(如果设备not working)对表进行了索引。

**Date                     n°1    n°2    n°3    n°4    n°5   n°6    n°7**    
1  2011-12-13 00:00:00      0      1      1      1      1      1      1           
2  2011-12-13 01:00:00      0      1      1      1      1      1      1            
3  2011-12-13 02:00:00      0      1      1      1      1      1      1           
4  2011-12-13 03:00:00      0      1      1      1      1      1      1          
5  2011-12-13 04:00:00      0      1      1      1      1      1      1          
6  2011-12-13 05:00:00      0      1      1      1      1      1      1          
7  2011-12-13 06:00:00      0      1      1      1      1      1      1         

有时，出于特定目的，设备必须停止(不是同时)更长的时间(超过 480 小时)。这相当于480 多行成功不工作。

我想确定这些特定时期，并将其与常规停止分开0并替换为-1，以获得这些长周期的开始日期。

我有一个代码已经在工作了。问题是运行需要很长时间...我想这是因为嵌套循环。但是我尝试过，但无法找到另一种使用 lapply 的处理方式。

for (c in 2:ncol(dataframe)){
for (r in 1:(nrow(dataframe)-480)) {
if(sum(dataframe[r:(r+480),c])==0)     
{dataframe[r,c]<-(-1) }
else 
{dataframe[r,c]<-dataframe[r,c]}
}}

for (c in 2:ncol(dataframe)){
for (r in 1:(nrow(dataframe)-1)) {
if (dataframe[r,c]==-1 && dataframe[r+1,c]==0)
{dataframe[r+1,c]<-(-1)} 
}}

如果列中至少有 480 个零后跟，则此代码将 0 替换为 (-1)。如果后面还有一些零(最后一个)，它们将被转换为"-1"。

我只是想知道如何改进这种编码方案并节省计算时间......

提前谢谢你

Answer 1

您可以使用rle(感谢@A.Suriman的有用评论)。

f <- function(x, thres = 480, replacement = -1) {
r <- rle(x)
r$values <- with(r, replace(values, lengths >= thres & values == 0, replacement))
inverse.rle(r)
}

在每列上应用函数，我以 5 个连续的 0 为例。(您需要排除第一列并设置thres = 480，即dat[-1] <- lapply(dat[-1], f))

dat[] <- lapply(dat, f, thres = 5)
dat
#   X1 X2 X3 X4 X5 X6 X7
#1   0  1  1  1  0  0  1
#2   0 -1  0 -1  1  0  0
#3   0 -1  1 -1  0  0  0
#4   1 -1  0 -1  0  1  0
#5   0 -1  0 -1  1  0  1
#6   1 -1  1 -1  0  0 -1
#7   1 -1  0 -1  1  0 -1
#8  -1 -1  0  1 -1  0 -1
#9  -1  1  1  0 -1  1 -1
#10 -1 -1  0  1 -1  0 -1
#11 -1 -1  0  0 -1  1 -1
#12 -1 -1  1  1 -1  1 -1
#13 -1 -1 -1  0 -1  0 -1
#14 -1 -1 -1  0  1  0 -1
#15  1  1 -1  0  1  0  1
#16  0  0 -1  1  1  0  0
#17  1  1 -1  1  0  1  0
#18  1  0 -1  0  0  0  0
#19  0  1 -1  1  1  0  1
#20  1  0 -1  1  0  0  0

数据

set.seed(1)
dat <- data.frame(replicate(7, expr = sample(c(0, 1), 20, TRUE, prob = c(.7, .3))))