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

我想要所有＆＃34; 0＆＃34;连续长度为1的CODE1列成为紧接之前的数字。换句话说，如果i = 0＆amp; i + 1！= 0＆amp; 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

基本上，那些278＆＃34; 0＆＃34;长度为1，应该消失并且是另一个数字（-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

你走了：

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

code_1_behind <- c(0, df1$CODE1[-nrow(df1)])
code_1_ahead  <- c(df1$CODE1[-1], 0)

ifelse(code_1_behind != 0 & code_1_ahead != 0, code_1_behind, df1$CODE1)

Answer 2

这是另一种可能很快的方法。我添加了评论，以说明每一行正在做什么：

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

Whee！基准！

在创建样本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()似乎不太正确，但似乎（根据你在答案中的评论）你知道这一点，并且能够解决它。

Answer 3

这应该有效

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

根据R中的其他数字，从大数据框中更改一行中的数字

3 个答案:

Whee！基准！