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
假设以下 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