通过考虑 r (2) 中的分组 Q 矩阵来操作字符向量答案

【问题标题】：Manipulating a character vector by considering a grouping Q-matrix in r (2)通过考虑 r (2) 中的分组 Q 矩阵来操作字符向量
【发布时间】：2020-09-21 22:04:11
【问题描述】：

我正在尝试基于 Group 变量 item.map 编写代码，该变量具有项目信息，其中包含一个 q 矩阵，显示哪个项目与哪个组相关联。

    Group <- c(1,2,3,4)
item.map <- data.frame(
  item.id = c(21,41,61,72),
  group.1 = c(1,1,1,0),
  group.2 = c(0,1,0,1),
  group.3 = c(1,1,1,0),
  group.4 = c(0,0,0,1))

> item.map
  item.id group.1 group.2 group.3 group.4
1      21       1       0       1       0
2      41       1       1       1       0
3      61       1       0       1       0
4      72       0       1       0       1

在这个item.map group.1 有 3 个项目，而 group.2 有两个项目，group.3 有三个，group.4 有 1 个项目。使用这个 item.map 我想在块中分配这些项目下面的代码，但我无法插入item.map 信息。

   OUTPUT <- as.data.frame(c())
for(i in 1:length(item.map$item.id)) {
 
  for(k in 0:(length(Group))) { # here with the length(State) I gained the sequqnece of 0,1,2,3
    output <- paste0("Equal = ",paste0(paste("(", "G1, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),", ",
                                        paste( "(", "G2, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),
                                        ";"))
    OUTPUT <- c(OUTPUT, output)
    
  }
}


[1] "Equal = (G1, 21, Slope[0]), (G2, 21, Slope[0]), (G3, 21, Slope[0]), (G4, 21, Slope[0]);"
[1] "Equal = (G1, 21, Slope[1]), (G2, 21, Slope[1]), (G3, 21, Slope[1]), (G4, 21, Slope[1]);"
[1] "Equal = (G1, 21, Slope[2]), (G2, 21, Slope[2]), (G3, 21, Slope[2]), (G4, 21, Slope[2]);"
[1] "Equal = (G1, 21, Slope[3]), (G2, 21, Slope[3]), (G3, 21, Slope[3]), (G4, 21, Slope[3]);"
[1] "Equal = (G1, 21, Slope[4]), (G2, 21, Slope[4]), (G3, 21, Slope[4]), (G4, 21, Slope[4]);"
[1] "Equal = (G1, 41, Slope[0]), (G2, 41, Slope[0]), (G3, 41, Slope[0]), (G4, 41, Slope[0]);"
[1] "Equal = (G1, 41, Slope[1]), (G2, 41, Slope[1]), (G3, 41, Slope[1]), (G4, 41, Slope[1]);"
[1] "Equal = (G1, 41, Slope[2]), (G2, 41, Slope[2]), (G3, 41, Slope[2]), (G4, 41, Slope[2]);"
[1] "Equal = (G1, 41, Slope[3]), (G2, 41, Slope[3]), (G3, 41, Slope[3]), (G4, 41, Slope[3]);"
[1] "Equal = (G1, 41, Slope[4]), (G2, 41, Slope[4]), (G3, 41, Slope[4]), (G4, 41, Slope[4]);"
[1] "Equal = (G1, 61, Slope[0]), (G2, 61, Slope[0]), (G3, 61, Slope[0]), (G4, 61, Slope[0]);"
[1] "Equal = (G1, 61, Slope[1]), (G2, 61, Slope[1]), (G3, 61, Slope[1]), (G4, 61, Slope[1]);"
[1] "Equal = (G1, 61, Slope[2]), (G2, 61, Slope[2]), (G3, 61, Slope[2]), (G4, 61, Slope[2]);"
[1] "Equal = (G1, 61, Slope[3]), (G2, 61, Slope[3]), (G3, 61, Slope[3]), (G4, 61, Slope[3]);"
[1] "Equal = (G1, 61, Slope[4]), (G2, 61, Slope[4]), (G3, 61, Slope[4]), (G4, 61, Slope[4]);"
[1] "Equal = (G1, 72, Slope[0]), (G2, 72, Slope[0]), (G3, 72, Slope[0]), (G4, 72, Slope[0]);"
[1] "Equal = (G1, 72, Slope[1]), (G2, 72, Slope[1]), (G3, 72, Slope[1]), (G4, 72, Slope[1]);"
[1] "Equal = (G1, 72, Slope[2]), (G2, 72, Slope[2]), (G3, 72, Slope[2]), (G4, 72, Slope[2]);"
[1] "Equal = (G1, 72, Slope[3]), (G2, 72, Slope[3]), (G3, 72, Slope[3]), (G4, 72, Slope[3]);"
[1] "Equal = (G1, 72, Slope[4]), (G2, 72, Slope[4]), (G3, 72, Slope[4]), (G4, 72, Slope[4]);"

因此，在所需的输出中，G1 不应该有项目 72 并且 G2 不应该在分组块中有项目 21 和 61 信息。此外，我无法在我的代码中对“G1”和“G2”进行排序。考虑到G1、G2、G3 和G4，有没有办法将这两行合并为一条？

output <- paste0("Equal = ",paste0(paste("(", "G1, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),", ",
                                       paste("(", "G2, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),", ",
                                       paste("(", "G3, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),", ",
                                       paste( "(", "G4, ",item.map$item.id[i], ","," Slope[",k,"])",collapse=", ", sep=""),
                                       
                                       ";"))

想要的输出是：

[1] "Equal = (G1, 21, Slope[0]), (G3, 21, Slope[0]);"
[1] "Equal = (G1, 21, Slope[1]), (G3, 21, Slope[1]);"
[1] "Equal = (G1, 21, Slope[2]), (G3, 21, Slope[2]);"
[1] "Equal = (G1, 21, Slope[3]), (G3, 21, Slope[3]);"
[1] "Equal = (G1, 21, Slope[4]), (G3, 21, Slope[4]);"
[1] "Equal = (G1, 41, Slope[0]), (G2, 41, Slope[0]), (G3, 41, Slope[0]);"
[1] "Equal = (G1, 41, Slope[1]), (G2, 41, Slope[1]), (G3, 41, Slope[1]);"
[1] "Equal = (G1, 41, Slope[2]), (G2, 41, Slope[2]), (G3, 41, Slope[2]);"
[1] "Equal = (G1, 41, Slope[3]), (G2, 41, Slope[3]), (G3, 41, Slope[3]);"
[1] "Equal = (G1, 41, Slope[4]), (G2, 41, Slope[4]), (G3, 41, Slope[4]);"
[1] "Equal = (G1, 61, Slope[0]), (G3, 61, Slope[0]);"
[1] "Equal = (G1, 61, Slope[1]), (G3, 61, Slope[1]);"
[1] "Equal = (G1, 61, Slope[2]), (G3, 61, Slope[2]);"
[1] "Equal = (G1, 61, Slope[3]), (G3, 61, Slope[3]);"
[1] "Equal = (G1, 61, Slope[4]), (G3, 61, Slope[4]);"
[1] "Equal = (G2, 72, Slope[0]), (G4, 72, Slope[0]);"
[1] "Equal = (G2, 72, Slope[1]), (G4, 72, Slope[1]);"
[1] "Equal = (G2, 72, Slope[2]), (G4, 72, Slope[2]);"
[1] "Equal = (G2, 72, Slope[3]), (G4, 72, Slope[3]);"
[1] "Equal = (G2, 72, Slope[4]), (G4, 72, Slope[4]);"

有人有什么想法吗？谢谢

【问题讨论】：

请在此问题和stackoverflow.com/questions/64000557/… 之间进行选择...要么删除那个问题，要么删除这个问题。请不要同时打开。
这些问题实际上略有不同。
这里，我认为'group1', ;group2' 需要一个嵌套循环，因为 k 从 0:group 循环，而在 R 中，索引从 1 开始。

标签： r character

【解决方案1】：

这是tidyverse 的一个选项，我们在其中循环“组”列名称，select 来自list 中的'item.map 的那些@，rename 它到'G1'，'G2'，然后使用crossing 扩展数据集，filter 基于逻辑组列，使用glue_data（来自grlue）和flatten 将list 创建为vector 的表达式

library(dplyr)
library(purrr)
library(stringr)
out <- map(c('group.1', 'group.2'), 
      ~ item.map %>% 
          select(item.id, .x) %>% 
          rename_at(.x, ~ str_c('G', str_remove(., "\\D+"))) %>% 
          crossing(k = 0:2) %>%
          filter(across(starts_with('G'), as.logical)) %>% 
          glue::glue_data("Equal = ({names(.)[2]}, {item.id}, Slope[{k}]);")%>%
          as.character) %>%
    flatten_chr

-输出

out
#[1] "Equal = (G1, 21, Slope[0]);" "Equal = (G1, 21, Slope[1]);" "Equal = (G1, 21, Slope[2]);" "Equal = (G1, 41, Slope[0]);"
#[5] "Equal = (G1, 41, Slope[1]);" "Equal = (G1, 41, Slope[2]);" "Equal = (G1, 61, Slope[0]);" "Equal = (G1, 61, Slope[1]);"
#[9] "Equal = (G1, 61, Slope[2]);" "Equal = (G2, 41, Slope[0]);" "Equal = (G2, 41, Slope[1]);" "Equal = (G2, 41, Slope[2]);"
#[13] "Equal = (G2, 72, Slope[0]);" "Equal = (G2, 72, Slope[1]);" "Equal = (G2, 72, Slope[2]);"

如果我们要将两个组中都为 1 的人分组，

i1 <- ave(seq_along(out), sub("G\\d+", "", out), FUN = length)

 out[i1 > 1] <- ave(out[i1 > 1], sub("Equal = \\(G\\d+", "", out[i1 > 1]), 
      FUN = function(x) {
          x[1] <- sub(";", "", x[1])
          paste(x[1], sub("Equal = ", "", x[2]), sep =", ")
  })
out1 <- unique(out)
out1

#[1] "Equal = (G1, 21, Slope[0]);"                     "Equal = (G1, 21, Slope[1]);"                    
#[3] "Equal = (G1, 21, Slope[2]);"                     "Equal = (G1, 41, Slope[0]), (G2, 41, Slope[0]);"
#[5] "Equal = (G1, 41, Slope[1]), (G2, 41, Slope[1]);" "Equal = (G1, 41, Slope[2]), (G2, 41, Slope[2]);"
#[7] "Equal = (G1, 61, Slope[0]);"                     "Equal = (G1, 61, Slope[1]);"                    
#[9] "Equal = (G1, 61, Slope[2]);"                     "Equal = (G2, 72, Slope[0]);"                    
#[11] "Equal = (G2, 72, Slope[1]);"                     "Equal = (G2, 72, Slope[2]);"

更新

使用更新的数据集

out <- map(c('group.1', 'group.2', 'group.3', 'group.4'), 
       ~ item.map %>% 
            select(item.id, .x) %>% 
            rename_at(.x, ~ str_c('G', str_remove(., "\\D+"))) %>% 
            crossing(k = 0:4) %>%
            filter(across(starts_with('G'), as.logical)) %>% 
            glue::glue_data("Equal = ({names(.)[2]}, {item.id}, Slope[{k}]);")%>%
            as.character) %>%
      flatten_chr
 
out[i1 > 1] <- ave(out[i1 > 1], sub("Equal = \\(G\\d+", "", out[i1 > 1]),
     FUN = function(x) {
      x[-length(x)] <- sub(";", "", x[-length(x)])
      paste(x[1], paste(sub("Equal = ", "", x[-1]), collapse = ", "), sep=", ") 
   })
   
unique(out)
 [1] "Equal = (G1, 21, Slope[0]), (G3, 21, Slope[0]);"                    
 [2] "Equal = (G1, 21, Slope[1]), (G3, 21, Slope[1]);"                    
 [3] "Equal = (G1, 21, Slope[2]), (G3, 21, Slope[2]);"                    
 [4] "Equal = (G1, 21, Slope[3]), (G3, 21, Slope[3]);"                    
 [5] "Equal = (G1, 21, Slope[4]), (G3, 21, Slope[4]);"                    
 [6] "Equal = (G1, 41, Slope[0]), (G2, 41, Slope[0]), (G3, 41, Slope[0]);"
 [7] "Equal = (G1, 41, Slope[1]), (G2, 41, Slope[1]), (G3, 41, Slope[1]);"
 [8] "Equal = (G1, 41, Slope[2]), (G2, 41, Slope[2]), (G3, 41, Slope[2]);"
 [9] "Equal = (G1, 41, Slope[3]), (G2, 41, Slope[3]), (G3, 41, Slope[3]);"
[10] "Equal = (G1, 41, Slope[4]), (G2, 41, Slope[4]), (G3, 41, Slope[4]);"
[11] "Equal = (G1, 61, Slope[0]), (G3, 61, Slope[0]);"                    
[12] "Equal = (G1, 61, Slope[1]), (G3, 61, Slope[1]);"                    
[13] "Equal = (G1, 61, Slope[2]), (G3, 61, Slope[2]);"                    
[14] "Equal = (G1, 61, Slope[3]), (G3, 61, Slope[3]);"                    
[15] "Equal = (G1, 61, Slope[4]), (G3, 61, Slope[4]);"                    
[16] "Equal = (G2, 72, Slope[0]), (G4, 72, Slope[0]);"                    
[17] "Equal = (G2, 72, Slope[1]), (G4, 72, Slope[1]);"                    
[18] "Equal = (G2, 72, Slope[2]), (G4, 72, Slope[2]);"                    
[19] "Equal = (G2, 72, Slope[3]), (G4, 72, Slope[3]);"                    
[20] "Equal = (G2, 72, Slope[4]), (G4, 72, Slope[4]);"

或者使用嵌套的for 循环

OUTPUT <- c()
# // loop over the sequence of rows
for(i in seq_len(nrow(item.map))) {
    # // nested loop to expand on a sequence
    for(k in  0:2) {  
        # // do a second nest based on the 'Group'  
         for(j in seq_along(Group)) {
              # // create a logical expression based on the 'group' column
              i1 <- as.logical(item.map[[paste0("group.", j)]][i])
              # // if it is TRUE, then only do the below
              if(i1) {
                  # // create the expression with paste
                  output <- paste0("Equal = ", paste("(", "G", j, 
                     ", ", item.map$item.id[i], ", Slope[", k, "])", 
                         collapse=", ", sep=""))
                 
              # // concatenate the NULL vector with the temporary output
              OUTPUT <- c(OUTPUT, output)
              }
         
         }
    
    }

}

【讨论】：

感谢@akrun。由于某种原因，我的 R 无法运行 map_c 函数。我应该使用任何其他库吗？
感谢您的两个回答。你今天拯救了我的一天:)
这就像一个冠军！感谢您抽出宝贵时间！ :)
@amisos55 否，across 不适用于该版本。你需要filter_at(vars(starts_with("G")), as.logical)
感谢您的及时回复，效果很好！美好的一天！