결 측값을 포함한 값이있는 데이터 세트가 있습니다. 목표는 change마지막 이전 유효 값에서 변경된 것을 나타내는 벡터를 만드는 것 입니다.
다음은 몇 가지 데이터입니다.
test <- data.frame(resp = c(9, NA, NA, 11, NA, NA, 6, 16, NA, 12, 0, 0, 0, 0, 0, NA, 0, 11, NA, NA, NA, NA, NA, NA, 14, NA, 23, NA, NA, 16, 16))
아이디어는 다음과 같습니다.
01각 증가에 대한 마지막 이전 유효 값 추가 (예 : 1, 2, 3)-1와 -1이전의 경우 이미 부정적이었다.따라서 위의 데이터에 대한 결과는 다음과 같습니다.
resp change
1 9 0
2 NA NA
3 NA NA
4 11 1
5 NA NA
6 NA NA
7 6 -1
8 16 1
9 NA NA
10 12 -1
11 0 -2
12 0 0
13 0 0
14 0 0
15 0 0
16 NA NA
17 0 0
18 11 1
19 NA NA
20 NA NA
21 NA NA
22 NA NA
23 NA NA
24 NA NA
25 14 2
나는 for 루프를 시도했고 어떻게 든 작동하지만 이것이 지저분한 코드라고 느끼고 매우 느립니다. 이 작업에 대한 더 나은 솔루션에 대한 아이디어가 있습니까 (예 : purrr)?
for (i in 2:nrow(test)) {
test$change[i] <- 0
test$change[i] <- case_when(
test$resp[i] > last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) >= 0 ~ test$change[i] + last(test$change[which(!is.na(test$resp[1:i-1]))]) + 1,
test$resp[i] > last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) <= 0 ~ test$change[i] + 1,
test$resp[i] < last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) <= 0 ~ test$change[i] + last(test$change[which(!is.na(test$resp[1:i-1]))]) - 1,
test$resp[i] < last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) >= 0 ~ test$change[i]- 1,
TRUE ~ test$change[i])
test$change[i] <- if_else(is.na(test$resp[i]), NA_real_, test$change[i])
}
결국 이것은 변수가 30 개를 초과하고 행이 100000 개를 초과하는 데이터 세트에 적용되어야합니다.
다음은 NA가있는 모든 행을 제거하고 일부 계산을 수행하고 올바른 위치에서 NA 행을 다시 조인하는 대체 방법입니다.
library(tidyverse)
library(zoo)
# example data
test <- data.frame(resp = c(9, NA, NA, 11, NA, NA, 6, 16, NA, 12, 0, 0, 0, 0, 0, NA, 0, 11, NA, NA, NA, NA, NA, NA, 14))
# add an id for each row
test = test %>% mutate(id = row_number())
test %>%
na.omit() %>% # exclude rows with NAs
mutate(flag = case_when(resp == lag(resp, default = first(resp)) ~ 0,
resp > lag(resp, default = first(resp)) ~ 1,
resp < lag(resp, default = first(resp)) ~ -1)) %>% # check relationship between current and previous value
mutate(g = cumsum(flag != lag(flag, default = first(flag)))) %>% # create a grouping based on change in flag column
group_by(g) %>% # for each group
mutate(change = ifelse(flag != 0, flag * row_number(), flag)) %>% # calculate the change column
ungroup() %>% # forget the grouping
select(id, change) %>% # keep useful columns
right_join(test, by="id") %>% # join back to get NA rows in the right place
select(resp, change) # keep useful columns
결과적으로 다음을 얻을 수 있습니다.
# resp change
# 1 9 0
# 2 NA NA
# 3 NA NA
# 4 11 1
# 5 NA NA
# 6 NA NA
# 7 6 -1
# 8 16 1
# 9 NA NA
# 10 12 -1
# 11 0 -2
# 12 0 0
# 13 0 0
# 14 0 0
# 15 0 0
# 16 NA NA
# 17 0 0
# 18 11 1
# 19 NA NA
# 20 NA NA
# 21 NA NA
# 22 NA NA
# 23 NA NA
# 24 NA NA
# 25 14 2
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다