如何使用 r 中的 igraph 分别计算不同时期的网络度量？

Question

这是我的交易数据：

data:

id          from_id        to_id      amount    date_trx
<fctr>      <fctr>         <fctr>     <dbl>     <date>
0           7468           5695       700.0     2005-01-04
1           6213           9379       11832.0   2005-01-08
2           7517           8170       1000.0    2005-01-10
3           6143           9845       4276.0    2005-01-12
4           6254           9640       200.0     2005-01-14
5           6669           5815       200.0     2005-01-20
6           6934           8583       49752.0   2005-01-24
7           9240           8314       19961.0   2005-01-26
8           6374           8865       1000.0    2005-01-30
9           6143           6530       13.4      2005-01-31
...

我形成了在节点（帐户）from_id 和 to_id 之间形成边的网络，边的权重由它们的交易量决定。然后我计算了网络的度中心性、介数中心性、接近中心性等指标。

即：

relations <- data.frame(from = data$from_id, 
                        to = data$to_id)
network <- graph_from_data_frame(relations, directed = T)

E(network)$weight <- data$amount
V(network)$degree <- degree(network, normalized=TRUE)
V(network)$betweenness <- betweenness(network, normalized=TRUE)
V(network)$closeness <- closeness(network, normalized=TRUE)

但现在我想定期计算这些度量。例如，我想将我的数据按周划分（从第一个交易日期开始）并计算每个帐户对应周的网络度量。

data$week <- unsplit(tapply(data$date_trx, data$from_id, function(x) (as.numeric(x-min(data$trx_date)) %/% 7)+1),data$from_id)

select(data, from_id, to_id, date_trx, week, amount) %>% arrange(date_trx)

from_id       to_id      date_trx      week    amount
<fctr>        <fctr>     <date>        <dbl>   <dbl>
6644           6934       2005-01-01    1      700
6753           8456       2005-01-01    1      600
9242           9333       2005-01-01    1      1000
9843           9115       2005-01-01    1      900 
7075           6510       2005-01-02    1      400 
8685           7207       2005-01-02    1      1100   

...            ...        ...           ...    ...

9866           6697       2010-12-31    313    95.8
9866           5992       2010-12-31    313    139.1
9866           5797       2010-12-31    313    72.1
9866           9736       2010-12-31    313    278.9
9868           8644       2010-12-31    313    242.8
9869           8399       2010-12-31    313    372.2

由于我将数据划分为周期间，现在我需要分别形成每周的账户网络，以便我可以计算周期间账户的网络度量。我怎样才能一次完成 313 周？

Answer 1

一种可能性是根据周拆分数据，将每周转换为 igraph 对象，然后使用 lapply 一次将中心性和度数添加到所有图表。我的初始 data.frame 被命名为 d（见下文）：

library(igraph)

head(d)
  from_id to_id weight   date_trx
1       D     I      8 1999-09-12
2       E     H     10 1999-10-20
3       A     G     10 1999-09-10
4       C     G     13 1999-04-15
5       E     J      9 1999-06-26
6       B     F     15 1999-04-30

首先得到星期：

d$week <- strftime(d$date_trx, format = "%V")

现在按周划分：

dd <- split(d, d$week )

将每周转换为igraph

dd <- lapply(dd, function(x) graph_from_data_frame(x, directed = T))

编写一个函数来执行您想要执行的所有操作，然后将其应用于每个图形：

my.funct <- function(x) {
  V(x)$degree <- degree(x, normalized=TRUE)
  V(x)$betweenness <- betweenness(x, normalized=TRUE)
  V(x)$closeness <- closeness(x, normalized=TRUE)
  return(x)
}

dd <- lapply(dd, my.funct)

例如，第一周：

dd[[1]]
IGRAPH f515e52 DN-- 4 2 -- 
+ attr: name (v/c), degree (v/n), betweenness (v/n), closeness (v/n), weigth (e/n), date_trx
| (e/n), week (e/c)
+ edges from f515e52 (vertex names):
[1] B->F C->G



get.vertex.attribute(dd[[1]])
$name
[1] "B" "C" "F" "G"

$degree
[1] 0.3333333 0.3333333 0.3333333 0.3333333

$betweenness
[1] 0 0 0 0

$closeness
[1] 0.3333333 0.3333333 0.2500000 0.2500000



get.edge.attribute(dd[[1]])
$weight
[1] 9 7

$date_trx
[1] 10595 10601

$week
[1] "01" "01"

然后您可以检索所有周的所有中心性和度数：

ddd <- lapply(dd, function(x) igraph::as_data_frame(x, what = "vertices") )

# keep in mind that `split` names the objects in the list according to
# the value it used to split, therefore the name of the data.frames in
# the list is the name of the week.

library(dplyr)
ddd <- bind_rows(ddd, .id="week")

head(ddd)
  week name    degree betweenness closeness
1   01    E 1.4444444           0 0.2000000
2   01    D 1.5555556           0 0.1666667
3   01    B 0.7777778           0 0.2000000
4   01    A 1.0000000           0 0.2000000
5   01    C 0.7777778           0 0.1666667
6   01    F 1.0000000           0 0.1000000

以防万一，您可以使用它来合并回原始边列表。

本例中使用的数据：

set.seed(123)
d <- data.frame(from_id = sample(LETTERS[1:5], 2000, replace = T),
                to_id = sample(LETTERS[6:10], 2000, replace = T),
                weight = rpois(2000, 10),
                date_trx = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 2000, replace = T))