清理R数据框,以便在列中没有行值大于下一行值的2倍

Question

我有一个数据框,如下所示

dist <- c(1.1,1.0,10.0,5.0,2.1,12.2,3.3,3.4)
id <- rep("A",length(dist))
df<-cbind.data.frame(id,dist)

df

  id dist
1  A  1.1
2  A  1.0
3  A 10.0
4  A  5.0
5  A  2.1
6  A 12.2
7  A  3.3
8  A  3.4

我需要清理它,因此dist列中的行值在任何时候都不会大于下一行值的2倍.清理后的数据框如下所示:

  id dist
1  A  1.1
2  A  1.0
5  A  2.1
7  A  3.3
8  A  3.4

我已经尝试使用for循环和if语句来清理它

cleaner <-  function (df,dist,times_larger) {

              for (i in 1:(nrow(df)-1)) {

                  if (df$dist[i] > df$dist[i+1]*times_larger){
                    df<-df[-i,]
                    break       
                  }
              }
              df
            }

显然,如果我不打破循环,它将产生错误,因为df中的行数将在此过程中发生变化.如果我在df上手动运行循环几次:

df<-cleaner(df,"dist",2)

它将按我的要求清理.

我也尝试了不同的函数结构,并将其应用于数据框,但没有任何运气.

有没有一个很好的建议,如何重复数据框上的功能,直到它不再改变,更好的功能结构或更好的清洁方式？

任何建议都非常感谢

Answer 1

您可以将dist列向左移动一个元素,将其乘以2,然后与原始元素进行比较dist:

subset(df,dist < c(2*dist[-1],Inf))
#  id dist
#1  A  1.1
#2  A  1.0
#5  A  2.1
#7  A  3.3
#8  A  3.4

Answer 2

你可以尝试lead从dplyr

library(dplyr) #dplyr_0.4.0
filter(df, dist < 2 * lead(dist, default = Inf)) 
#    id dist
#1  A  1.1
#2  A  1.0
#3  A  2.1
#4  A  3.3
#5  A  3.4

或者使用类似的方法data.table.shift在data.table的devel版本中引入了一个新函数.我们可以指定类型lead.默认情况下,它是lag并且fill是NA.修改fill为'Inf'(灵感来自@Marat Talipov的帖子).

library(data.table) #data.table_1.9.5
setDT(df)[dist <2 *shift(dist,type='lead', fill=Inf)]
#   id dist
#1:  A  1.1
#2:  A  1.0
#3:  A  2.1
#4:  A  3.3
#5:  A  3.4

更新

如果'dist'的值等于下一个值的'2'倍,则上述解决方案将删除该行.在这种情况下,

setDT(df)[dist <2 *(shift(dist,type='lead',
             fill=Inf)+.Machine$double.eps)]
#    id dist
#1:  A  1.1
#2:  A  1.0
#3:  A  2.1
#4:  A  3.3
#5:  A  3.4

使用@Henrik评论的另一个示例.

df1 <- data.frame(dist= as.numeric(3:1))
setDT(df1)[dist <2 *(shift(dist,type='lead', 
            fill=Inf)+.Machine$double.eps)]
#    dist
#1:    3
#2:    2
#3:    1

基准

set.seed(49)
df <- data.frame(id='A', dist=rnorm(1e7,20))
df1 <- copy(df)
akrun1 <- function() {filter(df, dist < 2 * lead(dist,
                                 default = Inf)) }
akrun2 <- function() {setDT(df1)[dist <2 *shift(dist,type='lead',
                                     fill=Inf)]}
marat <- function() {subset(df,dist < c(2*dist[-1],Inf))}
Colonel <- function() {df[with(df, dist<2*c(dist[-1], tail(dist,1))),]}

library(microbenchmark)
microbenchmark(akrun1(), akrun2(), marat(), Colonel(), 
                                unit='relative', times=20L)
#Unit: relative
#    expr      min       lq     mean   median       uq      max neval  cld
# akrun1() 2.029087 1.990739 1.864697 1.965247 1.773722 1.727474    20  b  
# akrun2() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    20  a   
# marat() 8.032147 8.137982 7.359821 7.937062 7.134686 5.837623     20  d
#Colonel() 7.094465 7.045000 6.473552 6.903460 6.197737 5.359575    20  c