在 R 中为整个数据集和计数自动化“for循环”答案

【问题标题】：Automating "for loop" in R for the whole data set and counting在 R 中为整个数据集和计数自动化“for循环”
【发布时间】：2021-09-04 19:26:52
【问题描述】：

我正在做一个分析，我在 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)。而且，我不知道如何自动化整个数据集的循环。

**注由于 parent 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 年 6 月 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 这样的新数据帧中，或者只是将“1s”的计数放在两个新列中（如在 df2 中）是一个好主意吗？工作数据集是一个巨大的。所以，内存和高效的方式是这里的问题。我想要的输出是这样的[为第一个组合组 c(ad, ae, bg, be, bf, cd) 计数 1，并且为每行的第二个组合组 c(af, ag, bd, ce, cf, cg) 计数 1]：

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 年 6 月 21 日创建}

所以，我需要两个建议：

如何自动化整个数据集的循环
如何存储两个组合组的 1/0 (TRUE/FALSE) 并为组计数“1”。

请帮我解决数据集的这两个问题。

【问题讨论】：

标签： r dataframe loops for-loop purrr

【解决方案1】：

tidyverse 策略。对于第二部分，我假设您想要矩阵形式的 colsum。

我已将您的列名分为两组，例如 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

【讨论】：

非常感谢，@AnilGoyal。我很抱歉迟到了回复。这对我来说是忙碌的一天，我生病了。第一部分工作 100% 正确。关于第二部分：我应该为两个组合组的每一行计算 1。我承认我的查询不够清楚。我更新了问题的最后一部分（使用可重现的数据）。希望它会奏效。
我正在逐行计算ad, ae, bg, be, bf, cdcolumns（第一个组合组）中1s 的总数，即4，然后再次计算1s 中的总数987654339@ 列（第二个组合组），第一行为 5（Man2）。将遵循对每一行相同的两次计数。它有助于阐述第二部分吗？
是的，他们有分组标准。它们 (ad, bd, cd, ae, be, ce, af, bf, cf, ag, bg, cg) 有一些其他值，根据这些值，我将它们拼接成两个相等的组，其中第一组的任何成员的值都高于第二组。

【解决方案2】：

您可以编写一个函数进行比较并循环列以在数据框中获取结果。然后，使用lapply() 对dataframe 的每一列运行table() 得到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>

【讨论】：

非常感谢@Zaw，再次抱歉迟到了。它非常适合第一部分。对于计数，我已经更新了我的问题。我认为我的查询没有得到完美的描述。我希望这个问题现在很清楚，可以指导我。

【解决方案3】：

您也可以使用以下解决方案：

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

【讨论】：

非常感谢@Anoushiravan R，很抱歉迟到了。第一部分是正确的。第二部分应该稍作修改。是的，我想按行计算，但是对于两个组合组。我不明白如何计算这两种组合的1s 的数量。
@Rasheduzzaman 不客气。我认为如果这对变量的组合是正确的，因为当我们计算行的总和时我们的值是二进制的，我们实际上计算了每行中1s 的数量。但是让我知道是否应该以其他方式对其进行修改。
非常感谢，@Anoshiravan R。你是对的。我误解了这件事。所以，我的问题解决了！ :) 保重！
非常感谢您帮助我。我很感激你的热情！
你真好。如果您在这个问题上需要更多帮助，请在此处告诉我们。