dplyr :: mutateでpurrrのマップを使用して、列のペアに基づいて複数の新しい列を作成する方法
Rを使用して問題を追跡する必要があります。要するに、データフレーム内の異なる列ペアの計算に基づいて、データフレーム内に複数の新しい列を作成したいのです。
データは次のようになります。
df <- data.frame(a1 = c(1:5),
b1 = c(4:8),
c1 = c(10:14),
a2 = c(9:13),
b2 = c(3:7),
c2 = c(15:19))
df
a1 b1 c1 a2 b2 c2
1 4 10 9 3 15
2 5 11 10 4 16
3 6 12 11 5 17
4 7 13 12 6 18
5 8 14 13 7 19
出力は次のようになります。
a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 4 10 9 3 15 10 7 25
2 5 11 10 4 16 12 9 27
4 7 13 12 6 18 16 13 31
5 8 14 13 7 19 18 15 33
次の方法でいくつかの手動作業を行うdplyrを使用して、これを実現できます。
df %>% rowwise %>% mutate(sum_a = sum(a1, a2),
sum_b = sum(b1, b2),
sum_c = sum(c1, c2)) %>%
as.data.frame()
そのため、「a」という文字が含まれる列を取得し、行ごとに合計を計算し、sum_ [letter]という名前の合計で新しい列を作成します。異なる文字の列について繰り返します。
ただし、これは機能していますが、300の異なる列のペアを持つ大きなデータセットがある場合、300の変換呼び出しを記述する必要があるため、手動入力が重要になります。
私は最近Rパッケージ "purrr"に出くわしました。これは、これにより、より自動化された方法で必要なことを行うという私の問題が解決されると思います。
特に、列名の2つのリストを渡すpurrr：map2を使用できると思います。
- list1 =数字が1のすべての列
- list2 =数字が2のすべての列
次に、一致する各リストエントリの合計を次の形式で計算できます。
map2(list1, list2, ~mutate(sum))
ただし、purrrを使用してこの問題に最善のアプローチをする方法を理解することはできません。私はpurrrを使うのはかなり新しいので、この問題に関する助けを本当に感謝します。
purrrを使用した1つのオプションを次に示します。データセット（ 'nm1'）のuniqueのnamesプレフィックスを取得し、map（purrrから）を使用して一意の名前をループします。 selectmatchesが 'nm1'のプレフィックス値である列、reduceを使用して行を追加し、列をバインドします（bind_cols）元のデータセット
library(tidyverse)
nm1 <- names(df) %>%
substr(1, 1) %>%
unique
nm1 %>%
map(~ df %>%
select(matches(.x)) %>%
reduce(`+`)) %>%
set_names(paste0("sum_", nm1)) %>%
bind_cols(df, .)
# a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
#1 1 4 10 9 3 15 10 7 25
#2 2 5 11 10 4 16 12 9 27
#3 3 6 12 11 5 17 14 11 29
#4 4 7 13 12 6 18 16 13 31
#5 5 8 14 13 7 19 18 15 33
df %>%
mutate(sum_a = pmap_dbl(select(., starts_with("a")), sum),
sum_b = pmap_dbl(select(., starts_with("b")), sum),
sum_c = pmap_dbl(select(., starts_with("c")), sum))
a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 1 4 10 9 3 15 10 7 25
2 2 5 11 10 4 16 12 9 27
3 3 6 12 11 5 17 14 11 29
4 4 7 13 12 6 18 16 13 31
5 5 8 14 13 7 19 18 15 33
編集：
多くの列があり、プログラムで適用したい場合：
row_sums <- function(x) {
transmute(df, !! paste0("sum_", quo_name(x)) := pmap_dbl(select(df, starts_with(x)), sum))
}
newdf <- map_dfc(letters[1:3], row_sums)
newdf
sum_a sum_b sum_c
1 10 7 25
2 12 9 27
3 14 11 29
4 16 13 31
5 18 15 33
必要に応じて、元の変数を次の方法で追加できます。
bind_cols(df, dfnew)
a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 1 4 10 9 3 15 10 7 25
2 2 5 11 10 4 16 12 9 27
3 3 6 12 11 5 17 14 11 29
4 4 7 13 12 6 18 16 13 31
5 5 8 14 13 7 19 18 15 33
ベースRアプローチを検討したい場合は、次のようにします。
cbind(df, lapply(split.default(df, substr(names(df), 0,1)), rowSums))
# a1 b1 c1 a2 b2 c2 a b c
#1 1 4 10 9 3 15 10 7 25
#2 2 5 11 10 4 16 12 9 27
#3 3 6 12 11 5 17 14 11 29
#4 4 7 13 12 6 18 16 13 31
#5 5 8 14 13 7 19 18 15 33
各列名の最初の文字（a、b、またはc）に基づいて、データを列ごとにリストに分割します。
多数の列があり、各列名の末尾の数字を除くすべての文字を区別する必要がある場合は、次の方法を変更できます。
cbind(df, lapply(split.default(df, sub("\\d+$", "", names(df))), rowSums))
ベースRで、すべてベクトル化：
nms <- names(df)
df[paste0("sum_",unique(gsub("[1-9]","",nms)))] <-
df[endsWith(nms,"1")] + df[endsWith(nms,"2")]
# a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
# 1 1 4 10 9 3 15 10 7 25
# 2 2 5 11 10 4 16 12 9 27
# 3 3 6 12 11 5 17 14 11 29
# 4 4 7 13 12 6 18 16 13 31
# 5 5 8 14 13 7 19 18 15 33
ハックのようなきちんとしたソリューションについては、これをチェックしてください：
library(tidyr)
library(dplyr)
df %>%
rownames_to_column(var = 'row') %>%
gather(a1:c2, key = 'key', value = 'value') %>%
extract(key, into = c('col.base', 'col.index'), regex = '([a-zA-Z]+)([0-9]+)') %>%
group_by(row, col.base) %>%
summarize(.sum = sum(value)) %>%
spread(col.base, .sum) %>%
bind_cols(df, .) %>%
select(-row)
基本的に、すべての行の値を持つすべての列のペアを収集し、列名を2つの部分に分け、同じ文字の列の行の合計を計算し、ワイドフォームにキャストし直します。
dfを計算するためにReduceを使用するよりも、数値でsumを分割する別のソリューション
library(tidyverse)
df %>%
split.default(., substr(names(.), 2, 3)) %>%
Reduce('+', .) %>%
set_names(paste0("sum_", substr(names(.), 1, 1))) %>%
cbind(df, .)
#> a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
#> 1 1 4 10 9 3 15 10 7 25
#> 2 2 5 11 10 4 16 12 9 27
#> 3 3 6 12 11 5 17 14 11 29
#> 4 4 7 13 12 6 18 16 13 31
#> 5 5 8 14 13 7 19 18 15 33
reprexパッケージ （v0.2.0）によって2018-04-13に作成されました。
1）dplyr/tidyr長い形式に変換し、要約してワイド形式に変換します。
_library(dplyr)
library(tidyr)
DF %>%
mutate(Row = 1:n()) %>%
gather(colname, value, -Row) %>%
group_by(g = gsub("\\d", "", colname), Row) %>%
summarize(sum = sum(value)) %>%
ungroup %>%
mutate(g = paste("sum", g, sep = "_")) %>%
spread(g, sum) %>%
arrange(Row) %>%
cbind(DF, .) %>%
select(-Row)
_与える：
_ a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 1 4 10 9 3 15 10 7 25
2 2 5 11 10 4 16 12 9 27
3 4 7 13 12 6 18 16 13 31
4 5 8 14 13 7 19 18 15 33
_2）行列乗算を使用したベース
nmsは、数字を含まず、_sum__で始まる列名のベクトルです。 uは、その一意の要素のベクトルです。 outerを乗算すると合計が得られるDFを使用して論理行列を作成します。これが完了すると、論理は0-1に変換されます。最後に入力にバインドします。
_nms <- gsub("(\\D+)\\d", "sum_\\1", names(DF))
u <- unique(nms)
sums <- as.matrix(DF) %*% outer(nms, setNames(u, u), "==")
cbind(DF, sums)
_与える：
_ a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 1 4 10 9 3 15 10 7 25
2 2 5 11 10 4 16 12 9 27
3 4 7 13 12 6 18 16 13 31
4 5 8 14 13 7 19 18 15 33
_）タップ付きベース
（2）からnmsを使用して、各行にタップリを適用します。
_cbind(DF, t(apply(DF, 1, tapply, nms, sum)))
_与える：
_ a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
1 1 4 10 9 3 15 10 7 25
2 2 5 11 10 4 16 12 9 27
3 4 7 13 12 6 18 16 13 31
4 5 8 14 13 7 19 18 15 33
_名前が昇順でない場合、上記の式でnmsをfactor(nms, levels = unique(nms))に置き換えることができます。
ベースRを使用したわずかに異なるアプローチ：
cbind(df, lapply(unique(gsub("\\d+","", colnames(df))), function(li) {
set_names(data.frame(V = apply(df[grep(li, colnames(df), val = T)], FUN = sum, MARGIN = 1)), paste0("sum_", li))
}))
# a1 b1 c1 a2 b2 c2 sum_a sum_b sum_c
#1 1 4 10 9 3 15 10 7 25
#2 2 5 11 10 4 16 12 9 27
#3 3 6 12 11 5 17 14 11 29
#4 4 7 13 12 6 18 16 13 31
#5 5 8 14 13 7 19 18 15 33