Manipulating a character vector by considering a grouping Q-matrix in r (2)

Question

I am trying to write code based on a Group variable, item.map that has item information that includes an q-matrix showing which item is associated with

Answer 1

Here is one option with tidyverse where we loop over the 'group' column names, select those from 'item.map in a list, rename it to 'G1', 'G2', then do crossing to expand the dataset, filter based on the logical group column, create the expression with glue_data (from grlue) and flatten the list to a 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

-output

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]);"

If we want to group those that are 1 in both groups,

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]);"  

Update

With the updated dataset

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]);"       

---

Or with the nested for loop

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)
              }
         
         }
    
    }

}