Pushed to CRAN

USCCANA · Aug 15, 2022 · f83b35f · f83b35f
1 parent 4cda66a
commit f83b35f
Show file tree

Hide file tree

Showing 26 changed files with 456 additions and 98 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -0,0  1,41 @@
 # This workflow uses actions that are not certified by GitHub.
 # They are provided by a third-party and are governed by
 # separate terms of service, privacy policy, and support
 # documentation.
 #
 # See https://github.com/r-lib/actions/tree/master/examples#readme for
 # additional example workflows available for the R community.
 
 name: R CI 
 
 on: [push, pull_request]
 
 env:
   cntr: uscbiostats/fmcmc:latest
 
 jobs:
   build:
     runs-on: Ubuntu-latest
     strategy:
       matrix:
         include:
         - name: release
            cmd: R
         - name: dev
            cmd: RD
 
     steps:
       - uses: actions/checkout@v2
 
       - name: Container
         run: docker pull ${{ cntr }}
 
       - name: SessionInfo
         run: docker run --rm -i -v ${PWD}:/mnt -w /mnt ${{ cntr }} ${{ matrix.cmd }} -q -e 'sessionInfo()'
 
       - name: Build
         run: docker run --rm -i -v ${PWD}:/mnt -w /mnt ${{ cntr }} ${{ matrix.cmd }} CMD build --no-build-vignettes --no-manual .
 
       - name: Check
         run: docker run --rm -i -v ${PWD}:/mnt -w /mnt -e CI=true ${{ cntr }} ${{ matrix.cmd }} CMD check --no-vignettes --no-manual fmcmc_*.tar.gz
 
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6  1,6 @@
 Package: netdiffuseR
 Title: Analysis of Diffusion and Contagion Processes on Networks
