我想基于第三個列創建兩個新列。這兩列應該具有兩種不同型別的遞增值。
讓我們以以下資料集為例：
events <- data.frame(Frame = seq(from = 1001, to = 1033, by = 1),
Value = c(2.05, 0, 2.26, 2.38, 0, 0, 2.88, 0.32, 0.85, 2.85, 2.09, 0, 0, 0, 1.11, 0, 0,
0, 2.46, 2.85, 0, 0, 0.38, 1.91, 0, 0, 0, 2.23, 0, 0.48, 1.83, 0.23, 1.49))
我想創建：
- 每次在“值”列中存在以 0 開頭的序列時，名為“數字”的列就會遞增，并且
- 每次在“值”列中出現一個新的 0 序列時，一個名為“持續時間”的列從 1 開始，并且只要 0 序列繼續存在，它就會以 1 遞增。
理想情況下，最終的資料框應該是這樣的：
events_final <- data.frame(Frame = seq(from = 1001, to = 1033, by = 1),
Value = c(2.05, 0, 2.26, 2.38, 0, 0, 2.88, 0.32, 0.85, 2.85, 2.09, 0, 0, 0, 1.11, 0, 0,
0, 2.46, 2.85, 0, 0, 0.38, 1.91, 0, 0, 0, 2.23, 0, 0.48, 1.83, 0.23, 1.49),
Number = c(0, 1, 0, 0, 2, 2, 0, 0, 0, 0, 0, 3, 3, 3, 0, 4, 4,
4, 0, 0, 5, 5, 0, 0, 6, 6, 6, 0, 7, 0, 0, 0, 0),
Duration = c(0, 1, 0, 0, 1, 2, 0, 0, 0, 0, 0, 1, 2, 3, 0, 1, 2,
3, 0, 0, 1, 2, 0, 0, 1, 2, 3, 0, 1, 0, 0, 0, 0))
我嘗試使用tidyverse來做到這一點，但我無法得到我需要的東西[我什至離它很遠]：
events %>%
mutate(Number = ifelse(Value > 0, NA, 1),
Duration = case_when(Value == 0 & lag(Value, n = 1) != 0 ~ 1,
Value == 0 & lag(Value, n = 1) == 0 ~ 2))
通過查找相關問題，我發現這在 SQL [https://stackoverflow.com/questions/42971752/increment-value-based-on-another-column] 中是可行的。我也知道這在 Excel 中很容易做到[第一個值在單元格 B2 中]：
- 數字列[C列]：=IF(B2>0,0,IF(B1=0,C1,MAX(C$1:C1) 1))
- 持續時間列 [D 列]：=IF(B2>0,0,IF(B1=0,D1 1,1))
但我需要讓它在 R 中作業；-)
歡迎任何幫助:-)
uj5u.com熱心網友回復：
您可以data.table::rleid()在這里利用兩次來解決問題
library(data.table)
setDT(events)
events[, Number:=rleid(fifelse(Value==0,1,0))] %>%
.[Value==0,Number:=rleid(Number)] %>%
.[Value!=0,Number:=0] %>%
.[, Duration:=fifelse(Value==0, 1:.N,0), Number] %>%
.[]
輸出：
Frame Value Number Duration
1: 1001 2.05 0 0
2: 1002 0.00 1 1
3: 1003 2.26 0 0
4: 1004 2.38 0 0
5: 1005 0.00 2 1
6: 1006 0.00 2 2
7: 1007 2.88 0 0
8: 1008 0.32 0 0
9: 1009 0.85 0 0
10: 1010 2.85 0 0
11: 1011 2.09 0 0
12: 1012 0.00 3 1
13: 1013 0.00 3 2
14: 1014 0.00 3 3
15: 1015 1.11 0 0
16: 1016 0.00 4 1
17: 1017 0.00 4 2
18: 1018 0.00 4 3
19: 1019 2.46 0 0
20: 1020 2.85 0 0
21: 1021 0.00 5 1
22: 1022 0.00 5 2
23: 1023 0.38 0 0
24: 1024 1.91 0 0
25: 1025 0.00 6 1
26: 1026 0.00 6 2
27: 1027 0.00 6 3
28: 1028 2.23 0 0
29: 1029 0.00 7 1
30: 1030 0.48 0 0
31: 1031 1.83 0 0
32: 1032 0.23 0 0
33: 1033 1.49 0 0
uj5u.com熱心網友回復：
這是一個tidyverse解決方案：
library(tidyverse)
events |>
mutate(Number = replace(cumsum(Value == 0 & lag(Value != 0)), which(Value != 0), 0)) |>
group_by(tmp = cumsum(Value == 0 & lag(Value != 0))) |>
mutate(Duration = replace(row_number(), which(Value != 0), 0)) |>
ungroup() |>
select(-tmp)
#> # A tibble: 33 x 4
#> Frame Value Number Duration
#> <dbl> <dbl> <dbl> <dbl>
#> 1 1001 2.05 0 0
#> 2 1002 0 1 1
#> 3 1003 2.26 0 0
#> 4 1004 2.38 0 0
#> 5 1005 0 2 1
#> 6 1006 0 2 2
#> 7 1007 2.88 0 0
#> 8 1008 0.32 0 0
#> 9 1009 0.85 0 0
#> 10 1010 2.85 0 0
#> # ... with 23 more rows
uj5u.com熱心網友回復：
這是一個dplyr基于 - 的解決方案，對列有點聰明Number，但仍然依賴于data.table::rleid列Duration：
events_final %>%
mutate(
add = Value == 0 & lag(Value) != 0,
Number_result = cumsum(add) * (Value == 0),
rle_0 = data.table::rleid(Value == 0)
) %>%
group_by(rle_0) %>%
mutate(
Duration_result = ifelse(Value == 0, row_number(), 0)
) %>%
ungroup() %>%
select(-add, -rle_0)
# # A tibble: 33 × 6
# Frame Value Number Duration Number_result Duration_result
# <dbl> <dbl> <dbl> <dbl> <int> <dbl>
# 1 1001 2.05 0 0 0 0
# 2 1002 0 1 1 1 1
# 3 1003 2.26 0 0 0 0
# 4 1004 2.38 0 0 0 0
# 5 1005 0 2 1 2 1
# 6 1006 0 2 2 2 2
# 7 1007 2.88 0 0 0 0
# 8 1008 0.32 0 0 0 0
# 9 1009 0.85 0 0 0 0
# 10 1010 2.85 0 0 0 0
# # … with 23 more rows
# # ? Use `print(n = ...)` to see more rows
uj5u.com熱心網友回復：
這是另一種（丑陋的）方法。遠沒有@langtang的解決方案那么優雅，但它確實有效......
events <- data.frame(Frame = seq(from = 1001, to = 1033, by = 1),
Value = c(2.05, 0, 2.26, 2.38, 0, 0, 2.88, 0.32, 0.85, 2.85, 2.09, 0, 0, 0, 1.11, 0, 0,
0, 2.46, 2.85, 0, 0, 0.38, 1.91, 0, 0, 0, 2.23, 0, 0.48, 1.83, 0.23, 1.49))
events_final <- data.frame(Frame = seq(from = 1001, to = 1033, by = 1),
Value = c(2.05, 0, 2.26, 2.38, 0, 0, 2.88, 0.32, 0.85, 2.85, 2.09, 0, 0, 0, 1.11, 0, 0,
0, 2.46, 2.85, 0, 0, 0.38, 1.91, 0, 0, 0, 2.23, 0, 0.48, 1.83, 0.23, 1.49),
Number = c(0, 1, 0, 0, 2, 2, 0, 0, 0, 0, 0, 3, 3, 3, 0, 4, 4,
4, 0, 0, 5, 5, 0, 0, 6, 6, 6, 0, 7, 0, 0, 0, 0),
Duration = c(0, 1, 0, 0, 1, 2, 0, 0, 0, 0, 0, 1, 2, 3, 0, 1, 2,
3, 0, 0, 1, 2, 0, 0, 1, 2, 3, 0, 1, 0, 0, 0, 0))
library(stringr)
events$Number <- events$Value == 0
events$tmp <- NA
i <- 0
lapply(2:nrow(events), function(x) {
if ((events[ x, 'Number' ] == TRUE) &
(events[ x - 1, 'Number' ] == FALSE)) {
i <<- i 1
events[ x, 'tmp' ] <<- i
} else if ((events[ x, 'Number' ] == TRUE) &
(events[ x - 1, 'Number' ] == TRUE)) {
events[ x, 'tmp' ] <<- i
}
}) |>
invisible()
idx <- which(is.na(events$tmp))
events[ idx, 'tmp' ] <- 0
events <- split(events, events$tmp) |>
lapply(function(x) {
if (unique(x$tmp) > 0) {
x$duration <- 1:nrow(x)
} else {
x$duration <- 0
}
x
}) |>
data.table::rbindlist(fill = TRUE) |>
as.data.frame()
idx <- order(events$Frame)
events <- events[ idx, ]
events$Number <- NULL
colnames(events) <- c('Frame', 'Value', 'Number', 'Duration')
rownames(events) <- NULL
print(events)
identical(events, events_final)
轉載請註明出處，本文鏈接：https://www.uj5u.com/qita/526956.html
標籤：r擅长