在一个小时内更改下一个唯一值并展开并聚合

Question

我正在尝试实现滑动窗口聚合。我尝试使用tidyr函数进行操作，但是我相信有很多更好/更快的方法可以实现。

让我解释一下我要实现的目标：

我有一个输入数据框dat：

dat <- tibble(timestamp = seq.POSIXt(as.POSIXct("2019-01-01 00:00:00"), as.POSIXct("2019-01-01 02:00:00"), by = "15 min"))
set.seed(42)
dat$value <- sample(1:5, nrow(dat), replace = T)
dat
# A tibble: 9 x 2
  timestamp           value
  <dttm>              <int>
1 2019-01-01 00:00:00     5
2 2019-01-01 00:15:00     5
3 2019-01-01 00:30:00     2
4 2019-01-01 00:45:00     5
5 2019-01-01 01:00:00     4
6 2019-01-01 01:15:00     3
7 2019-01-01 01:30:00     4
8 2019-01-01 01:45:00     1
9 2019-01-01 02:00:00     4

对于每一行，我想从接下来的60分钟内出现的value字段中找到唯一值的列表（但如果存在，则忽略自身）。让我们将该列表称为nextvalue，然后展开每一行以在value和nextvalue之间生成对。然后group_by，value和nextvalue和summarise计数并按降序排序。

我阅读了文档，并放置了以下代码。

t <- dat$timestamp
value <- dat$value

getCI <- function(start, end) {
  paste(value[(start+1):end], collapse = "|")
}

LETTERS <- LETTERS[1:(length(unique(value)) - 1)]

dat %>%
  mutate(time_next = timestamp + 60*60) %>%
  rowwise() %>%
  mutate(flag = max(which(time_next >= t))) %>%
  ungroup() %>%
  mutate(row = row_number()) %>%
  rowwise() %>%
  mutate(nextvalue = getCI(row, flag)) %>%
  select(value, nextvalue) %>%
  separate(nextvalue, c(LETTERS), extra = "warn", fill = "right") %>%
  pivot_longer(LETTERS, names_to = c("Letter"), values_to = "nextvalue") %>%
  filter(!is.na(nextvalue)) %>%
  filter(value != nextvalue) %>%
  select(value, nextvalue) %>%
  group_by(value, nextvalue) %>%
  summarise(count = n()) %>%
  arrange(desc(count))
# A tibble: 13 x 3
# Groups:   value [5]
   value nextvalue count
   <int> <chr>     <int>
 1     5 4             4
 2     2 4             2
 3     3 4             2
 4     4 1             2
 5     5 2             2
 6     5 3             2
 7     1 4             1
 8     2 3             1
 9     2 5             1
10     3 1             1
11     4 3             1
12     4 NA            1
13     5 1             1

但是我想看到有趣的方法来以更少的代码和更简单的方式实现这一目标。请评论

Answer 1

我的解决方案如下：您首先创建一个小标题与自己的完整连接，然后使用一个虚拟变量来这样做：

dat <- mutate(dat, allc=1)
> dat
# A tibble: 9 x 3
  timestamp           value  allc
  <dttm>              <int> <dbl>
1 2019-01-01 00:00:00     1     1
2 2019-01-01 00:15:00     5     1
3 2019-01-01 00:30:00     1     1
4 2019-01-01 00:45:00     1     1
5 2019-01-01 01:00:00     2     1
6 2019-01-01 01:15:00     4     1
7 2019-01-01 01:30:00     2     1
8 2019-01-01 01:45:00     2     1
9 2019-01-01 02:00:00     1     1

然后加入，根据日期进行过滤并汇总：

dat %>% full_join(dat, by="allc") %>% filter(timestamp.x < timestamp.y, timestamp.y < timestamp.x+60*60, value.x!=value.y) %>% group_by(value.x, value.y) %>% summarize(count=n())
# A tibble: 9 x 3
# Groups:   value.x [4]
  value.x value.y count
    <int>   <int> <int>
1       1       2     3
2       1       4     2
3       1       5     1
4       2       1     2
5       2       4     1
6       4       1     1
7       4       2     2
8       5       1     2
9       5       2     1