#r #dataframe #apply #sapply #tapply
#r #фрейм данных #применить #sapply #tapply
Вопрос:
Я выполняю простые математические операции по столбцам над строками фрейма данных, которые также включают доступ к соседним предыдущим строкам фрейма данных. Хотя приведенный ниже код работает, он громоздкий (по крайней мере, в отношении моего свободного использования cbind() subset() функций и), и мне интересно, есть ли простой способ получить те же результаты, используя apply() ту или иную супер-пупер-функцию R. По возможности в базе R.
Я добавляю и вычитаю значения столбцов в каждой строке фрейма данных (ссылаясь на столбцы ниже, «плюс 1» «плюс 2» — «минус» = «итого»), и если идентификационный номер совпадает с тем, что вы переходите от одной строки к следующей, добавляя значение plus1из предыдущей строки. Смотрите иллюстрацию ниже:
id plus1 plus2 minus total [total explained]
1 1 3 5 10 -2
2 2 4 5 9 0
3 3 8 5 8 5 [8 5 - 8 = 5, ignoring "plus1" in row 2 since "id" changed between rows 2 and 3]
4 3 1 4 7 6 [1 4 - 7, 8 from "plus1" col in row 3 since "id" is same in rows 3 and 4, = 6]
5 3 2 5 6 2 [2 5 - 6, 1 from "plus1" col in row 4 since "id" is same in rows 4 and 5, = 2]
6 5 3 6 5 4 [3 6 - 5 = 4, ignoring "plus1" in row 5 since "id" changed between rows 5 and 6]
Вот код, который я использовал для создания вышеупомянутого:
data <- data.frame(id=c(1,2,3,3,3,5),
plus1=c(3,4,8,1,2,3),
plus2=c(5,5,5,4,5,6),
minus = c(10,9,8,7,6,5))
data <- cbind(data,
tmp1=(data[ ,"plus1"]
data[ ,"plus2"] -
data[ ,"minus"]
)
)
grp <- with(rle(data$id), rep(seq_along(values), lengths))
data$tmp2 <- with(data,ave(plus1, grp, FUN = function(x) c(0, x[-length(x)])))
data <- cbind(data, total = round((data[ ,"tmp1"] data[ ,"tmp2"]),2))
data <- subset(data, select = -c(tmp1,tmp2) )
data
Я стремлюсь к простоте в мире apply() , потому что я буду использовать множество производных такого рода в своем текущем проекте. Похоже, я имитирую Excel в R, которым я и являюсь.
Ответ №1:
Я думаю, что простой способ сделать это — использовать функцию lag из пакета dplyr. Я использовал case_when, чтобы проверить, изменился ли идентификатор. Если он не изменился, вы добавляете дополнительный член, в противном случае вы добавляете 0.
library(dplyr)
data2<-data %>%
mutate(extra=case_when(
id==lag(id) ~ lag(plus1),
TRUE ~ 0
)) %>%
mutate(computed_total=plus1 plus2-minus extra)
Комментарии:
1. Да, я начинаю видеть свет с dplyr. Код, несомненно, выглядит интуитивно понятным, как для ответов dplyr от Питера, так и для Джо. Хотя пример base R, опубликованный Питером, тоже выглядит довольно простым. Я опасался полагаться на слишком много пакетов, но, похоже, dplyr используется всеми, кто имеет опыт работы с R.
2. В более крупной программе, в которой это будет использоваться, есть гораздо больше переменных для манипулирования, чем в OP. Это решение очень простое при работе со многими переменными.
Ответ №2:
apply , поэтому может быть неприемлемым, хотя оно кажется менее сложным, чем код OP.
Не уверен, что семейство apply (извините за каламбур) применяется в этом случае, поскольку, насколько я понимаю, обычно функции применяются ко всем столбцам, или строкам, или элементам списка, тогда как в этом случае создается новая переменная. Однако я не очень хорошо знаком с использованием apply и friends, поэтому это может быть неверно.
Для сравнения добавили dplyr решение, хотя я знаю, что OP просил специально для базы R.
data$lag_id <- c(0, data$id[-nrow(data)])
data$lag_plus1 <- c(NA, data$plus1[-nrow(data)])
data$total <- with(data, ifelse(id == lag_id, plus1 plus2 - minus lag_plus1, plus1 plus2 - minus))
data[ , -c(5:6)]
#> id plus1 plus2 minus total
#> 1 1 3 5 10 -2
#> 2 2 4 5 9 0
#> 3 3 8 5 8 5
#> 4 3 1 4 7 6
#> 5 3 2 5 6 2
#> 6 5 3 6 5 4
library(dplyr)
data %>%
mutate(total = case_when(id == lag(id) ~ plus1 plus2 - minus lag(plus1),
TRUE ~ plus1 plus2 - minus))
#> id plus1 plus2 minus total
#> 1 1 3 5 10 -2
#> 2 2 4 5 9 0
#> 3 3 8 5 8 5
#> 4 3 1 4 7 6
#> 5 3 2 5 6 2
#> 6 5 3 6 5 4