Style package

DESCRIPTION

@@ -45,4 +45,4 @@ Suggests:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

R/directed_dcsbm.R

@@ -1,14 +1,14 @@
 new_directed_dcsbm <- function(
-  X, S, Y,
-  theta_out,
-  theta_in,
-  z_out,
-  z_in,
-  pi_out,
-  pi_in,
-  sorted,
-  ...,
-  subclass = character()) {
+    X, S, Y,
+    theta_out,
+    theta_in,
+    z_out,
+    z_in,
+    pi_out,
+    pi_in,
+    sorted,
+    ...,
+    subclass = character()) {
   subclass <- c(subclass, "directed_dcsbm")
   dcsbm <- directed_factor_model(X, S, Y, ..., subclass = subclass)
   dcsbm$theta_out <- theta_out
@@ -22,7 +22,6 @@ new_directed_dcsbm <- function(
 }
 
 validate_directed_dcsbm <- function(x) {
-
   values <- unclass(x)
 
   if (!is.factor(values$z_out)) {
@@ -335,17 +334,16 @@ validate_directed_dcsbm <- function(x) {
 #' population_svd <- svds(ddcsbm)
 #'
 directed_dcsbm <- function(
-  n = NULL,
-  theta_out = NULL, theta_in = NULL,
-  k_out = NULL, k_in = NULL, B = NULL,
-  ...,
-  pi_out = rep(1 / k_out, k_out),
-  pi_in = rep(1 / k_in, k_in),
-  sort_nodes = TRUE,
-  force_identifiability = TRUE,
-  poisson_edges = TRUE,
-  allow_self_loops = TRUE) {
-
+    n = NULL,
+    theta_out = NULL, theta_in = NULL,
+    k_out = NULL, k_in = NULL, B = NULL,
+    ...,
+    pi_out = rep(1 / k_out, k_out),
+    pi_in = rep(1 / k_in, k_in),
+    sort_nodes = TRUE,
+    force_identifiability = TRUE,
+    poisson_edges = TRUE,
+    allow_self_loops = TRUE) {
   # NOTE:
   #   - X corresponds to outgoing communities, outgoing edges and rows of A
   #   - Y corresponds to incoming communities, incoming edges and columns of A
@@ -364,7 +362,6 @@ directed_dcsbm <- function(
       call. = FALSE
     )
   } else if (is.null(theta_out) && is.null(theta_in)) {
-
     if (n < 1) {
       stop("`n` must be a positive integer.", call. = FALSE)
     }
@@ -377,9 +374,7 @@ directed_dcsbm <- function(
 
     theta_out <- stats::rlnorm(n, meanlog = 2, sdlog = 1)
     theta_in <- stats::rlnorm(n, meanlog = 2, sdlog = 1)
-
   } else if (is.null(n)) {
-
     if (length(theta_out) != length(theta_in)) {
       stop(
         "Length of `theta_out` must match length of `theta_in`.",
@@ -398,7 +393,6 @@ directed_dcsbm <- function(
       call. = FALSE
     )
   } else if (is.null(B)) {
-
     if (k_out < 1) {
       stop("`k_out` must be a positive integer.", call. = FALSE)
     }
@@ -414,9 +408,7 @@ directed_dcsbm <- function(
     )
 
     B <- Matrix(data = stats::runif(k_out * k_in), nrow = k_out, ncol = k_in)
-
   } else if (!is.null(B)) {
-
     k_out <- nrow(B)
     k_in <- ncol(B)
   }
@@ -473,13 +465,13 @@ directed_dcsbm <- function(
 
 
   if (k_out > 1) {
-    X <- sparse.model.matrix(~z_out + 0)
+    X <- sparse.model.matrix(~ z_out + 0)
   } else {
     X <- Matrix(1, nrow = n, ncol = 1)
   }
 
   if (k_in > 1) {
-    Y <- sparse.model.matrix(~z_in + 0)
+    Y <- sparse.model.matrix(~ z_in + 0)
   } else {
     Y <- Matrix(1, nrow = n, ncol = 1)
   }
@@ -532,7 +524,6 @@ directed_dcsbm <- function(
 #' @method print directed_dcsbm
 #' @export
 print.directed_dcsbm <- function(x, ...) {
-
   cat(glue("Directed Degree-Corrected Stochastic Blockmodel\n", .trim = FALSE))
   cat(glue("-----------------------------------------------\n\n", .trim = FALSE))
 

R/directed_erdos_renyi.R

@@ -1,5 +1,4 @@
-new_directed_erdos_renyi <- function(X, S, Y, p, poisson_edges, allow_self_loops,...) {
-
+new_directed_erdos_renyi <- function(X, S, Y, p, poisson_edges, allow_self_loops, ...) {
   er <- directed_factor_model(
     X, S, Y, ...,
     subclass = "directed_erdos_renyi",
@@ -12,7 +11,6 @@ new_directed_erdos_renyi <- function(X, S, Y, p, poisson_edges, allow_self_loops
 }
 
 validate_directed_erdos_renyi <- function(x) {
-
   values <- unclass(x)
 
   if (ncol(values$X) != 1) {
@@ -59,15 +57,14 @@ validate_directed_erdos_renyi <- function(x) {
 #' A
 #'
 directed_erdos_renyi <- function(
-  n, ..., p = NULL,
-  poisson_edges = TRUE,
-  allow_self_loops = TRUE) {
-
+    n, ..., p = NULL,
+    poisson_edges = TRUE,
+    allow_self_loops = TRUE) {
   X <- Matrix(1, nrow = n, ncol = 1)
   Y <- Matrix(1, nrow = n, ncol = 1)
 
-  if (is.null(p) && is.null(expected_in_degree)
-      && is.null(expected_out_degree)) {
+  if (is.null(p) && is.null(expected_in_degree) &&
+    is.null(expected_out_degree)) {
     stop(
       "Must specify either `p`, `expected_in_degree` or ",
       " `expected_out_degree`.",
@@ -76,13 +73,14 @@ directed_erdos_renyi <- function(
   }
 
   if (is.null(p)) {
-    p <- 0.5  # doesn't matter, will get rescaled anyway
+    p <- 0.5 # doesn't matter, will get rescaled anyway
   }
 
   S <- matrix(p, nrow = 1, ncol = 1)
 
   er <- new_directed_erdos_renyi(
-    X, S, Y, p = p,
+    X, S, Y,
+    p = p,
     poisson_edges = poisson_edges,
     allow_self_loops = allow_self_loops,
     ...

R/directed_factor_model.R

@@ -1,10 +1,9 @@
 new_directed_factor_model <- function(
-  X, S, Y,
-  poisson_edges,
-  allow_self_loops,
-  ...,
-  subclass = character()) {
-
+    X, S, Y,
+    poisson_edges,
+    allow_self_loops,
+    ...,
+    subclass = character()) {
   ellipsis::check_dots_unnamed()
 
   n <- nrow(X)
@@ -29,7 +28,6 @@ new_directed_factor_model <- function(
 }
 
 validate_directed_factor_model <- function(x) {
-
   values <- unclass(x)
 
   if (any(values$X < 0) || any(values$S < 0) || any(values$Y < 0)) {
@@ -162,14 +160,13 @@ validate_directed_factor_model <- function(x) {
 #' fm2
 #'
 directed_factor_model <- function(
-  X, S, Y,
-  ...,
-  expected_in_degree = NULL,
-  expected_out_degree = NULL,
-  expected_density = NULL,
-  poisson_edges = TRUE,
-  allow_self_loops = TRUE) {
-
+    X, S, Y,
+    ...,
+    expected_in_degree = NULL,
+    expected_out_degree = NULL,
+    expected_density = NULL,
+    poisson_edges = TRUE,
+    allow_self_loops = TRUE) {
   X <- Matrix(X)
   S <- Matrix(S)
   Y <- Matrix(Y)
@@ -196,7 +193,6 @@ directed_factor_model <- function(
   )
 
   if (!is.null(expected_in_degree)) {
-
     if (expected_in_degree <= 0) {
       stop(
         "`expected_in_degree` must be strictly greater than zero.",
@@ -208,7 +204,6 @@ directed_factor_model <- function(
   }
 
   if (!is.null(expected_out_degree)) {
-
     if (expected_out_degree <= 0) {
       stop(
         "`expected_out_degree` must be strictly greater than zero.",
@@ -220,7 +215,6 @@ directed_factor_model <- function(
   }
 
   if (!is.null(expected_density)) {
-
     if (expected_density <= 0 || 1 <= expected_density) {
       stop(
         "`expected_density` must be strictly between zero and one.",
@@ -234,7 +228,6 @@ directed_factor_model <- function(
   fm$S <- S
 
   if (!poisson_edges) {
-
     # when poisson_edges = FALSE, S is the desired Bernoulli edge probability.
     # we must
     # back-transform it to a Poisson parameterization of S. see section 2.3
@@ -255,17 +248,16 @@ directed_factor_model <- function(
 }
 
 dim_and_class <- function(x, ...) {
-
-  if (is.matrix(x) || inherits(x, "Matrix"))
+  if (is.matrix(x) || inherits(x, "Matrix")) {
     paste0(nrow(x), " x ", ncol(x), " [", class(x)[1], "]")
-  else
+  } else {
     paste0(length(x), " [", class(x)[1], "]")
+  }
 }
 
 #' @method print directed_factor_model
 #' @export
 print.directed_factor_model <- function(x, ...) {
-
   cat(glue("Directed Factor Model\n", .trim = FALSE))
   cat(glue("---------------------\n\n", .trim = FALSE))
 
@@ -289,4 +281,3 @@ print.directed_factor_model <- function(x, ...) {
     sep = "\n"
   )
 }
-

R/expected-degrees.R

@@ -23,7 +23,7 @@
 #' a <- .1
 #' b <- .05
 #'
-#' B <- matrix(c(a,b,b,a), nrow = 2)
+#' B <- matrix(c(a, b, b, a), nrow = 2)
 #'
 #' b_model <- fastRG::sbm(n = n, k = 2, B = B, poisson_edges = FALSE)
 #'
@@ -34,7 +34,7 @@
 #' # compare
 #' mean(rowSums(triu(A)))
 #'
-#' pop * a + pop * b  # analytical average degree
+#' pop * a + pop * b # analytical average degree
 #'
 #' ##### more generic examples
 #'
@@ -75,7 +75,6 @@ expected_edges <- function(factor_model, ...) {
 
 #' @export
 expected_edges.directed_factor_model <- function(factor_model, ...) {
-
   X <- factor_model$X
   S <- factor_model$S
   Y <- factor_model$Y
@@ -87,7 +86,6 @@ expected_edges.directed_factor_model <- function(factor_model, ...) {
 
 #' @export
 expected_edges.undirected_factor_model <- function(factor_model, ...) {
-
   X <- factor_model$X
   S <- factor_model$S
 
@@ -134,7 +132,6 @@ expected_degrees <- function(factor_model, ...) {
 
 #' @export
 expected_degrees.undirected_factor_model <- function(factor_model, ...) {
-
   # rowSums of E[A|X, S] = XSX' are XSX'1 for 1 a column vector of ones
   # want to avoid memory cost of instantiating all of E[A|X, S], which is
   # typically large and dense
@@ -161,7 +158,6 @@ expected_out_degree.directed_factor_model <- function(factor_model, ...) {
 
 #' @export
 expected_density.directed_factor_model <- function(factor_model, ...) {
-
   n <- factor_model$n
   d <- factor_model$d
 

R/expected-spectra.R

@@ -20,7 +20,6 @@ eigs_sym.undirected_factor_model <- function(
     which = "LM", sigma = NULL,
     opts = list(),
     ...) {
-
   if (!requireNamespace("RSpectra", quietly = TRUE)) {
     stop(
       "Must install `RSpectra` for this functionality.",
@@ -49,7 +48,6 @@ svds.undirected_factor_model <- function(
     nv = k,
     opts = list(),
     ...) {
-
   if (!requireNamespace("RSpectra", quietly = TRUE)) {
     stop(
       "Must install `RSpectra` for this functionality.",
@@ -94,7 +92,6 @@ svds.directed_factor_model <- function(
     nv = k,
     opts = list(),
     ...) {
-
   if (!requireNamespace("RSpectra", quietly = TRUE)) {
     stop(
       "Must install `RSpectra` for this functionality.",

R/plotting.R

@@ -53,7 +53,6 @@ plot_expectation <- function(model) {
 #' @import ggplot2
 #' @export
 plot_dense_matrix <- function(A, ...) {
-
   # don't preserve rownames because rownames and colnames get coerced to
   # indices and this can lead to type errors
   rownames(A) <- 1:nrow(A)
@@ -76,7 +75,6 @@ plot_dense_matrix <- function(A, ...) {
 #' @rdname plot_expectation
 #' @export
 plot_sparse_matrix <- function(A) {
-
   stopifnot(inherits(A, "sparseMatrix"))
 
   A <- methods::as(A, "CsparseMatrix")