基于R中的其他数字更改大数据帧中的行中的数字

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

数据帧如下所示：

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

基本上，长度为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

我希望我足够具体，任何人都能帮助我

提前谢谢。

给你：

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)

df1这应该行得通

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

fun=函数（a）{
对于（第2部分中的i:（nrow（a）-1））{
如果（a[i，4]==0&！a[i+1,4]==0&！a[i-1,4]==0）{
a[i，4]这里有另一种可能很快的方法。我添加了注释，以指示每行正在做什么：

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

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

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

fun1太棒了！这么快又简单。我花了一段时间才理解你的解决方案背后的原理，但它非常适合我。我只需要用你的解决方案最后一行中的新值更改我的列CODE1。做得好，再次感谢你！没问题。今天早上我有点匆忙地回答了，所以我认出了answer不完整，但我很高兴它达到了目的。感谢您的输入。您编写的公式与我的基本相同，正如我所预期的，需要花费很长时间才能完成计算。JAponte的答案在几秒钟内就成功了。再次感谢，cheers@user2992593，我已经编辑了一些关于这方面的基准。谢谢你，阿南达。这确实是第一个乐趣Action与我以前尝试过的类似，但它确实需要很长时间。当我的data.frame有近一百万行时，你复制了10000*10。你可以想象这将花费我多少时间。我确实修复了
fun2（）
适合我和你的函数看起来非常简单。我将添加你有价值的答案作为主要答案，因为你对所有答案都做了很好的概述。可能会帮助其他人。再次感谢你，干杯
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