R sử dụng combn với áp dụng

Sep 04 2020

Tôi có một khung dữ liệu có các giá trị phần trăm cho một số biến và quan sát, như sau:

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

Tôi cần chuẩn bị dữ liệu này dưới dạng danh sách cạnh để phân tích mạng, với "Trang web" là các nút và các biến còn lại là các cạnh. Kết quả sẽ như thế này:

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

Vì vậy, đối với "Trọng lượng", chúng tôi đang tính toán tổng của tất cả các cặp có thể và điều này riêng biệt cho từng cột (kết thúc bằng "Loại").

Tôi cho rằng câu trả lời cho điều này phải được sử dụng applytrên một combnbiểu thức, như ở đây Áp dụng hàm combn () cho khung dữ liệu , nhưng tôi vẫn chưa thể giải quyết được.

Tôi có thể làm tất cả điều này bằng cách lấy các kết hợp cho "Trang web"

sites <- combn(obs$Site, 2)

Sau đó, các cột riêng lẻ như vậy

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

và liên kết các tập dữ liệu đó với nhau, nhưng điều này rõ ràng sẽ sớm trở nên khó chịu.

Tôi đã cố gắng thực hiện tất cả các cột biến trong một lần như thế này

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

nhưng có một cái gì đó sai với điều đó. Ai có thể giúp tôi không?

Trả lời

2 StephenK Sep 04 2020 at 21:01

Một tùy chọn sẽ là tạo một hàm và sau mapđó hàm đó cho tất cả các cột mà bạn có.

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()
2 ThomasIsCoding Sep 04 2020 at 21:05

Đây là một ví dụ sử dụng 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
  )
)

cái nào cho

  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
1 YuriySaraykin Sep 04 2020 at 21:07

thử theo cách này

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