-Version: 1.22.2
 Version: 1.22.3
 Authors@R: c(
   person("George", "Vega Yon", email="[email protected]", role=c("aut", "cre"),
     comment=c(ORCID = "0000-0002-3171-0844", what="Rewrite functions with Rcpp, plus new features")

diff --git a/NEWS.md b/NEWS.md
@@ -1,4  1,4 @@
-# Changes in netdiffuseR version 1.22.1 (2021-05-04)
 # Changes in netdiffuseR version 1.22.1 (2021-05-27)
 
 * netdiffuseR has now a logo!
 

diff --git a/R/bass.r b/R/bass.r
@@ -2,7  2,7 @@
 #'
 #' Fits the Bass Diffusion model. In particular, fits an observed curve of
 #' proportions of adopters to \eqn{F(t)}, the proportion of adopters at time
-#' \eqn{t}, finding the corresponding coeficients \eqn{p}, Innovation rate,
 #' \eqn{t}, finding the corresponding coefficients \eqn{p}, Innovation rate,
 #' and \eqn{q}, imitation rate.
 #'
 #' @param Time Integer vector with values greater than 0. The \eqn{t} parameter.

diff --git a/R/data.r b/R/data.r
@@ -846,6  846,7 @@ NULL # "medInnovationsDiffNet"
 #' @family diffusion datasets
 #' @name diffusion-data
 #' @author Thomas W. Valente
 #' @return No return value (this manual entry only provides information).
 NULL
 
 

diff --git a/R/diffnet-methods.r b/R/diffnet-methods.r
@@ -20,12  20,14 @@
 #'
 #'
 plot.diffnet <- function(
-  x,y=NULL, t=1,
-  vertex.color  = c(adopt="steelblue", noadopt="white"),
-  vertex.size = "degree",
-  main        = "Diffusion network in time %d",
   x,y          = NULL,
   t            = 1,
   vertex.color = c(adopt="steelblue", noadopt="white"),
   vertex.size  = "degree",
   main         = "Diffusion network in time %d",
   minmax.relative.size = getOption("diffnet.minmax.relative.size", c(0.01, 0.04)),
-  ...) {
   ...
   ) {
 
   # Listing arguments
   igraph.args <- list(...)
@@ -651,6  653,8 @@ plot_diffnet.default <- function(
 #' plot_threshold(graph, expos, toa, vertex.size = "indegree")
 #'
 #' @export
 #' @return Invisible. A data frame with the calculated coordinates, including:
 #' `toa`, `threshold`, and `jit` (a jittered version of `toa`).
 #' @author George G. Vega Yon
 plot_threshold <- function(graph, expo, ...) UseMethod("plot_threshold")
 
@@ -826,8  830,16 @@ plot_threshold.default <- function(
 
   # Plotting the edges
   mapply(function(x0, y0, x1, y1, col, edge.curved, arrow.color) {
-    y <- edges_arrow(x0, y0, x1, y1, width=arrow.width, height=arrow.length,
-                     beta=pi*(2/3), dev=par("pin"), ran=ran, curved = edge.curved)
 
     y <- edges_arrow(
       x0, y0, x1, y1,
       width  = arrow.width,
       height = arrow.length,
       beta   = pi*(2/3),
       dev    = par("pin"),
       ran    = ran,
       curved = edge.curved
       )
 
     # Drawing arrow
     if (edge.curved) {
@@ -836,7  848,7 @@ plot_threshold.default <- function(
       graphics::xspline(
         y$edge[,1],y$edge[,2],
         shape = c(0, 1, 0),
-        open=TRUE, border = col, lwd=edge.width)
         open  = TRUE, border = col, lwd=edge.width)
 
       # Arrow
       graphics::polygon(y$arrow[,1], y$arrow[,2], col = arrow.color, border = arrow.color)

diff --git a/R/graph_data.r b/R/graph_data.r
@@ -36,6  36,7 @@
 #' and \code{\link{names}} (in the case of dynamic graphs as lists). Otherwise,
 #' when no names are provided, these will be created from scratch.
 #' @include imports.r
 #' @return No return value (this manual entry only provides information).
 #' @author George G. Vega Yon
 #' @family graph formats
 NULL

diff --git a/R/misc.r b/R/misc.r
@@ -82,7  82,7 @@ recode.matrix <- function(data, ...) {
 #' pretty(x)
 #' pretty_within(x)
 #' range(x)
-#'
 #' @return A vector sequence of `n   1` round values in the specified range.
 #' @export
 #' @keywords misc
 pretty_within <- function(x, min.n=5, xrange=range(x, na.rm = TRUE), ...) {

diff --git a/R/rewire.r b/R/rewire.r
@@ -157,6  157,7 @@
 #' @family simulation functions
 #' @export
 #' @author George G. Vega Yon
 #' @return A rewired version of the graph.
 #' @examples
 #' # Checking the consistency of the "swap" ------------------------------------
 #'
@@ -209,12  210,18 @@
 # ' # Marking the original structure
 # ' baseline <- paste0(as.vector(x), collapse="")
 # ' points(x=7,y=table(as.factor(w))[baseline]/nsim*100, pch=3, col="red")
-rewire_graph <- function(graph, p,
-                         algorithm="endpoints",
-                         both.ends=FALSE, self=FALSE, multiple=FALSE,
-                         undirected=getOption("diffnet.undirected"),
-                         pr.change= ifelse(self, 0.5, 1),
-                         copy.first=TRUE, althexagons=FALSE) {
 rewire_graph <- function(
   graph,
   p,
   algorithm="endpoints",
   both.ends   = FALSE,
   self        = FALSE,
   multiple    = FALSE,
   undirected  = getOption("diffnet.undirected"),
   pr.change   = ifelse(self, 0.5, 1),
   copy.first  = TRUE,
   althexagons = FALSE
   ) {
 
   # Checking undirected (if exists)
   checkingUndirected(graph)
@@ -225,6  232,16 @@ rewire_graph <- function(graph, p,
     warning("The option -althexagons- is still on development. So it has been set to FALSE.")
   }
 
   if (copy.first) {
 
     warning(
       "The option -copy.first- is set to TRUE. In this case, the first graph will be ",
       "treated as a baseline, and thus, networks after T=1 will be replaced with T-1.",
       immediate. = TRUE
       )
 
   }
 
   # Checking copy.first
   # if (missing(copy.first)) copy.first <- FALSE
 
@@ -246,19  263,33 @@ rewire_graph <- function(graph, p,
   # If diffnet, then it must return the same object but rewired, and change
   # the attribute of directed or not
   if (inherits(graph, "diffnet")) {
 
     graph$meta$undirected <- undirected
     graph$graph <- out
     return(graph)
 
   }
 
   attr(out, "undirected") <- FALSE
 
   return(out)
 
 }
 
 # @rdname rewire_graph
-rewire_graph.list <- function(graph, p, algorithm, both.ends, self, multiple, undirected,
-                              pr.change, copy.first, althexagons) {
 rewire_graph.list <- function(
   graph,
   p,
   algorithm,
   both.ends,
   self,
   multiple,
   undirected,
   pr.change,
   copy.first,
   althexagons
 ) {
 
   t   <- length(graph)
   out <- graph
 
@@ -291,10  322,22 @@ rewire_graph.list <- function(graph, p, algorithm, both.ends, self, multiple, un
   }
 
   out
 
 }
 
 # @rdname rewire_graph
-rewire_graph.dgCMatrix <- function(graph, p, algorithm, both.ends, self, multiple, undirected, pr.change, althexagons) {
 rewire_graph.dgCMatrix <- function(
   graph,
   p,
   algorithm,
   both.ends,
   self,
   multiple,
   undirected,
   pr.change,
   althexagons
   ) {
 
   out <- if (algorithm == "endpoints")
     rewire_endpoints(graph, p, both.ends, self, multiple, undirected)
   else if (algorithm == "swap")
@@ -307,10  350,12 @@ rewire_graph.dgCMatrix <- function(graph, p, algorithm, both.ends, self, multipl
   if (!length(rn)) rn <- 1:nrow(out)
   dimnames(out) <- list(rn, rn)
   out
 
 }
 
 # @rdname rewire_graph
-rewire_graph.array <-function(graph, p, algorithm, both.ends, self, multiple, undirected,
 rewire_graph.array <-function(
   graph, p, algorithm, both.ends, self, multiple, undirected,
                               pr.change, copy.first, althexagons) {
   n   <- dim(graph)[1]
   t   <- dim(graph)[3]
@@ -321,8  366,12 @@ rewire_graph.array <-function(graph, p, algorithm, both.ends, self, multiple, un
   if (!length(tn)) tn <- 1:t
   names(out) <- tn
 
-  return(rewire_graph.list(out, p, algorithm, both.ends, self, multiple, undirected,
-                    pr.change, copy.first, althexagons))
   return(
     rewire_graph.list(
       out, p, algorithm, both.ends, self, multiple, undirected,
       pr.change, copy.first, althexagons
       )
     )
 }
 
 #' Permute the values of a matrix
@@ -364,7  413,11 @@ rewire_graph.array <-function(graph, p, algorithm, both.ends, self, multiple, un
 #' @family simulation functions
 #' @export
 #' @aliases CUG QAP
-permute_graph <- function(graph, self=FALSE, multiple=FALSE) {
 permute_graph <- function(
   graph,
   self     = FALSE,
   multiple = FALSE
   ) {
 
   # Changing class
   cls <- class(graph)
@@ -444,10  497,10 @@ rewire_qap <- function(graph) {
     }
 
 
-  } else {
   } else
     ans <- rewirefun(x)
-  }
 
   return(ans)
 
 }
 
diff --git a/R/struct_equiv.R b/R/struct_equiv.R
@@ -271,7  271,8 @@ struct_equiv_by <- function(graph, v, inf.replace, groupvar, ...) {
 #' @details The transformation function \code{fun} must return a square matrix
 #' of size \eqn{m\times m}{m*m}, where \eqn{m} is the size of the subgroup
 #' given by \code{INDICES}. See examples below
-#'
 #' @return A transformed version of the network, with the desired function applied
 #' by blocks.
 #' @examples
 #' # Rewiring a graph by community --------------------------------------------
 #'