社交網絡和R中

Question

我試圖實現從物品的網絡核心 - 邊緣度量（聯繫：Borgatti & Everett 2000）遺傳算法在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，誰擁有健身芯法和分別爲2.3和1.1，FB。通過以概率1-Fa /（Fa + Fb）構造一個新矩陣C來構造矩陣，其中C_ {i} = A_ {i}以概率Fa /（Fa + Fb）或C_ {i} = B_ {i} ）。這只是繁殖基質的無限途徑之一。 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]