R mit combn mit apply

Question

Ich habe einen Datenrahmen mit Prozentwerten für eine Reihe von Variablen und Beobachtungen wie folgt:

obs <- data.frame(Site = c("A", "B", "C"), X = c(11, 22, 33), Y = c(44, 55, 66), Z = c(77, 88, 99))

Ich muss diese Daten als Kantenliste für die Netzwerkanalyse vorbereiten, mit "Site" als Knoten und den verbleibenden Variablen als Kanten. Das Ergebnis sollte folgendermaßen aussehen:

Node1    Node2    Weight  Type
A         B         33     X
A         C         44     X
...
B         C         187    Z       

Damit wir für "Gewicht" die Summe aller möglichen Paare berechnen, und dies separat für jede Spalte (die in "Typ" endet).

Ich nehme an, die Antwort darauf muss für applyeinen combnAusdruck verwendet werden, wie hier Anwenden der Funktion combn () auf den Datenrahmen , aber ich konnte es nicht ganz herausfinden.

Ich kann das alles von Hand machen, indem ich die Kombinationen für "Site" nehme.

sites <- combn(obs$Site, 2)

Dann mögen die einzelnen Spalten so

combA <- combn(obs$A, 2, function(x) sum(x)

und diese Datensätze zusammenzubinden, aber das wird offensichtlich sehr bald ärgerlich.

Ich habe versucht, alle variablen Spalten auf einmal so zu machen

b <- apply(newdf[, -1], 1, function(x){
sum(utils::combn(x, 2))
}
)

aber daran stimmt etwas nicht. Kann mir bitte jemand helfen?

Answer 1

Eine Möglichkeit wäre, eine Funktion und dann mapdiese Funktion für alle vorhandenen Spalten zu erstellen .

func1 <- function(var){
  obs %>% 
    transmute(Node1 = combn(Site, 2)[1, ],
           Node2 = combn(Site, 2)[2, ],
           Weight = combn(!!sym(var), 2, function(x) sum(x)),
           Type = var)
}

map(colnames(obs)[-1], func1) %>% bind_rows()

Answer 2

Hier ist ein Beispiel mit combn

do.call(
  rbind,
  combn(1:nrow(obs),
    2,
    FUN = function(k) cbind(data.frame(t(obs[k, 1])), stack(data.frame(as.list(colSums(obs[k, -1]))))),
    simplify = FALSE
  )
)

was gibt

  X1 X2 values ind
1  A  B     33   X
2  A  B     99   Y
3  A  B    165   Z
4  A  C     44   X
5  A  C    110   Y
6  A  C    176   Z
7  B  C     55   X
8  B  C    121   Y
9  B  C    187   Z

Answer 3

versuche es so

library(tidyverse)
obs_long <- obs %>% pivot_longer(-Site, names_to = "type")
sites <- combn(obs$Site, 2) %>% t() %>% as_tibble()
Type <- tibble(type = c("X", "Y", "Z"))

merge(sites, Type) %>% 
  left_join(obs_long, by = c("V1" = "Site", "type" = "type")) %>% 
  left_join(obs_long, by = c("V2" = "Site", "type" = "type")) %>% 
  mutate(res = value.x + value.y) %>% 
  select(-c(value.x, value.y))


  V1 V2 type res
1  A  B    X  33
2  A  C    X  44
3  B  C    X  55
4  A  B    Y  99
5  A  C    Y 110
6  B  C    Y 121
7  A  B    Z 165
8  A  C    Z 176
9  B  C    Z 187