r - 根据 R 中的其他数字从大数据框中连续更改数字

Question

我有一个包含多行和多列的大数据框，我想更改特定列的值。

数据框看起来像这样:

df1=data.frame(LOCAT=c(1,2,3,4,5,6,7,8,9,10),START=c(120,345,765,1045,1347,1879,2010,2130,2400,2560),END=c(150,390,802,1120,1436,1935,2070,2207,2476,2643),CODE1=c(1,1,0,1,0,0,-1,-1,0,-1))

> df1
   LOCAT START  END CODE1
1      1   120  150     1
2      2   345  390     1
3      3   765  802     0
4      4  1045 1120     1
5      5  1347 1436     0
6      6  1879 1935     0
7      7  2010 2070    -1
8      8  2130 2207    -1
9      9  2400 2476     0
10    10  2560 2643    -1

我希望列 CODE1 中连续长度为 1 的所有“0”成为紧接其前的数字。换句话说，如果 i = 0 & i+1 !=0 & i-1 !=0，则 i = i-1。

我尝试了几个公式，但它们都需要花费大量时间。这是我试过的:

fun = function (a)
{
for (i in 2:(length(row.names(a))-1))
{
a[a[i,4]==0 & !a[i+1,4]==0 & !a[i-1,4]==0,] <- a[i-1,4]
}
return(a)
}

没有成功。我还考虑过使用 rle 函数从数据帧中提取长度为 0 的 0，但我根本不知道该怎么做。将 rle 应用于我的数据框时，这是我得到的简短版本:

> table(rle1)
       values
lengths  -1  -2   0   1   2
  1      20   1 278   5   0
  2      25  18   5  15   2
  3      24   5   4  14   0
  4      20   4   2   5   0
  5      15   4   0  10   1
  6      17   1   1   3   0
  7      13   1   0   5   0
  8      12   1   0   6   0
  9       8   0   0   7   0
  10      3   1   1   4   0

基本上，那些长度为 1 的 278 个“0”应该消失并成为另一个数字(-1、-2、1 或 2)。

示例应该是这样的:

> df2
   LOCAT START  END CODE1
1      1   120  150     1
2      2   345  390     1
3      3   765  802     1
4      4  1045 1120     1
5      5  1347 1436     0
6      6  1879 1935     0
7      7  2010 2070    -1
8      8  2130 2207    -1
9      9  2400 2476    -1
10    10  2560 2643    -1

我希望我足够具体，任何人都可以帮助我。

提前致谢。

Answer 1

这是另一种可能比较快的方法。我添加了注释以指示每行在做什么:

within(df1, {
  # Where are the zeroes
  x <- which(CODE1 == 0)
  # Which of these don't have 0 in the previous or subsequent position
  x <- x[CODE1[x-1] != 0 & CODE1[x+1] != 0]
  # Replace CODE1 at this position with the value from the previous position
  CODE1[x] <- CODE1[x-1]
  # Remove the "x" value we created earlier
  rm(x)
})
#    LOCAT START  END CODE1
# 1      1   120  150     1
# 2      2   345  390     1
# 3      3   765  802     1
# 4      4  1045 1120     1
# 5      5  1347 1436     0
# 6      6  1879 1935     0
# 7      7  2010 2070    -1
# 8      8  2130 2207    -1
# 9      9  2400 2476    -1
# 10    10  2560 2643    -1

---

哇!基准!

以下是创建更大版本的示例 data.frame 后的一些基准:

df2 <- do.call(rbind, replicate(10000, df1, simplify=FALSE))

fun <- function (a) {
  for (i in 2:(nrow(a)-1)) {
    if(a[i,4]==0 & !a[i+1,4]==0 & !a[i-1,4]==0) {
      a[i,4] <- a[i-1,4]
    }
  }
  return(a)
}
system.time(fun(df2))
#    user  system elapsed 
# 354.448   0.322 358.397 

^^ 哎哟。打哈欠。有时间去和那个人喝杯咖啡....

fun1 <- function() {
  within(df2, {
    x <- which(CODE1 == 0)
    x <- x[CODE1[x-1] != 0 & CODE1[x+1] != 0]
    CODE1[x] <- CODE1[x+1]
    rm(x)
  })
} 

fun2 <- function() {
  code_1_behind <- c(0, df2$CODE1[-nrow(df2)])
  code_1_ahead  <- c(df2$CODE1[-1], 0)
  df2$CODE1 <- ifelse(code_1_behind != 0 & code_1_ahead != 0, 
                      code_1_behind, df2$CODE1)
  df2
}

library(microbenchmark)
microbenchmark(fun1(), fun2())
# Unit: milliseconds
#    expr      min       lq    median        uq      max neval
#  fun1() 16.78632 20.10185  74.80807  77.80418 128.7349   100
#  fun2() 59.36418 61.18353 114.74406 118.16778 167.3283   100

^^ 非常接近。 fun2() 似乎不太正确，但似乎(根据您在答案下的评论)您已经意识到这一点并且能够修复它。