识别并计算法术（每组中的特殊事件）
我正在寻找一种有效的方法来识别时间序列中的咒语/奔跑。在下图中，前三列是我所拥有的，第四列spell是我要计算的。我尝试使用dplyr的{{1}}和lead，但这太复杂了。我已经尝试过lag，但无果而终。
ReprEx
rle我更喜欢df <- structure(list(time = structure(c(1538876340, 1538876400,
1538876460,1538876520, 1538876580, 1538876640, 1538876700, 1538876760, 1526824800,
1526824860, 1526824920, 1526824980, 1526825040, 1526825100), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), group = c("A", "A", "A", "A", "A", "A", "A", "A", "B",
"B", "B", "B", "B", "B"), is.5 = c(0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1)),
class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -14L))
解决方案。
假设
-
数据按
tidyverse排序，然后按group -
每个组中
time中没有空格
更新
感谢您的贡献。我已对全部数据进行了一些建议的方法计时（n = 2,583,360）
- @markus的
time方法花费了0.53秒 - @ M-M的
rle方法花费了2.85秒 - @MrFlick的函数方法耗时0.66秒
- @tmfmnk的
cumsum和rle花费了0.89
我最终选择了@markus的（1），因为它快速且仍然有些直观（主观）。 （2）@ M-M最好地满足了我对dense_rank解决方案的需求，尽管它在计算上效率低下。
6 个答案:
答案 0 :(得分：7)
使用rle
library(dplyr)
df %>%
group_by(group) %>%
mutate(
spell = {
r <- rle(is.5)
r$values <- cumsum(r$values) * r$values
inverse.rle(r)
}
)
# A tibble: 14 x 4
# Groups: group [2]
# time group is.5 spell
# <dttm> <chr> <dbl> <dbl>
# 1 2018-10-07 01:39:00 A 0 0
# 2 2018-10-07 01:40:00 A 1 1
# 3 2018-10-07 01:41:00 A 1 1
# 4 2018-10-07 01:42:00 A 0 0
# 5 2018-10-07 01:43:00 A 1 2
# 6 2018-10-07 01:44:00 A 0 0
# 7 2018-10-07 01:45:00 A 0 0
# 8 2018-10-07 01:46:00 A 1 3
# 9 2018-05-20 14:00:00 B 0 0
#10 2018-05-20 14:01:00 B 0 0
#11 2018-05-20 14:02:00 B 1 1
#12 2018-05-20 14:03:00 B 1 1
#13 2018-05-20 14:04:00 B 0 0
#14 2018-05-20 14:05:00 B 1 2
您要求使用tidyverse解决方案，但是如果您担心速度，可以使用data.table。语法非常相似
library(data.table)
setDT(df)[, spell := {
r <- rle(is.5)
r$values <- cumsum(r$values) * r$values
inverse.rle(r)
}, by = group][] # the [] at the end prints the data.table
说明
当我们打电话
r <- rle(df$is.5)
我们得到的结果是
r
#Run Length Encoding
# lengths: int [1:10] 1 2 1 1 2 1 2 2 1 1
# values : num [1:10] 0 1 0 1 0 1 0 1 0 1
我们需要用累积和替换values，其中values == 1，而values应该保持为零。
当我们将cumsum(r$values)与r$values相乘时，我们可以实现这一目标；后者是0和1 s的向量。
r$values <- cumsum(r$values) * r$values
r$values
# [1] 0 1 0 2 0 3 0 4 0 5
最后，我们调用inverse.rle以获取与is.5相同长度的向量。
inverse.rle(r)
# [1] 0 1 1 0 2 0 0 3 0 0 4 4 0 5
我们对每个group执行此操作。
答案 1 :(得分：5)
这是一个辅助函数，可以返回您想要的内容
spell_index <- function(time, flag) {
change <- time-lag(time)==1 & flag==1 & lag(flag)!=1
cumsum(change) * (flag==1)+0
}
您可以将其与数据一起使用
library(dplyr)
df %>%
group_by(group) %>%
mutate(
spell = spell_index(time, is.5)
)
基本上，辅助函数使用lag()查找更改。我们使用cumsum()来增加更改数量。然后，我们将其乘以布尔值，以便将要归零的值归零。
答案 2 :(得分：2)
这是rleid中data.table的一个选项。将'data.frame'转换为'data.table'（setDT(df)），按'group'分组，获得'is.5'的运行长度ID（rleid）并乘以“ is.5”的值，以便将is.5中与0对应的id替换为0，将其分配给“ spell”，然后用逻辑矢量指定i以选择具有“ spell”的行'值不为零，match将'spell'的值与unique'spell'并分配给'spell'
library(data.table)
setDT(df)[, spell := rleid(is.5) * as.integer(is.5), group
][!!spell, spell := match(spell, unique(spell))][]
# time group is.5 spell
# 1: 2018-10-07 01:39:00 A 0 0
# 2: 2018-10-07 01:40:00 A 1 1
# 3: 2018-10-07 01:41:00 A 1 1
# 4: 2018-10-07 01:42:00 A 0 0
# 5: 2018-10-07 01:43:00 A 1 2
# 6: 2018-10-07 01:44:00 A 0 0
# 7: 2018-10-07 01:45:00 A 0 0
# 8: 2018-10-07 01:46:00 A 1 3
# 9: 2018-05-20 14:00:00 B 0 0
#10: 2018-05-20 14:01:00 B 0 0
#11: 2018-05-20 14:02:00 B 1 1
#12: 2018-05-20 14:03:00 B 1 1
#13: 2018-05-20 14:04:00 B 0 0
#14: 2018-05-20 14:05:00 B 1 2
或者在第一步之后，使用.GRP
df[!!spell, spell := .GRP, spell]
答案 3 :(得分：1)
这有效，
数据
df <- structure(list(time = structure(c(1538876340, 1538876400, 1538876460,1538876520, 1538876580, 1538876640, 1538876700, 1538876760, 1526824800, 1526824860, 1526824920, 1526824980, 1526825040, 1526825100), class = c("POSIXct", "POSIXt"), tzone = "UTC"), group = c("A", "A", "A", "A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "B"), is.5 = c(0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -14L))
我们按组划分数据，
df2 <- split(df, df$group)
构建一个我们可以应用于列表的功能
my_func <- function(dat){
rst <- dat %>%
mutate(change = diff(c(0,is.5))) %>%
mutate(flag = change*abs(is.5)) %>%
mutate(spell = ifelse(is.5 == 0 | change == -1, 0, cumsum(flag))) %>%
dplyr::select(time, group, is.5, spell)
return(rst)
}
然后应用它，
l <- lapply(df2, my_func)
我们现在可以打开此list back into a data frame：
do.call(rbind.data.frame, l)
答案 4 :(得分：1)
某种可能性（不涉及cumsum()）可能是：
df %>%
group_by(group) %>%
mutate(spell = with(rle(is.5), rep(seq_along(lengths), lengths))) %>%
group_by(group, is.5) %>%
mutate(spell = dense_rank(spell)) %>%
ungroup() %>%
mutate(spell = ifelse(is.5 == 0, 0, spell))
time group is.5 spell
<dttm> <chr> <dbl> <dbl>
1 2018-10-07 01:39:00 A 0 0
2 2018-10-07 01:40:00 A 1 1
3 2018-10-07 01:41:00 A 1 1
4 2018-10-07 01:42:00 A 0 0
5 2018-10-07 01:43:00 A 1 2
6 2018-10-07 01:44:00 A 0 0
7 2018-10-07 01:45:00 A 0 0
8 2018-10-07 01:46:00 A 1 3
9 2018-05-20 14:00:00 B 0 0
10 2018-05-20 14:01:00 B 0 0
11 2018-05-20 14:02:00 B 1 1
12 2018-05-20 14:03:00 B 1 1
13 2018-05-20 14:04:00 B 0 0
14 2018-05-20 14:05:00 B 1 2
在这里，首先，按“ group”进行分组，然后获取“ is.5”的运行长度ID。其次，它按“ group”和“ is.5”分组，并在游程长度ID上对值进行排名。最后，它将0分配给“ is.5” == 0的行。
答案 5 :(得分：1)
一种选择是使用cumsum：
library(dplyr)
df %>% group_by(group) %>% arrange(group, time) %>%
mutate(spell = is.5 * cumsum( c(0,lag(is.5)[-1]) != is.5 & is.5!=0) )
# # A tibble: 14 x 4
# # Groups: group [2]
# time group is.5 spell
# <dttm> <chr> <dbl> <dbl>
# 1 2018-10-07 01:39:00 A 0 0
# 2 2018-10-07 01:40:00 A 1 1
# 3 2018-10-07 01:41:00 A 1 1
# 4 2018-10-07 01:42:00 A 0 0
# 5 2018-10-07 01:43:00 A 1 2
# 6 2018-10-07 01:44:00 A 0 0
# 7 2018-10-07 01:45:00 A 0 0
# 8 2018-10-07 01:46:00 A 1 3
# 9 2018-05-20 14:00:00 B 0 0
# 10 2018-05-20 14:01:00 B 0 0
# 11 2018-05-20 14:02:00 B 1 1
# 12 2018-05-20 14:03:00 B 1 1
# 13 2018-05-20 14:04:00 B 0 0
# 14 2018-05-20 14:05:00 B 1 2
c(0,lag(is.5)[-1]) != is.5负责在spell更改时分配新的ID（即is.5）；但是我们要避免为与is.5相等的行0分配新的行，这就是为什么我在cumsum函数中有第二个规则（即(is.5!=0)）。
但是，第二条规则仅阻止分配新的ID（在先前的ID上加1），但不会将ID设置为0。这就是为什么我将答案乘以is.5。
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？