[英]R - Average of n observations from the most recent observed date
我有一個數據框,其中包含個人ID,觀察日期和度量標准。 它看起來像這樣:
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
我想將其濃縮為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 lastDate metric_avg prev2 prev3 prev4 prev5
a Day 10 6.2 3.5 4 4.5 5
b Day 8 7.63 9 8.67 8.25 7.8
我正在嘗試創建預測變量來分析我公司的損耗。 考慮到離開工作1個月或2個月后,約翰尼的績效指標發生了變化,可以預測吉米是否會在不久的將來闖入。
如何分析這些數據的任何建議或想法都會超級甜蜜!
謝謝!
我會用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)...
“lapply”可能有用:
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
另一個例子,顯示如果沒有足夠的天數來計算“prev5”,“prev4”,...:
> 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
>
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.