| Title: | A Dynamic Bipartite Latent Space Model to Analyse Irish Companies' Boards from 2003 to 2013 |
|---|---|
| Description: | Provides the dataset and an implementation of the method illustrated in Friel, N., Rastelli, R., Wyse, J. and Raftery, A.E. (2016) <DOI:10.1073/pnas.1606295113>. |
| Authors: | Riccardo Rastelli [aut, cre] |
| Maintainer: | Riccardo Rastelli <[email protected]> |
| License: | GPL-3 |
| Version: | 1.4 |
| Built: | 2025-02-19 03:28:06 UTC |
| Source: | https://github.com/cran/IrishDirectorates |
Provides the dataset and an implementation of the method illustrated in Friel, N., Rastelli, R., Wyse, J. and Raftery, A.E. (2016) <DOI:10.1073/pnas.1606295113>.
Riccardo Rastelli Maintainer: Riccardo Rastelli <[email protected]>
Friel, N., Rastelli, R., Wyse, J. and Raftery, A.E. (2016) <DOI:10.1073/pnas.1606295113>
Runs the Metropolis-within-Gibbs sampler on the given Dynamic Bipartite Latent Position Model (dblpm network).
dblpm_mcmc(network, niter, burnin, thin, x_var, w_var, gamma_var, beta_var, verbose = T)dblpm_mcmc(network, niter, burnin, thin, x_var, w_var, gamma_var, beta_var, verbose = T)
network |
A list identifying a dblpm network. |
niter |
Number of iterations after thinning and burnin. |
burnin |
Number of iterations to be discaded before starting the count for niter. The burnin iterations are not thinned. |
thin |
After burnin, keep one sampled observation every |
x_var |
Proposal variance for the positions of sender nodes. |
w_var |
Proposal variance for the positions of receiver nodes. |
gamma_var |
Proposal variance for the intercept gamma. |
beta_var |
Proposal variance for the intercept beta. |
verbose |
|
computing_time |
Number of seconds required for the sampling process. |
samples |
Sampled values for each of the model parameters. |
tail |
dblpm network sampled in the last iteration. |
data(IrishDirectoratesFit) IrishDirectoratesFit <- dblpm_mcmc(network = IrishDirectoratesFit$tail, niter = 3, burnin = 6, thin = 3, x_var = 4.75, w_var = 0.25, gamma_var = 1.825, beta_var = 0.2175, verbose = TRUE) # to replicate the results of the paper: niter = 10000, burnin = 500000, thin = 50data(IrishDirectoratesFit) IrishDirectoratesFit <- dblpm_mcmc(network = IrishDirectoratesFit$tail, niter = 3, burnin = 6, thin = 3, x_var = 4.75, w_var = 0.25, gamma_var = 1.825, beta_var = 0.2175, verbose = TRUE) # to replicate the results of the paper: niter = 10000, burnin = 500000, thin = 50
Evaluates the posterior value for a given Dynamic Bipartite Latent Position Model (dblpm network).
dblpm_posterior(network)dblpm_posterior(network)
network |
A list identifying a dblpm network. |
computing_time |
Number of seconds required for the evaluation. |
likelihood_value |
Likelihood value for the given network. |
posterior_value |
Posterior value for the given network. |
data(IrishDirectoratesFit) res <- dblpm_posterior(network = IrishDirectoratesFit$tail)data(IrishDirectoratesFit) res <- dblpm_posterior(network = IrishDirectoratesFit$tail)
Board composition for companies quoted on Irish Stock Exchange from 2003 to 2013. Board compositions are only observed at the end of each year.
data("IrishDirectoratesData")data("IrishDirectoratesData")
IrishDirectoratesData is a list containing:
edgelistthe edgelist for a bipartite dynamic network. Each row of this dataframe corresponds to an undirected edge in the network. For each row, the first entry identifies the time frame where the edge occurs, the second entry represents the director, whereas the third identifies the company. The presence of an edge at a certain time frame between a director and a company means that the director was part of the company's board at the end of the corresponding year.
yearslookup table for the time frame labels.
directors_nameslookup table for directors' names.
companies_nameslookup table for companies' names.
The adjacency cube can be constructed from the edgelist. Please see example for sample code.
Irish Stock Exchange (http://www.ise.ie/).
Friel, N., Rastelli, R., Wyse, J. and Raftery, A.E. (2016) <DOI:10.1073/pnas.1606295113>.
data(IrishDirectoratesData) attach(IrishDirectoratesData) N <- length(directors_names) M <- length(companies_names) tframes <- length(years) # construct the binary adjacency cube adj <- array(0,c(N,M,tframes)) for (l in 1:nrow(edgelist)) adj[edgelist[l,2],edgelist[l,3],edgelist[l,1]] = 1 dimnames(adj) = list(directors_names, companies_names, years) # calculate the degrees of directors and boards out_degrees <- apply(adj,c(1,3),sum) in_degrees <- apply(adj,c(2,3),sum) # create a binary matrix with ones corresponding to interlocked directors interlocked_directors <- ifelse(out_degrees > 1, 1, 0) # create a binary matrix with ones corresponding to interlocking companies interlocking_companies <- matrix(0,M,tframes) for (t in 1:tframes) for (i in 1:N) for (j in 1:M) if (adj[i,j,t] == 1) { if (interlocked_directors[i,t] > 0) interlocking_companies[j,t] = 1 } # extract labels of interlocking companies selected_companies <- which(rowSums(interlocking_companies) > 0) # extract labels of remaining active directors new_out_degrees <- apply(adj[,selected_companies,], c(1,3), sum) selected_directors <- which(rowSums(new_out_degrees) > 0) # create the new adjacency cube for the reduced data, as shown in the referenced paper adj_reduced <- adj[selected_directors, selected_companies, ]data(IrishDirectoratesData) attach(IrishDirectoratesData) N <- length(directors_names) M <- length(companies_names) tframes <- length(years) # construct the binary adjacency cube adj <- array(0,c(N,M,tframes)) for (l in 1:nrow(edgelist)) adj[edgelist[l,2],edgelist[l,3],edgelist[l,1]] = 1 dimnames(adj) = list(directors_names, companies_names, years) # calculate the degrees of directors and boards out_degrees <- apply(adj,c(1,3),sum) in_degrees <- apply(adj,c(2,3),sum) # create a binary matrix with ones corresponding to interlocked directors interlocked_directors <- ifelse(out_degrees > 1, 1, 0) # create a binary matrix with ones corresponding to interlocking companies interlocking_companies <- matrix(0,M,tframes) for (t in 1:tframes) for (i in 1:N) for (j in 1:M) if (adj[i,j,t] == 1) { if (interlocked_directors[i,t] > 0) interlocking_companies[j,t] = 1 } # extract labels of interlocking companies selected_companies <- which(rowSums(interlocking_companies) > 0) # extract labels of remaining active directors new_out_degrees <- apply(adj[,selected_companies,], c(1,3), sum) selected_directors <- which(rowSums(new_out_degrees) > 0) # create the new adjacency cube for the reduced data, as shown in the referenced paper adj_reduced <- adj[selected_directors, selected_companies, ]
Fitted Dynamic Bipartite Latent Position Model (dblpm) that serves as initialisation for the Metropolis-within-Gibbs algorithm
data("IrishDirectoratesFit")data("IrishDirectoratesFit")
The list IrishDirectoratesFit has one element called tail which contains the values for each of the model parameters.
Friel, N., Rastelli, R., Wyse, J. and Raftery, A.E. (2016) <DOI:10.1073/pnas.1606295113>.