如何转换二部网络并使用一层的节点属性作为 igraph (R) 中第二层的边权重

Question

Im trying right now to transfer a bipartite two-mode graph to its one-mode representation. The issue is that I want to conserve node atrributes from the two-mode graph to the one-mode representations. For example a dataframe is given by:

Person EventLocation DurationEvent Peter Bar 90 Jack Bar 90 Franz Train 20 Franz Bar 90 Laurie Train 20 Jack Train 20 ...

Now I want to get persons network using the igraph function bipartite_projection() on the Person and EventLocation columns but I see no ways how to presafe additional node attributes (duration) that might be transfer to edge weights between Persons, eg Peter-Jack with weight 90 or Franz-Laurie with weight 20.

Edit: I´ve added the last row to be more precise. The edge "Jack-Franz" would now correspond to 90+20 = 110. But basically my issue is just related how to implement a bipartite_projection which transfers the node attribute of a bipartite igraph-network to the correspoding edge attribute in the one-mode igraph-network.

Edit 2: I just added another example. First, I create a network among persons then I want to add the budget informations to the persons edges implying how much project budget did the both attracted together (the sum of budgets only from different unique projects as weights). Then I wanted to do some further weighted centrality calculations:

person_id <- c("X","Y","Z","Q","W","E","R","X","Y")
project <- c("a","b","c","a","a","b","c","b","a")
budget <- c(100,200,300,100,100,200,300,200,100)
employ.data <- data.frame(person_id, project, budget)
View(employ.data)
sna.complete.list <- employ.data
sna.list.complete.igraph.calc <- graph.data.frame(sna.complete.list)
V(sna.list.complete.igraph.calc)$type <- V(sna.list.complete.igraph.calc)$name%in%sna.complete.list$person_id
sna.list.complete.igraph.calc.one <- try(bipartite.projection(sna.list.complete.igraph.calc, type=V(sna.list.complete.igraph.calc)$type))
sna.statistics.persons <- sna.list.complete.igraph.calc.one[[2]]
plot.igraph(sna.statistics.persons)

EDIT3: I try to reformulate my concern:

Overall Goal: Get an weighted graph (edge values between nodes weighted with some values)

Outline/Data:

1. Data on people participating in different projects that differ in budget size

2. Convert bipartite connection graph (People-Project) to one-mode-People-People-graph

3. Use the budget sizes as weights for the edges between the people.

BUT for two people this value should only account for the sum of participating at unique projects. Thus, if A and B are only connected by project x of budget size 100 should result in an edge-weight of 100. If they also participate in another project with value 20, the result should be 120 etc.

I tried to transfer this information during using bipartite.projection but failed or couldn´t implement this information afterwards.

Answer 1

The bipartite_projection() can collect only structural weights of edges , that is to say, Peter and Jack are both affiliated to both Train and Bar. To handle edge -attributes is trickier.

If you only want to perserve the node -attributes, as you write above bipartite_projection() absolutely does that for you already. Just re-project and find your attributes preserved like so:

V(unipartite_graph)$your_attributee

If you need to preserve edge -attributes when re-projecting, however, there are several questions to ask before.

• How should multiple paths be treated when Franz-Train-Jack also has Franz-Bar_Jack?
• What role does directionality have in the calculation

I needed the exact same thing some years back, and solved it by writing my own extended re-projection function. It is perhaps not the shortest way around this, but calculates sums of a given edge-attribute by the shortest path between each unipartite-vertex-pair in the bipartite graph and returns an graph with one edge-attribute preserved (and summarised).

Note that the function does not calculate the unipartite Laurie-Peter. You could manipulate the function to your liking.

This reproduces your example data and applies my function

# Reproduce your data
df <- data.frame(Person = c("Peter","Jack","Franz","Franz","Laurie","Jack"),
                 EventLocation = c("Bar","Bar","Train","Bar","Train","Train"),
                 DurationEvent = c(90,90,20,90,20,20), stringsAsFactors = F)


## Make bipartite graph from example data
g <- graph_from_data_frame(df, directed=FALSE)
# Set vertex type using bipartite.mapping() (OBS type should be boolean for bipartite_projection())
V(g)$type <- bipartite.mapping(g)$type


## Plot Bipartite graph
E(g)$label <- E(g)$DurationEvent
V(g)$color <- ifelse(V(g)$type, "red", "yellow")
V(g)$size <- ifelse(V(g)$type, 40, 20)
plot(g, edge.label.color="gray", vertex.label.color="black")

