R โดยใช้ combn กับ Apply

Question

ฉันมีกรอบข้อมูลที่มีค่าเปอร์เซ็นต์สำหรับตัวแปรและการสังเกตจำนวนหนึ่งดังนี้:

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

ฉันจำเป็นต้องเตรียมข้อมูลนี้เป็นรายการขอบสำหรับการวิเคราะห์เครือข่ายโดยมี "ไซต์" เป็นโหนดและตัวแปรที่เหลือเป็นขอบ ผลลัพธ์ควรมีลักษณะดังนี้:

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

ดังนั้นสำหรับ "น้ำหนัก" เราจึงคำนวณผลรวมของคู่ที่เป็นไปได้ทั้งหมดและสิ่งนี้แยกกันสำหรับแต่ละคอลัมน์ (ซึ่งลงท้ายด้วย "Type")

ฉันคิดว่าคำตอบสำหรับสิ่งนี้จะต้องใช้applyกับcombnนิพจน์เช่นที่นี่การใช้ฟังก์ชัน combn () กับ data frameแต่ฉันยังไม่สามารถแก้ไขได้

ฉันสามารถทำทั้งหมดนี้ได้ด้วยการใช้ชุดค่าผสมสำหรับ "ไซต์"

sites <- combn(obs$Site, 2)

จากนั้นแต่ละคอลัมน์จะเป็นเช่นนั้น

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

และเชื่อมโยงชุดข้อมูลเหล่านั้นเข้าด้วยกัน แต่สิ่งนี้จะกลายเป็นเรื่องน่ารำคาญในไม่ช้า

ฉันได้พยายามทำคอลัมน์ตัวแปรทั้งหมดในครั้งเดียวเช่นนี้

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

แต่มีบางอย่างผิดปกติกับสิ่งนั้น ใครช่วยได้โปรด?

Answer 1

ทางเลือกหนึ่งคือสร้างฟังก์ชันจากนั้นmapฟังก์ชันนั้นให้กับคอลัมน์ทั้งหมดที่คุณมี

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

นี่คือตัวอย่างการใช้ 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
  )
)

ซึ่งจะช่วยให้

  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

ลองวิธีนี้

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