R 中的社交网络和遗传算法

Question

我正在尝试从一篇文章中实现网络核心外围测量（链接：Borgatti & Everett 2000) in R。作者采用的基本方法是：

1. < 占据左上角。

2. 根据步骤 1 中的行/列排列创建理想模式矩阵

3. 评估两个矩阵之间的相关性

   >

根据作者的说法，第一步的技巧是找到与其诱导模式矩阵相关性最高的矩阵的行/列排列，他们建议使用遗传算法来找到最佳行/列排列。我陷入了算法的第一步：

1. 如何在 R 中创建随机行/列矩阵排列以保留列/行条目的顺序？

2. 一旦我评估了矩阵排列和模式矩阵之间的适合度，我如何基于“最适合”矩阵“培育”新的矩阵排列？

谢谢。

Answer 1

给定特定大小的矩阵，您可以生成随机的行/列矩阵排列。

#create fake data
mydata.block1 <- matrix (rep(1, times=100), ncol=10)
mydata.block2 <- matrix (rep(0, times=900), ncol=90)
mydata.block3 <- matrix (rep(0, times=900), ncol=10)
mydata.block4 <- matrix (rep(1, times=8100), ncol=90)

mydata <- rbind(cbind (mydata.block1, mydata.block2), cbind (mydata.block3, mydata.block4))

#Mix mydata
mix.order <- sample(1:dim (mydata)[1])
mydata <- mydata[mix.order,mix.order]

#create 100 random orderings

##preallocate matrix
rand.samp <- matrix (rep(NA, times=10000), ncol=100)
##create orderings
for (i in 1:100){
rand.samp[i,] <- sample(1:dim (mydata)[1])
}
##Eliminate duplicate orderings (unlikely to occur)
rand.samp <- unique (rand.samp)


#Reorder and measure fitness
##preallocate fitness measure
fit.meas <- rep (NA, times=100)

for (i in 1:100){
mydata.reordered <- mydata[rand.samp[i,],rand.samp[i,]]
fit.meas[i] <- myfitnessfunc(mydata.reordered)
}

在测量了适应度之后，您将需要某种方法来确定哪些区域对适应度有贡献，并在改变其他区域（“品种”）的同时修复这些区域。 ）。也许 dist() 会有一些用处。也许热图或聚类 hclust() 也有用？您能否提供有关如何确定局部适应性的更多详细信息？

Answer 2

OneWhoIsUnnamed 的响应与我解释您对#1 的需求相同。

这是两个邻接矩阵的基于适应度的重组方法，#2：

假设您有两个矩阵 A 和 B，它们的适应度核心 Fa 和 Fb 分别为 2.3 和 1.1。通过构造新矩阵 C 来培育矩阵，其中 C_{i} = A_{i} 的概率为 Fa/(Fa+Fb) 或 C_{i} = B_{i} 的概率为 1-Fa/(Fa+Fb ）。这只是无限的育种基质方式之一。 M是A和B基于适应度的配对结果。

# lets define a function to create random adjacency matrices
random_adjacent <- function(dimension)
{
    ret  <- matrix(runif(dimension^2)>0.5,dimension,dimension)
    retl <- ret * lower.tri(ret)
    return( retl + t(retl) )
}
# set fitness
Fa <- 2.3
Fb <- 1.1
# initialize matrices
A  <- random_adjacent(4)
B  <- random_adjacent(4)
# compute symmetric fitness probability matrix
C  <- matrix(runif(16)<Fa/(Fa+Fb),4,4)
Cl <- C * lower.tri(C) # take the lower triangular portion
C  <- Cl + t(Cl)       # reflect the lower triangular portion into the upper
# compute mated result
M  <- matrix(0,4,4)
M[C]  <- A[C]
M[!C] <- B[!C]