input_data[[2]] <- y_list_all[[26]]
20000/12
install.packages('GERGM')
install.packages("GERGM")
install.packages("GERGM")
devtools::install_github("matthewjdenny/GERGM")
library(GERGM)
?gergm
?`nodematch-ergmTerm`
library(GERGM)
set.seed(12345)
data("lending_2005")
library(GERGM)
set.seed(12345)
data("lending_2005")
View(lending_2005)
data("covariate_data_2005")
View(covariate_data_2005)
data("net_exports_2005")
View(net_exports_2005)
plot_network(lending_2005)
plot_network(lending_2005)
data("lending_2005")
data("covariate_data_2005")
data("net_exports_2005")
plot_network(lending_2005)
test <- gergm(formula,
covariate_data = covariate_data_2005,
number_of_networks_to_simulate = 40000,
thin = 1/100,
proposal_variance = 0.05,
MCMC_burnin = 10000,
seed = 456,
convergence_tolerance = 0.5)
set.seed(12345)
data("lending_2005")
data("covariate_data_2005")
data("net_exports_2005")
plot_network(lending_2005)
formula <- lending_2005 ~ edges + mutual(alpha = 0.8) + sender("log_GDP") +
receiver("log_GDP") + nodemix("G8", base = "No") + netcov(net_exports_2005)
test <- gergm(formula,
covariate_data = covariate_data_2005,
number_of_networks_to_simulate = 40000,
thin = 1/100,
proposal_variance = 0.05,
MCMC_burnin = 10000,
seed = 456,
convergence_tolerance = 0.5)
# Generate Estimate Plot
Estimate_Plot(test)
# Generate Estimate Plot
?Estimate_Plot()
summary(test)
View(covariate_data_2005)
array(0, dim=c(3,5,5))
temp <- array(rnorm(75), dim=c(5,5,3))
temp
temp[,,4]
temp[,,3]
(temp[,,3] - mean(temp[,,3]))/sd(temp[,,])
(temp[,,3] - mean(temp[,,3]))/sd(temp[,,3])
(temp[,,3] - mean(temp[,,3]))/sd(temp[,,3])
library(ergm)
data(florentine)
summary(flomarriage ~ sender)
summary(flomarriage ~ sendersender(base=1))
summary(flomarriage ~ sender(base=1))
data(samplk)
summary(samplk1 ~ sender(base=1))
summary(samplk1 ~ edge + sender(base=1))
summary(samplk1 ~ edges + sender(base=1))
summary(samplk1 ~ edges + sender(base=2))
formula <- lending_2005 ~ edges + mutual(alpha = 0.8) + sender("log_GDP") + degree_atleast(threshold=5) +
receiver("log_GDP") + nodemix("G8", base = "No") + netcov(net_exports_2005)
library(GERGM)
set.seed(12345)
data("lending_2005")
data("covariate_data_2005")
data("net_exports_2005")
plot_network(lending_2005)
formula <- lending_2005 ~ edges + mutual(alpha = 0.8) + sender("log_GDP") + degree_atleast(threshold=5) +
receiver("log_GDP") + nodemix("G8", base = "No") + netcov(net_exports_2005)
test <- gergm(formula,
covariate_data = covariate_data_2005,
number_of_networks_to_simulate = 40000,
thin = 1/100,
proposal_variance = 0.05,
MCMC_burnin = 10000,
seed = 456,
convergence_tolerance = 0.5)
formula <- lending_2005 ~ edges + mutual(alpha = 0.8) + sender("log_GDP") +
receiver("log_GDP") + nodemix("G8", base = "No") + netcov(net_exports_2005)
test <- gergm(formula,
covariate_data = covariate_data_2005,
number_of_networks_to_simulate = 40000,
thin = 1/100,
proposal_variance = 0.05,
MCMC_burnin = 10000,
seed = 456,
convergence_tolerance = 0.5)
View(lending_2005)
View(covariate_data_2005)
s12 <- matrix(c(72.0694, 112.7418, 112.7418, 192.8651), byrow = T, nrow = 2)
s12 <- matrix(c(72.0694, 112.7418, 112.7418, 192.8651), byrow = T, nrow = 2)
s22 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s12
s22
s12 %*% solve(s22) %*% c(22,3)
s21 <- t(s12)
s11 - s12 %*% solve(s22) %*% s21
s11 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s12 <- matrix(c(72.0694, 112.7418, 112.7418, 192.8651), byrow = T, nrow = 2)
s22 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s21 <- t(s12)
s12 %*% solve(s22) %*% c(22,3)
s11 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s12 <- matrix(c(46.8667,  73.3160, 73.3160, 125.4201), byrow = T, nrow = 2)
s22 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s21 <- t(s12)
s12 %*% solve(s22) %*% c(22,3)
s11 - s12 %*% solve(s22) %*% s21
s11 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s12 <- matrix(c(35.8853, 56.1373, 56.1373, 96.0329), byrow = T, nrow = 2)
s22 <- matrix(c(114.8921, 179.7316, 179.7316, 307.4631), byrow = T, nrow = 2)
s21 <- t(s12)
mu <- s12 %*% solve(s22) %*% c(22,3)
V <- s11 - s12 %*% solve(s22) %*% s21
det(V)
log(det(V)) + t(c(20,3) - mu) %*% solve(V) %*% t(c(20,3) - mu)
log(det(V)) + t(c(20,3) - mu) %*% solve(V) %*% (c(20,3) - mu)
test <- read.table(file.choose())
View(test)
library(ergm)
data(florentine)
y <- as.matrix(flomarriage)
cal_g <- function(y){
edges <- 0
tri <- 0
for(i in 1:16){
for(j in i:16){
if(i < j) edges <- edges + y[i,j]
for(k in j:16){ tri <- tri + (y[i,j]*y[i,k]*y[j,k]) }
}
}
return(c(edges, tri))
}
cal_g(y)
summary(ergm(flomarriage ~ edges + triangles))
summary(flomarriage ~ edges + triangles))
summary(flomarriage ~ edges + triangles)
summary(ergm(flomarriage ~ edges + triangles))
summary(ergm(flomarriage ~ edges + triangles))
library(mvtnorm)
library(MASS)
library(plotly)
mu = c(20, 2)
Sigma = matrix (c(156.0500, 239.8816,239.8816, 413.8816), 2, 2) # var-covariance matrix
Sigma
density <- dmvnorm(mu, mean = mu, sigma = Sigma)
density
sum(c(1.7797e-01, 1.7100e-01, 1.7100e-01, 1.6451e-01, 1.3553e-01, 6.0344e-02,
3.8338e-02, 1.3725e-02, 1.4206e-03, 2.3523e-03, 4.4996e-03, 1.6787e-02,
7.1169e-03, 1.4352e-02, 5.7106e-03, 6.7403e-04, 5.5295e-03, 4.1394e-03,
2.3712e-03, 2.6243e-03))
sum(c(1.4862e-01, 1.5467e-01, 1.5467e-01, 1.5355e-01, 1.3937e-01, 7.6212e-02,
5.2445e-02, 2.1655e-02, 2.8482e-03, 4.4932e-03, 8.0712e-03, 2.5599e-02,
1.1494e-02, 1.8095e-02, 8.8902e-03, 1.2670e-03, 7.4039e-03, 5.7194e-03,
2.5577e-03, 2.3720e-03))
c
mu = c(20, 3)
Sigma = matrix (c(156.0500, 239.8816,239.8816, 413.8816), 2, 2) # var-covariance matrix
density <- dmvnorm(mu, mean = mu, sigma = Sigma)
mu %*% t(mu0
mu %*% t(mu)
mu %*% t(mu)
library(ergm)
data(florentine)
y <- as.matrix(flomarriage)
cal_g <- function(y){
edges <- 0
tri <- 0
for(i in 1:16){
for(j in i:16){
if(i < j) edges <- edges + y[i,j]
for(k in j:16){ tri <- tri + (y[i,j]*y[i,k]*y[j,k]) }
}
}
return(c(edges, tri))
}
cal_g(y)
holder <- matrix(0, nrow=40, ncol=2)
schedule <- seq(0.01,0.4,length.out=40)
y_cur <- y
holder[1,] <- cal_g(y_cur)
for(iter in 1:39){
prob_cur <- y_cur*(1-schedule[iter]) + 0.5*schedule[iter]
y_new <- matrix(0,nrow=16,ncol=16)
for(i in 1:16){
for(j in 1:16){
if(i < j){ y_new[i,j] <- rbinom(1,1,prob_cur[i,j]); y_new[j,i] <- y_new[i,j] }
}
}
holder[iter+1,] <- cal_g(y_new)
y_cur <- y_new
}
rm(y, y_cur, y_new, prob_cur, i, j, schedule)
cov_list <- list()
eta <- c(0,0)
for(iter in 40:2){
output <- simulate(network(16, directed=FALSE) ~ edges+triangles, coef=eta, nsim=200, output="stats")
cov_list[[41-iter]] <- cov(output)
eta_new <- eta + c( solve(cov(output)) %*% (holder[iter-1,] - colMeans(output)) )
eta <- eta_new
}
library(ergm)
data(florentine)
y <- as.matrix(flomarriage)
cal_g <- function(y){
edges <- 0
tri <- 0
for(i in 1:16){
for(j in i:16){
if(i < j) edges <- edges + y[i,j]
for(k in j:16){ tri <- tri + (y[i,j]*y[i,k]*y[j,k]) }
}
}
return(c(edges, tri))
}
cal_g(y)
holder <- matrix(0, nrow=40, ncol=2)
schedule <- seq(0.01,0.2,length.out=20)
y_cur <- y
holder[1,] <- cal_g(y_cur)
for(iter in 1:39){
prob_cur <- y_cur*(1-schedule[iter]) + 0.5*schedule[iter]
y_new <- matrix(0,nrow=16,ncol=16)
for(i in 1:16){
for(j in 1:16){
if(i < j){ y_new[i,j] <- rbinom(1,1,prob_cur[i,j]); y_new[j,i] <- y_new[i,j] }
}
}
holder[iter+1,] <- cal_g(y_new)
y_cur <- y_new
}
library(ergm)
data(florentine)
y <- as.matrix(flomarriage)
cal_g <- function(y){
edges <- 0
tri <- 0
for(i in 1:16){
for(j in i:16){
if(i < j) edges <- edges + y[i,j]
for(k in j:16){ tri <- tri + (y[i,j]*y[i,k]*y[j,k]) }
}
}
return(c(edges, tri))
}
cal_g(y)
holder <- matrix(0, nrow=20, ncol=2)
schedule <- seq(0.01,0.2,length.out=20)
y_cur <- y
holder[1,] <- cal_g(y_cur)
for(iter in 1:19){
prob_cur <- y_cur*(1-schedule[iter]) + 0.5*schedule[iter]
y_new <- matrix(0,nrow=16,ncol=16)
for(i in 1:16){
for(j in 1:16){
if(i < j){ y_new[i,j] <- rbinom(1,1,prob_cur[i,j]); y_new[j,i] <- y_new[i,j] }
}
}
holder[iter+1,] <- cal_g(y_new)
y_cur <- y_new
}
rm(y, y_cur, y_new, prob_cur, i, j, schedule)
cov_list <- list()
eta <- c(0,0)
for(iter in 20:2){
output <- simulate(network(16, directed=FALSE) ~ edges+triangles, coef=eta, nsim=200, output="stats")
cov_list[[41-iter]] <- cov(output)
eta_new <- eta + c( solve(cov(output)) %*% (holder[iter-1,] - colMeans(output)) )
eta <- eta_new
}
cov_list
library(ergm)
data(florentine)
y <- as.matrix(flomarriage)
cal_g <- function(y){
edges <- 0
tri <- 0
for(i in 1:16){
for(j in i:16){
if(i < j) edges <- edges + y[i,j]
for(k in j:16){ tri <- tri + (y[i,j]*y[i,k]*y[j,k]) }
}
}
return(c(edges, tri))
}
cal_g(y)
holder <- matrix(0, nrow=20, ncol=2)
schedule <- seq(0.01,0.2,length.out=20)
y_cur <- y
holder[1,] <- cal_g(y_cur)
for(iter in 1:19){
prob_cur <- y_cur*(1-schedule[iter]) + 0.5*schedule[iter]
y_new <- matrix(0,nrow=16,ncol=16)
for(i in 1:16){
for(j in 1:16){
if(i < j){ y_new[i,j] <- rbinom(1,1,prob_cur[i,j]); y_new[j,i] <- y_new[i,j] }
}
}
holder[iter+1,] <- cal_g(y_new)
y_cur <- y_new
}
rm(y, y_cur, y_new, prob_cur, i, j, schedule)
cov_list <- list()
eta <- c(0,0)
for(iter in 20:2){
output <- simulate(network(16, directed=FALSE) ~ edges+triangles, coef=eta, nsim=200, output="stats")
cov_list[[21-iter]] <- cov(output)
eta_new <- eta + c( solve(cov(output)) %*% (holder[iter-1,] - colMeans(output)) )
eta <- eta_new
}
eta
summary(ergm(flomarriage ~ edges + triangles))
eta
cov_list
cov(holder)
choose(5,5)
library(CPDstergm)
sqrt
sqrt(0.01)
sqrt(0.)
sqrt(0.1)
(0.04 + 0.1 + 0.02)/3
(0.09 + 0.22 + 0.003)/3
v <- matrix(rnorm(100*4),nrow=100, ncol=4)
dim(v)
gamma <- v[1,]
beta <- matrix(0, nrow=99, ncol=4)
for(i in 1:99){
beta[i,] <- v[i+1,]-v[i,]
}
beta[1,]
v[1:2,]
v[2,]-v[1,]
x <- matrix(0,nrow=100,ncol=99)
x <- matrix(0,nrow=100,ncol=99)
for(i in 1:100){
for(j in 1:99){
if(i > j) x[i,j] <- 1
}
}
dim(x)
dim(beta)
x_beta = x %*% beta
head(x_beta)
head(v)
matrix(1,nrow=100,ncol1)
matrix(1,nrow=100,ncol=1)
matrix(1,nrow=100,ncol=1)*gamma
matrix(1,nrow=100,ncol=1) %*% gamma
matrix(1,nrow=100,ncol=1) %*% gamma
v <- matrix(rnorm(100*4),nrow=100, ncol=4)
gamma <- v[1,]
beta <- matrix(0, nrow=99, ncol=4)
gamma <- v[1,]
beta <- matrix(0, nrow=99, ncol=4)
for(i in 1:99){
beta[i,] <- v[i+1,]-v[i,]
}
x <- matrix(0,nrow=100,ncol=99)
for(i in 1:100){
for(j in 1:99){
if(i > j) x[i,j] <- 1
}
}
x_beta = matrix(1,nrow=100,ncol=1) %*% gamma + x %*% beta
head(v)
head(x_beta)
View(x)
v <- matrix(rnorm(100*4),nrow=100, ncol=4)
gamma <- v[1,]
beta <- matrix(0, nrow=99, ncol=4)
for(i in 1:99){
beta[i,] <- v[i+1,]-v[i,]
}
x <- matrix(0,nrow=100,ncol=99)
for(i in 1:100){
for(j in 1:99){
if(i > j) x[i,j] <- 1
}
}
x_beta = matrix(1,nrow=100,ncol=1) %*% gamma + x %*% beta
head(v);head(x_beta)
v <- matrix(rnorm(100*4),nrow=100, ncol=4)
gamma <- v[1,]
beta <- matrix(0, nrow=99, ncol=4)
for(i in 1:99){
beta[i,] <- v[i+1,]-v[i,]
}
x <- matrix(0,nrow=100,ncol=99)
for(i in 1:100){
for(j in 1:99){
if(i > j) x[i,j] <- 1
}
}
View(x)
View(x)
x[95:100,95:99]
x[1:5,1:%]
x[1:5,1:5]
x[95:100,95:99]
seq(1,100,by=2)
test = seq(1,100,by=2)
which(test == 27)
which(test == 25)
which(test == 51)
which(test == 49)
which(test == 75)
which(test == 777)
which(test == 77)
t1 <- c(0.04829523, 0.03370712, 0.03191759, 0.14852995, 0.13260822, 0.05286577,
0.07354052, 0.06341308, 0.29579365, 0.23495623, 0.05774909, 0.03914339,
0.04865481, 0.06832256, 0.11914399, 0.06557712, 0.06770283, 0.03022665,
0.04683429, 0.07816365, 0.06011788, 0.08447211, 0.04934229, 0.66248995,
1.8609697, 0.05557026, 0.03616103, 0.03538253, 0.07504214, 0.04861293,
0.04497394, 0.05267814, 0.04527733, 0.05555185, 0.04420725, 0.0656525,
0.06579246, 0.0730993, 0.05005317, 0.04983377, 0.07247024, 0.07761799,
0.04140697, 0.06336141, 0.05090606, 0.04253986, 0.04590825, 0.05819613,
0.06651331, 0.9152578, 0.11857651, 0.08705562, 0.04757683, 0.04092372,
0.03336564, 0.05526538, 0.06266876, 0.08954296, 0.05362024, 0.06334446,
0.04341932, 0.0570527, 0.05166741, 0.05080192, 0.11178593, 0.11073406,
0.02785043, 0.07669766, 0.06208089, 0.03320793, 0.0264291, 0.03390304,
0.05611379, 0.05349701, 1.1547698, 0.02854473, 0.05522152, 0.04648184,
0.06378458, 0.08748868, 0.06284118, 0.03900947, 0.04584656, 0.08662048,
0.04669708, 0.04633844, 0.05619528, 0.03691754, 0.05138377, 0.05655726,
0.08391093, 0.06701378, 0.03455441, 0.05048372, 0.04216522, 0.04638223,
0.03852563, 0.0414434, 0.03090671)
t2 <- c(0.6788417, 0.5083323, 0.36999276, 0.7753989, 0.5283993, 0.6903808,
3.254796, 0.51743186, 4.8320303, 2.386005, 0.4798491, 0.93909377,
1.5864683, 0.30843604, 3.4804049, 0.36488006, 0.67040634, 0.7393992,
3.3121986, 0.38207185, 0.35259116, 0.27862957, 0.38700244, 2.0364108,
11.572213, 0.24474941, 0.6343682, 0.35765728, 1.0704255, 1.2477112,
2.2156048, 0.30888018, 0.2772028, 1.2373465, 0.30698082, 0.4586882,
0.7920391, 1.0434561, 0.48489377, 0.26479715, 3.635516, 0.33476433,
0.36185282, 0.4305883, 0.44207197, 0.34899658, 0.32418787, 0.3681082,
0.18692632, 8.094489, 0.6036593, 0.97388935, 0.5604748, 0.45199633,
4.1498466, 0.37314034, 0.49348262, 2.7074277, 0.6933442, 0.40921655,
0.5846872, 0.5147775, 0.48254135, 5.0917053, 0.45473474, 0.20754421,
1.1486979, 0.4675127, 2.2295876, 0.6555717, 1.0096756, 0.4886245,
0.8080836, 0.45067203, 6.8908114, 0.19715683, 0.25242692, 0.8355674,
0.42864332, 0.8804361, 0.3787648, 0.46983433, 0.38911495, 0.53986955,
0.22235599, 3.8977609, 0.4606311, 0.24020448, 1.7574425, 0.44777113,
0.41546053, 0.23959345, 3.7582765, 0.30329096, 0.27459487, 0.80068135,
0.30330974, 0.24329542, 0.19530587)
mean(t1)
mean(t1)
sd(t1)
mean(t2)
sd(t2)
mean(t1)/sd(t1)
mean(t2)/sd(t2)
sd(t1)/mean(t1)
sd(t2)/mean(t2)
?read_excel
install.package('clue')
install.packages('clue')
library(clue)
# Assuming 'labels_t' and 'labels_tp1' are vectors of community labels at time t and t+1
labels_t <- c(1, 2, 3, 1, 2)  # Example community labels at time t
labels_tp1 <- c(2, 3, 1, 2, 1)  # Example community labels at time t+1
# Compute Hamming distance between the label vectors
hamming_distance <- sum(labels_t != labels_tp1)
# Create a matrix of costs based on the Hamming distance
cost_matrix <- matrix(ifelse(outer(labels_t, labels_tp1, "=="), 0, 1), nrow = length(labels_t))
View(cost_matrix)
# Solve the assignment problem to minimize total cost
library(clue)
assignment <- solve_LSAP(cost_matrix)
# Get the matched indices
matched_indices <- assignment$col_ind
assignment
c(assignment)
assignment[0]
assignment[1]
# Get the matched indices
matched_indices <- c(assignment)
# Create a mapping of nodes from time t to time t+1
node_mapping <- data.frame(Node_t = 1:length(labels_t), Node_tp1 = matched_indices)
# Print the node mapping
print(node_mapping)
# Assuming 'labels_t' and 'labels_tp1' are vectors of community labels at time t and t+1
labels_t <- c(1, 1, 1, 2, 2)  # Example community labels at time t
labels_tp1 <- c(2, 2, 2, 1, 1)  # Example community labels at time t+1
# Compute Hamming distance between the label vectors
hamming_distance <- sum(labels_t != labels_tp1)
# Create a matrix of costs based on the Hamming distance
cost_matrix <- matrix(ifelse(outer(labels_t, labels_tp1, "=="), 0, 1), nrow = length(labels_t))
# Solve the assignment problem to minimize total cost
library(clue)
assignment <- solve_LSAP(cost_matrix)
# Get the matched indices
matched_indices <- c(assignment)
# Create a mapping of nodes from time t to time t+1
node_mapping <- data.frame(Node_t = 1:length(labels_t), Node_tp1 = matched_indices)
# Print the node mapping
print(node_mapping)
assignment
?solve_LSAP
setwd("/Users/allen/Downloads/R_code")
