删除tibble中的偏移行

时间:2017-12-11 20:19:12

标签: r tidyverse

请注意,数据和VALUE列的顺序与我之前的问题不同。 How do I remove offsetting rows in a tibble?此问题的已接受答案适用于我提供的数据集,但更改值会导致答案失败。

我正在尝试删除具有抵消值的行。

library(dplyr)
a <- c(1, 1, 1, 1, 2, 2, 2, 2,2,2)
b <- c("a", "b", "b", "b", "c", "c","c", "d", "d", "d")
d <- c(10, 10, -10, 50, 20, -20, 60, 30, -30, 70)
o <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
df <- tibble(ID = a, SEQ = b, VALUE = d, OTHER = o)

生成此有序表,按ID和SEQ。

分组
> df
# A tibble: 10 x 4
      ID   SEQ VALUE OTHER
   <dbl> <chr> <dbl> <chr>
 1     1     a    10     A
 2     1     b   -10     B
 3     1     b    10     C
 4     1     b    50     D
 5     2     c   -20     E
 6     2     c    20     F
 7     2     c    60     G
 8     2     d   -30     H
 9     2     d    30     I
10     2     d    70     J

我想删除行对(2,3),(5,6),(8,9),因为VALUE否定匹配前一行中的VALUE。

我希望结果表是

> df2
# A tibble: 4 x 4
     ID   SEQ VALUE OTHER
  <dbl> <chr> <dbl> <chr>
1     1     a    10     A
2     1     b    50     D
3     2     c    60     G
4     2     d    70     J

我知道我不能使用group_by %>% summarize,因为我需要保留在OTHER中的值。我查看了dplyr::lag()函数,但我看不出它有多大帮助。我相信我可以使用某种类型的for each循环遍历表,并生成可用于删除行的逻辑向量,但我希望有更优雅的解决方案。

2 个答案:

答案 0 :(得分:1)

这是另一个没有任何假设的解决方案,不同于假设的接受答案:

1-数据也是基于VALUE

订购的

2-每当cumsum的差异为负时,意味着该值与前一行相比已被否定。

3-如果差异为负,则这些行属于同一组(根据提供的有序数据,可以接受)。

更一般的答案是:

df %>% arrange(ID,SEQ,VALUE) %>%  group_by(ID, SEQ) %>% 
              mutate(helper = VALUE + lag(VALUE, default = -999)) %>% 
              filter(!(helper==0 | lead(helper, default = -999)==0)) %>% select(-helper))
## # A tibble: 4 x 4
## # Groups:   ID, SEQ [4]
##      ID   SEQ VALUE OTHER
##   <dbl> <chr> <dbl> <chr>
## 1     1     a    10     A
## 2     1     b    50     D
## 3     2     c    60     G
## 4     2     d    70     J

答案 1 :(得分:0)

除非我完全误解了你的问题,否则这样做了吗?

idx <- which(diff(cumsum(df$VALUE)) < 0);
df[-c(idx, idx + 1), ];
## A tibble: 4 x 4
#     ID   SEQ VALUE OTHER
#  <dbl> <chr> <dbl> <chr>
#1     1     a    10     A
#2     1     b    50     D
#3     2     c    60     G
#4     2     d    70     J