## 2. MULTIPLEX SOCIAL NETWORKS ------------------------------------------------ ## Load the multiplex package library("multiplex") ## Load data set 'incC' and look at the data structure data("incC") str(incC) ## Load "multigraph" library("multigraph") ## Plot 'incC' as a multigraph scp <- list(cex = 3, vcol = 8, bwd = 0.5, pos = 0, fsize = 7) multigraph(incC, layout = "force", seed = 123, scope = scp) ## Assign social relations in 'incC' in object 'netC', and perform the bundle census netC <- incC$net[ , , 1:3] bundle.census(netC) ## Export the bundle classes of 'netC' as a tex file summaryBundles(bundles(netC), latex = TRUE, file = "./bundles.tex") ## Obtain the tie exchange ties as pairwise list rel.sys(netC, type="tolist", bonds="txch")$Ties ## Obtain the tie entrainment ties as array rel.sys(netC, type="toarray", bonds="tent") ## Ties with a mutual character are *strong* bonds identical( rel.sys(netC, type = "toarray", bonds = c("recp", "txch", "mixd")), rel.sys(netC, type = "toarray", bonds = "strong") ) ## Plot the system of strong bonds in 'netC' as undirected multigraph (PICTURE NOT INCLUDED) multigraph(rel.sys(netC, bonds = "strong")$Ties, directed = FALSE) ## Select one component of 'netC' and record it in 'nCc' nCc <- rel.sys(netC, type = "toarray", sel = comps(netC)$com[[3]]) ## Look at the unique string relation in 'nCc' strings(nCc) ## Look at the equations in 'nCc' of compounds equal and less than 3 strings(nCc, equat = TRUE, k = 3)$equat ## Construct the semigroup of 'nCc' with a numerical format semigroup(nCc, type = "numerical")$S ## Construct the partial order table of string relations in 'nCc' partial.order(strings(nCc), type = "strings") ### 2.5 Positional analysis ## Two ways to specify a person hierarchy from Relation-Box hierar(rbox(nCc), 1, type = "person") hierar(rbox(nCc), "339", type = "person") ## Cumulated person hierarchy (CPH) in Relation-Box of 'nCc' cph(rbox(nCc)) ## Assign the Relation-Box and CPH of 'netC' into objects 'netCrb' and 'netCcph' netCrb <- rbox(netC, transp = TRUE) netCcph <- cph(netCrb) ## Plot the CPH of 'netC' with and without incomparable elements ## (requires to install Rgraphviz from Bioconductor) library("Rgraphviz") diagram(netCcph) diagram(netCcph, incmp = FALSE) ## Assign the clustering information in 'cls' cls <- c(2, 3, 3, 3, 2, 1, 3, 3, 3, 3, 2, 3, 2, 2, 1, 2, 2, 3, 3, 3, 2, 1) ## Clustering information as table as.table(rbind(dimnames(netCcph)[[1]], cls)) ## Permutation of CPH with 'cls' perm(netCcph, clu = cls) ### 2.6 Algebraic constraints ## Positional system of 'netC' netCps <- reduc(netC, clu = cls) ## Role table with a symbolic format netCS <- semigroup(netCps, type = "symbolic") netCS ## Plot the Cayley graph of the role structure in 'netCS' scpc <- list(cex = 4, vcol = 8, lwd = 3, ecol = 1, fsize = 9, pos = 0) ccgraph(netCS, seed = 1, scope = scpc) ## Set of equations strings(netCps, equat = TRUE, k = 3)$equat ## Hierarchy structure of string relations netCst <- strings(netCps) netCpo <- partial.order(netCst, type = "strings") diagram(netCpo) ### 2.7 Decomposition ## Decomposition of abstract semigroup through congruence classes decomp(netCS, cngr(netCS, uniq = TRUE), type = "cc")$clu ## Decomposition of partially ordered semigroup through factorization decomp(netCS, pi.rels(fact(netCS, netCpo)), type = "mca")$clu ## 3. SIGNED NETWORKS ---------------------------------------------------------- ## Make 'nCc' as a signed network signed(nCc) ## Another way to make 'nCc' as a signed network signed(nCc[ , , 2], nCc[ , , 1]) ## The formal arguments of the semiring function formals(semiring) ## Assign two relations of 'netC' into 'netC2' netC2 <- netC[ , , c(1, 3)] ## Plot the signed structure with the costumized scope multigraph(rm.isol(netC2), signed = TRUE, layout = "force", seed = 1, scope = scp) ## Components and isolates of signed structure comps(netC2) ## Select large component sel <- which(dimnames(netC2)[[1]] %in% comps(netC2)$com[[1]]) ## Assign the large component in 'netC2' into Signed class object 'netCsg' netCsg <- signed(netC2[sel, sel, ]) netCsg ## Symmetric closure in signed structure semiring(netCsg, symclos = TRUE, k = 1)$Q ## The balance semiring structure with default values semiring(netCsg, type = "balance")$Q ## The balance semiring structure without symmetric closure semiring(netCsg, type = "balance", symclos = FALSE)$Q ## The balance semiring structure with semipaths of length 3 semiring(netCsg, type = "balance", k = 3)$Q ## Checking for balamced structure with cluster semiring operations identical( semiring(netCsg, type = "cluster", k=4, symclos=FALSE)$Q, semiring(netCsg, type = "cluster", k=5, symclos=TRUE)$Q ) ## The cluster semiring structure without symmetric closure and paths of length 4 semiring(netCsg, type = "cluster", k = 4, symclos = FALSE)$Q ## 4. AFFILIATION NETWORKS ----------------------------------------------------- ## Construct the data frame 'G20' with different affiliations of the actors in the rownames G20 <- data.frame( P5 = c(0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1), G4 = c(0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0), G7 = c(0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1), BRICS = c(0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0), MITKA = c(0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0), DAC = c(0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1), OECD = c(0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1), Cwth = c(0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0), N11 = c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0) ) rownames(G20) <- c("ARG", "AUS", "BRA", "CAN", "CHN", "FRA", "DEU", "IND", "IDN", "ITA", "JPN", "KOR", "MEX", "RUS", "SAU", "ZAF", "TUR", "GBR", "USA") ## Assign cluster information for "events" ec <- c(1, 1, 2, 0, 1, 2, 1, 1, 1) ## Assign cluster information for "actors" ac <- c(0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1) ac <- replace(ac, ac == 0, "Emerging") ac <- replace(ac, ac == 1, "Advanced") ac ## Depict 'G20' as clustered bipartite graph and as a graph with force-directed layout bmgraph(G20, layout = "bipc", clu = list(ac, ec), cex = 5, fsize = 8) bmgraph(G20, layout = "force", seed = 321, vcol = 8, cex = 3, fsize = 8) ## Obtain the Galois derivations of 'G20' galois(G20) ## Obtain the Galois derivations of 'G20' with a reduced labeling galois(G20, labeling = "reduced") ## Assign the Galois derivations of 'G20' with a reduced labeling into 'G20gc' G20gc <- galois(G20, labeling = "reduced") ## Look at the partial order structure of 'G20gc' partial.order(G20gc, type = "galois", lbs = paste0("c", seq(1, 25))) ## The partial order structure of the Concept lattice G20po <- partial.order(G20gc, type = "galois") diagram(G20po) ## Look at the principal filter of the thrid concept of 'G20po' fltr(3, G20po) ## Look at the principal ideal of a set of concepts in 'G20po' fltr(c("G7", "BRICS"), G20po, ideal = TRUE) ## PLOTS GENERATION ------------------------------------------------------------ pdf("./figures.pdf") multigraph(incC, layout = "force", seed = 123, scope = scp) diagram(netCcph) diagram(netCcph, incmp = FALSE) ccgraph(netCS, seed = 1, scope = scpc, hds=.75) diagram(netCpo) multigraph(rm.isol(netC2), signed = TRUE, layout = "force", seed = 1, scope = scp) bmgraph(G20, layout = "bipc", clu = list(ac, ec), cex = 5, fsize = 8) bmgraph(G20, layout = "force", seed = 321, vcol = 8, cex = 3, fsize = 8) diagram(G20po) dev.off() summaryBundles(bundles(netC), latex = TRUE, file = "./bundles.tex") tools::texi2pdf(file = "./bundles.tex", clean = TRUE) ## -----------------------------------------------------------------------------