From df68caaaf09ae2ecff9046cc19e00590f61b417a Mon Sep 17 00:00:00 2001 From: "George G. Vega Yon" Date: Wed, 30 Nov 2022 14:43:59 -0700 Subject: [PATCH] Correcting warning and errors --- DESCRIPTION | 4 +- NAMESPACE | 12 ++++++ NEWS.md | 13 +++++- R/bass.r | 3 +- R/diffnet-methods.r | 75 +++++++++++++++++++++++++++++++++++ R/random_graph.R | 9 ++++- R/rdiffnet.r | 2 +- R/spatial.R | 49 +++++++++++++++++------ inst/NEWS | 11 +++++ man/bass.Rd | 3 +- man/diag_expand.Rd | 37 +++-------------- man/diffnet-class.Rd | 45 +++++++++++++++++++++ src/rgraph.cpp | 2 +- tests/testthat/test-spatial.R | 4 +- 14 files changed, 214 insertions(+), 55 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3fde99f1..90193ba4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: netdiffuseR Title: Analysis of Diffusion and Contagion Processes on Networks -Version: 1.22.4 +Version: 1.22.5 Authors@R: c( person("George", "Vega Yon", email="g.vegayon@gmail.com", role=c("aut", "cre"), comment=c(ORCID = "0000-0002-3171-0844", what="Rewrite functions with Rcpp, plus new features") @@ -50,7 +50,7 @@ Suggests: survival VignetteBuilder: knitr LinkingTo: Rcpp, RcppArmadillo -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.2 Encoding: UTF-8 URL: https://github.com/USCCANA/netdiffuseR, https://USCCANA.github.io/netdiffuseR/ diff --git a/NAMESPACE b/NAMESPACE index 2ee08f3b..04314db4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -43,6 +43,14 @@ S3method(ftable,diffnet_adopters) S3method(hist,diffnet_bootnet) S3method(hist,diffnet_struct_test) S3method(image,diffnet_diffmap) +S3method(is_multiple,default) +S3method(is_multiple,diffnet) +S3method(is_self,default) +S3method(is_self,diffnet) +S3method(is_undirected,default) +S3method(is_undirected,diffnet) +S3method(is_valued,default) +S3method(is_valued,diffnet) S3method(plot,diffnet) S3method(plot,diffnet_adopters) S3method(plot,diffnet_bass) @@ -118,6 +126,10 @@ export(hazard_rate) export(igraph_to_diffnet) export(igraph_vertex_rescale) export(infection) +export(is_multiple) +export(is_self) +export(is_undirected) +export(is_valued) export(isolated) export(leader_matching) export(matrix_compare) diff --git a/NEWS.md b/NEWS.md index ebe4e0d1..7f1370c0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,19 @@ +# Changes in netdiffuseR version 1.22.5 (2022-11-30) + +* Solved warning and errors reported by CRAN before the package was archived. + +* New S3 generic functions `is_self`, `is_multiple`, `is_valued`, and + `is_undirected` allow querying graph information for some methods. + +* Fixed bug in `diag_expand`. Graphs with self ties were not transformed correctly + (diagonals were excluded.) + + # Changes in netdiffuseR version 1.22.4 (2022-09-16) * Replaced `getMethod("t"...)` by `t` responding to changes in the `Matrix` package. - + # Changes in netdiffuseR version 1.22.1 (2021-05-27) diff --git a/R/bass.r b/R/bass.r index a1268ea5..22ff8e53 100644 --- a/R/bass.r +++ b/R/bass.r @@ -61,7 +61,8 @@ #' #' @references #' Bass's Basement Institute Institute. The Bass Model. (2010). -#' Available at: \url{http://www.bassbasement.org/BassModel/Default.aspx}. (Accessed: 29th March 2017) +#' Available at: \url{https://web.archive.org/web/20220331222618/http://www.bassbasement.org/BassModel/}. +#' (accessed live for the last time on March 29th, 2017.) #' @name bass #' @author George G. Vega Yon #' @family statistics diff --git a/R/diffnet-methods.r b/R/diffnet-methods.r index eef351d1..6e0bdc08 100644 --- a/R/diffnet-methods.r +++ b/R/diffnet-methods.r @@ -1699,3 +1699,78 @@ dim.diffnet <- function(x) { as.integer(with(x$meta, c(n, k, nper))) } +#' @rdname diffnet-class +#' @details The function `is_undirected` returns TRUE if the network is marked +#' as undirected. In the case of `diffnet` objects, this information is stored +#' in the `meta` element as `undirected`. The default method is to try to find +#' an attribute called `undirected`, i.e., `attr(x, "undirected")`, if no +#' attribute is found, then the function returns `FALSE`. +#' +#' The functions `is_self`, `is_valued`, and `is_multiple` work exactly the same +#' as `is_undirected`. `diffnet` networks are not valued. +#' @export +is_undirected <- function(x) UseMethod("is_undirected") + +#' @export +#' @rdname diffnet-class +is_undirected.diffnet <- function(x) x$meta$undirected + +#' @export +#' @rdname diffnet-class +is_undirected.default <- function(x) { + und <- attr(x, "undirected", exact = TRUE) + if (!length(und)) + return(FALSE) + und +} + +#' @export +#' @rdname diffnet-class +is_self <- function(x) UseMethod("is_self") + +#' @export +#' @rdname diffnet-class +is_self.diffnet <- function(x) x$meta$self + +#' @export +#' @rdname diffnet-class +is_self.default <- function(x) { + und <- attr(x, "self", exact = TRUE) + if (!length(und)) + return(FALSE) + und +} + +#' @export +#' @rdname diffnet-class +is_multiple <- function(x) UseMethod("is_multiple") + +#' @export +#' @rdname diffnet-class +is_multiple.diffnet <- function(x) x$meta$multiple + +#' @export +#' @rdname diffnet-class +is_multiple.default <- function(x) { + und <- attr(x, "multiple", exact = TRUE) + if (!length(und)) + return(FALSE) + und +} + +#' @export +#' @rdname diffnet-class +is_valued <- function(x) UseMethod("is_valued") + +#' @export +#' @rdname diffnet-class +is_valued.diffnet <- function(x) return(FALSE) + +#' @export +#' @rdname diffnet-class +is_valued.default <- function(x) { + und <- attr(x, "valued", exact = TRUE) + if (!length(und)) + return(FALSE) + und +} diff --git a/R/random_graph.R b/R/random_graph.R index 540184dd..6e6ce655 100644 --- a/R/random_graph.R +++ b/R/random_graph.R @@ -176,7 +176,14 @@ NULL #' @export #' @rdname rgraph_ba -rgraph_ba <- function(m0=1L, m=1L, t=10L, graph=NULL, self=TRUE, eta=NULL) { +rgraph_ba <- function( + m0 = 1L, + m = 1L, + t = 10L, + graph = NULL, + self = TRUE, + eta = NULL + ) { # Eta should be numeric vector if (length(eta)) { diff --git a/R/rdiffnet.r b/R/rdiffnet.r index 3be2c6c7..3a479b20 100644 --- a/R/rdiffnet.r +++ b/R/rdiffnet.r @@ -153,6 +153,7 @@ rdiffnet_make_threshold <- function(x, n) { } rdiffnet_check_seed_graph <- function(seed.graph, rgraph.args, t, n) { + test <- class(seed.graph) if ("function" %in% test) { @@ -337,7 +338,6 @@ rdiffnet <- function( # Checking the class of the seed.graph sgraph <- rdiffnet_check_seed_graph(seed.graph, rgraph.args, t, n) - # Checking baseline graph -------------------------------------------------- meta <- classify_graph(sgraph) diff --git a/R/spatial.R b/R/spatial.R index 686f42c0..8d65a2ea 100644 --- a/R/spatial.R +++ b/R/spatial.R @@ -20,9 +20,12 @@ #' @export diag_expand <- function(...) UseMethod("diag_expand") -.diag_expand <- function(graph, nper, - self=getOption("diffnet.self"), - valued=getOption("diffnet.valued")) { +.diag_expand <- function( + graph, + nper, + self = getOption("diffnet.self"), + valued = getOption("diffnet.valued") + ) { # Checking class meta <- classify_graph(graph) @@ -66,23 +69,35 @@ diag_expand <- function(...) UseMethod("diag_expand") #' @export #' @rdname diag_expand -diag_expand.list <- function(graph, self=getOption("diffnet.self"), - valued=getOption("diffnet.valued"), ...) { +diag_expand.list <- function( + graph, + self = is_self(graph), + valued = is_valued(graph), + ... + ) { .diag_expand(graph, length(graph), self, valued) } #' @export #' @rdname diag_expand -diag_expand.diffnet <- function(graph, self=getOption("diffnet.self"), - valued=getOption("diffnet.valued"), ...) { +diag_expand.diffnet <- function( + graph, + self = is_self(graph), + valued = is_valued(graph), + ... + ) { .diag_expand(graph$graph, graph$meta$nper, self, valued) } #' @export #' @rdname diag_expand -diag_expand.matrix <- function(graph, nper, self=getOption("diffnet.self"), - valued=getOption("diffnet.valued"), ...) { +diag_expand.matrix <- function( + graph, + nper, + self = is_self(graph), + valued = is_valued(graph), + ...) { .diag_expand(list(methods::as(graph, "dgCMatrix")), nper, self, valued) } @@ -90,8 +105,12 @@ diag_expand.matrix <- function(graph, nper, self=getOption("diffnet.self"), #' @export #' @rdname diag_expand -diag_expand.array <- function(graph, self=getOption("diffnet.self"), - valued=getOption("diffnet.valued"), ...) { +diag_expand.array <- function( + graph, + self = is_self(graph), + valued = is_valued(graph), + ... + ) { graph <- apply(graph, 3, function(x) methods::as(x, "dgCMatrix")) diag_expand(graph, nslices(graph), self, valued) @@ -100,8 +119,12 @@ diag_expand.array <- function(graph, self=getOption("diffnet.self"), #' @export #' @rdname diag_expand -diag_expand.dgCMatrix <- function(graph, nper, self=getOption("diffnet.self"), - valued=getOption("diffnet.valued"), ...) { +diag_expand.dgCMatrix <- function( + graph, + nper, + self = is_self(graph), + valued = is_valued(graph), + ...) { .diag_expand(list(graph), nper, self, valued) } diff --git a/inst/NEWS b/inst/NEWS index 16679b16..cc271449 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,3 +1,14 @@ +Changes in netdiffuseR version 1.22.5 (2022-11-30) + +- Solved warning and errors reported by CRAN before the package was + archived. + +- New S3 generic functions is_self, is_multiple, is_valued, and + is_undirected allow querying graph information for some methods. + +- Fixed bug in diag_expand. Graphs with self ties were not transformed + correctly (diagonals were excluded.) + Changes in netdiffuseR version 1.22.4 (2022-09-16) - Replaced getMethod("t"...) by t responding to changes in the Matrix diff --git a/man/bass.Rd b/man/bass.Rd index 2fa5199a..c6512d3b 100644 --- a/man/bass.Rd +++ b/man/bass.Rd @@ -131,7 +131,8 @@ plot(ans) } \references{ Bass's Basement Institute Institute. The Bass Model. (2010). -Available at: \url{http://www.bassbasement.org/BassModel/Default.aspx}. (Accessed: 29th March 2017) +Available at: \url{https://web.archive.org/web/20220331222618/http://www.bassbasement.org/BassModel/}. +(accessed live for the last time on March 29th, 2017.) } \seealso{ Other statistics: diff --git a/man/diag_expand.Rd b/man/diag_expand.Rd index 23f9766a..0e4efc27 100644 --- a/man/diag_expand.Rd +++ b/man/diag_expand.Rd @@ -11,42 +11,15 @@ \usage{ diag_expand(...) -\method{diag_expand}{list}( - graph, - self = getOption("diffnet.self"), - valued = getOption("diffnet.valued"), - ... -) +\method{diag_expand}{list}(graph, self = is_self(graph), valued = is_valued(graph), ...) -\method{diag_expand}{diffnet}( - graph, - self = getOption("diffnet.self"), - valued = getOption("diffnet.valued"), - ... -) +\method{diag_expand}{diffnet}(graph, self = is_self(graph), valued = is_valued(graph), ...) -\method{diag_expand}{matrix}( - graph, - nper, - self = getOption("diffnet.self"), - valued = getOption("diffnet.valued"), - ... -) +\method{diag_expand}{matrix}(graph, nper, self = is_self(graph), valued = is_valued(graph), ...) -\method{diag_expand}{array}( - graph, - self = getOption("diffnet.self"), - valued = getOption("diffnet.valued"), - ... -) +\method{diag_expand}{array}(graph, self = is_self(graph), valued = is_valued(graph), ...) -\method{diag_expand}{dgCMatrix}( - graph, - nper, - self = getOption("diffnet.self"), - valued = getOption("diffnet.valued"), - ... -) +\method{diag_expand}{dgCMatrix}(graph, nper, self = is_self(graph), valued = is_valued(graph), ...) } \arguments{ \item{...}{Further arguments to be passed to the method.} diff --git a/man/diffnet-class.Rd b/man/diffnet-class.Rd index 88202924..734375c8 100644 --- a/man/diffnet-class.Rd +++ b/man/diffnet-class.Rd @@ -19,6 +19,18 @@ \alias{dimnames.diffnet} \alias{t.diffnet} \alias{dim.diffnet} +\alias{is_undirected} +\alias{is_undirected.diffnet} +\alias{is_undirected.default} +\alias{is_self} +\alias{is_self.diffnet} +\alias{is_self.default} +\alias{is_multiple} +\alias{is_multiple.diffnet} +\alias{is_multiple.default} +\alias{is_valued} +\alias{is_valued.diffnet} +\alias{is_valued.default} \title{Creates a \code{diffnet} class object} \usage{ as_diffnet(graph, ...) @@ -77,6 +89,30 @@ diffnetLapply(graph, FUN, ...) \method{t}{diffnet}(x) \method{dim}{diffnet}(x) + +is_undirected(x) + +\method{is_undirected}{diffnet}(x) + +\method{is_undirected}{default}(x) + +is_self(x) + +\method{is_self}{diffnet}(x) + +\method{is_self}{default}(x) + +is_multiple(x) + +\method{is_multiple}{diffnet}(x) + +\method{is_multiple}{default}(x) + +is_valued(x) + +\method{is_valued}{diffnet}(x) + +\method{is_valued}{default}(x) } \arguments{ \item{graph}{A dynamic graph (see \code{\link{netdiffuseR-graphs}}).} @@ -193,6 +229,15 @@ presented in the right order. See the example below. If the user does not provide the names of the vertex id and time period variables then the function does not check the way the rows are sorted, further it assumes that the data is in the correct order. + +The function `is_undirected` returns TRUE if the network is marked +as undirected. In the case of `diffnet` objects, this information is stored +in the `meta` element as `undirected`. The default method is to try to find +an attribute called `undirected`, i.e., `attr(x, "undirected")`, if no +attribute is found, then the function returns `FALSE`. + +The functions `is_self`, `is_valued`, and `is_multiple` work exactly the same +as `is_undirected`. `diffnet` networks are not valued. } \section{Auxiliary functions}{ diff --git a/src/rgraph.cpp b/src/rgraph.cpp index 285363e0..9db962b1 100644 --- a/src/rgraph.cpp +++ b/src/rgraph.cpp @@ -254,7 +254,7 @@ arma::sp_mat rewire_swap( newj = indexes.at(newij, 1); bool ismultiple = !multiple && - (newgraph.at(i, newj) != 0) || (newgraph.at(newi, j) != 0); + ((newgraph.at(i, newj) != 0) || (newgraph.at(newi, j) != 0)); /*// Alternating Hexagons // Ramachandra Rao, et al, The Indian Journal of Statistics diff --git a/tests/testthat/test-spatial.R b/tests/testthat/test-spatial.R index a941dadc..f4f9fe66 100644 --- a/tests/testthat/test-spatial.R +++ b/tests/testthat/test-spatial.R @@ -2,10 +2,10 @@ context("Spatial functions (beta)") test_that("diag expansion", { set.seed(1231) - dn <- rdiffnet(n=100,t=5) + dn <- rdiffnet(n = 100, t = 5) ans1 <- diag_expand(dn) - ans2 <- diag_expand(dn$graph) + ans2 <- diag_expand(dn$graph, self = is_self(dn)) # Checking methods expect_equal(ans1,ans2)