diff --git a/Makefile-cigraph b/Makefile-cigraph index 49591b85a6..43b1206872 100644 --- a/Makefile-cigraph +++ b/Makefile-cigraph @@ -72,7 +72,7 @@ src/sources.mk: # R source and doc files -RSRC := $(shell git ls-files R doc inst demo NEWS cleanup.win configure.win) +RSRC := $(shell git ls-files R doc inst NEWS cleanup.win configure.win) # ARPACK Fortran sources diff --git a/NAMESPACE b/NAMESPACE index 3b318d4395..95be07fb20 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -514,11 +514,9 @@ export(igraph.shape.noclip) export(igraph.shape.noplot) export(igraph.to.graphNEL) export(igraph.version) -export(igraph_demo) export(igraph_opt) export(igraph_options) export(igraph_version) -export(igraphdemo) export(in_circle) export(incident) export(incident_edges) diff --git a/R/demo.R b/R/demo.R deleted file mode 100644 index e4fd3a0012..0000000000 --- a/R/demo.R +++ /dev/null @@ -1,211 +0,0 @@ -#' Run igraph demos, step by step -#' -#' @description -#' `r lifecycle::badge("deprecated")` -#' -#' `igraphdemo()` was renamed to [igraph_demo()] to create a more -#' consistent API. -#' @inheritParams igraph_demo -#' @keywords internal -#' @export -igraphdemo <- function(which) { - # nocov start - lifecycle::deprecate_soft("2.0.0", "igraphdemo()", "igraph_demo()") - igraph_demo(which = which) -} # nocov end -# IGraph R package -# Copyright (C) 2005-2012 Gabor Csardi -# 334 Harvard street, Cambridge, MA 02139 USA -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 USA -# -################################################################### - -#' Run igraph demos, step by step -#' -#' Run one of the accompanying igraph demos, somewhat interactively, using a Tk -#' window. -#' -#' This function provides a somewhat nicer interface to igraph demos that come -#' with the package, than the standard [demo()] function. igraph -#' demos are divided into chunks and `igraph_demo()` runs them chunk by -#' chunk, with the possibility of inspecting the workspace between two chunks. -#' -#' The `tcltk` package is needed for `igraph_demo()`. -#' -#' @param which If not given, then the names of the available demos are listed. -#' Otherwise it should be either a filename or the name of an igraph demo. -#' @return Returns `NULL`, invisibly. -#' @author Gabor Csardi \email{csardi.gabor@@gmail.com} -#' @seealso [demo()] -#' @family demo -#' @export -#' @keywords graphs -#' @examples -#' -#' igraph_demo() -#' -#' @examplesIf interactive() && rlang::is_installed("tcltk") -#' igraph_demo("centrality") -#' -igraph_demo <- function(which) { - if (missing(which)) { - demodir <- system.file("demo", package = "igraph") - if (demodir == "") { - stop("Could not find igraph demos, broken igraph installation?") - } - return(sub("\\.R$", "", list.files(demodir))) - } - - if (!grepl("\\.R$", which)) { - which <- paste(which, sep = ".", "R") - } - - if (!file.exists(which) && !grepl("^/", which)) { - which <- system.file(paste("demo", sep = "/", which), package = "igraph") - } - - if (which == "" || !file.exists(which)) { - stop("Could not find demo file") - } - - .igraphdemo.next <- function(top, txt) { - act <- as.character(tcltk::tktag.nextrange(txt, "active", "0.0")) - if (length(act) == 0) { - return() - } - - options(keep.source = TRUE) - - text <- tcltk::tclvalue(tcltk::tkget(txt, act[1], act[2])) - cat("=======================================================\n") - - expr <- parse(text = text) - for (i in seq_along(expr)) { - co <- as.character(attributes(expr)$srcref[[i]]) - co[1] <- paste("> ", sep = "", co[1]) - if (length(co) > 1) { - co[-1] <- paste(" +", sep = "", co[-1]) - } - cat(co, sep = "\n") - res <- withVisible(eval(expr[[i]], envir = .GlobalEnv)) - if (res$visible) { - print(res$value) - } - } - cat("> -------------------------------------------------------\n") - cat(options()$prompt) - - tcltk::tktag.remove(txt, "activechunk", act[1], act[2]) - tcltk::tktag.remove(txt, "active", act[1], act[2]) - - nex <- as.character(tcltk::tktag.nextrange(txt, "activechunk", act[1])) - if (length(nex) != 0) { - tcltk::tktag.add(txt, "active", nex[1], nex[2]) - tcltk::tksee(txt, paste(sep = "", as.numeric(nex[2]), ".0")) - tcltk::tksee(txt, paste(sep = "", as.numeric(nex[1]), ".0")) - } - } - - .igraphdemo.close <- function(top) { - tcltk::tkdestroy(top) - } - - .igraphdemo.reset <- function(top, txt, which) { - demolines <- readLines(which) - demolines <- demolines[!grepl("^pause\\(\\)$", demolines)] - demolines <- paste(" ", sep = "", demolines) - - ch <- grep("^[ ]*###", demolines) - ch <- c(ch, length(demolines) + 1) - if (length(ch) == 1) { - cli::cli_warn("Demo source file does not contain chunks.") - } else { - demolines <- demolines[ch[1]:length(demolines)] - ch <- grep("^[ ]*###", demolines) - ch <- c(ch, length(demolines) + 1) - } - - tcltk::tkconfigure(txt, state = "normal") - tcltk::tkdelete(txt, "0.0", "end") - tcltk::tkinsert(txt, "insert", paste(demolines, collapse = "\n")) - tcltk::tkconfigure(txt, state = "disabled") - - for (i in seq_along(ch[-1])) { - from <- paste(sep = "", ch[i], ".0") - to <- paste(sep = "", ch[i + 1] - 1, ".0") - tcltk::tktag.add(txt, "chunk", from, to) - tcltk::tktag.add(txt, "activechunk", from, to) - } - tcltk::tktag.configure(txt, "chunk", "-borderwidth", "1") - tcltk::tktag.configure(txt, "chunk", "-relief", "sunken") - if (length(ch) >= 2) { - tcltk::tktag.add( - txt, - "active", - paste(sep = "", ch[1], ".0"), - paste(sep = "", ch[2] - 1, ".0") - ) - tcltk::tktag.configure(txt, "active", "-foreground", "red") - tcltk::tktag.configure(txt, "active", "-background", "lightgrey") - } - - comm <- grep("^#", demolines) - for (i in comm) { - tcltk::tktag.add( - txt, - "comment", - paste(sep = "", i, ".0"), - paste(sep = "", i, ".end") - ) - } - tcltk::tktag.configure(txt, "comment", "-font", "bold") - tcltk::tktag.configure(txt, "comment", "-foreground", "darkolivegreen") - } - - top <- tcltk::tktoplevel(background = "lightgrey") - tcltk::tktitle(top) <- paste("igraph demo:", which) - - main.menu <- tcltk::tkmenu(top) - tcltk::tkadd(main.menu, "command", label = "Close", command = function() { - .igraphdemo.close(top) - }) - tcltk::tkadd(main.menu, "command", label = "Reset", command = function() { - .igraphdemo.reset(top, txt, which) - }) - tcltk::tkconfigure(top, "-menu", main.menu) - - scr <- tcltk::tkscrollbar(top, repeatinterval = 5, command = function(...) { - tcltk::tkyview(txt, ...) - }) - txt <- tcltk::tktext( - top, - yscrollcommand = function(...) tcltk::tkset(scr, ...), - width = 80, - height = 40 - ) - but <- tcltk::tkbutton(top, text = "Next", command = function() { - .igraphdemo.next(top, txt) - }) - - tcltk::tkpack(but, side = "bottom", fill = "x", expand = 0) - tcltk::tkpack(scr, side = "right", fill = "y", expand = 0) - tcltk::tkpack(txt, side = "left", fill = "both", expand = 1) - - .igraphdemo.reset(top, txt, which) - - invisible() -} diff --git a/_pkgdown.yml b/_pkgdown.yml index e543b111bf..633d73b986 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -214,9 +214,6 @@ reference: - has_concept("processes") - has_concept("random_walk") # ----- -- title: Demo -- contents: - - has_concept("demo") - title: I/O read/write files - contents: - has_concept("foreign") diff --git a/demo/00Index b/demo/00Index deleted file mode 100644 index 5ab11658d5..0000000000 --- a/demo/00Index +++ /dev/null @@ -1,6 +0,0 @@ -crashR A crash-course into R -centrality Classic and other vertex centrality indices -community Community structure detection -smallworld Small-world networks -cohesive Cohesive blocking, the Moody & White method -hrg Hierarchical random graphs diff --git a/demo/centrality.R b/demo/centrality.R deleted file mode 100644 index 83e5a5c09b..0000000000 --- a/demo/centrality.R +++ /dev/null @@ -1,224 +0,0 @@ -pause <- function() {} - -### Traditional approaches: degree, closeness, betweenness -g <- graph_from_literal( - Andre ---- Beverly:Diane:Fernando:Carol, - Beverly -- Andre:Diane:Garth:Ed, - Carol ---- Andre:Diane:Fernando, - Diane ---- Andre:Carol:Fernando:Garth:Ed:Beverly, - Ed ------- Beverly:Diane:Garth, - Fernando - Carol:Andre:Diane:Garth:Heather, - Garth ---- Ed:Beverly:Diane:Fernando:Heather, - Heather -- Fernando:Garth:Ike, - Ike ------ Heather:Jane, - Jane ----- Ike -) - -pause() - -### Hand-drawn coordinates -coords <- c( - 5, 5, 119, 256, 119, 256, 120, 340, 478, - 622, 116, 330, 231, 116, 5, 330, 451, 231, 231, 231 -) -coords <- matrix(coords, ncol = 2) - -pause() - -### Labels the same as names -V(g)$label <- V(g)$name -g$layout <- coords # $ - -pause() - -### Take a look at it -plotG <- function(g) { - plot( - g, - asp = FALSE, - vertex.label.color = "blue", - vertex.label.cex = 1.5, - vertex.label.font = 2, - vertex.size = 25, - vertex.color = "white", - vertex.frame.color = "white", - edge.color = "black" - ) -} -plotG(g) - -pause() - -### Add degree centrality to labels -V(g)$label <- paste(sep = "\n", V(g)$name, degree(g)) - -pause() - -### And plot again -plotG(g) - -pause() - -### Betweenness -V(g)$label <- paste(sep = "\n", V(g)$name, round(betweenness(g), 2)) -plotG(g) - -pause() - -### Closeness -V(g)$label <- paste(sep = "\n", V(g)$name, round(closeness(g), 2)) -plotG(g) - -pause() - -### Eigenvector centrality -V(g)$label <- paste(sep = "\n", V(g)$name, round(eigen_centrality(g)$vector, 2)) -plotG(g) - -pause() - -### PageRank -V(g)$label <- paste(sep = "\n", V(g)$name, round(page_rank(g)$vector, 2)) -plotG(g) - -pause() - -### Correlation between centrality measures -karate <- make_graph("Zachary") -cent <- list( - `Degree` = degree(g), - `Closeness` = closeness(g), - `Betweenness` = betweenness(g), - `Eigenvector` = eigen_centrality(g)$vector, - `PageRank` = page_rank(g)$vector -) - -pause() - -### Pairs plot -pairs(cent, lower.panel = function(x, y) { - usr <- par("usr") - text( - mean(usr[1:2]), - mean(usr[3:4]), - round(cor(x, y), 3), - cex = 2, - col = "blue" - ) -}) - -pause() - -## ### A real network, US supreme court citations -## ## You will need internet connection for this to work -## vertices <- read.csv("http://jhfowler.ucsd.edu/data/judicial.csv") -## edges <- read.table("http://jhfowler.ucsd.edu/data/allcites.txt") -## jg <- graph.data.frame(edges, vertices=vertices, directed=TRUE) - -## pause() - -## ### Basic data -## summary(jg) - -## pause() - -## ### Is it a simple graph? -## is_simple(jg) - -## pause() - -## ### Is it connected? -## is_connected(jg) - -## pause() - -## ### How many components? -## count_components(jg) - -## pause() - -## ### How big are these? -## table(components(jg)$csize) - -## pause() - -## ### In-degree distribution -## plot(degree_distribution(jg, mode="in"), log="xy") - -## pause() - -## ### Out-degree distribution -## plot(degree_distribution(jg, mode="out"), log="xy") - -## pause() - -## ### Largest in- and out-degree, total degree -## c(max(degree(jg, mode="in")), -## max(degree(jg, mode="out")), -## max(degree(jg, mode="all"))) - -## pause() - -## ### Density -## density(jg) - -## pause() - -## ### Transitivity -## transitivity(jg) - -## pause() - -## ### Transitivity of a random graph of the same size -## g <- sample_gnm(vcount(jg), ecount(jg)) -## transitivity(g) - -## pause() - -## ### Transitivity of a random graph with the same degree distribution -## g <- sample_degseq(degree(jg, mode="out"), degree(jg, mode="in"), -## method="simple") -## transitivity(g) - -## pause() - -## ### Authority and Hub scores -## AS <- authority_score(jg)$vector -## HS <- hub_score(jg)$vector - -## pause() - -## ### Time evolution of authority scores -## AS <- authority_score(jg)$vector -## center <- which.max(AS) -## startyear <- V(jg)[center]$year - -## pause() - -## ### Function to go back in time -## auth.year <- function(y) { -## print(y) -## keep <- which(V(jg)$year <= y) -## g2 <- subgraph(jg, keep) -## as <- abs(authority_score(g2, scale=FALSE)$vector) -## w <- match(V(jg)[center]$usid, V(g2)$usid) -## as[w] -## } - -## pause() - -## ### Go back in time for the top authority, do a plot -## AS2 <- sapply(startyear:2005, auth.year) -## plot(startyear:2005, AS2, type="b", xlab="year", ylab="authority score") - -## pause() - -## ### Check another case -## center <- "22US1" -## startyear <- V(jg)[center]$year - -## pause() - -## ### Calculate past authority scores & plot them -## AS3 <- sapply(startyear:2005, auth.year) -## plot(startyear:2005, AS3, type="b", xlab="year", ylab="authority score") diff --git a/demo/cohesive.R b/demo/cohesive.R deleted file mode 100644 index f38e3e696e..0000000000 --- a/demo/cohesive.R +++ /dev/null @@ -1,59 +0,0 @@ -pause <- function() {} - -### The Zachary Karate club network - -karate <- make_graph("Zachary") -summary(karate) - -pause() - -### Create a layout that is used from now on - -karate$layout <- layout_nicely(karate) -plot(karate) - -pause() - -### Run cohesive blocking on it - -cbKarate <- cohesive_blocks(karate) -cbKarate - -pause() - -### Plot the results and all the groups - -plot(cbKarate, karate) - -pause() - -### This is a bit messy, plot them step-by-step -### See the hierarchy tree first - -hierarchy(cbKarate) -plot_hierarchy(cbKarate) - -## Plot the first level, blocks 1 & 2 - -plot(cbKarate, karate, mark.groups = blocks(cbKarate)[1:2 + 1], col = "cyan") - -pause() - -### The second group is simple, plot its more cohesive subgroup - -plot( - cbKarate, - karate, - mark.groups = blocks(cbKarate)[c(2, 5) + 1], - col = "cyan" -) - -pause() - -### The first group has more subgroups, plot them - -sub1 <- blocks(cbKarate)[parent(cbKarate) == 1] -sub1 -plot(cbKarate, karate, mark.groups = sub1) - -pause() diff --git a/demo/community.R b/demo/community.R deleted file mode 100644 index 4dbf578a74..0000000000 --- a/demo/community.R +++ /dev/null @@ -1,243 +0,0 @@ -pause <- function() {} - -### A modular graph has dense subgraphs -mod <- make_full_graph(10) %du% make_full_graph(10) %du% make_full_graph(10) -perfect <- c(rep(1, 10), rep(2, 10), rep(3, 10)) -perfect - -pause() - -### Plot it with community (=component) colors -plot(mod, vertex.color = perfect, layout = layout_with_fr) - -pause() - -### Modularity of the perfect division -modularity(mod, perfect) - -pause() - -### Modularity of the trivial partition, quite bad -modularity(mod, rep(1, 30)) - -pause() - -### Modularity of a good partition with two communities -modularity(mod, c(rep(1, 10), rep(2, 20))) - -pause() - -### A real little network, Zachary's karate club data -karate <- make_graph("Zachary") -karate$layout <- layout_with_kk(karate) - -pause() - -### Greedy algorithm -fc <- cluster_fast_greedy(karate) -memb <- membership(fc) -plot(karate, vertex.color = memb) - -pause() - -### Greedy algorithm, easier plotting -plot(fc, karate) - -pause() - -### Spinglass algorithm, create a hierarchical network -pref.mat <- matrix(0, 16, 16) -pref.mat[1:4, 1:4] <- pref.mat[5:8, 5:8] <- - pref.mat[9:12, 9:12] <- pref.mat[13:16, 13:16] <- 7.5 / 127 -pref.mat[pref.mat == 0] <- 5 / (3 * 128) -diag(pref.mat) <- diag(pref.mat) + 10 / 31 - -pause() - -### Create the network with the given vertex preferences -G <- sample_pref(128 * 4, types = 16, pref.matrix = pref.mat) - -pause() - -### Run spinglass community detection with two gamma parameters -sc1 <- cluster_spinglass(G, spins = 4, gamma = 1.0) -sc2.2 <- cluster_spinglass(G, spins = 16, gamma = 2.2) - -pause() - -### Plot the adjacency matrix, use the Matrix package if available -if (require(Matrix)) { - myimage <- function(...) image(Matrix(...)) -} else { - myimage <- image -} -A <- as_adjacency_matrix(G) -myimage(A) - -pause() - -### Ordering according to (big) communities -ord1 <- order(membership(sc1)) -myimage(A[ord1, ord1]) - -pause() - -### Ordering according to (small) communities -ord2.2 <- order(membership(sc2.2)) -myimage(A[ord2.2, ord2.2]) - -pause() - -### Consensus ordering -ord <- order(membership(sc1), membership(sc2.2)) -myimage(A[ord, ord]) - -pause() - -### Comparision of algorithms -communities <- list() - -pause() - -### cluster_edge_betweenness -ebc <- cluster_edge_betweenness(karate) -communities$`Edge betweenness` <- ebc - -pause() - -### cluster_fast_greedy -fc <- cluster_fast_greedy(karate) -communities$`Fast greedy` <- fc - -pause() - -### cluster_leading_eigen -lec <- cluster_leading_eigen(karate) -communities$`Leading eigenvector` <- lec - -pause() - -### cluster_spinglass -sc <- cluster_spinglass(karate, spins = 10) -communities$`Spinglass` <- sc - -pause() - -### cluster_walktrap -wt <- cluster_walktrap(karate) -communities$`Walktrap` <- wt - -pause() - -### cluster_label_prop -labprop <- cluster_label_prop(karate) -communities$`Label propagation` <- labprop - -pause() - -### Plot everything -layout(rbind(1:3, 4:6)) -coords <- layout_with_kk(karate) -lapply(seq_along(communities), function(x) { - m <- modularity(communities[[x]]) - par(mar = c(1, 1, 3, 1)) - plot( - communities[[x]], - karate, - layout = coords, - main = paste( - names(communities)[x], - "\n", - "Modularity:", - round(m, 3) - ) - ) -}) - -pause() - -### Function to calculate clique communities -clique.community <- function(graph, k) { - clq <- cliques(graph, min = k, max = k) - edges <- c() - for (i in seq(along.with = clq)) { - for (j in seq(along.with = clq)) { - if ( - length(unique(c( - clq[[i]], - clq[[j]] - ))) == - k + 1 - ) { - edges <- c(edges, c(i, j)) - } - } - } - clq.graph <- simplify(graph(edges)) - V(clq.graph)$name <- - seq(length.out = vcount(clq.graph)) - comps <- decompose(clq.graph) - - lapply(comps, function(x) { - unique(unlist(clq[V(x)$name])) - }) -} - -pause() - -### Apply it to a graph, this is the example graph from -## the original publication -g <- graph_from_literal( - A - B:F:C:E:D, B - A:D:C:E:F:G, C - A:B:F:E:D, D - A:B:C:F:E, - E - D:A:C:B:F:V:W:U, F - H:B:A:C:D:E, G - B:J:K:L:H, - H - F:G:I:J:K:L, I - J:L:H, J - I:G:H:L, K - G:H:L:M, - L - H:G:I:J:K:M, M - K:L:Q:R:S:P:O:N, N - M:Q:R:P:S:O, - O - N:M:P, P - Q:M:N:O:S, Q - M:N:P:V:U:W:R, R - M:N:V:W:Q, - S - N:P:M:U:W:T, T - S:V:W:U, U - E:V:Q:S:W:T, - V - E:U:W:T:R:Q, W - U:E:V:Q:R:S:T -) - -pause() - -### Hand-made layout to make it look like the original in the paper -lay <- c( - 387.0763, 306.6947, 354.0305, 421.0153, 483.5344, 512.1145, - 148.6107, 392.4351, 524.6183, 541.5878, 240.6031, 20, - 65.54962, 228.0992, 61.9771, 152.1832, 334.3817, 371.8931, - 421.9084, 265.6107, 106.6336, 57.51145, 605, 20, 124.8780, - 273.6585, 160.2439, 241.9512, 132.1951, 123.6585, 343.1707, - 465.1220, 317.561, 216.3415, 226.0976, 343.1707, 306.5854, - 123.6585, 360.2439, 444.3902, 532.1951, 720, 571.2195, - 639.5122, 505.3659, 644.3902 -) -lay <- matrix(lay, ncol = 2) -lay[, 2] <- max(lay[, 2]) - lay[, 2] - -pause() - -### Take a look at it -layout(1) -plot(g, layout = lay, vertex.label = V(g)$name) - -pause() - -### Calculate communities -res <- clique.community(g, k = 4) - -pause() - -### Paint them to different colors -colbar <- rainbow(length(res) + 1) -for (i in seq(along.with = res)) { - V(g)[res[[i]]]$color <- colbar[i + 1] -} - -pause() - -### Paint the vertices in multiple communities to red -V(g)[unlist(res)[duplicated(unlist(res))]]$color <- "red" - -pause() - -### Plot with the new colors -plot(g, layout = lay, vertex.label = V(g)$name) diff --git a/demo/crashR.R b/demo/crashR.R deleted file mode 100644 index 07d4b8390c..0000000000 --- a/demo/crashR.R +++ /dev/null @@ -1,345 +0,0 @@ -pause <- function() {} - -### R objects, (real) numbers -a <- 3 -a -b <- 4 -b -a + b - -pause() - -### Case sensitive -A <- 16 -a -A - -pause() - -### Vector objects -a <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) -a -b <- 1:100 -b -a[1] -b[1:5] -a[1] <- 10 -a -a[1:4] <- 2 -a - -pause() - -### Vector arithmetic -a * 2 + 1 - -pause() - -### Functions -ls() -length(a) -mean(a) -sd(a) -sd -c - -pause() - -### Getting help -# ?sd -# ??"standard deviation" -# RSiteSearch("network betweenness") - -pause() - -### Classes -class(2) -class(1:10) -class(sd) - -pause() - -### Character vectors -char.vec <- c("this", "is", "a", "vector", "of", "characters") -char_vec <- char.vec -char.vec[1] - -pause() - -### Index vectors -age <- c(45, 36, 65, 21, 52, 19) -age[1] -age[1:5] -age[c(2, 5, 6)] - -b[seq(1, 100, by = 2)] - -pause() - -### Named vectors -names(age) <- c("Alice", "Bob", "Cecil", "David", "Eve", "Fiona") -age -age["Bob"] -age[c("Eve", "David", "David")] - -pause() - -### Indexing with logical vectors -age[c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE)] -names(age)[age > 40] -age > 40 - -pause() - -### Matrices -M <- matrix(1:20, 10, 2) -M -M2 <- matrix(1:20, 10, 2, byrow = TRUE) ## Named argument! -M2 -M[1, 1] -M[1, ] -M[, 1] -M[1:5, 2] - -pause() - -### Generic functions -sd(a) -sd(M) -class(a) -class(M) - -pause() - -### Lists -l <- list(1:10, "Hello!", diag(5)) -l -l[[1]] -l[2:3] -l -l2 <- list(A = 1:10, H = "Hello!", M = diag(5)) -l2 -l2$A -l2$M - -pause() - -### Factors -countries <- c( - "SUI", "USA", "GBR", "GER", "SUI", - "SUI", "GBR", "GER", "FRA", "GER" -) -countries -fcountries <- factor(countries) -fcountries -levels(fcountries) - -pause() - -### Data frames -survey <- data.frame( - row.names = c("Alice", "Bob", "Cecil", "David", "Eve"), - Sex = c("F", "M", "F", "F", "F"), - Age = c(45, 36, 65, 21, 52), - Country = c("SUI", "USA", "SUI", "GBR", "USA"), - Married = c(TRUE, FALSE, FALSE, TRUE, TRUE), - Salary = c(70, 65, 200, 45, 100) -) -survey -survey$Sex -plot(survey$Age, survey$Salary) -AS.model <- lm(Salary ~ Age, data = survey) -AS.model -summary(AS.model) -abline(AS.model) - -tapply(survey$Salary, survey$Country, mean) - -pause() - -### Packages -# install.packages("igraph") -# library(help="igraph") -library(igraph) -sessionInfo() - -pause() - -### Graphs -## Create a small graph, A->B, A->C, B->C, C->E, D -## A=1, B=2, C=3, D=4, E=5 -g <- make_graph(c(1, 2, 1, 3, 2, 3, 3, 5), n = 5) - -pause() - -### Print a graph to the screen -g - -pause() - -### Create an undirected graph as well -## A--B, A--C, B--C, C--E, D -g2 <- make_graph(c(1, 2, 1, 3, 2, 3, 3, 5), n = 5, dir = FALSE) -g2 - -pause() - -### Is this object an igraph graph? -is_igraph(g) -is_igraph(1:10) - -pause() - -### Summary, number of vertices, edges -summary(g) -vcount(g) -ecount(g) - -pause() - -### Is the graph directed? -is_directed(g) -is_directed(g2) - -pause() - -### Convert from directed to undirected -as.undirected(g) - -pause() - -### And back -as.directed(as.undirected(g)) - -pause() - -### Multiple edges -g <- make_graph(c(1, 2, 1, 2, 1, 3, 2, 3, 4, 5), n = 5) -g - -is_simple(g) -which_multiple(g) - -pause() - -### Remove multiple edges -g <- simplify(g) -is_simple(g) - -pause() - -### Loop edges -g <- make_graph(c(1, 1, 1, 2, 1, 3, 2, 3, 4, 5), n = 5) -g - -is_simple(g) -which_loop(g) - -pause() - -### Remove loop edges -g <- simplify(g) -is_simple(g) - -pause() - -### Naming vertices -g <- make_ring(10) -V(g)$name <- letters[1:10] -V(g)$name -g -print(g, v = T) - -pause() - -### Create undirected example graph -g2 <- graph_from_literal( - Alice - Bob:Cecil:Daniel, - Cecil:Daniel - Eugene:Gordon -) -print(g2, v = T) - -pause() - -### Remove Alice -g3 <- delete_vertices(g2, match("Alice", V(g2)$name)) - -pause() - -### Add three new vertices -g4 <- add_vertices(g3, 3) -print(g4, v = T) -igraph_options( - print.vertex.attributes = TRUE, - plot.layout = layout_with_fr -) -g4 -plot(g4) - -pause() - -### Add three new vertices, with names this time -g4 <- add_vertices(g3, 3, attr = list(name = c("Helen", "Ike", "Jane"))) -g4 - -pause() - -### Add some edges as well -g4 <- add_edges(g4, match(c("Helen", "Jane", "Ike", "Jane"), V(g4)$name)) -g4 - -pause() - -### Edge sequences, first create a directed example graph -g2 <- graph_from_literal( - Alice -+ Bob:Cecil:Daniel, - Cecil:Daniel +-+ Eugene:Gordon -) -print(g2, v = T) -plot(g2, layout = layout_with_kk, vertex.label = V(g2)$name) - -pause() - -### Sequence of all edges -E(g2) - -pause() - -### Edge from a vertex to another -E(g2, P = c(1, 2)) - -pause() - -### Delete this edge -g3 <- delete_edges(g2, E(g2, P = c(1, 2))) -g3 - -pause() - -### Get the id of the edge -as.vector(E(g2, P = c(1, 2))) - -pause() - -### All adjacent edges of a vertex -E(g2)[adj(3)] - -pause() - -### Or multiple vertices -E(g2)[adj(c(3, 1))] - -pause() - -### Outgoing edges -E(g2)[from(3)] - -pause() - -### Incoming edges -E(g2)[to(3)] - -pause() - -### Edges along a path -E(g2, path = c(1, 4, 5)) diff --git a/demo/hrg.R b/demo/hrg.R deleted file mode 100644 index 5c5fe4a1b6..0000000000 --- a/demo/hrg.R +++ /dev/null @@ -1,108 +0,0 @@ -pause <- function() {} - -### Construct the Zachary Karate Club network - -karate <- make_graph("zachary") -karate - -pause() - -### Optimalize modularity - -optcom <- cluster_optimal(karate) -V(karate)$comm <- membership(optcom) -plot(optcom, karate) - -pause() - -### Fit a HRG model to the network - -hrg <- fit_hrg(karate) -hrg - -pause() - -### The fitted model, more details - -print(hrg, level = 5) - -pause() - -### Plot the full hierarchy, as an igraph graph - -ihrg <- as.igraph(hrg) -ihrg$layout <- layout.reingold.tilford -plot(ihrg, vertex.size = 10, edge.arrow.size = 0.2) - -pause() - -### Customize the plot a bit, show probabilities and communities - -vn <- sub("Actor ", "", V(ihrg)$name) -colbar <- rainbow(length(optcom)) -vc <- ifelse(is.na(V(ihrg)$prob), colbar[V(karate)$comm], "darkblue") -V(ihrg)$label <- ifelse(is.na(V(ihrg)$prob), vn, round(V(ihrg)$prob, 2)) -par(mar = c(0, 0, 3, 0)) -plot( - ihrg, - vertex.size = 10, - edge.arrow.size = 0.2, - vertex.shape = "none", - vertex.label.color = vc, - main = "Hierarchical network model of the Karate Club" -) - -pause() - -### Plot it as a dendrogram, looks better if the 'ape' package is installed - -plot_dendrogram(hrg) - -pause() - -### Make a very hierarchical graph - -g1 <- make_full_graph(5) -g2 <- make_ring(5) - -g <- g1 + g2 -g <- g + edge(1, vcount(g1) + 1) - -plot(g) - -pause() - -### Fit HRG - -ghrg <- fit_hrg(g) -plot_dendrogram(ghrg) - -pause() - -### Create a consensus dendrogram from multiple samples, takes longer... - -hcons <- consensus_tree(g) -hcons$consensus - -pause() - -### Predict missing edges - -pred <- predict_edges(g) -pred - -pause() - -### Add some the top 5 predicted edges to the graph, colored red - -E(g)$color <- "grey" -lay <- layout_nicely(g) -g2 <- add_edges(g, t(pred$edges[1:5, ]), color = "red") -plot(g2, layout = lay) - -pause() - -### Add four more predicted edges, colored orange - -g3 <- add_edges(g2, t(pred$edges[6:9, ]), color = "orange") -plot(g3, layout = lay) diff --git a/demo/smallworld.R b/demo/smallworld.R deleted file mode 100644 index 8d66545fb7..0000000000 --- a/demo/smallworld.R +++ /dev/null @@ -1,189 +0,0 @@ -pause <- function() {} - -### Create a star-like graph -t1 <- graph_from_literal(A - B:C:D:E) -t1 - -pause() - -### Define its plotting properties -t1$layout <- layout_in_circle -V(t1)$color <- "white" -V(t1)[name == "A"]$color <- "orange" -V(t1)$size <- 40 -V(t1)$label.cex <- 3 -V(t1)$label <- V(t1)$name -E(t1)$color <- "black" -E(t1)$width <- 3 - -pause() - -### Plot 't1' and A's transitivity -tr <- transitivity(t1, type = "local")[1] -plot(t1, main = paste("Transitivity of 'A':", tr)) - -pause() - -### Add an edge and recalculate transitivity -t2 <- add_edges(t1, V(t1)[name %in% c("C", "D")], color = "red", width = 3) -tr <- transitivity(t2, type = "local")[1] -plot(t2, main = paste("Transitivity of 'A':", round(tr, 4))) - -pause() - -### Add two more edges -newe <- match(c("B", "C", "B", "E"), V(t2)$name) - 1 -t3 <- add_edges(t2, newe, color = "red", width = 3) -tr <- transitivity(t3, type = "local")[1] -plot(t3, main = paste("Transitivity of 'A':", round(tr, 4))) - -pause() - -### A one dimensional, circular lattice -ring <- make_ring(50) -ring$layout <- layout_in_circle -V(ring)$size <- 3 -plot(ring, vertex.label = NA, main = "Ring graph") - -pause() - -### Watts-Strogatz model -ws1 <- sample_smallworld(1, 50, 3, p = 0) -ws1$layout <- layout_in_circle -V(ws1)$size <- 3 -E(ws1)$curved <- 1 -plot(ws1, vertex.label = NA, main = "regular graph") - -pause() - -### Zoom in to this part -axis(1) -axis(2) -abline(h = c(0.8, 1.1)) -abline(v = c(-0.2, 0.2)) - -pause() - -### Zoom in to this part -plot(ws1, vertex.label = NA, xlim = c(-0.2, 0.2), ylim = c(0.8, 1.1)) - -pause() - -### Transitivity of the ring graph -transitivity(ws1) - -pause() - -### Path lengths, regular graph -mean_distance(ws1) - -pause() - -### Function to test regular graph with given size -try.ring.pl <- function(n) { - g <- sample_smallworld(1, n, 3, p = 0) - mean_distance(g) -} -try.ring.pl(10) -try.ring.pl(100) - -pause() - -### Test a number of regular graphs -ring.size <- seq(100, 1000, by = 100) -ring.pl <- sapply(ring.size, try.ring.pl) -plot(ring.size, ring.pl, type = "b") - -pause() - -### Path lengths, random graph -rg <- sample_gnm(50, 50 * 3) -rg$layout <- layout_in_circle -V(rg)$size <- 3 -plot(rg, vertex.label = NA, main = "Random graph") -mean_distance(rg) - -pause() - -### Path length of random graphs -try.random.pl <- function(n) { - g <- sample_gnm(n, n * 3) - mean_distance(g) -} -try.random.pl(100) - -pause() - -### Plot network size vs. average path length -random.pl <- sapply(ring.size, try.random.pl) -plot(ring.size, random.pl, type = "b") - -pause() - -### Plot again, logarithmic 'x' axis -plot(ring.size, random.pl, type = "b", log = "x") - -pause() - -### Transitivity, random graph, by definition -ecount(rg) / (vcount(rg) * (vcount(rg) - 1) / 2) -transitivity(rg, type = "localaverage") - -pause() - -### Rewiring -ws2 <- sample_smallworld(1, 50, 3, p = 0.1) -ws2$layout <- layout_in_circle -V(ws2)$size <- 3 -plot(ws2, vertex.label = NA) -mean_distance(ws2) - -pause() - -### Path lengths in randomized lattices -try.rr.pl <- function(n, p) { - g <- sample_smallworld(1, n, 3, p = p) - mean_distance(g) -} -rr.pl.0.1 <- sapply(ring.size, try.rr.pl, p = 0.1) -plot(ring.size, rr.pl.0.1, type = "b") - -pause() - -### Logarithmic 'x' axis -plot(ring.size, rr.pl.0.1, type = "b", log = "x") - -pause() - -### Create the graph in the Watts-Strogatz paper -ws.paper <- function(p, n = 1000) { - g <- sample_smallworld(1, n, 10, p = p) - tr <- transitivity(g, type = "localaverage") - pl <- mean_distance(g) - c(tr, pl) -} - -pause() - -### Do the simulation for a number of 'p' values -rewire.prob <- ((1:10)^4) / (10^4) -ws.result <- sapply(rewire.prob, ws.paper) -dim(ws.result) - -pause() - -### Plot it -plot( - rewire.prob, - ws.result[1, ] / ws.result[1, 1], - log = "x", - pch = 22, - xlab = "p", - ylab = "" -) -points(rewire.prob, ws.result[2, ] / ws.result[2, 1], pch = 20) -legend( - "bottomleft", - c(expression(C(p) / C(0)), expression(L(p) / L(0))), - pch = c(22, 20) -) diff --git a/man/igraph_demo.Rd b/man/igraph_demo.Rd deleted file mode 100644 index 765ad6c762..0000000000 --- a/man/igraph_demo.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/demo.R -\name{igraph_demo} -\alias{igraph_demo} -\title{Run igraph demos, step by step} -\usage{ -igraph_demo(which) -} -\arguments{ -\item{which}{If not given, then the names of the available demos are listed. -Otherwise it should be either a filename or the name of an igraph demo.} -} -\value{ -Returns \code{NULL}, invisibly. -} -\description{ -Run one of the accompanying igraph demos, somewhat interactively, using a Tk -window. -} -\details{ -This function provides a somewhat nicer interface to igraph demos that come -with the package, than the standard \code{\link[=demo]{demo()}} function. igraph -demos are divided into chunks and \code{igraph_demo()} runs them chunk by -chunk, with the possibility of inspecting the workspace between two chunks. - -The \code{tcltk} package is needed for \code{igraph_demo()}. -} -\examples{ - -igraph_demo() - -\dontshow{if (interactive() && rlang::is_installed("tcltk")) withAutoprint(\{ # examplesIf} -igraph_demo("centrality") -\dontshow{\}) # examplesIf} -} -\seealso{ -\code{\link[=demo]{demo()}} -} -\author{ -Gabor Csardi \email{csardi.gabor@gmail.com} -} -\concept{demo} -\keyword{graphs} diff --git a/man/igraphdemo.Rd b/man/igraphdemo.Rd deleted file mode 100644 index 08141022cd..0000000000 --- a/man/igraphdemo.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/demo.R -\name{igraphdemo} -\alias{igraphdemo} -\title{Run igraph demos, step by step} -\usage{ -igraphdemo(which) -} -\arguments{ -\item{which}{If not given, then the names of the available demos are listed. -Otherwise it should be either a filename or the name of an igraph demo.} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} - -\code{igraphdemo()} was renamed to \code{\link[=igraph_demo]{igraph_demo()}} to create a more -consistent API. -} -\keyword{internal}