R对数字列应用均值并对分类应用多数票

R apply mean for numerical columns and majority vote on categorical

假设以下 table

Name    Gender  Place Age V1
Tom     M       NY    24  A
Nadia   F       AT    22  A
Alex    M       DE    42  B
Jodie   F       OH    18  B
Tom     M       NY    28  B
Alex    F       ID    32  B
Nadia   F       AT    34  A
Tom     M       OH    18  A

我想按姓名和性别对 table 进行分组,使用已连接列的多数票替换地点和 V1,并用数值平均值替换年龄。结果应该是:

Name    Gender  Place Age      V1
Tom     M       NY    23.3334  A
Nadia   F       AT    28       A
Alex    M       DE    42       B
Jodie   F       OH    18       B
Alex    F       ID    32       B

Tom (M) 有 3 个条目,其中两次是 NY,一次是 OH。多数票 NJ 更常见,因此被选中。 V1 中的 A 也一样。年龄(24、28 和 18 岁)的平均值为 23.3334。

我使用 dplyr 得到了数值平均值:

dt <- dt %>%
    group_by_(.dots=lapply(names(dt)[c(1, 2)], as.symbol)) %>%
    summarise_each(funs(mean))

并且可以对地点和 V1 单独进行多数投票:

dt$place<- dt[, names(which.max(table(place))), by = paste(name, gender)]
dt$V1 <- dt[, names(which.max(table(V1))), by = paste(name, gender)]

我的问题是性能。我有一个非常大的数据集,这些多步修改花费的时间太长。至少使用某种应用函数一步完成多数表决会很棒。最好的办法是将多数票添加到 dplyr 函数中。

我们创建了一个 vector 的分组列名 ('grpCol'),使用 setdiff 得到其余的列名 ('nm1')。通过 'nm1' 列循环 (sapply) 以检查这些列中的哪些是 'numeric' (is.numeric) 到 return 逻辑索引 ('indx' ).

grpCol <- c('Name', 'Gender')
nm1 <- setdiff(names(df1), grpCol)
indx <- sapply(df1[nm1], is.numeric)

我们还创建了一个 Mode 函数来 return 具有最大频率的元素。

Mode <- function(x) {
 ux <- unique(x)
 ux[which.max(tabulate(match(x, ux)))]
}

将'data.frame'转换为'data.table'(setDT(df1)),按'grpCol'分组,我们循环遍历Data.table的子集(.SD) 对数字列使用 'indx' 到 return mean,对非数字列使用 mode,连接 (c) 以获得预期输出。

setDT(df1)[,c(lapply(.SD[, names(indx)[indx], with=FALSE], mean),
      lapply(.SD[, names(indx)[!indx], with=FALSE], Mode)) , 
               by = grpCol]
#   Name Gender      Age Place V1
#1:   Tom      M 23.33333    NY  A
#2: Nadia      F 28.00000    AT  A
#3:  Alex      M 42.00000    DE  B
#4: Jodie      F 18.00000    OH  B
#5:  Alex      F 32.00000    ID  B

或者正如@Frank 在评论中提到的,我们可以在 lapply 中执行 if/else 条件,而不是创建 'indx'.

setDT(df1)[, lapply(.SD, function(x) {if(is.numeric(x)) mean(x) 
                else Mode(x)} ),  by=.(Name,Gender)]
#    Name Gender Place      Age V1
#1:   Tom      M    NY 23.33333  A
#2: Nadia      F    AT 28.00000  A
#3:  Alex      M    DE 42.00000  B
#4: Jodie      F    OH 18.00000  B
#5:  Alex      F    ID 32.00000  B

数据

df1 <- structure(list(Name = c("Tom", "Nadia", "Alex", "Jodie", "Tom", 
"Alex", "Nadia", "Tom"), Gender = c("M", "F", "M", "F", "M", 
"F", "F", "M"), Place = c("NY", "AT", "DE", "OH", "NY", "ID", 
"AT", "OH"), Age = c(24L, 22L, 42L, 18L, 28L, 32L, 34L, 18L), 
V1 = c("A", "A", "B", "B", "B", "B", "A", "A")), .Names = c("Name", 
"Gender", "Place", "Age", "V1"), class = "data.frame",
row.names = c(NA, -8L))

这是dplyr方式

library(dplyr)

df1 %>% 
 group_by(Name, Gender) %>% 
 mutate(Age = mean(Age)) %>% 
 filter(Place == names(which.max(table(Place))) & 
           V1 == names(which.max(table(V1)))) %>% unique

#      Name Gender Place      Age V1
#1   Tom      M    NY 23.33333  A
#2 Nadia      F    AT 28.00000  A
#3  Alex      M    DE 42.00000  B
#4 Jodie      F    OH 18.00000  B
#5  Alex      F    ID 32.00000  B