基于节点属性（权重）在网络中添加关系
Adding ties in a network based on node attribute (weight)
我正在使用 r 中的 igraph 模拟网络随时间的变化，并且正在寻找一种高效且可扩展的方式来对其进行编码以供商业使用。
网络变化的主要驱动力是：
- 新节点
- 新关系
- 新节点权重
在第一阶段，100个节点的网络中有10%是随机连接的。节点权重也是随机分配的。网络是无向的。有100个阶段。
在以下每个阶段：
- 十 (10) 个新节点随机出现并添加到模型中。他们在这个阶段没有联系。
- 这些新节点的节点权重是随机分配的。
- t+1时刻两个节点之间的新关系是网络中这些节点之间的网络距离和前一阶段（t时刻）节点权重的概率函数。网络距离较远的节点比距离较短的节点更不可能连接。衰减函数是指数函数。
- 权重大的节点比权重小的节点吸引更多的联系。节点权重与联系形成概率增加之间的关系应该是超线性的。
- 在每一步中，将现有关系总数的 10% 添加为前一点的函数。
- 前一阶段的网络联系和节点被继承（即网络是累积的）。
- 在每个阶段，节点权重最多可以随机更改其当前权重的 10%（即权重 1 可以在 t+1 中更改为 {0.9-1.1}）
- 每个阶段都需要保存网络
这怎么写？
编辑：这些网络将在稍后阶段根据许多图级特征进行检查
这是我现在拥有的，但不包括节点权重。我们如何有效地包含它？
# number of nodes and ties to start with
n = 100
p = 0.1
r = -2
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
#plot(net1)
write_graph(net1, paste0("D://network_sim_0.dl"), format="pajek")
for(i in seq(1,100,1)){
print(i)
time <- proc.time()
net1 <- read_graph(paste0("D://network_sim_",i-1,".dl"), format="pajek")
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, 10)
# get network distance for each dyad in net1 + the new nodes
spel <- data.table::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) +1
# assign a probability (?) with a exponential decay function. Smallest distance == greatest prob.
spel$prob <- -0.5 * spel$distance^r # is this what I need?
#hist(spel$prob, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
# lets sample new ties from this probability
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, size = new_ties, prob=spel$prob))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# save the network
write_graph(net2, paste0("D://network_sim_",i,".dl"), format="pajek")
print(proc.time()-time)
}
我会尽量回答这个问题，据我所知。
我做了几个假设；我应该澄清一下。
首先，节点权重会遵循什么分布？
如果您正在为自然发生的事件建模，则节点权重很可能服从正态分布。但是，如果事件是面向社会的，并且其他社会机制影响事件或事件流行度，则节点权重可能遵循不同的分布——很可能是权力分布。
主要是，这可能适用于与客户相关的行为。因此，考虑为节点权重建模的随机分布将对您有益。
对于以下示例，我使用正态分布为每个节点定义正态分布的值。在每次迭代结束时，我让节点权重变化到 %10 {.9,1.10}。
二、平局形成的概率函数是多少？
我们有两个用于决策的输入：距离权重和节点权重。因此，我们将使用这两个输入创建一个函数并定义概率权重。我的理解是，距离越小，可能性越大。然后节点权重越大，似然度越高。
这可能不是最好的解决方案，但我做了以下事情：
首先计算距离的衰减函数，称之为距离权重。然后，我获取节点权重并使用距离和节点权重创建超线性函数。
因此，您可以使用一些参数，看看是否能得到您想要的结果。
顺便说一句，我没有更改您的大部分代码。另外，我并没有过多关注处理时间。还有改进的空间。
library(scales)
library(stringr)
library(igraph)
# number of nodes and ties to start with
n <- 100
p <- 0.2
number_of_simulation <- 100
new_nodes <- 15 ## new nodes for each iteration
## Parameters ##
## How much distance will be weighted?
## Exponential decay parameter
beta_distance_weight <- -.4
## probability function parameters for the distance and node weights
impact_of_distances <- 0.3 ## how important is the distance weights?
impact_of_nodes <- 0.7 ## how important is the node weights?
power_base <- 5.5 ## how important is having a high score? Prefential attachment or super-linear function
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
# Assign normally distributed random weights
V(net1)$weight <- rnorm(vcount(net1))
graph_list <- list(net1)
for(i in seq(1,number_of_simulation,1)){
print(i)
time <- proc.time()
net1 <- graph_list[[i]]
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, new_nodes)
## Add random weights to new nodes from a normal distribution
V(net2)$weight[is.na(V(net2)$weight)] <- rnorm(new_nodes)
# get network distance for each dyad in net1 + the new nodes
spel <- reshape2::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) +1
# Do not select nodes if they are self-looped or have already link
spel <- spel[!spel$distance %in% c(0,1) , ]
# Assign distance weights for each dyads
spel$distance_weight <- exp(beta_distance_weight*spel$distance)
#hist(spel$distance_weight, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
## Get the node weights for merging the data with the distances
node_weights <- data.frame(id= 1:vcount(net2),node_weight=V(net2)$weight)
spel <- merge(spel,node_weights,by.x='node_j',by.y='id')
## probability is the function of distince and node weight
spel$prob <- power_base^((impact_of_distances * spel$distance_weight) + (impact_of_nodes * spel$node_weight))
spel <- spel[order(spel$prob, decreasing = T),]
# lets sample new ties from this probability with a beta distribution
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, new_ties, p = 1/spel$index ))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# change in the weights up to %10
V(net2)$weight <- V(net2)$weight*rescale(rnorm(vcount(net2)), to = c(0.9, 1.1))
graph_list[[i+1]] <- net2
print(proc.time()-time)
}
要获取结果或将图表写入 Pajek，您可以使用以下方法：
lapply(seq_along(graph_list),function(x) write_graph(graph_list[[x]], paste0("network_sim_",x,".dl"), format="pajek"))
编辑
要更改节点权重，可以使用以下语法。
library(scales)
library(stringr)
library(igraph)
# number of nodes and ties to start with
n <- 100
p <- 0.2
number_of_simulation <- 100
new_nodes <- 10 ## new nodes for each iteration
## Parameters ##
## How much distance will be weighted?
## Exponential decay parameter
beta_distance_weight <- -.4
## Node weights for power-law dist
power_law_parameter <- -.08
## probability function parameters for the distance and node weights
impact_of_distances <- 0.3 ## how important is the distance weights?
impact_of_nodes <- 0.7 ## how important is the node weights?
power_base <- 5.5 ## how important is having a high score? Prefential attachment or super-linear function
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
## MADE A CHANGE HERE
# Assign normally distributed random weights
V(net1)$weight <- runif(vcount(net1))^power_law_parameter
graph_list <- list(net1)
for(i in seq(1,number_of_simulation,1)){
print(i)
time <- proc.time()
net1 <- graph_list[[i]]
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, new_nodes)
## Add random weights to new nodes from a normal distribution
V(net2)$weight[is.na(V(net2)$weight)] <- runif(new_nodes)^power_law_parameter
# get network distance for each dyad in net1 + the new nodes
spel <- reshape2::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) + 2
# Do not select nodes if they are self-looped or have already link
spel <- spel[!spel$distance %in% c(0,1) , ]
# Assign distance weights for each dyads
spel$distance_weight <- exp(beta_distance_weight*spel$distance)
#hist(spel$distance_weight, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
## Get the node weights for merging the data with the distances
node_weights <- data.frame(id= 1:vcount(net2),node_weight=V(net2)$weight)
spel <- merge(spel,node_weights,by.x='node_j',by.y='id')
## probability is the function of distince and node weight
spel$prob <- power_base^((impact_of_distances * spel$distance_weight) + (impact_of_nodes * spel$node_weight))
spel <- spel[order(spel$prob, decreasing = T),]
# lets sample new ties from this probability with a beta distribution
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, new_ties, p = 1/spel$index ))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# change in the weights up to %10
V(net2)$weight <- V(net2)$weight*rescale(rnorm(vcount(net2)), to = c(0.9, 1.1))
graph_list[[i+1]] <- net2
print(proc.time()-time)
}
结果
因此，为了验证代码是否有效，我检查了有限节点的少量迭代：4 个节点的 10 次迭代。对于每次迭代，我添加了 3 个新节点和一个新领带。
我用三种不同的设置做了这个模拟。
第一个设置只关注距离的权重函数：距离越近的节点越有可能在它们之间形成新的关系
第二个设置只关注节点的权重函数：权重节点越多，与它们形成新关系的可能性就越大。
第三个设置关注距离和节点的权重函数：权重节点越多，距离越近，越有可能出现新的平局和他们一起成立。
请观察每个设置如何提供不同结果的网络行为。
- 只有距离很重要
只有节点权重重要
节点权重和距离都很重要
我正在使用 r 中的 igraph 模拟网络随时间的变化，并且正在寻找一种高效且可扩展的方式来对其进行编码以供商业使用。
网络变化的主要驱动力是：
- 新节点
- 新关系
- 新节点权重
在第一阶段，100个节点的网络中有10%是随机连接的。节点权重也是随机分配的。网络是无向的。有100个阶段。
在以下每个阶段：
- 十 (10) 个新节点随机出现并添加到模型中。他们在这个阶段没有联系。
- 这些新节点的节点权重是随机分配的。
- t+1时刻两个节点之间的新关系是网络中这些节点之间的网络距离和前一阶段（t时刻）节点权重的概率函数。网络距离较远的节点比距离较短的节点更不可能连接。衰减函数是指数函数。
- 权重大的节点比权重小的节点吸引更多的联系。节点权重与联系形成概率增加之间的关系应该是超线性的。
- 在每一步中，将现有关系总数的 10% 添加为前一点的函数。
- 前一阶段的网络联系和节点被继承（即网络是累积的）。
- 在每个阶段，节点权重最多可以随机更改其当前权重的 10%（即权重 1 可以在 t+1 中更改为 {0.9-1.1}）
- 每个阶段都需要保存网络
这怎么写？
编辑：这些网络将在稍后阶段根据许多图级特征进行检查
这是我现在拥有的，但不包括节点权重。我们如何有效地包含它？
# number of nodes and ties to start with
n = 100
p = 0.1
r = -2
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
#plot(net1)
write_graph(net1, paste0("D://network_sim_0.dl"), format="pajek")
for(i in seq(1,100,1)){
print(i)
time <- proc.time()
net1 <- read_graph(paste0("D://network_sim_",i-1,".dl"), format="pajek")
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, 10)
# get network distance for each dyad in net1 + the new nodes
spel <- data.table::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) +1
# assign a probability (?) with a exponential decay function. Smallest distance == greatest prob.
spel$prob <- -0.5 * spel$distance^r # is this what I need?
#hist(spel$prob, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
# lets sample new ties from this probability
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, size = new_ties, prob=spel$prob))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# save the network
write_graph(net2, paste0("D://network_sim_",i,".dl"), format="pajek")
print(proc.time()-time)
}
我会尽量回答这个问题，据我所知。
我做了几个假设；我应该澄清一下。
首先，节点权重会遵循什么分布？
如果您正在为自然发生的事件建模，则节点权重很可能服从正态分布。但是，如果事件是面向社会的，并且其他社会机制影响事件或事件流行度，则节点权重可能遵循不同的分布——很可能是权力分布。
主要是，这可能适用于与客户相关的行为。因此，考虑为节点权重建模的随机分布将对您有益。
对于以下示例，我使用正态分布为每个节点定义正态分布的值。在每次迭代结束时，我让节点权重变化到 %10 {.9,1.10}。
二、平局形成的概率函数是多少？
我们有两个用于决策的输入：距离权重和节点权重。因此，我们将使用这两个输入创建一个函数并定义概率权重。我的理解是，距离越小，可能性越大。然后节点权重越大，似然度越高。
这可能不是最好的解决方案，但我做了以下事情：
首先计算距离的衰减函数，称之为距离权重。然后，我获取节点权重并使用距离和节点权重创建超线性函数。
因此，您可以使用一些参数，看看是否能得到您想要的结果。
顺便说一句，我没有更改您的大部分代码。另外，我并没有过多关注处理时间。还有改进的空间。
library(scales)
library(stringr)
library(igraph)
# number of nodes and ties to start with
n <- 100
p <- 0.2
number_of_simulation <- 100
new_nodes <- 15 ## new nodes for each iteration
## Parameters ##
## How much distance will be weighted?
## Exponential decay parameter
beta_distance_weight <- -.4
## probability function parameters for the distance and node weights
impact_of_distances <- 0.3 ## how important is the distance weights?
impact_of_nodes <- 0.7 ## how important is the node weights?
power_base <- 5.5 ## how important is having a high score? Prefential attachment or super-linear function
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
# Assign normally distributed random weights
V(net1)$weight <- rnorm(vcount(net1))
graph_list <- list(net1)
for(i in seq(1,number_of_simulation,1)){
print(i)
time <- proc.time()
net1 <- graph_list[[i]]
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, new_nodes)
## Add random weights to new nodes from a normal distribution
V(net2)$weight[is.na(V(net2)$weight)] <- rnorm(new_nodes)
# get network distance for each dyad in net1 + the new nodes
spel <- reshape2::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) +1
# Do not select nodes if they are self-looped or have already link
spel <- spel[!spel$distance %in% c(0,1) , ]
# Assign distance weights for each dyads
spel$distance_weight <- exp(beta_distance_weight*spel$distance)
#hist(spel$distance_weight, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
## Get the node weights for merging the data with the distances
node_weights <- data.frame(id= 1:vcount(net2),node_weight=V(net2)$weight)
spel <- merge(spel,node_weights,by.x='node_j',by.y='id')
## probability is the function of distince and node weight
spel$prob <- power_base^((impact_of_distances * spel$distance_weight) + (impact_of_nodes * spel$node_weight))
spel <- spel[order(spel$prob, decreasing = T),]
# lets sample new ties from this probability with a beta distribution
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, new_ties, p = 1/spel$index ))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# change in the weights up to %10
V(net2)$weight <- V(net2)$weight*rescale(rnorm(vcount(net2)), to = c(0.9, 1.1))
graph_list[[i+1]] <- net2
print(proc.time()-time)
}
要获取结果或将图表写入 Pajek，您可以使用以下方法：
lapply(seq_along(graph_list),function(x) write_graph(graph_list[[x]], paste0("network_sim_",x,".dl"), format="pajek"))
编辑
要更改节点权重，可以使用以下语法。
library(scales)
library(stringr)
library(igraph)
# number of nodes and ties to start with
n <- 100
p <- 0.2
number_of_simulation <- 100
new_nodes <- 10 ## new nodes for each iteration
## Parameters ##
## How much distance will be weighted?
## Exponential decay parameter
beta_distance_weight <- -.4
## Node weights for power-law dist
power_law_parameter <- -.08
## probability function parameters for the distance and node weights
impact_of_distances <- 0.3 ## how important is the distance weights?
impact_of_nodes <- 0.7 ## how important is the node weights?
power_base <- 5.5 ## how important is having a high score? Prefential attachment or super-linear function
# build random network
net1 <- erdos.renyi.game(n, p, "gnp", directed = F)
## MADE A CHANGE HERE
# Assign normally distributed random weights
V(net1)$weight <- runif(vcount(net1))^power_law_parameter
graph_list <- list(net1)
for(i in seq(1,number_of_simulation,1)){
print(i)
time <- proc.time()
net1 <- graph_list[[i]]
# how many will we build in next stage?
new_ties <- round(0.1*ecount(net1), 0) # 10% of those in net1
# add 10 new nodes
net2 <- add_vertices(net1, new_nodes)
## Add random weights to new nodes from a normal distribution
V(net2)$weight[is.na(V(net2)$weight)] <- runif(new_nodes)^power_law_parameter
# get network distance for each dyad in net1 + the new nodes
spel <- reshape2::melt(shortest.paths(net2))
names(spel) <- c("node_i", "node_j", "distance")
# replace inf with max observed value + 1
spel$distance[which(!is.finite(spel$distance))] <- max(spel$distance[is.finite(spel$distance)]) + 2
# Do not select nodes if they are self-looped or have already link
spel <- spel[!spel$distance %in% c(0,1) , ]
# Assign distance weights for each dyads
spel$distance_weight <- exp(beta_distance_weight*spel$distance)
#hist(spel$distance_weight, freq=T, xlab="Probability of tie-formation")
#hist(spel$distance, freq=T, xlab="Network Distance")
## Get the node weights for merging the data with the distances
node_weights <- data.frame(id= 1:vcount(net2),node_weight=V(net2)$weight)
spel <- merge(spel,node_weights,by.x='node_j',by.y='id')
## probability is the function of distince and node weight
spel$prob <- power_base^((impact_of_distances * spel$distance_weight) + (impact_of_nodes * spel$node_weight))
spel <- spel[order(spel$prob, decreasing = T),]
# lets sample new ties from this probability with a beta distribution
spel$index <- seq_along(spel$prob)
to_build <- subset(spel, index %in% sample(spel$index, new_ties, p = 1/spel$index ))
net2 <- add_edges(net2, as.numeric(unlist(str_split(paste(to_build$node_i, to_build$node_j), " "))))
# change in the weights up to %10
V(net2)$weight <- V(net2)$weight*rescale(rnorm(vcount(net2)), to = c(0.9, 1.1))
graph_list[[i+1]] <- net2
print(proc.time()-time)
}
结果
因此，为了验证代码是否有效，我检查了有限节点的少量迭代：4 个节点的 10 次迭代。对于每次迭代，我添加了 3 个新节点和一个新领带。
我用三种不同的设置做了这个模拟。
第一个设置只关注距离的权重函数：距离越近的节点越有可能在它们之间形成新的关系
第二个设置只关注节点的权重函数：权重节点越多，与它们形成新关系的可能性就越大。
第三个设置关注距离和节点的权重函数：权重节点越多，距离越近，越有可能出现新的平局和他们一起成立。
请观察每个设置如何提供不同结果的网络行为。
- 只有距离很重要
只有节点权重重要
节点权重和距离都很重要