在 R 中为整个数据集自动化 "for loop" 并计数
Automating "for loop" in R for the whole data set and counting
我在做分析，我对R不是很深，卡在这个阶段了。在这方面，我将不胜感激。
在示例数据集 (data1) 中，我有 7 列 (a, b, c, d, e, f, g)。前 3 列 (a, b, c) 来自一个组，其他 4 列 (d, e, f, g) 来自不同的组。
在我的 data1 中，我为来自 2 组的每个组合对应用了 TRUE/FALSE (1/0) 输出的公式 [a 与 d、e、f 的每一列, g (ad, ae, af, ag); b 每列 (bd, be, bf, bg)； c 每列 (cd, ce, cf, cg)]。在我的示例中，我尝试对 c 和 d 列 (cd) 执行此操作。但是，它没有向我显示正确的输出。在我想要的输出中，第二个输出应该是 1 (TRUE)。而且，我不知道如何为整个数据集自动执行循环。
**N.B。由于parental line任意取值都可以满足条件，所以我在循环中使用了|来得到结果。但是，我不确定这是正确的还是有效的方法。
a <- c(0, 0.501, 0.501, 0, 0.57, 20)
b <- c(0.108, 0.96, 0.110, 0.10, 4, 2)
c <- c(0.110, 1, 0.118, 0.107, 0.34, 0.019)
d <- c(0.115, 0.113, 0.98, 0.1, 13, 2)
e <- c(1, 3.113, 0.98, 0.560, 0.15, 1)
f <- c(2.45, 4.16, 0.045, 0.9, 0.12, 70)
g <- c(2, 0.6, 3, 7, 0.12, 29)
data1 <- data.frame(a, b, c, d, e, f, g)
rownames(data1) <- c(("Man2"), paste0('Man', 4:8))
data1
#> a b c d e f g
#> Man2 0.000 0.108 0.110 0.115 1.000 2.450 2.00
#> Man4 0.501 0.960 1.000 0.113 3.113 4.160 0.60
#> Man5 0.501 0.110 0.118 0.980 0.980 0.045 3.00
#> Man6 0.000 0.100 0.107 0.100 0.560 0.900 7.00
#> Man7 0.570 4.000 0.340 13.000 0.150 0.120 0.12
#> Man8 20.000 2.000 0.019 2.000 1.000 70.000 29.00
r <- c(1:6) #number of rows
c <- c(1:7) #number of cols
f <- c(1:3) #first group (a, b, c)
s <- c(4:7) #second group (d, e, f, g)
for (i in r) {
if ((data1[i,3] >= 0.5 & data1[i,4] >= data1[i, 3]*2) | (data1[i,4] >= 0.5 & data1[i,3] >= data1[i,4]*2)) {
print(1L)
} else if ((data1[i,3] < 0.5 & data1[i,4] >= 1.0) | (data1[i,4] < 0.5 & data1[1,3] >= 1.0)) {
print(1L)
} else {
print(0L)
}
}
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 1
#> [1] 1
由 reprex package (v2.0.0)
于 2021-06-21 创建
对于每个组合，
- 如果任何一列中的值为>=0.5，则另一列中的值应为>=2倍，
- 并且如果任何一列中的值低于 0.5，则另一列中的值需要 >= 1每行。
我寻找这样的输出 df:
ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 1L, 1L, 1L, 0L, 1L)
df <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg)
rownames(df) <- c(("Man2"), paste0('Man', 4:8))
df
#> ad ae af ag bd be bf bg cd ce cf cg
#> Man2 0 1 1 1 0 1 1 1 0 1 1 1
#> Man4 0 1 1 0 0 1 1 0 1 1 1 1
#> Man5 0 0 0 1 0 0 0 1 0 0 0 1
#> Man6 0 0 0 1 0 0 0 1 0 0 0 1
#> Man7 1 0 0 0 1 1 1 1 1 0 0 0
#> Man8 1 1 1 0 0 1 1 1 1 1 1 1
由 reprex package (v2.0.0)
于 2021-06-21 创建
组合对我也有两组。我想计算每一行中一组 c(ad, ae, bg, be, bf, cd) 和另一组 c(af, ag, bd, ce, cf, cg) 中“1”的数量。将 1/0 输出保存在像 df 这样的新数据框中，或者只是将“1”的计数放在两个新列中（如 df2）是个好主意吗？工作数据集很大。因此，内存和高效方式是这里的问题。
我想要的输出是这样的[为第一个组合组计算 1s c(ad, ae, bg, be, bf, cd) 并且为第二个组合组计算 1s c(af, ag, bd, ce, cf, cg) 每行]：
ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 0L, 1L, 1L, 0L, 1L)
#first_group <- c(ad, ae, bg, be, bf, cd)
#second_group <- c(af, ag, bd, ce, cf, cg)
first_combi <- c(4, 4, 1, 1, 5, 5)
second_combi <- c(5, 3, 2, 2, 1, 4)
df2 <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg, first_combi, second_combi)
rownames(df2) <- c(("Man2"), paste0('Man', 4:8))
df2
#> ad ae af ag bd be bf bg cd ce cf cg first_combi second_combi
#> Man2 0 1 1 1 0 1 1 1 0 1 1 1 4 5
#> Man4 0 1 1 0 0 1 1 0 1 1 1 0 4 3
#> Man5 0 0 0 1 0 0 0 1 0 0 0 1 1 2
#> Man6 0 0 0 1 0 0 0 1 0 0 0 1 1 2
#> Man7 1 0 0 0 1 1 1 1 1 0 0 0 5 1
#> Man8 1 1 1 0 0 1 1 1 1 1 1 1 5 4
由 reprex package (v2.0.0)
于 2021-06-21 创建
所以，我需要两个建议：
- 如何为整个数据集自动循环
- 如何为两个组合组存储 1/0 (TRUE/FALSE) 并为组计算“1”。
请教我解决数据集的这两个问题。
tidyverse 策略。对于第二部分，我假设您想要矩阵形式的 colsums。
- 我已将您的列名分为两组，例如
grp_1 和 grp_2
exapnd.grid 将生成两个名称组的所有组合- 接下来我们将把它作为第一个参数传递给
pmap_dfc
- 对于函数部分，我有
- 将逻辑值存储到临时变量
x 中。在存储之前，我用 + 包装了整个条件，它将逻辑值转换为数字
- 接下来我使用
paste0 根据组组合为这个 x 设置了名称
- 由于使用了
pmap_dfc，结果会自动绑定到列中
- 最后的代码恢复行名称
第二部分我使用了-
outer 函数，结合colSums.
使用 colSums 将根据列名而不是矩阵直接为您提供结果
library(tidyverse)
#optimised solution #for the loop part
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] > 2 * data1[[..1]]) |
(data1[[..2]] >= 0.5 & data1[[..1]] > 2 * data1[[..2]]) |
(data1[[..2]] < 0.5 & data1[[..1]] >= 1) |
(data1[[..1]] < 0.5 & data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
as.data.frame() %>%
`rownames<-`(rownames(data1)) -> res
res
#> ad bd cd ae be ce af bf cf ag bg cg
#> Man2 0 0 0 1 1 1 1 1 1 1 1 1
#> Man4 0 0 1 1 1 1 1 1 1 0 0 0
#> Man5 0 0 0 0 0 0 0 0 0 1 1 1
#> Man6 0 0 0 0 0 0 0 0 0 1 1 1
#> Man7 1 1 1 0 1 0 0 1 0 0 1 0
#> Man8 1 0 1 1 0 1 1 1 1 0 1 1
第二部分
#second part
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')
split.default(res, c('Gr1', 'Gr2')[1 + !(names(res) %in% out_gr1)]) %>%
sapply(rowSums)
Gr1 Gr2
Man2 4 5
Man4 4 3
Man5 1 2
Man6 1 2
Man7 5 1
Man8 5 4
在一个管道中完成
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')
expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] > 2 * data1[[..1]]) |
(data1[[..2]] >= 0.5 & data1[[..1]] > 2 * data1[[..2]]) |
(data1[[..2]] < 0.5 & data1[[..1]] >= 1) |
(data1[[..1]] < 0.5 & data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
as.data.frame() %>%
`rownames<-`(rownames(data1)) %>% cbind(split.default(., c('First_combi', 'Second_combi')[1 + !(names(.) %in% out_gr1)]) %>%
sapply(rowSums))
ad bd cd ae be ce af bf cf ag bg cg First_combi Second_combi
Man2 0 0 0 1 1 1 1 1 1 1 1 1 4 5
Man4 0 0 1 1 1 1 1 1 1 0 0 0 4 3
Man5 0 0 0 0 0 0 0 0 0 1 1 1 1 2
Man6 0 0 0 0 0 0 0 0 0 1 1 1 1 2
Man7 1 1 1 0 1 0 0 1 0 0 1 0 5 1
Man8 1 0 1 1 0 1 1 1 1 0 1 1 5 4
您可以编写比较函数并循环列以在数据框中获取结果。然后，用lapply()到运行table()遍历dataframe的每一列，得到1的个数。
# A function for the comparison
compare <- function(x, y) {
ifelse(
(x >= 0.5 & y >= (x * 2)) | (y >= 0.5 & x >= (y * 2)) | (x < 0.5 & y >= 1) | (y < 0.5 & x >= 1),
1L, 0L
)
}
# Get all combinations
comb <- expand.grid(first = c("a", "b", "c"),
second = c("d", "e", "f", "g"),
stringsAsFactors = FALSE)
n <- nrow(comb)
# Create an empty list
res <- vector("list", n)
for (i in seq_len(n)) {
res[[i]] <- compare(data1[[ comb$first[i] ]],
data1[[ comb$second[i] ]])
}
# Assign names to the list
names(res) <- paste0(comb$first, comb$second, collpase = "")
# Convert the list to a dataframe
res <- list2DF(res)
# Assign row names
rownames(res) <- c(("Man2"), paste0('Man', 4:8))
res
# ad bd cd ae be ce af bf cf ag bg cg
# Man2 0 0 0 1 1 1 1 1 1 1 1 1
# Man4 0 0 1 1 1 1 1 1 1 0 0 0
# Man5 0 0 0 0 0 0 0 0 0 1 1 1
# Man6 0 0 0 0 0 0 0 0 0 1 1 1
# Man7 1 1 1 0 1 0 0 1 0 0 1 0
# Man8 1 0 1 1 1 1 1 1 1 0 1 1
# use lapply to get the counts of 1s and 0s in each column
res_count <- lapply(res, table)
res_count
# $ad
#
# 0 1
# 4 2
#
# $bd
#
# 0 1
# 5 1
#
# $cd
#
# 0 1
# 3 3
# <omitted>
您也可以使用以下解决方案：
library(dplyr)
library(purrr)
# First we create every combinations of column names between 2 groups
expand.grid(names(data1)[1:3], names(data1[4:7])) -> cols
# Then we check your desired conditions
map2(cols$Var1, cols$Var2, ~ data1[, c(.x, .y)]) %>%
map(~ .x %>%
mutate(!!paste0(names(.x), collapse = "") :=
pmap_dbl(.x, ~ {x <- c(...)[-3];
if((..1 > 0.5 & ..2 >= ..1 * 2) | (..2 > 0.5 & ..1 >= ..2 * 2) |
(..1 < 0.5 & ..2 >= 1) | (..2 < 0.5 & ..1 >= 1)) {
1
} else {
0
}}))) %>%
map_dfc(~ .x %>% select(3)) -> df
ad bd cd ae be ce af bf cf ag bg cg
1 0 0 0 1 1 1 1 1 1 1 1 1
2 0 0 1 1 1 1 1 1 1 0 0 0
3 0 0 0 0 0 0 0 0 0 1 1 1
4 0 0 0 0 0 0 0 0 0 1 1 1
5 1 1 1 0 1 0 0 1 0 0 1 0
6 1 0 1 1 1 1 1 1 1 0 1 1
关于你的第二个问题，如果我理解你在寻找什么并且你想计算每对中每一行的 1 的数量，你可以使用这个：
col1 <- c("ad", "ae", "bg", "be", "bf", "cd")
col2 <- c("af", "ag", "bd", "ce", "cf", "cg")
split.default(df, names(df) %in% col1) %>%
map(~ .x %>%
rowwise() %>%
mutate(count = reduce(cur_data(), `+`)))
$`FALSE`
# A tibble: 6 x 7
# Rowwise:
bd ce af cf ag cg count
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0 1 1 1 1 1 5
2 0 1 1 1 0 0 3
3 0 0 0 0 1 1 2
4 0 0 0 0 1 1 2
5 1 0 0 0 0 0 1
6 0 1 1 1 0 1 4
$`TRUE`
# A tibble: 6 x 7
# Rowwise:
ad cd ae be bf bg count
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0 0 1 1 1 1 4
2 0 1 1 1 1 0 4
3 0 0 0 0 0 1 1
4 0 0 0 0 0 1 1
5 1 1 0 1 1 1 5
6 1 1 1 1 1 1 6
为了计算欧氏距离，您可以使用以下解决方案：
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
expand.grid(gr_1, gr_2) %>%
{map2(.$Var1, .$Var2, ~ data1[c(.x, .y)])} %>%
map_dfc(~ .x %>%
summarise(!!sym(paste0(names(.x), collapse = "")) := sqrt(sum((.x[[1]] - .x[[2]]) ^ 2))))
ad bd cd ae be ce af bf cf ag
1 21.88397 9.081539 12.87361 19.22347 4.714029 2.683949 50.20569 68.23066 70.09625 11.85147
bg cg
1 28.35006 29.99164
我在做分析，我对R不是很深，卡在这个阶段了。在这方面，我将不胜感激。
在示例数据集 (data1) 中，我有 7 列 (a, b, c, d, e, f, g)。前 3 列 (a, b, c) 来自一个组，其他 4 列 (d, e, f, g) 来自不同的组。
在我的 data1 中，我为来自 2 组的每个组合对应用了 TRUE/FALSE (1/0) 输出的公式 [a 与 d、e、f 的每一列, g (ad, ae, af, ag); b 每列 (bd, be, bf, bg)； c 每列 (cd, ce, cf, cg)]。在我的示例中，我尝试对 c 和 d 列 (cd) 执行此操作。但是，它没有向我显示正确的输出。在我想要的输出中，第二个输出应该是 1 (TRUE)。而且，我不知道如何为整个数据集自动执行循环。
**N.B。由于parental line任意取值都可以满足条件，所以我在循环中使用了|来得到结果。但是，我不确定这是正确的还是有效的方法。
a <- c(0, 0.501, 0.501, 0, 0.57, 20)
b <- c(0.108, 0.96, 0.110, 0.10, 4, 2)
c <- c(0.110, 1, 0.118, 0.107, 0.34, 0.019)
d <- c(0.115, 0.113, 0.98, 0.1, 13, 2)
e <- c(1, 3.113, 0.98, 0.560, 0.15, 1)
f <- c(2.45, 4.16, 0.045, 0.9, 0.12, 70)
g <- c(2, 0.6, 3, 7, 0.12, 29)
data1 <- data.frame(a, b, c, d, e, f, g)
rownames(data1) <- c(("Man2"), paste0('Man', 4:8))
data1
#> a b c d e f g
#> Man2 0.000 0.108 0.110 0.115 1.000 2.450 2.00
#> Man4 0.501 0.960 1.000 0.113 3.113 4.160 0.60
#> Man5 0.501 0.110 0.118 0.980 0.980 0.045 3.00
#> Man6 0.000 0.100 0.107 0.100 0.560 0.900 7.00
#> Man7 0.570 4.000 0.340 13.000 0.150 0.120 0.12
#> Man8 20.000 2.000 0.019 2.000 1.000 70.000 29.00
r <- c(1:6) #number of rows
c <- c(1:7) #number of cols
f <- c(1:3) #first group (a, b, c)
s <- c(4:7) #second group (d, e, f, g)
for (i in r) {
if ((data1[i,3] >= 0.5 & data1[i,4] >= data1[i, 3]*2) | (data1[i,4] >= 0.5 & data1[i,3] >= data1[i,4]*2)) {
print(1L)
} else if ((data1[i,3] < 0.5 & data1[i,4] >= 1.0) | (data1[i,4] < 0.5 & data1[1,3] >= 1.0)) {
print(1L)
} else {
print(0L)
}
}
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 1
#> [1] 1
由 reprex package (v2.0.0)
于 2021-06-21 创建对于每个组合，
- 如果任何一列中的值为>=0.5，则另一列中的值应为>=2倍，
- 并且如果任何一列中的值低于 0.5，则另一列中的值需要 >= 1每行。
我寻找这样的输出 df:
ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 1L, 1L, 1L, 0L, 1L)
df <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg)
rownames(df) <- c(("Man2"), paste0('Man', 4:8))
df
#> ad ae af ag bd be bf bg cd ce cf cg
#> Man2 0 1 1 1 0 1 1 1 0 1 1 1
#> Man4 0 1 1 0 0 1 1 0 1 1 1 1
#> Man5 0 0 0 1 0 0 0 1 0 0 0 1
#> Man6 0 0 0 1 0 0 0 1 0 0 0 1
#> Man7 1 0 0 0 1 1 1 1 1 0 0 0
#> Man8 1 1 1 0 0 1 1 1 1 1 1 1
由 reprex package (v2.0.0)
于 2021-06-21 创建组合对我也有两组。我想计算每一行中一组 c(ad, ae, bg, be, bf, cd) 和另一组 c(af, ag, bd, ce, cf, cg) 中“1”的数量。将 1/0 输出保存在像 df 这样的新数据框中，或者只是将“1”的计数放在两个新列中（如 df2）是个好主意吗？工作数据集很大。因此，内存和高效方式是这里的问题。
我想要的输出是这样的[为第一个组合组计算 1s c(ad, ae, bg, be, bf, cd) 并且为第二个组合组计算 1s c(af, ag, bd, ce, cf, cg) 每行]：
ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 0L, 1L, 1L, 0L, 1L)
#first_group <- c(ad, ae, bg, be, bf, cd)
#second_group <- c(af, ag, bd, ce, cf, cg)
first_combi <- c(4, 4, 1, 1, 5, 5)
second_combi <- c(5, 3, 2, 2, 1, 4)
df2 <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg, first_combi, second_combi)
rownames(df2) <- c(("Man2"), paste0('Man', 4:8))
df2
#> ad ae af ag bd be bf bg cd ce cf cg first_combi second_combi
#> Man2 0 1 1 1 0 1 1 1 0 1 1 1 4 5
#> Man4 0 1 1 0 0 1 1 0 1 1 1 0 4 3
#> Man5 0 0 0 1 0 0 0 1 0 0 0 1 1 2
#> Man6 0 0 0 1 0 0 0 1 0 0 0 1 1 2
#> Man7 1 0 0 0 1 1 1 1 1 0 0 0 5 1
#> Man8 1 1 1 0 0 1 1 1 1 1 1 1 5 4
由 reprex package (v2.0.0)
于 2021-06-21 创建所以，我需要两个建议：
- 如何为整个数据集自动循环
- 如何为两个组合组存储 1/0 (TRUE/FALSE) 并为组计算“1”。
请教我解决数据集的这两个问题。
tidyverse 策略。对于第二部分，我假设您想要矩阵形式的 colsums。
- 我已将您的列名分为两组，例如
grp_1和grp_2 exapnd.grid将生成两个名称组的所有组合- 接下来我们将把它作为第一个参数传递给
pmap_dfc - 对于函数部分，我有
- 将逻辑值存储到临时变量
x中。在存储之前，我用+包装了整个条件，它将逻辑值转换为数字 - 接下来我使用
paste0 根据组组合为这个 x 设置了名称
- 将逻辑值存储到临时变量
- 由于使用了
pmap_dfc，结果会自动绑定到列中 - 最后的代码恢复行名称
第二部分我使用了-
outer函数，结合colSums.
使用 colSums 将根据列名而不是矩阵直接为您提供结果
library(tidyverse)
#optimised solution #for the loop part
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] > 2 * data1[[..1]]) |
(data1[[..2]] >= 0.5 & data1[[..1]] > 2 * data1[[..2]]) |
(data1[[..2]] < 0.5 & data1[[..1]] >= 1) |
(data1[[..1]] < 0.5 & data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
as.data.frame() %>%
`rownames<-`(rownames(data1)) -> res
res
#> ad bd cd ae be ce af bf cf ag bg cg
#> Man2 0 0 0 1 1 1 1 1 1 1 1 1
#> Man4 0 0 1 1 1 1 1 1 1 0 0 0
#> Man5 0 0 0 0 0 0 0 0 0 1 1 1
#> Man6 0 0 0 0 0 0 0 0 0 1 1 1
#> Man7 1 1 1 0 1 0 0 1 0 0 1 0
#> Man8 1 0 1 1 0 1 1 1 1 0 1 1
第二部分
#second part
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')
split.default(res, c('Gr1', 'Gr2')[1 + !(names(res) %in% out_gr1)]) %>%
sapply(rowSums)
Gr1 Gr2
Man2 4 5
Man4 4 3
Man5 1 2
Man6 1 2
Man7 5 1
Man8 5 4
在一个管道中完成
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')
expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] > 2 * data1[[..1]]) |
(data1[[..2]] >= 0.5 & data1[[..1]] > 2 * data1[[..2]]) |
(data1[[..2]] < 0.5 & data1[[..1]] >= 1) |
(data1[[..1]] < 0.5 & data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
as.data.frame() %>%
`rownames<-`(rownames(data1)) %>% cbind(split.default(., c('First_combi', 'Second_combi')[1 + !(names(.) %in% out_gr1)]) %>%
sapply(rowSums))
ad bd cd ae be ce af bf cf ag bg cg First_combi Second_combi
Man2 0 0 0 1 1 1 1 1 1 1 1 1 4 5
Man4 0 0 1 1 1 1 1 1 1 0 0 0 4 3
Man5 0 0 0 0 0 0 0 0 0 1 1 1 1 2
Man6 0 0 0 0 0 0 0 0 0 1 1 1 1 2
Man7 1 1 1 0 1 0 0 1 0 0 1 0 5 1
Man8 1 0 1 1 0 1 1 1 1 0 1 1 5 4
您可以编写比较函数并循环列以在数据框中获取结果。然后，用lapply()到运行table()遍历dataframe的每一列，得到1的个数。
# A function for the comparison
compare <- function(x, y) {
ifelse(
(x >= 0.5 & y >= (x * 2)) | (y >= 0.5 & x >= (y * 2)) | (x < 0.5 & y >= 1) | (y < 0.5 & x >= 1),
1L, 0L
)
}
# Get all combinations
comb <- expand.grid(first = c("a", "b", "c"),
second = c("d", "e", "f", "g"),
stringsAsFactors = FALSE)
n <- nrow(comb)
# Create an empty list
res <- vector("list", n)
for (i in seq_len(n)) {
res[[i]] <- compare(data1[[ comb$first[i] ]],
data1[[ comb$second[i] ]])
}
# Assign names to the list
names(res) <- paste0(comb$first, comb$second, collpase = "")
# Convert the list to a dataframe
res <- list2DF(res)
# Assign row names
rownames(res) <- c(("Man2"), paste0('Man', 4:8))
res
# ad bd cd ae be ce af bf cf ag bg cg
# Man2 0 0 0 1 1 1 1 1 1 1 1 1
# Man4 0 0 1 1 1 1 1 1 1 0 0 0
# Man5 0 0 0 0 0 0 0 0 0 1 1 1
# Man6 0 0 0 0 0 0 0 0 0 1 1 1
# Man7 1 1 1 0 1 0 0 1 0 0 1 0
# Man8 1 0 1 1 1 1 1 1 1 0 1 1
# use lapply to get the counts of 1s and 0s in each column
res_count <- lapply(res, table)
res_count
# $ad
#
# 0 1
# 4 2
#
# $bd
#
# 0 1
# 5 1
#
# $cd
#
# 0 1
# 3 3
# <omitted>
您也可以使用以下解决方案：
library(dplyr)
library(purrr)
# First we create every combinations of column names between 2 groups
expand.grid(names(data1)[1:3], names(data1[4:7])) -> cols
# Then we check your desired conditions
map2(cols$Var1, cols$Var2, ~ data1[, c(.x, .y)]) %>%
map(~ .x %>%
mutate(!!paste0(names(.x), collapse = "") :=
pmap_dbl(.x, ~ {x <- c(...)[-3];
if((..1 > 0.5 & ..2 >= ..1 * 2) | (..2 > 0.5 & ..1 >= ..2 * 2) |
(..1 < 0.5 & ..2 >= 1) | (..2 < 0.5 & ..1 >= 1)) {
1
} else {
0
}}))) %>%
map_dfc(~ .x %>% select(3)) -> df
ad bd cd ae be ce af bf cf ag bg cg
1 0 0 0 1 1 1 1 1 1 1 1 1
2 0 0 1 1 1 1 1 1 1 0 0 0
3 0 0 0 0 0 0 0 0 0 1 1 1
4 0 0 0 0 0 0 0 0 0 1 1 1
5 1 1 1 0 1 0 0 1 0 0 1 0
6 1 0 1 1 1 1 1 1 1 0 1 1
关于你的第二个问题，如果我理解你在寻找什么并且你想计算每对中每一行的 1 的数量，你可以使用这个：
col1 <- c("ad", "ae", "bg", "be", "bf", "cd")
col2 <- c("af", "ag", "bd", "ce", "cf", "cg")
split.default(df, names(df) %in% col1) %>%
map(~ .x %>%
rowwise() %>%
mutate(count = reduce(cur_data(), `+`)))
$`FALSE`
# A tibble: 6 x 7
# Rowwise:
bd ce af cf ag cg count
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0 1 1 1 1 1 5
2 0 1 1 1 0 0 3
3 0 0 0 0 1 1 2
4 0 0 0 0 1 1 2
5 1 0 0 0 0 0 1
6 0 1 1 1 0 1 4
$`TRUE`
# A tibble: 6 x 7
# Rowwise:
ad cd ae be bf bg count
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0 0 1 1 1 1 4
2 0 1 1 1 1 0 4
3 0 0 0 0 0 1 1
4 0 0 0 0 0 1 1
5 1 1 0 1 1 1 5
6 1 1 1 1 1 1 6
为了计算欧氏距离，您可以使用以下解决方案：
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
expand.grid(gr_1, gr_2) %>%
{map2(.$Var1, .$Var2, ~ data1[c(.x, .y)])} %>%
map_dfc(~ .x %>%
summarise(!!sym(paste0(names(.x), collapse = "")) := sqrt(sum((.x[[1]] - .x[[2]]) ^ 2))))
ad bd cd ae be ce af bf cf ag
1 21.88397 9.081539 12.87361 19.22347 4.714029 2.683949 50.20569 68.23066 70.09625 11.85147
bg cg
1 28.35006 29.99164