给出当 R 中有多个模式时选择一种模式的条件
Give condition for choosing one mode when there are more than one in R
我有一个分类变量，我想为其查找众数。特别是，我想找到可变种族群体的模式，即最常见的种族群体。我将按家庭进行分组，即找到一个家庭中最常见的种族群体。问题是，如果有不止一种模式（不止一个民族占主导地位），那么我想从户主那里得到一个（还有另一个变量表明这个人是否是户主）。
基本上，我们会有 table HQ2:
H_Code Rela_HH Ethn
1 AS-01 10 SEN
2 AS-01 1 SEN
3 AS-02 1 FA
4 AS-02 2 MA
5 AS-02 4 MA
6 AS-02 4 FA
7 AS-03 1 NZ
8 AS-03 2 MA
其中H_Code=家庭代码，Rela_HH=与户主的关系（1表示户主），Ethn=族群。
你会看到AS-02有两种模式：FA和MA。在这种情况下，我希望 R 给我一个 Rela_HH.
值为 1 的人
到目前为止，我只是成功地完成了一个普通模式，找不到为附加位编码的方法。
Mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(, ux)))]
}
HQ2$c <- with(HQ2, ave(Ethn, H_Code, FUN=Mode))
我相信有一个很好的 data.table 方法可以做到这一点。如果我想出一个答案，我会编辑我的答案。现在我有一个简单的方法可以用 order 和 dplyr 来做到这一点。请注意，Mode 函数将取第一个 Ethn，因此我在 hq2 中将它们重新排序以进行演示。
Dplyr
library(dplyr)
hq2 <- data.table(H_Code = c("AS-01", "AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,1,1,2,4,4,2,1), Ethn = c("SEN", "SEN", "FA", "MA", "MA", "FA", "NZ", "MA"))
hq2[order(H_Code, Rela_HH), ] %>%
group_by(H_Code) %>%
summarize(Ethn_Mode = Mode(Ethn))
# A tibble: 3 x 2
H_Code Ethn_Mode
<chr> <chr>
1 AS-01 SEN
2 AS-02 MA
3 AS-03 MA
数据Table
如果您有一个大 table，您可以将键设置为 H_Code 和 Rela_HH 以进行更快的排序。
library(data.table)
hq1 <- as.data.table(hq2)
hq1[order(H_Code, Rela_HH), ][, Mode(Ethn), by = list(H_Code)]
H_Code V1
1: AS-01 SEN
2: AS-02 MA
3: AS-03 MA
编辑
这是修改后的 dplyr 代码。
hq3 %>%
group_by(H_Code, Ethn) %>%
mutate(eth_count = sum(n())) %>%
mutate(priority = all(1 %in% Rela_HH & !1 %in% eth_count)) %>%
arrange(H_Code, desc(priority), desc(eth_count), Rela_HH) %>%
ungroup() %>%
group_by(H_Code) %>%
filter(row_number() %in% 1)
这里是修改后的data.table代码，没有使用任何mode函数。它所做的是创建一个 priority 列，如果任何种族多次出现，则该列设置为 TRUE，并且该组中的条目在 Rela_HH 中设置了 1 .然后，您设置排序顺序以计算出顺序和任何关系 (H_Code, -priority, -count, Rela_HH)。
三个具有不同场景的数据集，hq3（HH 种族出现 >1，但非 HH），hq4（HH 种族出现 1），hq5（ HH 种族出现 >1，并且 > 非 HH）。
hq3 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "FA", "FA", "FA", "MA", "MA", "NZ", "MA"))
hq4 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "MA", "FA", "FA", "ZA", "MA", "NZ", "MA"))
hq5 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "MA", "FA", "FA", "MA", "MA", "NZ", "MA"))
hq3[, `:=` (count = .N), by = list(H_Code, Ethn)][, priority := all(1 %in% Rela_HH & !1 %in% count), by = list(H_Code, Ethn)][order(H_Code, Rela_HH, -count), ] # leave off the last [] section, it's here to show this output in order
H_Code Rela_HH Ethn count priority
1: AS-01 10 SEN 1 FALSE
2: AS-02 1 MA 2 TRUE
3: AS-02 2 FA 3 FALSE
4: AS-02 3 FA 3 FALSE
5: AS-02 4 FA 3 FALSE
6: AS-02 5 MA 2 TRUE
7: AS-03 1 MA 1 FALSE
8: AS-03 2 NZ 1 FALSE
hq3[order(H_Code, -priority, -count, Rela_HH), ][hq3[, .I[1], by = list(H_Code)]$V1]
H_Code Rela_HH Ethn count priority
1: AS-01 10 SEN 1 FALSE
2: AS-02 1 MA 2 TRUE
3: AS-03 1 MA 1 FALSE
基准
哪个更快？ Data.table，大约是 2 倍，并且键设置在大 table 上，可能更多。
> microbenchmark(DTmeth(hq1), dplyrmeth(hq2), neval = 1000)
Unit: nanoseconds
expr min lq mean median uq max neval cld
DTmeth(hq1) 624865 641316 665616.17 654145.5 677087 847038 100 b
dplyrmeth(hq2) 1144980 1161583 1202274.35 1180147.5 1223617 1651814 100 c
neval 0 0 3.56 1.0 1 303 100 a
修改后的代码测试（我很好奇 data.table 是否有更好的方法来执行此操作，因为它现在与 dplyr 大致相同）：
Unit: nanoseconds
expr min lq mean median uq max neval cld
DTmeth(hq5) 653542 683727.5 773249.70 706670.5 747120.5 1791880 100 b
DT2meth(hq5) 1670831 1816633.0 1947881.22 1874742.5 2040164.5 2892786 100 c
dplyrmeth(hq3) 1169733 1232672.5 1587836.22 1281876.5 1367757.5 24089844 100 c
dplyr2meth(hq3) 1414848 1506917.5 1903192.98 1541481.5 1631438.0 26743551 100 c
neval 0 1.0 18.88 1.0 1.0 303 100 a
我有一个分类变量，我想为其查找众数。特别是，我想找到可变种族群体的模式，即最常见的种族群体。我将按家庭进行分组，即找到一个家庭中最常见的种族群体。问题是，如果有不止一种模式（不止一个民族占主导地位），那么我想从户主那里得到一个（还有另一个变量表明这个人是否是户主）。
基本上，我们会有 table HQ2:
H_Code Rela_HH Ethn
1 AS-01 10 SEN
2 AS-01 1 SEN
3 AS-02 1 FA
4 AS-02 2 MA
5 AS-02 4 MA
6 AS-02 4 FA
7 AS-03 1 NZ
8 AS-03 2 MA
其中H_Code=家庭代码，Rela_HH=与户主的关系（1表示户主），Ethn=族群。
你会看到AS-02有两种模式：FA和MA。在这种情况下，我希望 R 给我一个 Rela_HH.
值为 1 的人到目前为止，我只是成功地完成了一个普通模式，找不到为附加位编码的方法。
Mode <- function(x) { ux <- unique(x) ux[which.max(tabulate(match(, ux)))] } HQ2$c <- with(HQ2, ave(Ethn, H_Code, FUN=Mode))
我相信有一个很好的 data.table 方法可以做到这一点。如果我想出一个答案，我会编辑我的答案。现在我有一个简单的方法可以用 order 和 dplyr 来做到这一点。请注意，Mode 函数将取第一个 Ethn，因此我在 hq2 中将它们重新排序以进行演示。
Dplyr
library(dplyr)
hq2 <- data.table(H_Code = c("AS-01", "AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,1,1,2,4,4,2,1), Ethn = c("SEN", "SEN", "FA", "MA", "MA", "FA", "NZ", "MA"))
hq2[order(H_Code, Rela_HH), ] %>%
group_by(H_Code) %>%
summarize(Ethn_Mode = Mode(Ethn))
# A tibble: 3 x 2
H_Code Ethn_Mode
<chr> <chr>
1 AS-01 SEN
2 AS-02 MA
3 AS-03 MA
数据Table
如果您有一个大 table，您可以将键设置为 H_Code 和 Rela_HH 以进行更快的排序。
library(data.table)
hq1 <- as.data.table(hq2)
hq1[order(H_Code, Rela_HH), ][, Mode(Ethn), by = list(H_Code)]
H_Code V1
1: AS-01 SEN
2: AS-02 MA
3: AS-03 MA
编辑
这是修改后的 dplyr 代码。
hq3 %>%
group_by(H_Code, Ethn) %>%
mutate(eth_count = sum(n())) %>%
mutate(priority = all(1 %in% Rela_HH & !1 %in% eth_count)) %>%
arrange(H_Code, desc(priority), desc(eth_count), Rela_HH) %>%
ungroup() %>%
group_by(H_Code) %>%
filter(row_number() %in% 1)
这里是修改后的data.table代码，没有使用任何mode函数。它所做的是创建一个 priority 列，如果任何种族多次出现，则该列设置为 TRUE，并且该组中的条目在 Rela_HH 中设置了 1 .然后，您设置排序顺序以计算出顺序和任何关系 (H_Code, -priority, -count, Rela_HH)。
三个具有不同场景的数据集，hq3（HH 种族出现 >1，但非 HH），hq4（HH 种族出现 1），hq5（ HH 种族出现 >1，并且 > 非 HH）。
hq3 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "FA", "FA", "FA", "MA", "MA", "NZ", "MA"))
hq4 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "MA", "FA", "FA", "ZA", "MA", "NZ", "MA"))
hq5 <- data.table(H_Code = c("AS-01", "AS-02", "AS-02", "AS-02", "AS-02", "AS-02", "AS-03", "AS-03"), Rela_HH = c(10,4,3,2,1,5,2,1), Ethn = c("SEN", "MA", "FA", "FA", "MA", "MA", "NZ", "MA"))
hq3[, `:=` (count = .N), by = list(H_Code, Ethn)][, priority := all(1 %in% Rela_HH & !1 %in% count), by = list(H_Code, Ethn)][order(H_Code, Rela_HH, -count), ] # leave off the last [] section, it's here to show this output in order
H_Code Rela_HH Ethn count priority
1: AS-01 10 SEN 1 FALSE
2: AS-02 1 MA 2 TRUE
3: AS-02 2 FA 3 FALSE
4: AS-02 3 FA 3 FALSE
5: AS-02 4 FA 3 FALSE
6: AS-02 5 MA 2 TRUE
7: AS-03 1 MA 1 FALSE
8: AS-03 2 NZ 1 FALSE
hq3[order(H_Code, -priority, -count, Rela_HH), ][hq3[, .I[1], by = list(H_Code)]$V1]
H_Code Rela_HH Ethn count priority
1: AS-01 10 SEN 1 FALSE
2: AS-02 1 MA 2 TRUE
3: AS-03 1 MA 1 FALSE
基准
哪个更快？ Data.table，大约是 2 倍，并且键设置在大 table 上，可能更多。
> microbenchmark(DTmeth(hq1), dplyrmeth(hq2), neval = 1000)
Unit: nanoseconds
expr min lq mean median uq max neval cld
DTmeth(hq1) 624865 641316 665616.17 654145.5 677087 847038 100 b
dplyrmeth(hq2) 1144980 1161583 1202274.35 1180147.5 1223617 1651814 100 c
neval 0 0 3.56 1.0 1 303 100 a
修改后的代码测试（我很好奇 data.table 是否有更好的方法来执行此操作，因为它现在与 dplyr 大致相同）：
Unit: nanoseconds
expr min lq mean median uq max neval cld
DTmeth(hq5) 653542 683727.5 773249.70 706670.5 747120.5 1791880 100 b
DT2meth(hq5) 1670831 1816633.0 1947881.22 1874742.5 2040164.5 2892786 100 c
dplyrmeth(hq3) 1169733 1232672.5 1587836.22 1281876.5 1367757.5 24089844 100 c
dplyr2meth(hq3) 1414848 1506917.5 1903192.98 1541481.5 1631438.0 26743551 100 c
neval 0 1.0 18.88 1.0 1.0 303 100 a