r - 在 dplyr 中分组的众多变量之间的相关性
问题描述
假设我有一个数据框,如下所示:
# Set RNG seed
set.seed(33550336)
# Create dummy data frame
df <- data.frame(PC1 = runif(20),
PC2 = runif(20),
PC3 = runif(20),
A = runif(20),
B = runif(20),
loc = sample(LETTERS[1:2], 20, replace = TRUE),
seas = sample(c("W", "S"), 20, replace = TRUE))
# > head(df)
# PC1 PC2 PC3 A B loc seas
# 1 0.8636470 0.02220823 0.7553348 0.4679607 0.0787467 A S
# 2 0.3522257 0.42733152 0.2412971 0.6691419 0.1194121 A W
# 3 0.5257408 0.44293320 0.3225228 0.0934192 0.2966507 B S
# 4 0.0667227 0.90273594 0.6297959 0.1962124 0.4894373 A W
# 5 0.3751383 0.50477920 0.6567203 0.4510632 0.4742191 B S
# 6 0.9197086 0.32024904 0.8382138 0.9907894 0.9335657 A S
我有兴趣计算、 和和 每个变量之间的相关性PC1
,并按和分组。因此,例如,基于此答案,我可以执行以下操作:PC2
PC3
A
B
loc
seas
# Correlation of variable A and PC1 per loc & seas combination
df %>%
group_by(loc, seas) %>%
summarise(cor = cor(PC1, A)) %>%
ungroup
# # A tibble: 4 x 3
# loc seas cor
# <fct> <fct> <dbl>
# 1 A S 0.458
# 2 A W 0.748
# 3 B S -0.0178
# 4 B W -0.450
这给了我我想要的:PC1
和A
的每个组合之间的相关loc
性seas
。太棒了。
我正在努力的是推断这个以执行PC*
变量和其他变量的每个组合的计算(即示例中的A
和B
)。我的预期结果是正上方的小标题,但每个组合PC*
和其他变量都有一列。我可以做这个长手...... cor(PC2, A)
,,,等等cor(PC3, A)
,cor(PC1, B)
但大概有一种简洁的方法来编码计算。我怀疑它涉及do
,但我无法完全理解它......有人可以启发我吗?
解决方案
我在下面使用了 G. Grothendieck 的解决方案,但这需要进行一些重组才能使其成为所需的格式。我已经发布了我在这里使用的代码,以防它对其他人有用。
# Perform calculation
res <- by(df[1:5], df[-(1:5)], cor)
# Combinations of loc & seas
comb <- expand.grid(dimnames(res))
# loc seas
# 1 A S
# 2 B S
# 3 A W
# 4 B W
# A matrix corresponding to a loc & seas
# Plus the loc & seas themselves
restructure <- function(m, n){
# Convert to data frame
# Add rownames as column
# Retains PCs as rows, but not columns
# Gather variables to long format
# Unite PC & variable names
# Spread to a single row
# Add combination of loc & seas
m %>%
data.frame %>%
rownames_to_column() %>%
filter(grepl("PC", rownames(m))) %>%
select(-contains("PC")) %>%
gather(variable, value, -rowname) %>%
unite(comb, rowname, variable) %>%
spread(comb, value) %>%
bind_cols(n)
}
# Restructure each list element & combine into data frame
do.call(rbind, lapply(1:length(res), function(x)restructure(res[[x]], comb[x, ])))
这使,
# PC1_A PC1_B PC2_A PC2_B PC3_A PC3_B loc seas
# 1 0.45763159 -0.00925106 0.3522161 0.20916667 -0.2003091 0.3741403 A S
# 2 -0.01779813 -0.74328144 -0.3501188 0.46324158 0.8034240 0.4580262 B S
# 3 0.74835455 0.49639477 -0.3994917 -0.05233889 -0.5902400 0.3606690 A W
# 4 -0.45025181 -0.66721038 -0.9899521 -0.80989058 0.7606430 0.3738706 B W
解决方案
像这样使用by
:
By <- by(df[1:5], df[-(1:5)], cor)
给予:
> By
loc: A
seas: S
PC1 PC2 PC3 A B
PC1 1.00000000 -0.3941583 0.1872622 0.4576316 -0.00925106
PC2 -0.39415826 1.0000000 -0.6797708 0.3522161 0.20916667
PC3 0.18726218 -0.6797708 1.0000000 -0.2003091 0.37414025
A 0.45763159 0.3522161 -0.2003091 1.0000000 0.57292305
B -0.00925106 0.2091667 0.3741403 0.5729230 1.00000000
-----------------------------------------------------------------------------------------------------------------------------
loc: B
seas: S
PC1 PC2 PC3 A B
PC1 1.00000000 -0.52651449 0.07120701 -0.01779813 -0.7432814
PC2 -0.52651449 1.00000000 -0.05448583 -0.35011878 0.4632416
PC3 0.07120701 -0.05448583 1.00000000 0.80342399 0.4580262
A -0.01779813 -0.35011878 0.80342399 1.00000000 0.5558740
B -0.74328144 0.46324158 0.45802622 0.55587404 1.0000000
-----------------------------------------------------------------------------------------------------------------------------
loc: A
seas: W
PC1 PC2 PC3 A B
PC1 1.0000000 -0.79784422 0.0932317 0.7483545 0.49639477
PC2 -0.7978442 1.00000000 -0.3526315 -0.3994917 -0.05233889
PC3 0.0932317 -0.35263151 1.0000000 -0.5902400 0.36066898
A 0.7483545 -0.39949171 -0.5902400 1.0000000 0.18081316
B 0.4963948 -0.05233889 0.3606690 0.1808132 1.00000000
-----------------------------------------------------------------------------------------------------------------------------
loc: B
seas: W
PC1 PC2 PC3 A B
PC1 1.0000000 0.3441459 0.1135686 -0.4502518 -0.6672104
PC2 0.3441459 1.0000000 -0.8447551 -0.9899521 -0.8098906
PC3 0.1135686 -0.8447551 1.0000000 0.7606430 0.3738706
A -0.4502518 -0.9899521 0.7606430 1.0000000 0.8832408
B -0.6672104 -0.8098906 0.3738706 0.8832408 1.0000000
添加
根据海报关于所需内容的进一步讨论,定义onerow
接受相关矩阵或数据帧的函数(在后一种情况下,它将前 5 列转换为相关矩阵)产生一行输出。对于代码行, if
in 语句onerow
不是必需的,但不会造成伤害,adply
但我们已将其包含在内,以便onerow
在下面的后续示例中也能以简单的方式工作。
library(plyr)
onerow <- function(x) {
if (is.data.frame(x)) x <- cor(x[1:5])
dtab <- as.data.frame.table(x[4:5, 1:3])
with(dtab, setNames(Freq, paste(Var2, Var1, sep = "_")))
}
adply(By, 1:2, onerow)
给予:
loc seas PC1_A PC1_B PC2_A PC2_B PC3_A PC3_B
1 A S 0.45763159 -0.00925106 0.3522161 0.20916667 -0.2003091 0.3741403
2 B S -0.01779813 -0.74328144 -0.3501188 0.46324158 0.8034240 0.4580262
3 A W 0.74835455 0.49639477 -0.3994917 -0.05233889 -0.5902400 0.3606690
4 B W -0.45025181 -0.66721038 -0.9899521 -0.80989058 0.7606430 0.3738706
或者可能完全摆脱by
并使用它给出相同的输出:
library(plyr)
ddply(df, -(1:5), onerow)
或使用 dplyr:
library(dplyr)
df %>%
group_by_at(-(1:5)) %>%
do( onerow(.) %>% t %>% as.data.frame ) %>%
ungroup
推荐阅读
- mongodb - 如何从 shell 暂停/恢复 mongodb 云/atlas 集群
- html - Svelte 无法正确处理来自 x3dom 的点击事件
- single-sign-on - Azure B2C 单一注销在 Edge 或 IE11 中不起作用
- hana - SAP HANA 中是否有任何方法可以查找所有 sql 语句属于同一过程的内容
- php - 短代码中的 WooCommerce 评论明星
- java - 如何正确迁移到 Realm 中的嵌入式对象?
- python - 如果变量没有,如何将备用值分配给变量
- css - 修改 GTK 按钮样式/CSS 并立即更新/刷新
- jenkins - 如何在詹金斯管道脚本上禁用轻量级结帐?
- winapi - 如何在 Win32 API 中重现资源管理器按钮