# Function to reproject a bipartite graph to unipartite projection while
# calculating an attribute-value sum between reprojected vertecies.
unipartite_projection_attr <- function(graph_bi, attribute, projection=FALSE){

  ## Make initial unipartite projection
  graph_uni <- bipartite_projection(graph_bi, which=FALSE)

  ## List paths in bipartite-graph along which to summarise selected attribute
  el <- as_edgelist(graph_uni)
  el <- matrix(sapply(el, function(x) as.numeric(which(x == V(graph_bi)$name))), ncol=2)

  ## Function to summarise given atribute-value
  summarise_graph_attribute_along_path <- function(source, target, attribute){
    attr_value <- edge_attr(g, attribute)
    path <- get.shortest.paths(g, source, target, output="epath")$epath[[1]]
    sum(E(g)$DurationEvent[path])
  }

  attr_uni <- mapply(summarise_graph_attribute_along_path, el[,1], el[,2], attribute)
  graph_uni <- set_edge_attr(graph_uni, attribute, value=attr_uni)

  (graph_uni)
}

# Use function to make unipartite projection
gg <- unipartite_projection_attr(g, "DurationEvent", FALSE)

# Visualise
V(gg)$color <- "yellow"
E(gg)$label <- E(gg)$DurationEvent
plot(gg, edge.label.color="gray", vertex.label.color="black")

Best of luck

Answer 2

Heavily borrowing from @nGL's answer, I changed the code a bit to account for all the shortest paths between 2 Persons and taking their cumulative Event Duration as their edge weight in the projected graph.

Resulting graph looks like this (eg edge weight between Jack and Franz = 110):

One word of caution: this assumes that the original weights are equally distributed between Persons (ie Jack and Franz meet for 90 minutes in the Bar). In other situations, Jack and Franz might visit the same Bar but for Jack the Duation is 70 and for Franz it is 110. Then one would need to think about whether taking the average is appropriate or another measure (eg, min or max).

# Reproduce your data
df <- data.frame(Person = c("Peter","Jack","Franz","Franz","Laurie","Jack"),
                 EventLocation = c("Bar","Bar","Train","Bar","Train","Train"),
                 DurationEvent = c(90,90,20,90,20,20), stringsAsFactors = F)


## Make bipartite graph from example data
g <- graph_from_data_frame(df, directed=FALSE)
# Set vertex type using bipartite.mapping() (OBS type should be boolean for bipartite_projection())
V(g)$type <- bipartite.mapping(g)$type


## Plot Bipartite graph
E(g)$label <- E(g)$DurationEvent
V(g)$color <- ifelse(V(g)$type, "red", "yellow")
V(g)$size <- ifelse(V(g)$type, 40, 20)
plot(g, edge.label.color="gray", vertex.label.color="black")

# Function to reproject a bipartite graph to unipartite projection while
# calculating an attribute-value sum between reprojected vertecies.
unipartite_projection_attr <- function(graph_bi, attribute, projection=FALSE){
  
  ## Make initial unipartite projection
  graph_uni <- bipartite_projection(graph_bi, which=projection)
  
  ## List paths in bipartite-graph along which to summarise selected attribute
  el <- as_edgelist(graph_uni)
  el <- matrix(sapply(el, function(x) as.numeric(which(x == V(graph_bi)$name))), ncol=2)
  
  ## Function to summarise given atribute-value
  summarise_graph_attribute_along_path <- function(source, target, attribute){
    attr_value <- edge_attr(graph_bi, attribute)
    path <- lapply(get.all.shortest.paths(graph_bi, source, target)$res, function(x) E(g, path=x))
    sum(unlist(lapply(path, function (x) mean(attr_value[x]))))
  }
  
  attr_uni <- mapply(summarise_graph_attribute_along_path, el[,1], el[,2], attribute)
  graph_uni <- set_edge_attr(graph_uni, attribute, value=attr_uni)
  
  (graph_uni)
}

# Use function to make unipartite projection
gg <- unipartite_projection_attr(graph_bi = g, attribute = "DurationEvent", projection = FALSE)

# Visualise
V(gg)$color <- "yellow"
E(gg)$label <- E(gg)$DurationEvent
plot(gg, edge.label.color="gray", vertex.label.color="black")

FYI: I also changed the code at a few lines to ensure it is fully reproducable when using other attributes (eg, replacing E(g)$DurationEvent with attr_value)

Additional word of caution: if your graph already has a weight argument, you need to set weights = NA in get.all.shortest.paths(graph_bi, from = source, to = target, weights = NA)