diff --git a/DESCRIPTION b/DESCRIPTION index da9272bf..9b20dc75 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: manynet Title: Many Ways to Make, Modify, Map, Mark, and Measure Myriad Networks -Version: 1.0.4 -Date: 2024-07-25 +Version: 1.0.5 +Date: 2024-08-29 Description: Many tools for making, modifying, mapping, marking, measuring, and motifs and memberships of many different types of networks. All functions operate with matrices, edge lists, and 'igraph', 'network', and 'tidygraph' objects, diff --git a/NAMESPACE b/NAMESPACE index 56e7fb5d..c653cc05 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -315,6 +315,7 @@ export(cluster_concor) export(cluster_hierarchical) export(create_components) export(create_core) +export(create_degree) export(create_empty) export(create_explicit) export(create_filled) @@ -332,7 +333,10 @@ export(from_slices) export(from_subgraphs) export(from_ties) export(from_waves) +export(generate_citations) export(generate_configuration) +export(generate_fire) +export(generate_islands) export(generate_permutation) export(generate_random) export(generate_scalefree) @@ -667,6 +671,7 @@ export(tie_cohesion) export(tie_degree) export(tie_eigenvector) export(tie_is_bridge) +export(tie_is_cyclical) export(tie_is_feedback) export(tie_is_loop) export(tie_is_max) @@ -674,6 +679,9 @@ export(tie_is_min) export(tie_is_multiple) export(tie_is_random) export(tie_is_reciprocated) +export(tie_is_simmelian) +export(tie_is_transitive) +export(tie_is_triangular) export(tie_signs) export(tie_weights) export(to_acyclic) @@ -694,6 +702,7 @@ export(to_multilevel) export(to_named) export(to_no_isolates) export(to_onemode) +export(to_permuted) export(to_reciprocated) export(to_redirected) export(to_simplex) @@ -827,6 +836,7 @@ importFrom(igraph,ivs_size) importFrom(igraph,knn) importFrom(igraph,largest_ivs) importFrom(igraph,make_ego_graph) +importFrom(igraph,make_graph) importFrom(igraph,make_lattice) importFrom(igraph,make_line_graph) importFrom(igraph,make_star) @@ -835,12 +845,17 @@ importFrom(igraph,max_bipartite_match) importFrom(igraph,mean_distance) importFrom(igraph,power_centrality) importFrom(igraph,read_graph) +importFrom(igraph,realize_bipartite_degseq) +importFrom(igraph,realize_degseq) importFrom(igraph,reciprocity) importFrom(igraph,reverse_edges) importFrom(igraph,sample_bipartite) importFrom(igraph,sample_degseq) +importFrom(igraph,sample_forestfire) importFrom(igraph,sample_gnm) importFrom(igraph,sample_gnp) +importFrom(igraph,sample_islands) +importFrom(igraph,sample_last_cit) importFrom(igraph,sample_pa) importFrom(igraph,sample_smallworld) importFrom(igraph,set_edge_attr) @@ -848,6 +863,7 @@ importFrom(igraph,set_vertex_attr) importFrom(igraph,simplify) importFrom(igraph,transitivity) importFrom(igraph,triad_census) +importFrom(igraph,triangles) importFrom(igraph,vcount) importFrom(igraph,vertex_attr) importFrom(igraph,vertex_attr_names) diff --git a/NEWS.md b/NEWS.md index 280cdb2d..7429e2da 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,43 @@ +# manynet 1.0.5 + +## Making + +- Added `create_degree()` for creating networks of a given degree sequence, including _k_-regular graphs +- Added `generate_citations()` for citation models +- Added `generate_fire()` for forest-fire models +- Added `generate_islands()` for island models +- `create_explicit()` now has its own documentation + +## Marking + +- Added `tie_is_triangular()` for identifying ties in triangles +- Added `tie_is_cyclical()` for identifying ties in cycles +- Added `tie_is_transitive()` for identifying ties involved in transitive closure +- Added `tie_is_simmelian()` for identifying Simmelian ties + +## Manipulating + +- `generate_permutation()` renamed to `to_permuted()` + +## Mapping + +- Updated how `graphr()` plots edges in directed networks +- Removed automatic legends for signed networks +- Fixed other legends issues + +## Data + +- `table_data()` can now report on data from multiple packages + - `{manynet}` and `{migraph}` are included by default, + and if any are not installed they are just ignored +- `tabe_data()` can now filter by any reported formats, +such as 'directed' or 'twomode' + +## Website + +- Added more structure to Modifying section +- Added more structure to Mapping section + # manynet 1.0.4 ## Modifying diff --git a/R/make_create.R b/R/make_create.R index 7b40824e..04f7d16b 100644 --- a/R/make_create.R +++ b/R/make_create.R @@ -1,3 +1,123 @@ +# Explicit #### + +#' Making networks with explicit ties +#' +#' +#' @description +#' This function creates a network from a vector of explicitly named nodes +#' and ties between them. +#' `create_explicit()` largely wraps `igraph::graph_from_literal()`, +#' but will also accept character input and not just a formula, +#' and will never simplify the result. +#' +#' Ties are indicated by `-`, and directed ties (arcs) +#' require `+` at either or both ends. +#' Ties are separated by commas, and isolates can be added as +#' an additional, unlinked node after the comma within the formula. +#' Sets of nodes can be linked to other sets of nodes through use of +#' a semi-colon. +#' See the example for a demonstration. +#' @name make_explicit +#' @family makes +#' @param ... Arguments passed on to `{igraph}`. +#' @importFrom igraph make_graph +#' @examples +#' create_explicit(A -+ B, B -+ C, A +-+ C, D, E:F:G-+A, E:F+-+G:H) +#' @export +create_explicit <- function(...){ + if(is.symbol(as.list(match.call())[-1][[1]])){ + mf <- stats::reformulate(...) + mf[[1]] <- NULL + } else mf <- as.list(match.call())[-1] + f <- function(x) { + if (is.call(x)) { + return(list(as.character(x[[1]]), lapply(x[-1], f))) + } + else return(NULL) + } + ops <- unlist(lapply(mf, f)) + if (all(ops %in% c("-", ":"))) { + directed <- FALSE + } + else if (all(ops %in% c("-", "+", ":"))) { + directed <- TRUE + } + else { + stop("Invalid operator in formula") + } + f <- function(x) { + if (is.call(x)) { + if (length(x) == 3) { + return(list(f(x[[2]]), op = as.character(x[[1]]), + f(x[[3]]))) + } + else { + return(list(op = as.character(x[[1]]), f(x[[2]]))) + } + } + else { + return(c(sym = as.character(x))) + } + } + ret <- lapply(mf, function(x) unlist(f(x))) + v <- unique(unlist(lapply(ret, function(x) { + x[names(x) == "sym"] + }))) + ret <- lapply(ret, function(x) { + res <- list() + for (i in seq(along.with = x)) { + if (x[i] == ":" && names(x)[i] == "op") { + } + else if (i > 1 && x[i - 1] == ":" && names(x)[i - + 1] == "op") { + res[[length(res)]] <- c(res[[length(res)]], unname(x[i])) + } + else { + res <- c(res, x[i]) + } + } + res + }) + edges <- numeric() + for (i in seq(along.with = ret)) { + prev.sym <- character() + lhead <- rhead <- character() + for (j in seq(along.with = ret[[i]])) { + act <- ret[[i]][[j]] + if (names(ret[[i]])[j] == "op") { + if (length(lhead) == 0) { + lhead <- rhead <- act + } + else { + rhead <- act + } + } + else if (names(ret[[i]])[j] == "sym") { + for (ps in prev.sym) { + for (ps2 in act) { + if (lhead == "+") { + edges <- c(edges, unname(c(ps2, ps))) + } + if (!directed || rhead == "+") { + edges <- c(edges, unname(c(ps, ps2))) + } + } + } + lhead <- rhead <- character() + prev.sym <- act + } + } + } + ids <- seq(along.with = v) + names(ids) <- v + res <- igraph::make_graph(unname(ids[edges]), + n = length(v), directed = directed) + res <- igraph::set_vertex_attr(res, "name", value = v) + as_tidygraph(res) +} + +# Defined #### + #' Making networks with defined structures #' #' @description @@ -13,8 +133,8 @@ #' - `create_components()` creates a network that clusters nodes into separate components. #' - `create_core()` creates a network in which a certain proportion of 'core' nodes #' are densely tied to each other, and the rest peripheral, tied only to the core. -#' - `create_explicit()` creates a network based on explicitly -#' named nodes and ties between them. +#' - `create_degree()` creates a network with a given (out/in)degree sequence, +#' which can also be used to create k-regular networks. #' #' These functions can create either one-mode or two-mode networks. #' To create a one-mode network, pass the main argument `n` a single integer, @@ -24,7 +144,7 @@ #' and the second integer indicates the number of nodes in the second mode. #' As an alternative, an existing network can be provided to `n` #' and the number of modes, nodes, and directedness will be inferred. -#' @name create +#' @name make_create #' @family makes #' @seealso [as] #' @param n Given: @@ -45,7 +165,6 @@ #' @param membership A vector of partition membership as integers. #' If left as `NULL` (the default), nodes in each mode will be #' assigned to two, equally sized partitions. -#' @param ... Additional arguments passed on to `{igraph}`. #' @return By default a `tbl_graph` object is returned, #' but this can be coerced into other types of objects #' using `as_edgelist()`, `as_matrix()`, @@ -61,7 +180,7 @@ #' @importFrom igraph graph_from_biadjacency_matrix NULL -#' @rdname create +#' @rdname make_create #' @examples #' create_empty(10) #' @export @@ -79,7 +198,7 @@ create_empty <- function(n, directed = FALSE) { as_tidygraph(out) } -#' @rdname create +#' @rdname make_create #' @examples #' create_filled(10) #' @export @@ -98,7 +217,8 @@ create_filled <- function(n, directed = FALSE) { as_tidygraph(out) } -#' @rdname create +#' @rdname make_create +#' @param ... Additional arguments passed on to `igraph::make_ring()`. #' @examples #' create_ring(8, width = 2) #' @export @@ -145,7 +265,7 @@ create_ring <- function(n, directed = FALSE, width = 1, ...) { as_tidygraph(out) } -#' @rdname create +#' @rdname make_create #' @importFrom igraph graph_from_adjacency_matrix graph_from_biadjacency_matrix #' make_star #' @examples @@ -169,7 +289,7 @@ create_star <- function(n, as_tidygraph(out) } -#' @rdname create +#' @rdname make_create #' @importFrom igraph make_tree #' @examples #' create_tree(c(7,8)) @@ -217,7 +337,7 @@ create_tree <- function(n, } } -#' @rdname create +#' @rdname make_create #' @section Lattice graphs: #' `create_lattice()` creates both two-dimensional grid and triangular #' lattices with as even dimensions as possible. @@ -325,7 +445,7 @@ create_lattice <- function(n, # } # } -#' @rdname create +#' @rdname make_create #' @examples #' create_components(10, membership = c(1,1,1,2,2,2,3,3,3,3)) #' @export @@ -349,7 +469,47 @@ create_components <- function(n, directed = FALSE, membership = NULL) { as_tidygraph(out) } -#' @rdname create +#' @rdname make_create +#' @param outdegree Numeric scalar or vector indicating the +#' desired outdegree distribution. +#' By default NULL and is required. +#' If `n` is an existing network object and the outdegree is not specified, +#' then the outdegree distribution will be inferred from that of the network. +#' Note that a scalar (single number) will result in a k-regular graph. +#' @param indegree Numeric vector indicating the desired indegree distribution. +#' By default NULL but not required unless a directed network is desired. +#' If `n` is an existing directed network object and the indegree is not specified, +#' then the indegree distribution will be inferred from that of the network. +#' @importFrom igraph realize_degseq realize_bipartite_degseq +#' @examples +#' create_degree(10, outdegree = rep(1:5, 2)) +#' @export +create_degree <- function(n, outdegree = NULL, indegree = NULL) { + directed <- infer_directed(n, !is.null(indegree)) + outdegree <- infer_outdegree(n, outdegree) + indegree <- infer_indegree(n, indegree) + n <- infer_n(n) + if (length(n) == 1) { + if(!directed){ + if(length(outdegree)==1) outdegree <- rep(outdegree, n) + stopifnot(n == length(outdegree)) + out <- igraph::realize_degseq(outdegree) + } else { + if(length(outdegree)==1) outdegree <- rep(outdegree, n) + if(length(indegree)==1) indegree <- rep(indegree, n) + stopifnot(n == length(outdegree), n == length(indegree)) + out <- igraph::realize_degseq(outdegree, indegree) + } + } else if (length(n) == 2) { + if(length(outdegree)==1) outdegree <- rep(outdegree, n[1]) + if(length(indegree)==1) indegree <- rep(indegree, n[2]) + stopifnot(n[1] == length(outdegree), n[2] == length(indegree)) + out <- igraph::realize_bipartite_degseq(outdegree, indegree) + } + as_tidygraph(out) +} + +#' @rdname make_create #' @param mark A logical vector the length of the nodes in the network. #' This can be created by, among other things, any `node_is_*()` function. #' @examples @@ -375,106 +535,6 @@ create_core <- function(n, directed = FALSE, mark = NULL) { } } -#' @rdname create -#' @seealso [igraph::graph_from_literal()] which `create_explicit()` mostly just wraps. -#' `create_explicit()` will also accept character input and not just a formula though, -#' and will never simplify the result. -#' @examples -#' create_explicit(A -+ B, B -+ C, A +-+ C, D) -#' @export -create_explicit <- function(...){ - if(is.symbol(as.list(match.call())[-1][[1]])){ - mf <- stats::reformulate(...) - mf[[1]] <- NULL - } else mf <- as.list(match.call())[-1] - f <- function(x) { - if (is.call(x)) { - return(list(as.character(x[[1]]), lapply(x[-1], f))) - } - else return(NULL) - } - ops <- unlist(lapply(mf, f)) - if (all(ops %in% c("-", ":"))) { - directed <- FALSE - } - else if (all(ops %in% c("-", "+", ":"))) { - directed <- TRUE - } - else { - stop("Invalid operator in formula") - } - f <- function(x) { - if (is.call(x)) { - if (length(x) == 3) { - return(list(f(x[[2]]), op = as.character(x[[1]]), - f(x[[3]]))) - } - else { - return(list(op = as.character(x[[1]]), f(x[[2]]))) - } - } - else { - return(c(sym = as.character(x))) - } - } - ret <- lapply(mf, function(x) unlist(f(x))) - v <- unique(unlist(lapply(ret, function(x) { - x[names(x) == "sym"] - }))) - ret <- lapply(ret, function(x) { - res <- list() - for (i in seq(along.with = x)) { - if (x[i] == ":" && names(x)[i] == "op") { - } - else if (i > 1 && x[i - 1] == ":" && names(x)[i - - 1] == "op") { - res[[length(res)]] <- c(res[[length(res)]], unname(x[i])) - } - else { - res <- c(res, x[i]) - } - } - res - }) - edges <- numeric() - for (i in seq(along.with = ret)) { - prev.sym <- character() - lhead <- rhead <- character() - for (j in seq(along.with = ret[[i]])) { - act <- ret[[i]][[j]] - if (names(ret[[i]])[j] == "op") { - if (length(lhead) == 0) { - lhead <- rhead <- act - } - else { - rhead <- act - } - } - else if (names(ret[[i]])[j] == "sym") { - for (ps in prev.sym) { - for (ps2 in act) { - if (lhead == "+") { - edges <- c(edges, unname(c(ps2, ps))) - } - if (!directed || rhead == "+") { - edges <- c(edges, unname(c(ps, ps2))) - } - } - } - lhead <- rhead <- character() - prev.sym <- act - } - } - } - ids <- seq(along.with = v) - names(ids) <- v - res <- igraph::make_graph(unname(ids[edges]), - n = length(v), directed = directed) - res <- igraph::set_vertex_attr(res, "name", value = v) - as_tidygraph(res) -} - - # #' @rdname create # #' @details Creates a nested two-mode network. # #' Will construct an affiliation matrix, @@ -507,6 +567,16 @@ create_explicit <- function(...){ # Helper functions ------------------ +infer_dims <- function(object) { + if(is_twomode(object) & + any(grepl("type", igraph::vertex_attr_names(as_igraph(object))))) { + c(sum(!igraph::V(as_igraph(object))$type), + sum(igraph::V(as_igraph(object))$type)) + } else { + igraph::vcount(as_igraph(object)) + } +} + infer_n <- function(n) { if (is_manynet(n)) n <- infer_dims(n) if (length(n) > 2) stop(paste("`n` should be a single integer for a one-mode network or", @@ -519,6 +589,22 @@ infer_directed <- function(n, directed) { directed } +infer_outdegree <- function(n, outdegree) { + if (is.null(outdegree) && is_manynet(n)){ + outdegree <- node_deg(n, direction = "out") + if(is_twomode(n)) outdegree <- outdegree[1:net_dims(n)[1]] + } + outdegree +} + +infer_indegree <- function(n, indegree) { + if (is.null(indegree) && is_manynet(n)){ + indegree <- node_deg(n, direction = "in") + if(is_twomode(n)) indegree <- indegree[(net_dims(n)[1]+1):sum(net_dims(n))] + } + indegree +} + infer_membership <- function(n, membership) { if (is.null(membership)) { if(is_manynet(n)) n <- infer_n(n) @@ -539,12 +625,3 @@ roll_over <- function(w) { cbind(w[, ncol(w)], w[, 1:(ncol(w) - 1)]) } -infer_dims <- function(object) { - if(is_twomode(object) & - any(grepl("type", igraph::vertex_attr_names(as_igraph(object))))) { - c(sum(!igraph::V(as_igraph(object))$type), - sum(igraph::V(as_igraph(object))$type)) - } else { - igraph::vcount(as_igraph(object)) - } -} diff --git a/R/make_generate.R b/R/make_generate.R index f70687b4..67f0f8b4 100644 --- a/R/make_generate.R +++ b/R/make_generate.R @@ -10,10 +10,10 @@ #' given degree distribution. #' - `generate_smallworld()` generates a small-world structure via ring rewiring at some probability. #' - `generate_scalefree()` generates a scale-free structure via preferential attachment at some probability. -#' - `generate_permutation()` generates a permutation of the network -#' using a Fisher-Yates shuffle on both the rows and columns (for a one-mode network) -#' or on each of the rows and columns (for a two-mode network). #' - `generate_utilities()` generates a random utility matrix. +#' - `generate_fire()` generates a forest fire model. +#' - `generate_islands()` generates an islands model. +#' - `generate_citations()` generates a citations model. #' #' These functions can create either one-mode or two-mode networks. #' To create a one-mode network, pass the main argument `n` a single integer, @@ -23,9 +23,9 @@ #' and the second integer indicates the number of nodes in the second mode. #' As an alternative, an existing network can be provided to `n` #' and the number of modes, nodes, and directedness will be inferred. -#' @name generate +#' @name make_generate #' @family makes -#' @inheritParams create +#' @inheritParams make_create #' @inheritParams is #' @param directed Whether to generate network as directed. By default FALSE. #' @return By default a `tbl_graph` object is returned, @@ -41,9 +41,12 @@ #' In two-mode networks, the directed argument is ignored. NULL -#' @rdname generate +#' @rdname make_generate #' @param p Proportion of possible ties in the network that are realised or, #' if integer greater than 1, the number of ties in the network. +#' @param with_attr Logical whether any attributes of the object +#' should be retained. +#' By default TRUE. #' @references #' Erdos, Paul, and Alfred Renyi. (1959). #' "\href{https://www.renyi.hu/~p_erdos/1959-11.pdf}{On Random Graphs I}" @@ -98,7 +101,33 @@ generate_random <- function(n, p = 0.5, directed = FALSE, with_attr = TRUE) { g } -#' @rdname generate +#' @rdname make_generate +#' @importFrom igraph sample_degseq +#' @export +generate_configuration <- function(.data){ + if(is_twomode(.data)){ + degs <- node_deg(.data) + outs <- ifelse(!c(attr(degs, "mode")),c(degs),rep(0,length(degs))) + ins <- ifelse(c(attr(degs, "mode")),c(degs),rep(0,length(degs))) + out <- igraph::sample_degseq(outs, ins, method = "simple.no.multiple") + out <- as_tidygraph(out) %>% mutate(type = c(attr(degs, "mode"))) + } else { + if(is_complex(.data) || is_multiplex(.data) && is_directed(.data)) + out <- igraph::sample_degseq(node_deg(.data, direction = "out"), + node_deg(.data, direction = "in"), + method = "simple") + if(is_complex(.data) || is_multiplex(.data) && !is_directed(.data)) + out <- igraph::sample_degseq(node_deg(.data), method = "simple") + if(!(is_complex(.data) || is_multiplex(.data)) && is_directed(.data)) + out <- igraph::sample_degseq(node_deg(.data, direction = "out"), + node_deg(.data, direction = "in"), method = "simple.no.multiple") + if(!(is_complex(.data) || is_multiplex(.data)) && !is_directed(.data)) + out <- igraph::sample_degseq(node_deg(.data), method = "simple.no.multiple") + } + as_tidygraph(out) +} + +#' @rdname make_generate #' @param p Proportion of possible ties in the network that are realised or, #' if integer greater than 1, the number of ties in the network. #' @references @@ -125,7 +154,7 @@ generate_smallworld <- function(n, p = 0.05, directed = FALSE, width = 2) { g } -#' @rdname generate +#' @rdname make_generate #' @param p Power of the preferential attachment, default is 1. #' @importFrom igraph sample_pa #' @references @@ -154,26 +183,7 @@ generate_scalefree <- function(n, p = 1, directed = FALSE) { g } -#' @rdname generate -#' @param with_attr Logical whether any attributes of the object -#' should be retained. -#' By default TRUE. -#' @examples -#' graphr(ison_adolescents) -#' graphr(generate_permutation(ison_adolescents)) -#' @export -generate_permutation <- function(.data, with_attr = TRUE) { - out <- as_matrix(.data) - if(is_twomode(.data)){ - out <- .r2perm(out) - } else { - out <- .r1perm(out) - } - if(with_attr) out <- bind_node_attributes(out, .data) - out -} - -#' @rdname generate +#' @rdname make_generate #' @param steps Number of simulation steps to run. #' By default 1: a single, one-shot simulation. #' If more than 1, further iterations will update the utilities @@ -206,53 +216,81 @@ generate_utilities <- function(n, steps = 1, volatility = 0, threshold = 0){ as_igraph(utilities) } -#' @rdname generate -#' @importFrom igraph sample_degseq +#' @rdname make_generate +#' @param contacts Number of contacts or ambassadors chosen from among existing +#' nodes in the network. +#' By default 1. +#' See `igraph::sample_forestfire()`. +#' @param their_out Probability of tieing to a contact's outgoing ties. +#' By default 0. +#' @param their_in Probability of tieing to a contact's incoming ties. +#' By default 1. +#' @importFrom igraph sample_forestfire +#' @examples +#' generate_fire(10) #' @export -generate_configuration <- function(.data){ - if(is_twomode(.data)){ - degs <- node_deg(.data) - outs <- ifelse(!c(attr(degs, "mode")),c(degs),rep(0,length(degs))) - ins <- ifelse(c(attr(degs, "mode")),c(degs),rep(0,length(degs))) - out <- igraph::sample_degseq(outs, ins, method = "simple.no.multiple") - out <- as_tidygraph(out) %>% mutate(type = c(attr(degs, "mode"))) +generate_fire <- function(n, contacts = 1, their_out = 0, their_in = 1, directed = FALSE){ + directed <- infer_directed(n, directed) + n <- infer_n(n) + if(length(n)==2){ + stop("There is currently no forest fire model implemented for two-mode networks.") } else { - if(is_complex(.data) || is_multiplex(.data) && is_directed(.data)) - out <- igraph::sample_degseq(node_deg(.data, direction = "out"), - node_deg(.data, direction = "in"), - method = "simple") - if(is_complex(.data) || is_multiplex(.data) && !is_directed(.data)) - out <- igraph::sample_degseq(node_deg(.data), method = "simple") - if(!(is_complex(.data) || is_multiplex(.data)) && is_directed(.data)) - out <- igraph::sample_degseq(node_deg(.data, direction = "out"), - node_deg(.data, direction = "in"), method = "simple.no.multiple") - if(!(is_complex(.data) || is_multiplex(.data)) && !is_directed(.data)) - out <- igraph::sample_degseq(node_deg(.data), method = "simple.no.multiple") + out <- igraph::sample_forestfire(n, + fw.prob = their_out, bw.factor = their_in, + ambs = contacts, directed = directed) } as_tidygraph(out) } -# Helper functions ------------------ - -.r1perm <- function(m) { - n <- sample(seq_len(dim(m)[1])) - if(is_labelled(m)){ - p <- matrix(data = m[n, n], nrow = dim(m)[1], ncol = dim(m)[2], - dimnames = dimnames(m)) +#' @rdname make_generate +#' @param islands Number of islands or communities to create. +#' By default 2. +#' See `igraph::sample_islands()` for more. +#' @param bridges Number of bridges between islands/communities. +#' By default 1. +#' @importFrom igraph sample_islands +#' @examples +#' generate_islands(10) +#' @export +generate_islands <- function(n, islands = 2, p = 0.5, bridges = 1, directed = FALSE){ + directed <- infer_directed(n, directed) + if(is_manynet(n)){ + m <- net_nodes(n) + extra_ties <- ifelse(islands > 2, islands * bridges, bridges) + aimed_ties <- net_ties(n) - extra_ties + m <- mean(c(table(cut(seq.int(m), islands, labels = FALSE)))) + p <- (aimed_ties/islands) / ifelse(directed, m*(m-1), (m*(m-1))/2) + if(p > 1) p <- 1 + } + n <- infer_n(n) + if(length(n)==2){ + stop("There is currently no island model implemented for two-mode networks.") } else { - p <- matrix(data = m[n, n], nrow = dim(m)[1], ncol = dim(m)[2]) + out <- igraph::sample_islands(islands.n = islands, + islands.size = c(table(cut(seq.int(n), islands, labels = FALSE))), + islands.pin = p, + n.inter = bridges) + if(net_nodes(out) != n) out <- delete_nodes(out, order(node_constraint(out), decreasing = TRUE)[1:(net_nodes(out)-n)]) + if(directed) out <- to_directed(out) } - p + as_tidygraph(out) } -.r2perm <- function(m) { - n <- sample(seq_len(dim(m)[1])) - o <- sample(seq_len(dim(m)[2])) - if(is_labelled(m)){ - p <- matrix(data = m[n, o], nrow = dim(m)[1], ncol = dim(m)[2], - dimnames = dimnames(m)) - } else { - p <- matrix(data = m[n, o], nrow = dim(m)[1], ncol = dim(m)[2]) - } - p +#' @rdname make_generate +#' @param ties Number of ties to add per new node. +#' By default a uniform random sample from 1 to 4 new ties. +#' @param agebins Number of aging bins. +#' By default either \eqn{\frac{n}{10}} or 1, +#' whichever is the larger. +#' See `igraphr::sample_last_cit()` for more. +#' @importFrom igraph sample_last_cit +#' @examples +#' generate_citations(10) +#' @export +generate_citations <- function(n, ties = sample(1:4,1), agebins = max(1, n/10), directed = FALSE){ + directed <- infer_directed(n, directed) + n <- infer_n(n) + out <- igraph::sample_last_cit(n, edges = ties, agebins = agebins, directed = directed) + as_tidygraph(out) } + diff --git a/R/manip_correlation.R b/R/manip_correlation.R index 5fa9679a..651d3591 100644 --- a/R/manip_correlation.R +++ b/R/manip_correlation.R @@ -12,7 +12,7 @@ #' and for complex networks it will include also the difference #' between the self ties in each pairwise calculation. #' This function runs in \eqn{O(mn^2)} complexity. -#' @name correlation +#' @name manip_correlation #' @inheritParams is #' @param method One of the following: #' "all" includes all information, @@ -39,6 +39,65 @@ to_correlation <- function(.data, method = NULL){ out } +#' Network permutation +#' +#' @description +#' `to_permuted()` permutes the network using a Fisher-Yates shuffle +#' on both the rows and columns (for a one-mode network) +#' or on each of the rows and columns (for a two-mode network). +#' @name manip_permutation +#' @inheritParams is +#' @family modifications +NULL + +#' @rdname manip_permutation +#' @param with_attr Logical whether any attributes of the object +#' should be retained. +#' By default TRUE. +#' @examples +#' graphr(ison_adolescents, node_size = 4) +#' graphr(to_permuted(ison_adolescents), node_size = 4) +#' @export +to_permuted <- function(.data, with_attr = TRUE) { + out <- as_matrix(.data) + if(is_twomode(.data)){ + out <- .r2perm(out) + } else { + out <- .r1perm(out) + } + if(with_attr) out <- bind_node_attributes(out, .data) + out +} + +#' @rdname make_generate +#' @export +generate_permutation <- to_permuted #to avoid migraph dependency issues + +# Helper functions ------------------ + +.r1perm <- function(m) { + n <- sample(seq_len(dim(m)[1])) + if(is_labelled(m)){ + p <- matrix(data = m[n, n], nrow = dim(m)[1], ncol = dim(m)[2], + dimnames = dimnames(m)) + } else { + p <- matrix(data = m[n, n], nrow = dim(m)[1], ncol = dim(m)[2]) + } + p +} + +.r2perm <- function(m) { + n <- sample(seq_len(dim(m)[1])) + o <- sample(seq_len(dim(m)[2])) + if(is_labelled(m)){ + p <- matrix(data = m[n, o], nrow = dim(m)[1], ncol = dim(m)[2], + dimnames = dimnames(m)) + } else { + p <- matrix(data = m[n, o], nrow = dim(m)[1], ncol = dim(m)[2]) + } + p +} + .corTwomode <- function(m0){ stats::cor(m0) } @@ -96,3 +155,5 @@ to_correlation <- function(.data, method = NULL){ m[upper.tri(m)] <- t(m)[upper.tri(m)] return(m) } + + diff --git a/R/manip_split.R b/R/manip_split.R index 41f67a70..d3eebe50 100644 --- a/R/manip_split.R +++ b/R/manip_split.R @@ -10,13 +10,13 @@ #' ```{r, echo = FALSE, cache = TRUE} #' knitr::kable(available_methods(c("to_egos", "to_subgraphs", "to_components", "to_waves", "to_slices"))) #' ``` -#' @name split +#' @name manip_split #' @family modifications #' @inheritParams reformat #' @return The returned object will be a list of network objects. NULL -#' @describeIn split Returns a list of ego (or focal) +#' @describeIn manip_split Returns a list of ego (or focal) #' networks. #' @param max_dist The maximum breadth of the neighbourhood. #' By default 1. @@ -86,7 +86,7 @@ to_egos.data.frame <- function(.data, lapply(out, function(x) as_edgelist(x)) } -#' @describeIn split Returns a list of subgraphs +#' @describeIn manip_split Returns a list of subgraphs #' on some given node attribute. #' @param attribute A character string indicating the categorical #' attribute in a network used to split into subgraphs. @@ -116,7 +116,7 @@ to_subgraphs.network <- function(.data, attribute){ lapply(to_subgraphs(as_igraph(.data), attribute), as_network) } -#' @describeIn split Returns a list of the components +#' @describeIn manip_split Returns a list of the components #' in a network. #' @examples #' to_components(ison_marvel_relationships) @@ -153,7 +153,7 @@ to_components.data.frame <- function(.data){ lapply(out, function(x) as_edgelist(x)) } -#' @describeIn split Returns a network +#' @describeIn manip_split Returns a network #' with some discrete observations over time #' into a list of those observations. #' @param attribute Character string indicating the date @@ -281,7 +281,7 @@ cumulative_ties <- function(x, attribute) { lapply(x, as_tidygraph) } -#' @describeIn split Returns a list of a network +#' @describeIn manip_split Returns a list of a network #' with some continuous time variable at some time slice(s). #' @param attribute One or two attributes used to slice data. #' @param slice Character string or character list indicating the date(s) diff --git a/R/manynet-tutorials.R b/R/manynet-tutorials.R index 2c6f6b00..2fbca680 100644 --- a/R/manynet-tutorials.R +++ b/R/manynet-tutorials.R @@ -94,56 +94,63 @@ extract_tute <- function(tute) { NULL #' @rdname data_overview +#' @param ... Network marks, e.g. directed, twomode, or signed, +#' that are used to filter the results. #' @examples #' table_data() -#' # to obtain list of all e.g. two-mode networks: -#' table_data() %>% -#' dplyr::filter(directed) +#' # to obtain list of all e.g. directed networks: +#' table_data(pkg = "manynet", directed) #' # to obtain overview of unique datasets: #' table_data() %>% #' dplyr::distinct(directed, weighted, twomode, signed, #' .keep_all = TRUE) #' @export -table_data <- function(pkg = "manynet") { +table_data <- function(pkg = c("manynet","migraph"), + ...) { nodes <- NULL - datanames <- utils::data(package = pkg)$results[,"Item"] - require(package = pkg, character.only = TRUE) - datasets <- lapply(datanames, function(d) get(d)) - datanames <- datanames[!vapply(datasets, is_list, logical(1))] - datasets <- datasets[!vapply(datasets, is_list, logical(1))] - out <- dplyr::tibble(dataset = tibble::char(datanames, min_chars = 18), - nodes = vapply(datasets, net_nodes, numeric(1)), - ties = vapply(datasets, net_ties, numeric(1)), - nattr = vapply(datasets, - function (x) length(net_node_attributes(x)), - numeric(1)), - tattr = vapply(datasets, - function (x) length(net_tie_attributes(x)), - numeric(1)), - directed = vapply(datasets, - is_directed, - logical(1)), - weighted = vapply(datasets, - is_weighted, + pkg <- intersect(pkg, rownames(utils::installed.packages())) + out <- lapply(pkg, function(x){ + datanames <- utils::data(package = x)$results[,"Item"] + require(package = x, character.only = TRUE) + datasets <- lapply(datanames, function(d) get(d)) + datanames <- datanames[!vapply(datasets, is_list, logical(1))] + datasets <- datasets[!vapply(datasets, is_list, logical(1))] + dplyr::tibble(dataset = tibble::char(datanames, min_chars = 18), + nodes = vapply(datasets, net_nodes, numeric(1)), + ties = vapply(datasets, net_ties, numeric(1)), + nattr = vapply(datasets, + function (x) length(net_node_attributes(x)), + numeric(1)), + tattr = vapply(datasets, + function (x) length(net_tie_attributes(x)), + numeric(1)), + directed = vapply(datasets, + is_directed, + logical(1)), + weighted = vapply(datasets, + is_weighted, + logical(1)), + twomode = vapply(datasets, + is_twomode, logical(1)), - twomode = vapply(datasets, - is_twomode, + labelled = vapply(datasets, + is_labelled, + logical(1)), + signed = vapply(datasets, + is_signed, + logical(1)), + multiplex = vapply(datasets, + is_multiplex, logical(1)), - labelled = vapply(datasets, - is_labelled, - logical(1)), - signed = vapply(datasets, - is_signed, - logical(1)), - multiplex = vapply(datasets, - is_multiplex, - logical(1)), - acyclic = vapply(datasets, + acyclic = vapply(datasets, is_acyclic, logical(1)), - attributed = vapply(datasets, - is_attributed, - logical(1))) - out <- dplyr::arrange(out, nodes) + attributed = vapply(datasets, + is_attributed, + logical(1))) + + }) + out <- dplyr::bind_rows(out) %>% dplyr::arrange(nodes) + if(!is.null(filter)) out <- dplyr::filter(out, ...) out } \ No newline at end of file diff --git a/R/map_autograph.R b/R/map_autograph.R index bdb9838f..7dd2faf8 100644 --- a/R/map_autograph.R +++ b/R/map_autograph.R @@ -145,7 +145,7 @@ graphr <- function(.data, layout, labels = TRUE, # Add layout ---- p <- .graph_layout(g, layout, labels, node_group, ...) # Add edges ---- - p <- .graph_edges(p, g, edge_color, edge_size) + p <- .graph_edges(p, g, edge_color, edge_size, node_size) # Add nodes ---- p <- .graph_nodes(p, g, node_color, node_shape, node_size) p @@ -224,105 +224,103 @@ graphr <- function(.data, layout, labels = TRUE, ggforce::geom_mark_hull(ggplot2::aes(x, y, fill = node_group, label = node_group), data = lo) + ggplot2::scale_fill_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Color")) } p } -.graph_edges <- function(p, g, edge_color, edge_size) { - weight <- NULL +.graph_edges <- function(p, g, edge_color, edge_size, node_size) { + weight <- lsize <- NULL esize <- .infer_esize(g, edge_size) check_edge_variables(g, edge_color, edge_size) # Begin plotting edges in various cases if (is_directed(g)) { + e_cap <- unlist(unname(.infer_end_cap(g, node_size))) bend <- .infer_bend(g) if (is_weighted(g)) { if (!is.null(edge_color)) { if (edge_color %in% names(tie_attribute(g))) { p <- p + ggraph::geom_edge_arc(ggplot2::aes( - width = esize, colour = as.factor(tie_attribute(g, edge_color))), - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(2, 'mm'), - type = "closed"), - end_cap = ggraph::circle(1.5, 'mm')) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "none") + + width = esize, colour = as.factor(tie_attribute(g, edge_color)), + end_cap = ggraph::circle(c(e_cap), 'mm')), + edge_alpha = 0.4, strength = bend, edge_linetype = "solid", + arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") + ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Edge color")) } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize), + p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize, + end_cap = ggraph::circle(c(e_cap), 'mm')), colour = edge_color, edge_alpha = 0.4, strength = bend, edge_linetype = "solid", arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), - type = "closed"), - end_cap = ggraph::circle(1.5, 'mm')) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "none") + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } else if (is_signed(g)) { p <- p + ggraph::geom_edge_arc( ggplot2::aes(width = esize, - colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, strength = bend, - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(2, 'mm'), - type = "closed"), - end_cap = ggraph::circle(1.5, 'mm')) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "none") + end_cap = ggraph::circle(c(e_cap), 'mm'), + edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), + edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), + edge_alpha = 0.4, strength = bend, show.legend = FALSE, + arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } else { - p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize), + p <- p + ggraph::geom_edge_arc(ggplot2::aes(width = esize, + end_cap = ggraph::circle(c(e_cap), 'mm')), edge_colour = "black", edge_alpha = 0.4, strength = bend, edge_linetype = "solid", arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(2, 'mm'), - type = "closed"), - end_cap = ggraph::circle(1.5, 'mm')) + - ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "none") + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } else { if (!is.null(edge_color)) { if (edge_color %in% names(tie_attribute(g))) { p <- p + ggraph::geom_edge_arc(ggplot2::aes( - colour = as.factor(tie_attribute(g, edge_color))), - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - edge_width = esize, - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(3, "mm"), - type = "closed"), - end_cap = ggraph::circle(3, "mm")) + + colour = as.factor(tie_attribute(g, edge_color)), + end_cap = ggraph::circle(c(e_cap), 'mm'), width = esize), + edge_alpha = 0.4, strength = bend, edge_linetype = "solid", + arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(3, "mm"), + type = "closed")) + ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Edge color")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } else { - p <- p + ggraph::geom_edge_arc(colour = edge_color, - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - edge_width = esize, + p <- p + ggraph::geom_edge_arc(ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), + width = esize), + colour = edge_color, edge_alpha = 0.4, + strength = bend, edge_linetype = "solid", arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(3, "mm"), - type = "closed"), - end_cap = ggraph::circle(3, "mm")) + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } else if (is_signed(g)) { p <- p + ggraph::geom_edge_arc( - ggplot2::aes(colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, strength = bend, edge_width = esize, + ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), width = esize, + edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), + edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), + edge_alpha = 0.4, strength = bend, show.legend = FALSE, arrow = ggplot2::arrow(angle = 15, length = ggplot2::unit(3, "mm"), - type = "closed"), end_cap = ggraph::circle(3, "mm")) + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } else { - p <- p + ggraph::geom_edge_arc(edge_colour = "black", - edge_alpha = 0.4, strength = bend, - edge_linetype = "solid", - edge_width = esize, - arrow = ggplot2::arrow(angle = 15, - length = ggplot2::unit(3, "mm"), - type = "closed"), - end_cap = ggraph::circle(3, "mm")) + p <- p + ggraph::geom_edge_arc(ggplot2::aes(end_cap = ggraph::circle(c(e_cap), 'mm'), + width = esize), + edge_colour = "black", + edge_alpha = 0.4, strength = bend, + edge_linetype = "solid", + arrow = ggplot2::arrow(angle = 15, + length = ggplot2::unit(3, "mm"), + type = "closed")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } } else { @@ -330,11 +328,11 @@ graphr <- function(.data, layout, labels = TRUE, if (!is.null(edge_color)) { if (edge_color %in% names(tie_attribute(g))) { p <- p + ggraph::geom_edge_link0(ggplot2::aes( - width = esize, colour = as.factor(tie_attribute(g, edge_color))), - edge_alpha = 0.4, edge_linetype = "solid") + + width = weight, colour = as.factor(tie_attribute(g, edge_color))), + edge_alpha = 0.4, edge_linetype = "solid") + ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") + ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Edge color")) } else { p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = weight), colour = edge_color, @@ -345,9 +343,9 @@ graphr <- function(.data, layout, labels = TRUE, } else if (is_signed(g)) { p <- p + ggraph::geom_edge_link0( ggplot2::aes(width = weight, - colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4) + + edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), + edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), + edge_alpha = 0.4, show.legend = FALSE) + ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") } else { p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = weight), @@ -360,62 +358,46 @@ graphr <- function(.data, layout, labels = TRUE, if (!is.null(edge_color)) { if (edge_color %in% names(tie_attribute(g))) { p <- p + ggraph::geom_edge_link0(ggplot2::aes( - colour = as.factor(tie_attribute(g, edge_color))), + colour = as.factor(tie_attribute(g, edge_color)), width = esize), edge_linetype = "solid", - edge_alpha = 0.4, edge_width = esize) + + edge_alpha = 0.4) + ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Edge color")) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } else { - p <- p + ggraph::geom_edge_link0(colour = edge_color, + p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = esize), + colour = edge_color, edge_linetype = "solid", - edge_alpha = 0.4, edge_width = esize) + edge_alpha = 0.4) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } else if (is_signed(g)) { p <- p + ggraph::geom_edge_link0( - ggplot2::aes(colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, edge_width = esize) + ggplot2::aes(edge_colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), + edge_linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed"), + width = esize), + edge_alpha = 0.4, show.legend = FALSE) + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } else { - p <- p + ggraph::geom_edge_link0(edge_colour = "black", - edge_linetype = "solid", - edge_alpha = 0.4, edge_width = esize) + p <- p + ggraph::geom_edge_link0(ggplot2::aes(width = esize), + edge_colour = "black", edge_alpha = 0.4, + edge_linetype = "solid") + + ggraph::scale_edge_width_continuous(range = c(0.2, 2.5), guide = "Edge Size") } } } if (is_complex(g)) { - lsize <- .infer_lsize(g, edge_size) - if (is_signed(g)) { - p <- p + ggraph::geom_edge_loop( - ggplot2::aes(width = weight, - colour = ifelse(igraph::E(g)$sign >= 0, "#d73027", "#4575b4"), - linetype = ifelse(igraph::E(g)$sign >= 0, "solid", "dashed")), - edge_alpha = 0.4, edge_width = lsize) + - ggraph::scale_edge_width_continuous(range = c(0.2, 1), guide = "none") - } else if (!is.null(edge_color)) { - if (edge_color %in% names(tie_attribute(g))) { - p <- p + ggraph::geom_edge_loop(ggplot2::aes( - colour = as.factor(tie_attribute(g, edge_color))), - edge_linetype = "solid", - edge_alpha = 0.4, edge_width = lsize) + - ggraph::scale_edge_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) - } else { - p <- p + ggraph::geom_edge_link0(colour = edge_color, - edge_linetype = "solid", - edge_alpha = 0.4, edge_width = lsize) - } - } else { - p <- p + ggraph::geom_edge_loop(edge_colour = "black", - edge_linetype = "solid", - edge_alpha = 0.4, edge_width = lsize) - } + p <- p + ggraph::geom_edge_loop0(edge_width = esize, edge_alpha = 0.4) } + if (length(unique(esize)) == 1) { + p <- p + ggplot2::guides(edge_width = "none") + } else p <- p + ggplot2::guides(edge_width = ggplot2::guide_legend(title = "Edge size")) p } .graph_nodes <- function(p, g, node_color, node_shape, node_size){ nshape <- .infer_shape(g, node_shape) - nsize <- .infer_nsize(p, g, node_size) + nsize <- .infer_nsize(g, node_size) check_node_variables(g, node_color, node_size) if (is.null(node_color) & "Infected" %in% names(node_attribute(g))) { node_color <- as.factor(ifelse(node_attribute(g, "Exposed"), "Exposed", @@ -464,7 +446,7 @@ graphr <- function(.data, layout, labels = TRUE, p <- p + ggraph::geom_node_point(ggplot2::aes(color = node_color), size = nsize, shape = nshape) + ggplot2::scale_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Color")) } else { p <- p + ggraph::geom_node_point(color = node_color, size = nsize, shape = nshape) @@ -480,9 +462,9 @@ graphr <- function(.data, layout, labels = TRUE, levels = c("TRUE", "FALSE")) } else node_color <- factor(node_attribute(g, node_color)) p <- p + ggraph::geom_node_point(aes(color = node_color, - size = nsize), shape = nshape) + + size = nsize, shape = nshape)) + ggplot2::scale_colour_manual(values = colorsafe_palette, - guide = ggplot2::guide_legend("")) + guide = ggplot2::guide_legend("Color")) } else { p <- p + ggraph::geom_node_point(color = node_color, size = nsize, @@ -493,18 +475,15 @@ graphr <- function(.data, layout, labels = TRUE, } } } - # Drop legends for elements that don't vary - if(length(unique(nsize)) == 1){ + if(length(unique(nsize)) == 1) { p <- p + ggplot2::guides(size = "none") } else p <- p + ggplot2::guides(size = ggplot2::guide_legend(title = "Size")) - if(length(unique(nshape)) == 1) p <- p + ggplot2::guides(shape = "none") - # if(length(unique(node_color)) == 1) p <- p + ggplot2::guides(color = FALSE) - + if (length(unique(nshape)) == 1) { + p <- p + ggplot2::guides(shape = "none") + } else p <- p + ggplot2::guides(shape = ggplot2::guide_legend(title = "Shape")) # Consider rescaling nodes - p <- p + scale_size(range = c(1/net_nodes(g)*50, - 1/net_nodes(g)*100)) - + p <- p + ggplot2::scale_size(range = c(1/net_nodes(g)*50, 1/net_nodes(g)*100)) p } @@ -517,7 +496,7 @@ graphr <- function(.data, layout, labels = TRUE, out } -.infer_nsize <- function(p, g, node_size){ +.infer_nsize <- function(g, node_size){ if (!is.null(node_size)) { if (is.character(node_size)) { out <- node_attribute(g, node_size) @@ -533,6 +512,17 @@ graphr <- function(.data, layout, labels = TRUE, out } +.infer_end_cap <- function(g, node_size) { + nsize <- NULL + g %>% + tidygraph::activate("edges") %>% + data.frame() %>% + left_join(data.frame(node_id = 1:length(node_names(g)), + nsize = .infer_nsize(g, node_size)/2), + by = c("to" = "node_id")) %>% + dplyr::select(nsize) +} + .infer_shape <- function(g, node_shape) { if (!is.null(node_shape)) { if (node_shape %in% names(node_attribute(g))) { @@ -564,29 +554,11 @@ graphr <- function(.data, layout, labels = TRUE, out } -.infer_lsize <- function(g, edge_size) { - if (!is.null(edge_size)) { - if (is.character(edge_size)) { - out <- tie_attribute(g, edge_size) - } else { - out <- edge_size - } - if (length(out > 1) & all(out <= 1 & out >= 0)) { - out <- sum(out)/length(out)*10 - } else if (length(out > 1)) { - out <- sum(out)/length(out) - } - } else { - out <- 0.5 - } - out -} - .check_color <- function(v) { color <- grDevices::colors() color <- color[!color %in% "black"] v <- ifelse(is.na(v), "black", v) - if (!any(grepl(paste(color, collapse = "|"), v)) | any(grepl("#", v))) { + if (!any(grepl(paste(color, collapse = "|"), v)) | any(grepl("^#", v))) { for(i in unique(v)) { if (i != "black") { v[v == i] <- sample(color, 1) diff --git a/R/mark_ties.R b/R/mark_ties.R index 18a99a60..7d22a1b6 100644 --- a/R/mark_ties.R +++ b/R/mark_ties.R @@ -77,6 +77,98 @@ tie_is_bridge <- function(.data){ make_tie_mark(out, .data) } +# Triangular properties #### + +#' Marking ties based on structural properties +#' +#' @description +#' These functions return logical vectors the length of the ties +#' in a network identifying which hold certain properties or positions in the network. +#' +#' - `tie_is_triangular()` marks ties that are in triangles. +#' - `tie_is_cyclical()` marks ties that are in cycles. +#' - `tie_is_transitive()` marks ties that complete transitive closure. +#' - `tie_is_simmelian()` marks ties that are both in a triangle +#' and fully reciprocated. +#' +#' They are most useful in highlighting parts of the network that +#' are cohesively connected. +#' @inheritParams mark_nodes +#' @family marks +#' @name mark_triangles +NULL + +#' @rdname mark_triangles +#' @importFrom igraph triangles +#' @examples +#' tie_is_triangular(ison_monastery_like) +#' @export +tie_is_triangular <- function(.data){ + if(missing(.data)) {expect_edges(); .data <- .G()} + out <- .triangle_ties(.data) + ties <- as_edgelist(to_unnamed(.data))[,c("from","to")] + out <- do.call(paste, ties) %in% do.call(paste, as.data.frame(out)) + make_tie_mark(out, .data) +} + +.triangle_ties <- function(.data){ + out <- t(matrix(igraph::triangles(as_igraph(.data)), nrow = 3)) + # out <- as.data.frame(out) + out <- rbind(out[,c(1,2)],out[,c(2,3)],out[,c(3,1)], + out[,c(1,3)],out[,c(3,2)],out[,c(2,1)]) + out +} + +#' @rdname mark_triangles +#' @examples +#' ison_adolescents %>% to_directed() %>% +#' mutate_ties(trans = tie_is_transitive()) %>% +#' graphr(edge_color = "trans") +#' @export +tie_is_transitive <- function(.data){ + if(missing(.data)) {expect_edges(); .data <- .G()} + out <- vapply(seq_len(net_ties(.data)), function(x){ + nodes <- as_edgelist(to_unnamed(.data))[x,] + igraph::distances(delete_ties(.data, x), + v = nodes[1], to = nodes[2], + mode = "out") == 2 + }, FUN.VALUE = logical(1)) + make_tie_mark(out, .data) +} + +#' @rdname mark_triangles +#' @examples +#' ison_adolescents %>% to_directed() %>% +#' mutate_ties(cyc = tie_is_cyclical()) %>% +#' graphr(edge_color = "cyc") +#' @export +tie_is_cyclical <- function(.data){ + if(missing(.data)) {expect_edges(); .data <- .G()} + out <- vapply(seq_len(net_ties(.data)), function(x){ + nodes <- as_edgelist(to_unnamed(.data))[x,] + igraph::distances(delete_ties(.data, x), + v = nodes[2], to = nodes[1], + mode = "out") == 2 + }, FUN.VALUE = logical(1)) + make_tie_mark(out, .data) +} + +#' @rdname mark_triangles +#' @examples +#' ison_monastery_like %>% +#' mutate_ties(simmel = tie_is_simmelian()) %>% +#' graphr(edge_color = "simmel") +#' @export +tie_is_simmelian <- function(.data){ + if(missing(.data)) {expect_edges(); .data <- .G()} + recip <- filter_ties(.data, tie_is_reciprocated()) + simmel <- filter_ties(recip, tie_is_triangular()) + ties <- as_edgelist(to_unnamed(.data))[,c("from","to")] + simmel <- as_edgelist(to_unnamed(simmel))[,c("from","to")] + out <- do.call(paste, ties) %in% do.call(paste, simmel) + make_tie_mark(out, .data) +} + # Selection properties #### #' Marking ties for selection based on measures diff --git a/R/measure_features.R b/R/measure_features.R index fe05344d..f18ca057 100644 --- a/R/measure_features.R +++ b/R/measure_features.R @@ -28,7 +28,7 @@ #' #' These `net_*()` functions return a single numeric scalar or value. #' @inheritParams is -#' @inheritParams create +#' @inheritParams make_create #' @param membership A vector of partition membership. #' @name measure_features #' @family measures diff --git a/R/measure_heterogeneity.R b/R/measure_heterogeneity.R index 0be48d42..46bc4396 100644 --- a/R/measure_heterogeneity.R +++ b/R/measure_heterogeneity.R @@ -18,8 +18,8 @@ #' - `node_heterophily()` measures each node's embeddedness within groups #' of nodes with the same attribute. #' - `net_assortativity()` measures the degree assortativity in a network. -#' - `net_spatial()` measures the spatial association/autocorrelation ( -#' global Moran's I) in a network. +#' - `net_spatial()` measures the spatial association/autocorrelation +#' (global Moran's I) in a network. #' #' @inheritParams is #' @param attribute Name of a nodal attribute or membership vector diff --git a/cran-comments.md b/cran-comments.md index d4887669..732539ec 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -8,10 +8,3 @@ ## R CMD check results 0 errors | 0 warnings | 0 notes - -* Among other things, this major release consolidates a number of functions that were in migraph, -* We are simultaneously submitting a new version of migraph that is without these -functions to avoid conflicts. -* migraph still Depends on manynet, so there should be no impact for users -downloading migraph and expecting to use the functions in question. -* Any function name changes are listed as deprecated in manynet diff --git a/man/add_nodes.Rd b/man/add_nodes.Rd index eb3975f5..bdd445aa 100644 --- a/man/add_nodes.Rd +++ b/man/add_nodes.Rd @@ -104,11 +104,12 @@ Below are the currently implemented S3 methods:\tabular{lrrr}{ Other modifications: \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/add_ties.Rd b/man/add_ties.Rd index dd9af56d..f15fd5ec 100644 --- a/man/add_ties.Rd +++ b/man/add_ties.Rd @@ -87,11 +87,12 @@ Note that while \verb{add_*()}/\verb{delete_*()} functions operate similarly as Other modifications: \code{\link{add_nodes}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/as.Rd b/man/as.Rd index 528dd041..5c589a1c 100644 --- a/man/as.Rd +++ b/man/as.Rd @@ -134,11 +134,12 @@ as_network(test) Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/data_overview.Rd b/man/data_overview.Rd index d9e263ee..88a14715 100644 --- a/man/data_overview.Rd +++ b/man/data_overview.Rd @@ -5,10 +5,13 @@ \alias{table_data} \title{Obtain overview of available network data} \usage{ -table_data(pkg = "manynet") +table_data(pkg = c("manynet", "migraph"), ...) } \arguments{ \item{pkg}{String, name of the package.} + +\item{...}{Network marks, e.g. directed, twomode, or signed, +that are used to filter the results.} } \description{ This function makes it easy to get an overview of available data: @@ -19,9 +22,8 @@ network datasets included in the packages. } \examples{ table_data() -# to obtain list of all e.g. two-mode networks: -table_data() \%>\% - dplyr::filter(directed) +# to obtain list of all e.g. directed networks: +table_data(pkg = "manynet", directed) # to obtain overview of unique datasets: table_data() \%>\% dplyr::distinct(directed, weighted, twomode, signed, diff --git a/man/from.Rd b/man/from.Rd index b5ec889e..4d508f29 100644 --- a/man/from.Rd +++ b/man/from.Rd @@ -67,10 +67,11 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/learning.Rd b/man/learning.Rd index 404d5982..e9772686 100644 --- a/man/learning.Rd +++ b/man/learning.Rd @@ -81,8 +81,9 @@ These functions allow learning games to be played upon networks. } \seealso{ Other makes: -\code{\link{create}}, -\code{\link{generate}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, +\code{\link{make_generate}}, \code{\link{play}}, \code{\link{read}}, \code{\link{write}()} diff --git a/man/create.Rd b/man/make_create.Rd similarity index 81% rename from man/create.Rd rename to man/make_create.Rd index 81d9e86d..7d7eaf44 100644 --- a/man/create.Rd +++ b/man/make_create.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/make_create.R -\name{create} -\alias{create} +\name{make_create} +\alias{make_create} \alias{create_empty} \alias{create_filled} \alias{create_ring} @@ -9,8 +9,8 @@ \alias{create_tree} \alias{create_lattice} \alias{create_components} +\alias{create_degree} \alias{create_core} -\alias{create_explicit} \title{Making networks with defined structures} \usage{ create_empty(n, directed = FALSE) @@ -27,9 +27,9 @@ create_lattice(n, directed = FALSE, width = 8) create_components(n, directed = FALSE, membership = NULL) -create_core(n, directed = FALSE, mark = NULL) +create_degree(n, outdegree = NULL, indegree = NULL) -create_explicit(...) +create_core(n, directed = FALSE, mark = NULL) } \arguments{ \item{n}{Given: @@ -50,12 +50,24 @@ use \code{to_redirected()} on the output of these functions.} \item{width}{Integer specifying the width of the ring, breadth of the branches, or maximum extent of the neighbourbood.} -\item{...}{Additional arguments passed on to \code{{igraph}}.} +\item{...}{Additional arguments passed on to \code{igraph::make_ring()}.} \item{membership}{A vector of partition membership as integers. If left as \code{NULL} (the default), nodes in each mode will be assigned to two, equally sized partitions.} +\item{outdegree}{Numeric scalar or vector indicating the +desired outdegree distribution. +By default NULL and is required. +If \code{n} is an existing network object and the outdegree is not specified, +then the outdegree distribution will be inferred from that of the network. +Note that a scalar (single number) will result in a k-regular graph.} + +\item{indegree}{Numeric vector indicating the desired indegree distribution. +By default NULL but not required unless a directed network is desired. +If \code{n} is an existing directed network object and the indegree is not specified, +then the indegree distribution will be inferred from that of the network.} + \item{mark}{A logical vector the length of the nodes in the network. This can be created by, among other things, any \verb{node_is_*()} function.} } @@ -85,8 +97,8 @@ neighbours form a clique. \item \code{create_components()} creates a network that clusters nodes into separate components. \item \code{create_core()} creates a network in which a certain proportion of 'core' nodes are densely tied to each other, and the rest peripheral, tied only to the core. -\item \code{create_explicit()} creates a network based on explicitly -named nodes and ties between them. +\item \code{create_degree()} creates a network with a given (out/in)degree sequence, +which can also be used to create k-regular networks. } These functions can create either one-mode or two-mode networks. @@ -127,19 +139,16 @@ create_star(12) create_tree(c(7,8)) create_lattice(12, width = 4) create_components(10, membership = c(1,1,1,2,2,2,3,3,3,3)) +create_degree(10, outdegree = rep(1:5, 2)) create_core(6) - create_explicit(A -+ B, B -+ C, A +-+ C, D) } \seealso{ \link{as} -\code{\link[igraph:graph_from_literal]{igraph::graph_from_literal()}} which \code{create_explicit()} mostly just wraps. -\code{create_explicit()} will also accept character input and not just a formula though, -and will never simplify the result. - Other makes: -\code{\link{generate}}, \code{\link{learning}}, +\code{\link{make_explicit}}, +\code{\link{make_generate}}, \code{\link{play}}, \code{\link{read}}, \code{\link{write}()} diff --git a/man/make_explicit.Rd b/man/make_explicit.Rd new file mode 100644 index 00000000..235e2531 --- /dev/null +++ b/man/make_explicit.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make_create.R +\name{make_explicit} +\alias{make_explicit} +\alias{create_explicit} +\title{Making networks with explicit ties} +\usage{ +create_explicit(...) +} +\arguments{ +\item{...}{Arguments passed on to \code{{igraph}}.} +} +\description{ +This function creates a network from a vector of explicitly named nodes +and ties between them. +\code{create_explicit()} largely wraps \code{igraph::graph_from_literal()}, +but will also accept character input and not just a formula, +and will never simplify the result. + +Ties are indicated by \code{-}, and directed ties (arcs) +require \code{+} at either or both ends. +Ties are separated by commas, and isolates can be added as +an additional, unlinked node after the comma within the formula. +Sets of nodes can be linked to other sets of nodes through use of +a semi-colon. +See the example for a demonstration. +} +\examples{ + create_explicit(A -+ B, B -+ C, A +-+ C, D, E:F:G-+A, E:F+-+G:H) +} +\seealso{ +Other makes: +\code{\link{learning}}, +\code{\link{make_create}}, +\code{\link{make_generate}}, +\code{\link{play}}, +\code{\link{read}}, +\code{\link{write}()} +} +\concept{makes} diff --git a/man/generate.Rd b/man/make_generate.Rd similarity index 76% rename from man/generate.Rd rename to man/make_generate.Rd index 897364f5..4d0edc05 100644 --- a/man/generate.Rd +++ b/man/make_generate.Rd @@ -1,26 +1,40 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/make_generate.R -\name{generate} -\alias{generate} +% Please edit documentation in R/make_generate.R, R/manip_correlation.R +\name{make_generate} +\alias{make_generate} \alias{generate_random} +\alias{generate_configuration} \alias{generate_smallworld} \alias{generate_scalefree} -\alias{generate_permutation} \alias{generate_utilities} -\alias{generate_configuration} +\alias{generate_fire} +\alias{generate_islands} +\alias{generate_citations} +\alias{generate_permutation} \title{Making networks with a stochastic element} \usage{ generate_random(n, p = 0.5, directed = FALSE, with_attr = TRUE) +generate_configuration(.data) + generate_smallworld(n, p = 0.05, directed = FALSE, width = 2) generate_scalefree(n, p = 1, directed = FALSE) -generate_permutation(.data, with_attr = TRUE) - generate_utilities(n, steps = 1, volatility = 0, threshold = 0) -generate_configuration(.data) +generate_fire(n, contacts = 1, their_out = 0, their_in = 1, directed = FALSE) + +generate_islands(n, islands = 2, p = 0.5, bridges = 1, directed = FALSE) + +generate_citations( + n, + ties = sample(1:4, 1), + agebins = max(1, n/10), + directed = FALSE +) + +generate_permutation(.data, with_attr = TRUE) } \arguments{ \item{n}{Given: @@ -41,9 +55,6 @@ a network of the same dimensions will be created. should be retained. By default TRUE.} -\item{width}{Integer specifying the width of the ring, -breadth of the branches, or maximum extent of the neighbourbood.} - \item{.data}{An object of a manynet-consistent class: \itemize{ \item matrix (adjacency or incidence) from \code{{base}} R @@ -53,6 +64,9 @@ breadth of the branches, or maximum extent of the neighbourbood.} \item tbl_graph, from the \code{{tidygraph}} package }} +\item{width}{Integer specifying the width of the ring, +breadth of the branches, or maximum extent of the neighbourbood.} + \item{steps}{Number of simulation steps to run. By default 1: a single, one-shot simulation. If more than 1, further iterations will update the utilities @@ -67,6 +81,32 @@ parameter.} changes in utility that are minor. The default 0 will recognise all changes in utility, but raising the threshold will mute any changes less than this threshold.} + +\item{contacts}{Number of contacts or ambassadors chosen from among existing +nodes in the network. +By default 1. +See \code{igraph::sample_forestfire()}.} + +\item{their_out}{Probability of tieing to a contact's outgoing ties. +By default 0.} + +\item{their_in}{Probability of tieing to a contact's incoming ties. +By default 1.} + +\item{islands}{Number of islands or communities to create. +By default 2. +See \code{igraph::sample_islands()} for more.} + +\item{bridges}{Number of bridges between islands/communities. +By default 1.} + +\item{ties}{Number of ties to add per new node. +By default a uniform random sample from 1 to 4 new ties.} + +\item{agebins}{Number of aging bins. +By default either \eqn{\frac{n}{10}} or 1, +whichever is the larger. +See \code{igraphr::sample_last_cit()} for more.} } \value{ By default a \code{tbl_graph} object is returned, @@ -92,10 +132,10 @@ for exploring or testing network properties. given degree distribution. \item \code{generate_smallworld()} generates a small-world structure via ring rewiring at some probability. \item \code{generate_scalefree()} generates a scale-free structure via preferential attachment at some probability. -\item \code{generate_permutation()} generates a permutation of the network -using a Fisher-Yates shuffle on both the rows and columns (for a one-mode network) -or on each of the rows and columns (for a two-mode network). \item \code{generate_utilities()} generates a random utility matrix. +\item \code{generate_fire()} generates a forest fire model. +\item \code{generate_islands()} generates an islands model. +\item \code{generate_citations()} generates a citations model. } These functions can create either one-mode or two-mode networks. @@ -114,8 +154,9 @@ graphr(generate_smallworld(12, 0.025)) graphr(generate_smallworld(12, 0.25)) graphr(generate_scalefree(12, 0.25)) graphr(generate_scalefree(12, 1.25)) -graphr(ison_adolescents) -graphr(generate_permutation(ison_adolescents)) +generate_fire(10) +generate_islands(10) +generate_citations(10) } \references{ Erdos, Paul, and Alfred Renyi. (1959). @@ -134,8 +175,9 @@ Barabasi, Albert-Laszlo, and Reka Albert. 1999. } \seealso{ Other makes: -\code{\link{create}}, \code{\link{learning}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, \code{\link{play}}, \code{\link{read}}, \code{\link{write}()} diff --git a/man/correlation.Rd b/man/manip_correlation.Rd similarity index 93% rename from man/correlation.Rd rename to man/manip_correlation.Rd index 0b4fd1da..a63f6511 100644 --- a/man/correlation.Rd +++ b/man/manip_correlation.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/manip_correlation.R -\name{correlation} -\alias{correlation} +\name{manip_correlation} +\alias{manip_correlation} \alias{to_correlation} \title{Node correlation} \usage{ @@ -43,9 +43,10 @@ Other modifications: \code{\link{add_ties}()}, \code{\link{as}()}, \code{\link{from}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/manip_permutation.Rd b/man/manip_permutation.Rd new file mode 100644 index 00000000..8dde81b9 --- /dev/null +++ b/man/manip_permutation.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manip_correlation.R +\name{manip_permutation} +\alias{manip_permutation} +\alias{to_permuted} +\title{Network permutation} +\usage{ +to_permuted(.data, with_attr = TRUE) +} +\arguments{ +\item{.data}{An object of a manynet-consistent class: +\itemize{ +\item matrix (adjacency or incidence) from \code{{base}} R +\item edgelist, a data frame from \code{{base}} R or tibble from \code{{tibble}} +\item igraph, from the \code{{igraph}} package +\item network, from the \code{{network}} package +\item tbl_graph, from the \code{{tidygraph}} package +}} + +\item{with_attr}{Logical whether any attributes of the object +should be retained. +By default TRUE.} +} +\description{ +\code{to_permuted()} permutes the network using a Fisher-Yates shuffle +on both the rows and columns (for a one-mode network) +or on each of the rows and columns (for a two-mode network). +} +\examples{ +graphr(ison_adolescents, node_size = 4) +graphr(to_permuted(ison_adolescents), node_size = 4) +} +\seealso{ +Other modifications: +\code{\link{add_nodes}()}, +\code{\link{add_ties}()}, +\code{\link{as}()}, +\code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_split}}, +\code{\link{miss}}, +\code{\link{reformat}}, +\code{\link{to_levels}}, +\code{\link{to_paths}}, +\code{\link{to_project}}, +\code{\link{to_scope}} +} +\concept{modifications} diff --git a/man/split.Rd b/man/manip_split.Rd similarity index 97% rename from man/split.Rd rename to man/manip_split.Rd index 8e7eccc4..d5cefc2b 100644 --- a/man/split.Rd +++ b/man/manip_split.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/manip_split.R -\name{split} -\alias{split} +\name{manip_split} +\alias{manip_split} \alias{to_egos} \alias{to_subgraphs} \alias{to_components} @@ -107,8 +107,9 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, \code{\link{miss}}, \code{\link{reformat}}, \code{\link{to_levels}}, diff --git a/man/mark_diff.Rd b/man/mark_diff.Rd index 2340811d..326fa2c5 100644 --- a/man/mark_diff.Rd +++ b/man/mark_diff.Rd @@ -71,6 +71,7 @@ Other marks: \code{\link{mark_nodes}}, \code{\link{mark_select}}, \code{\link{mark_tie_select}}, -\code{\link{mark_ties}} +\code{\link{mark_ties}}, +\code{\link{mark_triangles}} } \concept{marks} diff --git a/man/mark_nodes.Rd b/man/mark_nodes.Rd index c5037dfe..f889a303 100644 --- a/man/mark_nodes.Rd +++ b/man/mark_nodes.Rd @@ -79,6 +79,7 @@ Other marks: \code{\link{mark_diff}}, \code{\link{mark_select}}, \code{\link{mark_tie_select}}, -\code{\link{mark_ties}} +\code{\link{mark_ties}}, +\code{\link{mark_triangles}} } \concept{marks} diff --git a/man/mark_select.Rd b/man/mark_select.Rd index ec1b01e0..2e336464 100644 --- a/man/mark_select.Rd +++ b/man/mark_select.Rd @@ -54,6 +54,7 @@ Other marks: \code{\link{mark_diff}}, \code{\link{mark_nodes}}, \code{\link{mark_tie_select}}, -\code{\link{mark_ties}} +\code{\link{mark_ties}}, +\code{\link{mark_triangles}} } \concept{marks} diff --git a/man/mark_tie_select.Rd b/man/mark_tie_select.Rd index 8b809d5e..9cfe6a8b 100644 --- a/man/mark_tie_select.Rd +++ b/man/mark_tie_select.Rd @@ -46,6 +46,7 @@ Other marks: \code{\link{mark_diff}}, \code{\link{mark_nodes}}, \code{\link{mark_select}}, -\code{\link{mark_ties}} +\code{\link{mark_ties}}, +\code{\link{mark_triangles}} } \concept{marks} diff --git a/man/mark_ties.Rd b/man/mark_ties.Rd index 204c8e3a..67458bef 100644 --- a/man/mark_ties.Rd +++ b/man/mark_ties.Rd @@ -55,6 +55,7 @@ Other marks: \code{\link{mark_diff}}, \code{\link{mark_nodes}}, \code{\link{mark_select}}, -\code{\link{mark_tie_select}} +\code{\link{mark_tie_select}}, +\code{\link{mark_triangles}} } \concept{marks} diff --git a/man/mark_triangles.Rd b/man/mark_triangles.Rd new file mode 100644 index 00000000..007e712b --- /dev/null +++ b/man/mark_triangles.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mark_ties.R +\name{mark_triangles} +\alias{mark_triangles} +\alias{tie_is_triangular} +\alias{tie_is_transitive} +\alias{tie_is_cyclical} +\alias{tie_is_simmelian} +\title{Marking ties based on structural properties} +\usage{ +tie_is_triangular(.data) + +tie_is_transitive(.data) + +tie_is_cyclical(.data) + +tie_is_simmelian(.data) +} +\arguments{ +\item{.data}{An object of a manynet-consistent class: +\itemize{ +\item matrix (adjacency or incidence) from \code{{base}} R +\item edgelist, a data frame from \code{{base}} R or tibble from \code{{tibble}} +\item igraph, from the \code{{igraph}} package +\item network, from the \code{{network}} package +\item tbl_graph, from the \code{{tidygraph}} package +}} +} +\description{ +These functions return logical vectors the length of the ties +in a network identifying which hold certain properties or positions in the network. +\itemize{ +\item \code{tie_is_triangular()} marks ties that are in triangles. +\item \code{tie_is_cyclical()} marks ties that are in cycles. +\item \code{tie_is_transitive()} marks ties that complete transitive closure. +\item \code{tie_is_simmelian()} marks ties that are both in a triangle +and fully reciprocated. +} + +They are most useful in highlighting parts of the network that +are cohesively connected. +} +\examples{ +tie_is_triangular(ison_monastery_like) +ison_adolescents \%>\% to_directed() \%>\% + mutate_ties(trans = tie_is_transitive()) \%>\% + graphr(edge_color = "trans") +ison_adolescents \%>\% to_directed() \%>\% + mutate_ties(cyc = tie_is_cyclical()) \%>\% + graphr(edge_color = "cyc") +ison_monastery_like \%>\% + mutate_ties(simmel = tie_is_simmelian()) \%>\% + graphr(edge_color = "simmel") +} +\seealso{ +Other marks: +\code{\link{mark_diff}}, +\code{\link{mark_nodes}}, +\code{\link{mark_select}}, +\code{\link{mark_tie_select}}, +\code{\link{mark_ties}} +} +\concept{marks} diff --git a/man/measure_heterogeneity.Rd b/man/measure_heterogeneity.Rd index d7a84955..1699810c 100644 --- a/man/measure_heterogeneity.Rd +++ b/man/measure_heterogeneity.Rd @@ -61,8 +61,8 @@ are within groups of nodes with the same attribute. \item \code{node_heterophily()} measures each node's embeddedness within groups of nodes with the same attribute. \item \code{net_assortativity()} measures the degree assortativity in a network. -\item \code{net_spatial()} measures the spatial association/autocorrelation ( -global Moran's I) in a network. +\item \code{net_spatial()} measures the spatial association/autocorrelation +(global Moran's I) in a network. } } \section{net_diversity}{ diff --git a/man/miss.Rd b/man/miss.Rd index ac447f9f..be9ac63a 100644 --- a/man/miss.Rd +++ b/man/miss.Rd @@ -50,10 +50,11 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/play.Rd b/man/play.Rd index 37a798ce..23c78b77 100644 --- a/man/play.Rd +++ b/man/play.Rd @@ -206,9 +206,10 @@ This can be used in in SEI, SEIS, SEIR, and SEIRS models. } \seealso{ Other makes: -\code{\link{create}}, -\code{\link{generate}}, \code{\link{learning}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, +\code{\link{make_generate}}, \code{\link{read}}, \code{\link{write}()} diff --git a/man/read.Rd b/man/read.Rd index e49552e1..662ca850 100644 --- a/man/read.Rd +++ b/man/read.Rd @@ -100,9 +100,10 @@ you will need to unpack them and convert them one by one. \link{as} Other makes: -\code{\link{create}}, -\code{\link{generate}}, \code{\link{learning}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, +\code{\link{make_generate}}, \code{\link{play}}, \code{\link{write}()} } diff --git a/man/reformat.Rd b/man/reformat.Rd index bc978b80..3ee52134 100644 --- a/man/reformat.Rd +++ b/man/reformat.Rd @@ -146,10 +146,11 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}}, diff --git a/man/to_levels.Rd b/man/to_levels.Rd index 15db1434..2dd908bc 100644 --- a/man/to_levels.Rd +++ b/man/to_levels.Rd @@ -64,11 +64,12 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_paths}}, \code{\link{to_project}}, \code{\link{to_scope}} diff --git a/man/to_paths.Rd b/man/to_paths.Rd index c8d7b078..dfe49db9 100644 --- a/man/to_paths.Rd +++ b/man/to_paths.Rd @@ -105,11 +105,12 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_project}}, \code{\link{to_scope}} diff --git a/man/to_project.Rd b/man/to_project.Rd index daa90b5e..e0dd5dcc 100644 --- a/man/to_project.Rd +++ b/man/to_project.Rd @@ -88,11 +88,12 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_scope}} diff --git a/man/to_scope.Rd b/man/to_scope.Rd index 1f8341a8..bdb574af 100644 --- a/man/to_scope.Rd +++ b/man/to_scope.Rd @@ -81,11 +81,12 @@ Other modifications: \code{\link{add_nodes}()}, \code{\link{add_ties}()}, \code{\link{as}()}, -\code{\link{correlation}}, \code{\link{from}}, +\code{\link{manip_correlation}}, +\code{\link{manip_permutation}}, +\code{\link{manip_split}}, \code{\link{miss}}, \code{\link{reformat}}, -\code{\link{split}()}, \code{\link{to_levels}}, \code{\link{to_paths}}, \code{\link{to_project}} diff --git a/man/write.Rd b/man/write.Rd index 45d87757..08df8e57 100644 --- a/man/write.Rd +++ b/man/write.Rd @@ -75,9 +75,10 @@ by \href{https://github.com/stocnet/manynet/issues}{raising an issue on Github}. \link{as} Other makes: -\code{\link{create}}, -\code{\link{generate}}, \code{\link{learning}}, +\code{\link{make_create}}, +\code{\link{make_explicit}}, +\code{\link{make_generate}}, \code{\link{play}}, \code{\link{read}} } diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index ee3cad1a..270c3847 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -52,7 +52,8 @@ reference: Functions for deterministically creating and stochastically generating directed and undirected, one-mode and two-mode networks. contents: - - starts_with("create_") + - make_explicit + - make_create - starts_with("generate_") - subtitle: "Playing" desc: | @@ -71,9 +72,6 @@ reference: with other dimensions, such as from a two-mode network into a one-mode network. There are also functions for splitting networks, e.g. into a list of ego networks, and rejoining them from such lists. - contents: - - starts_with("to_") - - starts_with("from_") - subtitle: "Coercion" desc: | Functions for modifying networks into other classes. @@ -86,6 +84,37 @@ reference: new data on nodes or ties to networks. contents: - starts_with("add_") + - subtitle: "Reformatting" + desc: | + Functions for reformatting networks, retaining the same network dimensions. + contents: + - reformat + - subtitle: "Transforming" + desc: | + Functions for transforming networks, which may change the network's dimensions. + contents: + - to_paths + - to_scope + - subtitle: "Levels" + desc: | + Functions for modifying multimodal networks. + contents: + - to_levels + - to_project + - subtitle: "Converting" + desc: | + Functions for permuting networks or constructing a network + from the nodal correlations of another network. + contents: + - manip_permutation + - manip_correlation + - subtitle: "Splits" + desc: | + Functions for splitting networks into a list of networks, + or (re)joining a list of networks into a single network. + contents: + - manip_split + - starts_with("from_") - subtitle: "Missing" desc: | Functions for modifying how missing data is treated. @@ -95,12 +124,19 @@ reference: - title: "Mapping" desc: | Functions for plotting and visualising graphs of different types. + - subtitle: "Graphing" + desc: | + Functions for graphing networks and plotting results. `graphr()` graphs any manynet-compatible class object automagically. `graphs()` and `grapht()` do the same for multiple networks and dynamic networks, respectively. contents: - starts_with("graph") - starts_with("layout") + - subtitle: "Theming" + desc: | + Functions for tailoring graphs with themes, scales, and palettes. + contents: - starts_with("theme") - starts_with("scale") - ends_with("palettes") @@ -109,14 +145,23 @@ reference: desc: | Functions for identifying properties of networks, nodes, or ties, all returning logical scalars or vectors. - Note that all `node_` and `tie_` measures return a single vector - so that they can be added directly to graph objects. - `net_` measures return one or, in some cases of two-mode measures, - two values. - All `node_` and `tie_` measures return a single vector, - the length of the nodes or ties in the network, respectively. + - subtitle: "Network marks" + desc: | + `is_*()` functions return a single logical value for the network. + contents: + - starts_with("is_") + - subtitle: "Nodal marks" + desc: | + `node_is_*()` functions return a vector of logical values the length + of the nodes in the network. + contents: + - starts_with("node_is_") + - subtitle: "Tie marks" + desc: | + `tie_is_*()` functions return a vector of logical values the length + of the ties in the network. contents: - - contains("is_") + - starts_with("tie_is_") - title: "Measuring" desc: | Functions for measuring networks and returning a numeric vector or value. diff --git a/tests/testthat/test-map_autographr.R b/tests/testthat/test-map_autographr.R index 67a9537d..a606d304 100644 --- a/tests/testthat/test-map_autographr.R +++ b/tests/testthat/test-map_autographr.R @@ -38,8 +38,6 @@ test_that("unweighted, unsigned, directed networks graph correctly", { expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_alpha"]], 0.4) expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_linetype"]], "solid") expect_equal(test_algebra[["layers"]][[1]][["aes_params"]][["edge_colour"]], "black") - expect_equal(as.character(test_algebra[["layers"]][[1]][["aes_params"]][["end_cap"]]), "circle") - expect_s3_class(test_algebra[["layers"]][[1]][["aes_params"]][["end_cap"]], "ggraph_geometry") # Node parameters #expect_equal(round(test_algebra[["layers"]][[2]][["aes_params"]][["size"]]), 3) #expect_equal(test_algebra[["layers"]][[2]][["aes_params"]][["shape"]], "circle") @@ -57,7 +55,6 @@ test_that("weighted, unsigned, directed networks graph correctly", { expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_alpha"]], 0.4) expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_linetype"]], "solid") expect_equal(test_networkers[["layers"]][[2]][["aes_params"]][["edge_colour"]], "black") - expect_equal(as.character(test_networkers[["layers"]][[2]][["aes_params"]][["end_cap"]]), "circle") # Node parameters #expect_equal(round(test_networkers[["layers"]][[3]][["aes_params"]][["size"]]), 2) #expect_equal(test_networkers[["layers"]][[3]][["aes_params"]][["shape"]], "circle") @@ -69,10 +66,8 @@ test_that("fancy node mods graph correctly", { # one-mode network ison_marvel_relationships <- dplyr::mutate(ison_marvel_relationships, nodesize = Appearances/1000) - testcolnodes <- graphr(ison_marvel_relationships, - node_color = "Gender", - node_size = "nodesize", - node_shape = "Attractive") + testcolnodes <- graphr(ison_marvel_relationships, node_color = "Gender", + node_size = "nodesize", node_shape = "Attractive") expect_s3_class(testcolnodes, c("ggraph","gg","ggplot")) expect_equal(round(testcolnodes$data$x[1]), 4) expect_equal(round(testcolnodes$data$y[1]), 3) @@ -83,8 +78,7 @@ test_that("fancy node mods graph correctly", { c(sample(c("a", "b"), length(ison_southern_women), replace = TRUE))) - test2 <- graphr(ison_southern_women, - node_color = "type") + test2 <- graphr(ison_southern_women, node_color = "type") expect_s3_class(test2, c("ggraph","gg","ggplot")) expect_equal(round(test2$data$x[1]), 0) expect_equal(round(test2$data$y[1]), 0) diff --git a/tests/testthat/test-map_theme.R b/tests/testthat/test-map_theme.R index 6e6ffe6f..b6e40e5f 100644 --- a/tests/testthat/test-map_theme.R +++ b/tests/testthat/test-map_theme.R @@ -50,9 +50,9 @@ test_that("scales graph correctly", { mutate(color = c(rep(c(1,2), 4), 1, 2, 1)) %>% graphr(node_color = color) + scale_color_rug() - expect_equal(as.character(test_sdg[["scales"]][["scales"]][[2]][["call"]]), "scale_color_sdgs") - expect_equal(as.character(test_iheid[["scales"]][["scales"]][[2]][["call"]]), "scale_color_iheid") - expect_equal(as.character(test_ethz[["scales"]][["scales"]][[2]][["call"]]), "scale_color_ethz") - expect_equal(as.character(test_uzh[["scales"]][["scales"]][[2]][["call"]]), "scale_color_uzh") - expect_equal(as.character(test_rug[["scales"]][["scales"]][[2]][["call"]]), "scale_color_rug") + expect_equal(as.character(test_sdg[["scales"]][["scales"]][[3]][["call"]]), "scale_color_sdgs") + expect_equal(as.character(test_iheid[["scales"]][["scales"]][[3]][["call"]]), "scale_color_iheid") + expect_equal(as.character(test_ethz[["scales"]][["scales"]][[3]][["call"]]), "scale_color_ethz") + expect_equal(as.character(test_uzh[["scales"]][["scales"]][[3]][["call"]]), "scale_color_uzh") + expect_equal(as.character(test_rug[["scales"]][["scales"]][[3]][["call"]]), "scale_color_rug") })