我有一个数据框,其中包含个人ID,观察日期和度量标准。它看起来像这样:
SELECT
CASE WHEN val = (SELECT MAX(val) FROM my_table) THEN
val + 1
ELSE
val
END AS val
FROM my_table
我想将其浓缩为ID上的一行,并添加变量(prev2,prev3,prev4,prev5),计算自最近观察日期以来n次观测的平均值(但不包括平均值中的最后日期) 。例如 - " prev2"是最近2次观察的平均值," prev3"是最近3次观察的平均值。因此ID A的prev2是第8天和第9天的平均值(3.5)。 ID B的prev3是第5,6,7天(8.67)的平均值。最终回顾最近/最大的日期并平均一系列观察。
看起来应该是这样的:
ID Date Metric
a Day 1 9
a Day 2 8
a Day 3 9
a Day 4 8
a Day 5 7
a Day 6 6
a Day 7 5
a Day 8 4
a Day 9 3
a Day 10 3
b Day 1 6
b Day 2 7
b Day 3 6
b Day 4 7
b Day 5 8
b Day 6 9
b Day 7 9
b Day 8 9
我正在尝试创建预测变量来分析我公司的损耗。考虑到离开工作1个月或2个月后,约翰尼的绩效指标发生了变化,可以预测吉米是否会在不久的将来闯入。
如何分析这些数据的任何建议或想法都会超级甜蜜!
谢谢!
答案 0 :(得分:1)
我会使用dplyr
,tidyr
和magrittr
来解决这个问题。
<强> 数据 强>
df <-
data.frame(ID=c(rep("a", 10), rep("b", 8), rep("c", 3), "d"),
Date=c(paste("Day", 1:10), paste("Day", 1:8), paste("Day", 11:13), "Day 8"),
Metric=c(9, 8, 9, 8, 7, 6, 5, 4, 3, 3, 6, 7, 6, 7, 8, 9, 9, 9, 3, 1, 8, 10))
<强> 代码 强>
library(tidyr); library(dplyr); library(magrittr)
df %<>% separate(Date, into=c("d1", "d2")) %>%
arrange(ID, as.numeric(d2)) %>%
group_by(ID) %>%
mutate(last_Date=paste("Day", max(as.numeric(d2))),
metric_Avg=mean(Metric),
prev2=(lag(Metric)+lag(Metric, 2))/2,
prev3=(lag(Metric)+lag(Metric, 2)+lag(Metric, 3))/3,
prev4=(lag(Metric)+lag(Metric, 2)+lag(Metric, 3)+lag(Metric, 4))/4,
prev5=(lag(Metric)+lag(Metric, 2)+lag(Metric, 3)+lag(Metric, 4)+lag(Metric, 5))/5) %>%
ungroup %>%
filter(last_Date==paste(d1, d2)) %>%
select(ID, last_Date, metric_Avg, prev2, prev3, prev4, prev5)
df
<强> 输出 强>
ID last_Date metric_Avg prev2 prev3 prev4 prev5
1 a Day 10 6.200 3.5 4.000 4.50 5.0
2 b Day 8 7.625 9.0 8.667 8.25 7.8
3 c Day 13 4.000 2.0 NA NA NA
4 d Day 8 10.000 NA NA NA NA
<强> 备注 强>
如果您的Date
列包含日期,请使用lubridate
包。代码的前几行是:
df$Date <- ymd(df$Date) # id the Date is of the form yyyy-mm-dd or yyyy/mm/dd
df %<>% arrange(ID, Date) %>% group_by(ID) %>% mutate(last_Date= max(Date)...
答案 1 :(得分:0)
&#34; lapply&#34;可能有用:
ID <- unique(data$ID)
rowNr <- lapply(ID,function(id){which(data$ID==id)})
lastDate <- lapply(rowNr,function(n){data$Date[rev(n)[1]]})
metricAvg <- lapply(rowNr,function(n){mean(data$Metric[n])})
prev2 <- lapply(rowNr,function(n){mean(data$Metric[head(tail(c(NA,n),3),2)])})
prev3 <- lapply(rowNr,function(n){mean(data$Metric[head(tail(c(NA,n),4),3)])})
prev4 <- lapply(rowNr,function(n){mean(data$Metric[head(tail(c(NA,n),5),4)])})
prev5 <- lapply(rowNr,function(n){mean(data$Metric[head(tail(c(NA,n),6),5)])})
output <- data.frame( ID = ID,
last_Date = unlist(lastDate),
metric_Avg = unlist(metricAvg),
prev2 = unlist(prev2),
prev3 = unlist(prev3),
prev4 = unlist(prev4),
prev5 = unlist(prev5) )
输出:
> output
ID last_Date metric_Avg prev2 prev3 prev4 prev5
1 a Day 10 6.200 3.5 4.000000 4.50 5.0
2 b Day 8 7.625 9.0 8.666667 8.25 7.8
另一个例子,显示如果没有足够的时间来计算会发生什么&#34; prev5&#34;,&#34; prev4&#34;,...:
> data
ID Date Metric
1 a Day 1 9
2 a Day 2 8
3 a Day 3 9
4 a Day 4 8
5 a Day 5 7
6 a Day 6 6
7 a Day 7 5
8 a Day 8 4
9 a Day 9 3
10 a Day 10 3
11 b Day 1 6
12 b Day 2 7
13 b Day 3 6
14 b Day 4 7
15 b Day 5 8
16 b Day 6 9
17 b Day 7 9
18 b Day 8 9
19 c Day 11 3
20 c Day 12 1
21 c Day 13 8
22 d Day 8 10
输出:
> output
ID last_Date metric_Avg prev2 prev3 prev4 prev5
1 a Day 10 6.200 3.5 4.000000 4.50 5.0
2 b Day 8 7.625 9.0 8.666667 8.25 7.8
3 c Day 13 4.000 2.0 NA NA NA
4 d Day 8 10.000 NA NA NA NA
>
这种轻量级基础R解决方案甚至比其过度收费的竞争对手更快:
> system.time(
+ for ( i in 1:5000)
+ {
+ ID <- unique(data$ID)
+ .... [TRUNCATED]
user system elapsed
28.28 0.01 28.47
> #-----------------------------------------------------------------
>
> library(tidyr); library(dplyr); library(magrittr)
> system.time(
+ for ( i in 1:5000)
+ {
+ df <-data
+
+ df %<>% separate(Date, into=c("d1", "d2")) %>%
+ arrange(ID, as.numeri .... [TRUNCATED]
user system elapsed
46.56 0.05 46.87
>