library("sna") set.seed(1913) g <- rgraph(10, 3, tprob=c(0.1, 0.9, 0.5)) gden(g) g.p <- sapply((1:10) / 10, rep, 10) g <- rgraph(10, tprob = g.p) g apply(g, 2, mean) g <- rgnm(5, 10, 12) apply(g, 1, sum) k10 <- rguman(1, 10, mut = 45, asym = 0, null = 0, method = "exact") t10 <- rguman(1, 10, mut = 0, asym = 45, null = 0, method = "exact") n10 <- rguman(1, 10, mut = 0, asym = 0, null = 45, method = "exact") k10 t10 n10 g <- rguman(1, 100, mut = 0.15, asym = 0.05, null = 0.8) mean(g[upper.tri(g)] * t(g)[upper.tri(g)]) mean(g[upper.tri(g)] != t(g)[upper.tri(g)]) mean((!g)[upper.tri(g)] * t(!g)[upper.tri(g)]) g <- rgbn(5, 10, param = list(pi = 0.05, sigma = 0.1, rho = 0.05, d = 0.15)) g <- matrix(0, 10, 10) g[1,] <- 1 g2 <- rewire.ws(g, 0.5)[1,,] g2 sum(g - g2) == 0 g3 <- rmperm(g2) all(sort(apply(g2, 2, sum)) == sort(apply(g3, 2, sum))) g <- rgraph(5) eval.edgeperturbation(g, 1, 2, centralization, betweenness) g <- rgraph(10, tp = 1.5 / 9) g.in <- ego.extract(g, neighborhood = "in") g.out <- ego.extract(g, neighborhood = "out") g.comb <- ego.extract(g, neighborhood = "combined") g.comb[1:3] all(sapply(g.in, NROW) == degree(g, cmode = "indegree") + 1) all(sapply(g.out, NROW) == degree(g, cmode = "outdegree") + 1) all(sapply(g.comb, NROW) <= degree(g) + 1) ego.size <- sapply(g.comb, NROW) if(any(ego.size > 2)) sapply(g.comb[ego.size > 2], function(x){gden(x[-1,-1])}) g <- rgraph(6) all(gapply(g, 1, rep(1, 6), sum) == degree(g, cmode = "outdegree")) all(gapply(g, 2, rep(1, 6), sum) == degree(g, cmode = "degree")) all(gapply(g, c(1, 2), rep(1, 6), sum) == degree(symmetrize(g), cmode = "freeman") / 2) gapply(g, c(1, 2), 1:6, mean) gapply(g, c(1, 2), 1:6, mean, distance = 2) g <- rgraph(10, tp = 2/9) neigh <- neighborhood(g, 9, neighborhood.type = "out", return.all = TRUE) par(mfrow=c(3,3)) for(i in 1:9) gplot(neigh[i,,],main = paste("Partial Neighborhood of Order", i)) neigh <- neighborhood(g, 9, neighborhood.type="out", return.all = TRUE, partial = FALSE) par(mfrow = c(3, 3)) for(i in 1:9) gplot(neigh[i,,], main = paste("Cumulative Neighborhood of Order", i)) g <- rgraph(5, diag = TRUE) par(mfrow = c(2, 3)) gplot(g, main = "Default") gplot(g, usecurv = TRUE, main = "Curved Edges") gplot(g, mode = "mds", main = "MDS Layout") gplot(g, mode = "circle", main = "Circular Layout") plot.sociomatrix(g, main = "Sociomatrix") gplot(g, diag = TRUE, vertex.cex = 1:5, vertex.sides = 3:8, vertex.col = 1:5, vertex.border = 2:6, vertex.rot = (0:4) * 72, displaylabels = TRUE, label.bg = "gray90", main = "Multiple Options") gplot3d(rgws(1, 5, 3, 1, 0)) gplot3d(rgws(1, 5, 3, 1, 0.05)) gplot3d(rgws(1, 5, 3, 1, 0.2)) par(mfrow = c(1, 3)) plot(0, 0, type = "n", xlim = c(-1.5, 1.5), ylim = c(-1.5, 1.5), asp = 1, xlab = "", ylab = "", main = "gplot.vertex Example") gplot.vertex(cos((1:10) / 10 * 2 * pi), sin((1:10) / 10 * 2 * pi), col = 1:10, sides = 3:12, radius = 0.1) plot(1:2, 1:2, xlab = "", ylab = "", main = "gplot.arrow Example") gplot.arrow(1, 1, 2, 2, width = 0.01, col = "red", border = "black") plot(0, 0, type = "n", xlim = c(-2, 2), ylim = c(-2, 2), asp = 1, xlab = "", ylab = "", main = "gplot.loop Example") gplot.loop(c(0, 0), c(1, -1), col = c(3, 2), width = 0.05, length = 0.4, offset = sqrt(2) / 4, angle = 20, radius = 0.5, edge.steps = 50, arrowhead = TRUE) polygon(c(0.25, -0.25, -0.25, 0.25, NA, 0.25, -0.25, -0.25, 0.25), c(1.25, 1.25, 0.75, 0.75, NA, -1.25, -1.25, -0.75, -0.75), col = c(2, 3)) dat <- rgraph(10) degree(dat, cmode = "indegree") degree(dat, cmode = "outdegree") degree(dat) closeness(dat) betweenness(dat) stresscent(dat) graphcent(dat) evcent(dat) infocent(dat) bonpow(dat, exponent = 0) / degree(dat, cmode = "outdegree") all(abs(bonpow(dat, exponent = 1 / eigen(dat)$values[1], rescale = TRUE) - evcent(dat, rescale = TRUE)) < 1e-10) bonpow(dat, exponent = -0.5) memb <- sample(1:3, 10, replace = TRUE) summary(brokerage(dat, memb)) g <- rgraph(10, 5, tprob = c(0.1, 0.25, 0.5, 0.75, 0.9)) gden(g) grecip(g) grecip(g, measure = "edgewise") grecip(g) == 1 - hierarchy(g) gtrans(g) gtrans(g, measure = "weakcensus") connectedness(g) efficiency(g) hierarchy(g, measure = "krackhardt") lubness(g) centralization(g, degree, cmode = "outdegree") centralization(g, betweenness) apply(g, 1, centralization, degree, cmode = "outdegree") apply(g, 1, centralization, betweenness) o2scent <- function(dat, tmaxdev = FALSE, ...){ n <- NROW(dat) if(tmaxdev) return((n-1) * choose(n-1, 2)) odeg <- degree(dat, cmode = "outdegree") choose(odeg, 2) } apply(g, 1, centralization, o2scent) g1 <- rgbn(50, 10, param = list(pi = 0, sigma = 0, rho = 0, d = 0.17)) apply(dyad.census(g1), 2, mean) apply(triad.census(g1), 2, mean) g2 <- rgbn(50, 10, param = list(pi = 0.5, sigma = 0, rho = 0, d = 0.17)) apply(dyad.census(g2), 2, mean) apply(triad.census(g2), 2, mean) g3 <- rgbn(50, 10, param = list(pi = 0.0, sigma = 0.25, rho = 0, d = 0.17)) apply(dyad.census(g3), 2, mean) apply(triad.census(g3), 2, mean) kpath.census(g3[1,,], maxlen = 5, path.comembership = "bylength", dyadic.tabulation = "bylength")$path.count kcycle.census(g3[1,,], maxlen = 5, cycle.comembership = "bylength")$cycle.count component.dist(g3[1,,]) structure.statistics(g3[1,,]) g4 <- g1[1:2,,] g4[2,,] <- g2[1,,] cug <- cugtest(g4, gliop, cmode = "order", GFUN = grecip, OP = "-", g1 = 1, g2 = 2) summary(cug) cug <- cugtest(g4, gliop, GFUN = grecip, OP = "-", g1 = 1, g2 = 2) summary(cug) g.p <- sapply(runif(20, 0, 1), rep, 20) g <- rgraph(20, tprob = g.p) eq <- equiv.clust(g) b <- blockmodel(g, eq, h = 15) g.e <- blockmodel.expand(b, rep(2, length(b$rlabels))) g.e g.1 <- rgraph(5) g.2 < -rgraph(5) g.3 <- rmperm(g.2) gcor(g.1, g.2) gcor(g.1, g.3) gcor(g.2, g.3) gscor(g.1, g.2, reps = 1e5) gscor(g.1, g.3, reps = 1e5) gscor(g.2, g.3, reps = 1e5) x <- rgraph(20, 4) y <- x[1,,] + 4 * x[2,,] + 2 * x[3,,] nl <- netlm(y, x) summary(nl) x <- rgraph(20, 4) y.l <- x[1,,] + 4 * x[2,,] + 2 * x[3,,] y.p <- apply(y.l, c(1, 2), function(a){1 / (1 + exp(-a))}) y <- rgraph(20, tprob = y.p) nl <- netlogit(y, x) summary(nl) g <- rgraph(20) ep <- rbeta(20, 1, 25) em <- rbeta(20, 15, 25) dat <- array(dim = c(20, 20, 20)) for(i in 1:20) dat[i,,] <- rgraph(20, 1, tprob = (g * (1 - em[i]) + (1 - g) * ep[i])) pnet <- matrix(0.5, ncol = 20, nrow = 20) pem <- matrix(nrow = 20, ncol = 2) pem[,1] <- 2 pem[,2] <- 11 pep <- matrix(nrow = 20, ncol = 2) pep[,1] <- 2 pep[,2] <- 11 b <- bbnam(dat, model = "actor", nprior = pnet, emprior = pem, epprior = pep, burntime = 300, draws = 100) summary(b) cor(em, apply(b$em, 2, median)) cor(ep, apply(b$ep, 2, median)) mean(apply(b$net, c(2, 3), median) == g) mean(consensus(dat, method = "LAS.intersection") == g) mean(consensus(dat, method = "LAS.union") == g) mean(consensus(dat, method = "central.graph") == g) mean(consensus(dat, method = "romney.batchelder") == g) w1 <- rgraph(50) w2 <- rgraph(50) x <- matrix(rnorm(50 * 5), 50, 5) r1 <- 0.2 r2 <- 0.3 sigma <- 0.1 beta <- rnorm(5) nu <- rnorm(50, 0, sigma) e <- qr.solve(diag(50) - r2 * w2, nu) y <- qr.solve(diag(50) - r1 * w1, x %*% beta + e) fit <- lnam(y, x, w1, w2) summary(fit)