1) split / map2: Вот вариант с split
на основе names
набора данных. Здесь мы удаляем цифру в конце из имен, split
набор данных в list
из data.frames
, используя map2
, передаем векторные элементы для сравнения reduce
и получаем rowSums
library(dplyr)
library(purrr)
library(stringr)
anscombe %>%
split.default(str_remove(names(.), "\\d+$")) %>%
map2(., c(10, 9), `>`) %>%
reduce(`&`) %>%
rowSums %>%
bind_cols(anscombe, new_var = .)
# x1 x2 x3 x4 y1 y2 y3 y4 new_var
#1 10 10 10 8 8.04 9.14 7.46 6.58 0
#2 8 8 8 8 6.95 8.14 6.77 5.76 0
#3 13 13 13 8 7.58 8.74 12.74 7.71 1
#4 9 9 9 8 8.81 8.77 7.11 8.84 0
#5 11 11 11 8 8.33 9.26 7.81 8.47 1
#6 14 14 14 8 9.96 8.10 8.84 7.04 1
#7 6 6 6 8 7.24 6.13 6.08 5.25 0
#8 4 4 4 19 4.26 3.10 5.39 12.50 1
#9 12 12 12 8 10.84 9.13 8.15 5.56 2
#10 7 7 7 8 4.82 7.26 6.42 7.91 0
#11 5 5 5 8 5.68 4.74 5.73 6.89 0
2) pivot_longer: Другой вариант - pivot_longer
из tidyr
, который может принимать несколько наборов столбцов и преобразовывать его в «длинный» формат
library(dplyr)
library(tidyr) #1.0.0
library(tibble)
anscombe %>%
rownames_to_column('rn') %>%
pivot_longer( -rn, names_to = c(".value", "repl"),
values_to = c('x', 'y'), names_pattern = '(\\D+)(\\d+)') %>%
group_by(rn) %>%
summarise(new_var = sum(x > 10 & y > 9, na.rm = TRUE)) %>%
arrange(as.integer(rn)) %>%
select(-rn) %>%
bind_cols(anscombe, .)
# x1 x2 x3 x4 y1 y2 y3 y4 new_var
#1 10 10 10 8 8.04 9.14 7.46 6.58 0
#2 8 8 8 8 6.95 8.14 6.77 5.76 0
#3 13 13 13 8 7.58 8.74 12.74 7.71 1
#4 9 9 9 8 8.81 8.77 7.11 8.84 0
#5 11 11 11 8 8.33 9.26 7.81 8.47 1
#6 14 14 14 8 9.96 8.10 8.84 7.04 1
#7 6 6 6 8 7.24 6.13 6.08 5.25 0
#8 4 4 4 19 4.26 3.10 5.39 12.50 1
#9 12 12 12 8 10.84 9.13 8.15 5.56 2
#10 7 7 7 8 4.82 7.26 6.42 7.91 0
#11 5 5 5 8 5.68 4.74 5.73 6.89 0
3) основание R: (аналогично логике, использованной для первого метода). Это сделало бы его автоматическим, поскольку мы можем split
данные в куски на основе сходства префикса
anscombe$new_var <- rowSums(Reduce(`&`, Map(`>`,
split.default(anscombe, sub("\\d+$", "", names(anscombe))), c(10, 9))))
4) уникальный префикс подстроки: или другой вариант, который использует префикссопоставление выполняется в цикле по уникальному префиксу подстроки (будет медленнее, чем split
), а затем применяется
rowSums(Reduce(`&`, Map(`>`, lapply(unique(sub("\\d+$", "",
names(anscombe))), function(nm)
anscombe[grep(nm, names(anscombe))]), c(10, 9))))
#[1] 0 0 1 0 1 1 0 1 2 0 0