在多个内核上运行时,ergmm(latentnet)错误

时间:2018-10-01 00:20:37

标签: r networking doparallel

我尝试在多个内核上运行潜在空间模型。但是,会发生以下错误,但仅在与%dopar%并行使用时(仅使用%do%可以正常工作):

  

{的错误:
  任务1失败-“未找到ERGM术语'euclidean'初始化函数'InitErgmTerm.euclidean'。”

这是我的代码:

rm(list=ls())
#install.packages("MASS")
#install.packages("plyr")
#install.packages("latentnet")
#install.packages("spaMM")
library(foreach)
library(doParallel)
library(data.table)
library(plyr)
library(MASS)
library(igraph)
library(latentnet)

invlogit <- function(cc) exp(cc)/(1+exp(cc))
sim <- 1
gammaZ <- 0
gammaX <- 3  
##########################################
#  data genetation
##########################################
data_gen <- function(npeople, tau1){
dt.people <- data.table::data.table(ego = 1:npeople)
dt.people[, X :=  rnorm(npeople,0.5,1)]
dt.people[, Z := qt(pnorm(tau1*X),1)]
dt.people[, er := rnorm(npeople,0,1)]

# create dyads
dt.dyads <- data.table::as.data.table(expand.grid(ego=dt.people$ego,alter=dt.people$ego))
dt.dyads <- data.table::as.data.table(unique(t(apply(dt.dyads, 1,  sort))))
colnames(dt.dyads) <- c("ego","alter")

data.table::setnames(dt.people,c("alter","X2","Z2","er2"))
dt.dyads <- merge(dt.dyads,dt.people,by="alter")
data.table::setnames(dt.people,c("ego","X","Z","er"))
dt.dyads <- merge(dt.dyads,dt.people,by="ego")

distZ <- as.matrix(dist(dt.people$Z, diag=TRUE, upper=TRUE))
distX <- as.matrix(dist(dt.people$X, diag=TRUE, upper=TRUE))

adj.probs <- array(rbinom(length(distZ), 1, invlogit(0-gammaZ*distZ-   gammaX*distX)>0.3), dim(distZ))

diag(adj.probs) <- 0
adj.probs[lower.tri(adj.probs)] <- t(adj.probs)[lower.tri(adj.probs)]

# only keep dyads
alter_ego_friend <- which(adj.probs==1, arr.ind = TRUE) 

# generate network
net_all <- igraph::graph_from_adjacency_matrix(adj.probs)
net_all <- igraph::simplify(net_all, remove.multiple = T, remove.loops = T)
net_all <- igraph::set_vertex_attr(net_all,"name",index = igraph::V(net_all), dt.people$ego)
# set initial outcome value
dt.dyads[, outcome0 := rnorm(1,10,10) + er]
dt.people[, outcome0 := rnorm(1,10,10) + er]
## join dt.dyads with alter_ego_friend
net_all <- igraph::set_vertex_attr(net_all,"outcome0",index = igraph::V(net_all), dt.people$outcome0)
# retrieve list with neigbours per node from network
n1 <- igraph::neighborhood(net_all,1, as.character(dt.people[ego %in%  names(igraph::V(net_all)),]$ego))
# retrieve number of friends and outcome from network
dt.people[,N.friends := length(n1[[ego]])-1,by=ego]
dt.people[,N.outcome0 := sum(igraph::vertex_attr(net_all, "outcome0", n1[[ego]]))-outcome0,by=ego]
dt.people[,M := N.outcome0/N.friends]
dt.people[N.friends == 0, M := 0]

dt.people[,outcome1 :=  10 +  0.7*outcome0 + 1.3*Z + X  + 1.5*M + rnorm(1,0,10)]
net_all <- igraph::set_vertex_attr(net_all,"outcome1",index = igraph::V(net_all), dt.people$outcome1)
w <- igraph::as_adjacency_matrix(net_all,sparse = TRUE,type="both")
res_dat <- list(dat = dt.people, net=net_all, w_mat = w)
}

######### latent space model #########
latent_par <- function(dt.people4, weightmat){
  test.lat <- latentnet::ergmm(weightmat ~ euclidean(d = 2))
  dt.people4$U  <-  test.lat$mcmc.mle$Z[,1]
  dt.people4$U2 <-  test.lat$mcmc.mle$Z[,2]
  model_lat <- stats::glm(outcome1 ~ Z + U2 + U + M + outcome0,data=dt.people4)
  res_latent <- matrix(model_lat$coefficients,1)
  res_latent
}

######## print results ##########
results <- function(d1, wmat){
  res <- data.frame(latent = latent_par(d1,wmat))
  res
}

cl <- makeCluster(detectCores() - 1, type="PSOCK")
registerDoParallel(cl)
getDoParWorkers()
clusterExport(cl, ls())
system.time({
  r <- foreach(1:sim, .combine=rbind) %dopar% {
   dat1 <- data_gen(100, 0.7)
    results(dat1$dat, dat1$w_mat)
    }})

stopCluster(cl)

0 个答案:

没有答案