Christopher Course's questions

Eu tenho um conjunto de dados como este:

 df1 <- data.frame(
    col1 = c(1, 2, 3),
    col2 = c(4, 5, 6),
    col3 = c(2, 8, 9),
    col4 = c(5, 11, 12),
    col5 = c(13, 14, 15),
    col6 = c(16, 17, 18),
    col7 = c(19, 20, 21),
    col8 = c(22, 23, 24)
  )

e um segundo que tem uma 'chave' de correspondências que estou procurando no df1:

df2 <- data.frame(
    colA = c(1, 2, 3),
    colB = c(4, 5, 6),
    value = c(100, 200, 300)
  )

o que estou tentando fazer é encontrar cada correspondência de coluna em pares da esquerda para a direita e criar uma nova coluna contendo o valor de df2 toda vez que houver uma correspondência, para que fique assim:

 df3 <- data.frame(
    col1 = c(1, 2, 3),
    col2 = c(4, 5, 6),
    col3 = c(2, 8, 9),
    col4 = c(5, 11, 12),
    col5 = c(13, 14, 15),
    col6 = c(16, 17, 18),
    col7 = c(19, 20, 21),
    col8 = c(22, 23, 24),
    match1 = c(100, 200, 300),
    match2 = c(200, NA, NA)
  )

Eu tentei esse tipo de abordagem:

df_match <- inner_join(df1, df2, by = c("col1" = "colA", "col2" = "colB"))
  
  df1$matched_value <- df_match$value[match(paste(df1$col1, df1$col2), paste(df_match$col1, df_match$col2))]

mas ele retorna apenas uma correspondência entre as linhas. O outro problema é que estou executando isso por muitas iterações que têm números variados de colunas em df1. Estou pensando que preciso de algo do tipo entre as linhas começa com 'col', mas estou bem travado.

Estou tentando personalizar a posição do nó em um eixo x e y em um diagrama de rede usando o DiagrammeR, usando os seguintes DFS de nó, posição e arestas:

nodesdat <- read.table(text = "
id label color fillcolor fontcolor fontsize
1   1    A1 black     white     black       16
2   2    A3 black     white     black       16
5   5    A6 black     white     black       16
18 18    Si black     white     black       16
19 19    Z1 black     white     black       16
", header = TRUE)

positionsdat <- read.table(text = "
label id color fillcolor fontcolor fontsize x y
1     A1  1 black     white     black       16 3 3
2     A3  2 black     white     black       16 3 4
5     A6  5 black     white     black       16 3 5
18    Si 18 black     white     black       16 2 4
19    Z1 19 black     white     black       16 5 4
", header = TRUE)

edgesdat <- read.table(text = "
id from to          rel  dir arrowhead arrowtail  style color
1   1    1  1 connected_to both      odot      none dashed black
2   2    2  2 connected_to both      odot      none dashed black
5   5    5  5 connected_to both      odot      none dashed black
39 39   18  1 connected_to both    normal      odot dashed black
40 40   18  5 connected_to both    normal      odot  solid black
41 41   18 18 connected_to both      odot      none  solid black
42 42   19  2 connected_to both      odot    normal  solid black
43 43   19 19 connected_to both      odot      none  solid black
68 68   18  2 connected_to both      none    normal dashed black
69 69   18  2 connected_to both    normal      odot  solid black
", header = TRUE)

library(DiagrammeR)
library(DiagrammeRsvg)
library(dplyr)

g <- create_graph(nodes_df = nodesdat, edges_df = edgesdat, directed = TRUE)

render_graph(g)

g2 <- g %>%
  add_global_graph_attrs(attr = "width",value = 0.5, attr_type = "node") %>%     #node size %>%
  add_global_graph_attrs(attr = "penwidth",value = 2, attr_type = "edge" )  %>%  #edge size
  set_node_position(node=nodesdat$id,x = positionsdat$x, positionsdat$y) 

Recebo o erro "Erro em !use_labels && !(node ​​%in% graph$nodes_df[, 1]) : 'length = 5' em coerção para 'logical(1)'" na linha set_node_position.

Este erro não acontece quando executo o código no R versão 4.0.2, mas atualizei para 4.4.2

Tenho dados parecidos com estes:

Tab4 <- read.table(text = "
  nodepair  `++`  `--`  `+-`  `-+`  `0+`  `+0`  `0-`  `-0`  `00` ES   
1 A1_A1        0     4     0     0     0     0     0     0    16 3    
2 A1_A1        0     5     0     0     0     0     0     0    16 4    
3 A1_A1        0     5     0     0     0     0     0     0    15 5    
", header = TRUE)

e escrevi este código para que cada grupo 'ES' seja comparado aos pares por nodepair:

ES_combs <- combn(unique(Tab4$ES), 2, simplify = FALSE)

Tab5 <- Tab4 %>%                            ########### compare every pair to eachother
  group_split(nodepair) %>% 
  map(.f = function(df) df %>%
        map(.x = 1:length(ES_combs),
            .f = ~df %>% 
              filter(ES %in% ES_combs[[.x]]) %>% 
              summarize(nodepair = first(nodepair),
                        ES_1 = ES[1],
                        ES_2 = ES[2], 
                        across(2:10, ~as.numeric(.))))) %>%
  bind_rows()

resultando nisso:

Tab5 <- read.table(text = "
  nodepair ES_1  ES_2   `++`  `--`  `+-`  `-+`  `0+`  `+0`  `0-`  `-0`  `00`
1 A1_A1    3     4         0     4     0     0     0     0     0     0    16
2 A1_A1    3     4         0     5     0     0     0     0     0     0    16
3 A1_A1    3     5         0     4     0     0     0     0     0     0    16
4 A1_A1    3     5         0     5     0     0     0     0     0     0    15
5 A1_A1    4     5         0     5     0     0     0     0     0     0    16
6 A1_A1    4     5         0     5     0     0     0     0     0     0    15    
", header = TRUE)

Isso funciona, mas demora muito quando estou comparando meu conjunto de dados completo. Eu esperava que houvesse um código mais eficaz. Suspeito que este aviso que recebo esteja expondo parte do problema:

Warning messages:
  1: Returning more (or less) than 1 row per `summarise()` group was deprecated in dplyr 1.1.0.
ℹ Please use `reframe()` instead.
ℹ When switching from `summarise()` to `reframe()`, remember that `reframe()` always returns an ungrouped
data frame and adjust accordingly.

mas não tenho certeza para onde ir a partir daqui.