From 7b2be03f603784c7362deee7db88031bef54be8a Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 13 Apr 2025 17:38:06 +0200 Subject: [PATCH 01/21] Added to_no_missing() --- NAMESPACE | 2 ++ R/manip_reformed.R | 14 +++++++++++++- man/manip_scope.Rd | 7 ++++++- 3 files changed, 21 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c5259370..3629913f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -242,6 +242,7 @@ S3method(to_no_isolates,list) S3method(to_no_isolates,matrix) S3method(to_no_isolates,network) S3method(to_no_isolates,tbl_graph) +S3method(to_no_missing,tbl_graph) S3method(to_onemode,igraph) S3method(to_onemode,matrix) S3method(to_onemode,tbl_graph) @@ -792,6 +793,7 @@ export(to_mode2) export(to_multilevel) export(to_named) export(to_no_isolates) +export(to_no_missing) export(to_onemode) export(to_permuted) export(to_reciprocated) diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 55a9e38b..e3199a0b 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -218,7 +218,9 @@ to_ties.matrix <- function(.data){ #' #' - `to_ego()` scopes a network into the local neighbourhood of a given node. #' - `to_giant()` scopes a network into one including only the main component and no smaller components or isolates. -#' - `to_no_isolates()` scopes a network into one excluding all nodes without ties +#' - `to_no_isolates()` scopes a network into one excluding all nodes without ties. +#' - `to_no_missing()` scopes a network to one retaining only complete cases, +#' i.e. nodes with no missing values. #' - `to_subgraph()` scopes a network into a subgraph by filtering on some node-related logical statement. #' - `to_blocks()` reduces a network to ties between a given partition membership vector. #' @details @@ -242,6 +244,16 @@ to_ties.matrix <- function(.data){ #' with certain modifications as outlined for each function. NULL +#' @rdname manip_scope +#' @export +to_no_missing <- function(.data) UseMethod("to_no_missing") + +#' @export +to_no_missing.tbl_graph <- function(.data){ + delete_nodes(.data, !stats::complete.cases(as_nodelist(test))) +} + + #' @rdname manip_scope #' @param node Name or index of node. #' @param max_dist The maximum breadth of the neighbourhood. diff --git a/man/manip_scope.Rd b/man/manip_scope.Rd index 3959b12d..1c7c194a 100644 --- a/man/manip_scope.Rd +++ b/man/manip_scope.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/manip_reformed.R \name{manip_scope} \alias{manip_scope} +\alias{to_no_missing} \alias{to_ego} \alias{to_time} \alias{to_giant} @@ -10,6 +11,8 @@ \alias{to_blocks} \title{Modifying networks scope} \usage{ +to_no_missing(.data) + to_ego(.data, node, max_dist = 1, min_dist = 0, direction = c("out", "in")) to_time(.data, time) @@ -69,7 +72,9 @@ than the original object. \itemize{ \item \code{to_ego()} scopes a network into the local neighbourhood of a given node. \item \code{to_giant()} scopes a network into one including only the main component and no smaller components or isolates. -\item \code{to_no_isolates()} scopes a network into one excluding all nodes without ties +\item \code{to_no_isolates()} scopes a network into one excluding all nodes without ties. +\item \code{to_no_missing()} scopes a network to one retaining only complete cases, +i.e. nodes with no missing values. \item \code{to_subgraph()} scopes a network into a subgraph by filtering on some node-related logical statement. \item \code{to_blocks()} reduces a network to ties between a given partition membership vector. } From d772403a1811c972cc6a46b7ec59062a41a9a961 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 16 Apr 2025 11:29:33 +0200 Subject: [PATCH 02/21] More detail on LOTR dataset --- R/data_ison.R | 11 ++++++++++- man/fict_lotr.Rd | 11 ++++++++++- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/R/data_ison.R b/R/data_ison.R index 923a4197..277e5555 100644 --- a/R/data_ison.R +++ b/R/data_ison.R @@ -456,9 +456,18 @@ #' One-mode network of Lord of the Rings character interactions #' #' @description -#' A network of 36 Lord of the Rings book characters and 66 interactional relationships. +#' The Lord of the Rings is a beloved, epic high fantasy novel written by +#' J.R.R. Tolkien. +#' This is a network of 36 Lord of the Rings book characters and +#' 66 interactional relationships. +#' #' The ties are unweighted and concern only interaction. #' Interaction can be cooperative or conflictual. +#' +#' In addition, the race of these characters has been coded, +#' though not without debate. +#' The most contentious is the coding of Tom Bombadil and Goldberry as Maiar, +#' presumably coded as such to avoid having categories of one. #' @docType data #' @keywords datasets #' @name fict_lotr diff --git a/man/fict_lotr.Rd b/man/fict_lotr.Rd index e4e0eb78..779720e2 100644 --- a/man/fict_lotr.Rd +++ b/man/fict_lotr.Rd @@ -39,8 +39,17 @@ data(fict_lotr) } \description{ -A network of 36 Lord of the Rings book characters and 66 interactional relationships. +The Lord of the Rings is a beloved, epic high fantasy novel written by +J.R.R. Tolkien. +This is a network of 36 Lord of the Rings book characters and +66 interactional relationships. + The ties are unweighted and concern only interaction. Interaction can be cooperative or conflictual. + +In addition, the race of these characters has been coded, +though not without debate. +The most contentious is the coding of Tom Bombadil and Goldberry as Maiar, +presumably coded as such to avoid having categories of one. } \keyword{datasets} From 463015adb38b01f04a9c7615a3cd0281a2d6d162 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 16 Apr 2025 11:29:51 +0200 Subject: [PATCH 03/21] Page cite in heterogeneity --- R/measure_heterogeneity.R | 5 +++++ man/measure_heterogeneity.Rd | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/R/measure_heterogeneity.R b/R/measure_heterogeneity.R index 32c64893..2c9aa549 100644 --- a/R/measure_heterogeneity.R +++ b/R/measure_heterogeneity.R @@ -71,6 +71,11 @@ node_richness <- function(.data, attribute){ #' Blau, Peter M. 1977. #' _Inequality and heterogeneity_. #' New York: Free Press. +#' +#' Page, Scott E. 2010. +#' _Diversity and Complexity_. +#' Princeton: Princeton University Press. +#' \doi{10.1515/9781400835140} #' @examples #' marvel_friends <- to_unsigned(ison_marvel_relationships, "positive") #' net_diversity(marvel_friends, "Gender") diff --git a/man/measure_heterogeneity.Rd b/man/measure_heterogeneity.Rd index dc425095..8a995173 100644 --- a/man/measure_heterogeneity.Rd +++ b/man/measure_heterogeneity.Rd @@ -115,6 +115,11 @@ net_spatial(ison_lawfirm, "age") Blau, Peter M. 1977. \emph{Inequality and heterogeneity}. New York: Free Press. + +Page, Scott E. 2010. +\emph{Diversity and Complexity}. +Princeton: Princeton University Press. +\doi{10.1515/9781400835140} } \subsection{On heterophily}{ From 8cfd5248f5ffe8faf606dd2054b4028a7aee67f9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 7 May 2025 14:31:57 +0200 Subject: [PATCH 04/21] Added irps_revere --- R/data_ison.R | 43 +++++++++++++++++++++++++++ data/irps_revere.rda | Bin 0 -> 3489 bytes man/irps_revere.Rd | 67 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 110 insertions(+) create mode 100644 data/irps_revere.rda create mode 100644 man/irps_revere.Rd diff --git a/R/data_ison.R b/R/data_ison.R index 277e5555..6c9de06e 100644 --- a/R/data_ison.R +++ b/R/data_ison.R @@ -796,3 +796,46 @@ #' irps_usgeo #' ``` "irps_usgeo" + +## Revere #### + +#' Two-mode network of Paul Revere's (Fischer 1995) +#' +#' @description +#' This network is of Paul Revere and 253 of his contemporary's overlapping +#' memberships in seven colonial organisations. +#' The data has been collected by Kieran Healy from the appendix to +#' David Hackett Fischer's "Paul Revere's Ride". +#' It highlights Paul Revere's centrality in this network, and thus his +#' ability to mobilise the towns he rode through on horseback north +#' from Boston on the night of April 18, 1775. +#' This is in contrast to William Dawes, who set out the same night, +#' but south. +#' Despite both men coming from similar class and backgrounds, +#' and riding through towns with similar demography and political leanings, +#' only Paul Revere was able to mobilise those he encountered, +#' and his social network was thought key to this. +#' @docType data +#' @keywords datasets +#' @name irps_revere +#' @usage data(irps_revere) +#' @references +#' Fischer, David Hackett. 1995. +#' "Paul Revere's Ride". +#' Oxford: Oxford University Press. +#' +#' Han, Shin-Kap. 2009. +#' "The Other Ride of Paul Revere: The Brokerage Role in the Making of the American Revolution". +#' _Mobilization: An International Quarterly_, 14(2): 143-162. +#' \doi{10.17813/maiq.14.2.g360870167085210} +#' +#' Healy, Kieran. 2013. +#' "Using Metadata to find Paul Revere". +#' @format +#' ```{r, echo = FALSE} +#' irps_revere +#' ``` +"irps_revere" + + + diff --git a/data/irps_revere.rda b/data/irps_revere.rda new file mode 100644 index 0000000000000000000000000000000000000000..6dbcd6d39df1f77db2a0f2cfd75a9d5c95cb6ebb GIT binary patch literal 3489 zcma);X;f3!_Q0v&fS{N(WeAf7g1Hbvic}HB0m6`*0_KJS7aJ8J5>uX42w@QF#3%yh zdI^(Y2?-b!!~_Ha=mSJ0aS9CzKH*WMN@TE#sNlfEXS>$>@c;1towd&1XOExuImauU zyYbuYumcNL^iD3;vpPKAH-BWF_Cx5A`M>yco8Di`Vi;#j-L~qep59lh_5KHcD?R;f z`rGh&dTx95mK+JUYwtK75+dnXWU(QM3&GUAvH;kqV*C9DnaYy<1&C@2uI2M zB~mBi9&~{!QxKAh=#IpAq!X1x%5v}bei0XLKYd;5@HMhA5Z(hvG=1+=1>D*BZPED2 zVq+2Ota=|6t~(Po42S7qN% zn=h@q`%}9KLp#%+*%%Zz^bYU=MuVqHh8Ab!Fa@(EpMaW&|2RE=@f!0!BG{JZH+{`Z zy((>MNy$Lk^&^7t0X*${aLv98&KQg#eOdkpvZ}9NqW|_t@XZSk89_@HS+Ov>@NcXRdQ;L75jkvx);XG!C+0FVcr0*$i;ppR@d~b9Ju2D4|~;D80+0{0>@?M$>oK& z)%SC_+w|15OvmxSiuNa($Pv`xS0=z;A=grchd1 z1t+4o)C^9DjDH*!Bg*FX@mY<6Fm_Y}%h^)uLv4*};%XF;E1=|FMFsidpYm3pM`z90 zj_iz_`a)Bf+jT=#zLasodFOg)^0B2fo!BEve;Csf-`h#mxLB?baXU{nu$(TA=ol-V zP=)v9eLb+kH|I*kK4?IUD3Pi#=uSVc1!ZR7DLt(&kE`&mUD0ca57?LeKDE*|^}e4E z{duJ8)2sZ1Aa+U5$lMW5>Hf{+S;h}C%=EbjU92@(_d;sJ8+m=rj;g*3A+@Y;k87DM*S}l=1Ug9jtbz6@f86)LBRICMdZ ziKMiJc#ux300*bG^S`@LR*Vav&!!;{Hj~Myc-RYGQCgu2AFXN1h^M`S5@$R73_lyU{6$Vu+xovd9DQ{*;MwOx|_eUvYA06O1A}4N7wt!Hfn5CI&_nZn;zIeTewS*oh4QxhNy_f8 zM_#Q@*=^R{^TPY`OOMmMPfO=;lkC1(KwF?0czrcU&`dCFgw;rSZU6D- zmy{288CxTleOg+9HaBoY0hSfE1td3~)V6lchWl~5Zu?MIj&Ci3Hm#CxloUP_$VOv+ zc|Tpm&6>kX+{@Q`1uY6BOHeU{))i)hf;M%VLkO=gdTqJ@bEa*A7K3g=y!psrCH@+y zcCXm;F{i=fEITXj2KH@3L}9H-T;xzedFBW1d~{q(ftz3}OZe__<~PN@0q0&P**v)c zkH9CQ8PSkAxLXsn{8sf#er4Q0t2^XnT{7Ij-mwuh$2#X+{-Km6xEoU@1c(%^Fgioz zU%1!;yfHu#h<8;U>xg1ih|e;;CQC?zzec1#+F+ABEAWPCK9Nx+KjHGQmX1u>v7vnv$!6M zxFhQ-W-6Qgpv@)(p*SQ-3qMI5T3s(Kw@u{|L2wPQ(Hez#S)*}-ZCVy8lO zdxTR{?){{ish@N`bMmf>qb?EYNDxz9(O-6HdKE~w-R;(v34WWy)H8e8Q(DQ?%u)la zU%kC($|Y8mG&pH}kqX|bI)Ccdm&6sl=xNxuhlU$`&eG1AA1+^N;#FGOYz0+58n~~c zsf z1q5x*Rx7W-@yfHfKgHCDH8>PR(#rz7J3TB865l4}rPX4vP_X)#|3*qxHN9VxpyPBz z(kl5v<5*gfP)8@99|MC6%G4AM(Vk7ZOhl@1VWN+)suER8L8_yih|)%fCiIt$klhB z+l5MdpT25mT;-HU@v5804$&PG$h25G;IiEF4t`}7cDgMfB&GeuVLt>cYYlp)u?r2}{b7y;seS%vF&o%{(&=78 z!cJ-dK$9VCr}o7~Z0&6M4+EUEl7+{fRht1rp~<_J7L2BnMxSp4v|)ZAv%?t| zHOO~zJP6+(*6f>lVCjAdZ8f@bAg@tPY2{cpf45^G{*f6!dyf=B>t~eE5hI5lI0FO< ziMUpm8w$e%s_+f4Jd~G~8ZhW=Y-zjqUXZ@A>&Re7#>J9GSTOe5?Es%d571`pyxMrr zsUrQ{rnjD#+%vT!^QAtX)%{fl?U~+2n=h1^7)f52-PM76JzY{C=Z#(gAx`(`;YDiG zg_mTP4^n9)<4aBO<&sL~Q+kbxHx(mSw;#A+y&{Zb-<;q1iZxWobhbz}|1B%FkSxpo&CjL%k}>xn}>mLbGqS>Yw?7 z@Yd)T@(z4~`}BW_`}}\preformatted{#> # A labelled, two-mode network of 261 nodes and 319 ties +#> +#> -- Nodes +#> # A tibble: 261 x 2 +#> type name +#> +#> 1 FALSE Adams.John +#> 2 FALSE Adams.Samuel +#> 3 FALSE Allen.Dr +#> 4 FALSE Appleton.Nathaniel +#> 5 FALSE Ash.Gilbert +#> 6 FALSE Austin.Benjamin +#> # i 255 more rows +#> +#> -- Ties +#> # A tibble: 319 x 2 +#> from to +#> +#> 1 1 257 +#> 2 1 258 +#> 3 2 257 +#> 4 2 258 +#> 5 2 260 +#> 6 2 261 +#> # i 313 more rows +#> +}\if{html}{\out{}} +} +\usage{ +data(irps_revere) +} +\description{ +This network is of Paul Revere and 253 of his contemporary's overlapping +memberships in seven colonial organisations. +The data has been collected by Kieran Healy from the appendix to +David Hackett Fischer's "Paul Revere's Ride". +It highlights Paul Revere's centrality in this network, and thus his +ability to mobilise the towns he rode through on horseback north +from Boston on the night of April 18, 1775. +This is in contrast to William Dawes, who set out the same night, +but south. +Despite both men coming from similar class and backgrounds, +and riding through towns with similar demography and political leanings, +only Paul Revere was able to mobilise those he encountered, +and his social network was thought key to this. +} +\references{ +Fischer, David Hackett. 1995. +"Paul Revere's Ride". +Oxford: Oxford University Press. + +Han, Shin-Kap. 2009. +"The Other Ride of Paul Revere: The Brokerage Role in the Making of the American Revolution". +\emph{Mobilization: An International Quarterly}, 14(2): 143-162. +\doi{10.17813/maiq.14.2.g360870167085210} + +Healy, Kieran. 2013. +"Using Metadata to find Paul Revere". +} +\keyword{datasets} From 86496b9263db1fb1d44b8ac76435589ff0d847fd Mon Sep 17 00:00:00 2001 From: James Hollway Date: Wed, 7 May 2025 14:32:54 +0200 Subject: [PATCH 05/21] Minor bump --- DESCRIPTION | 4 ++-- devmanynet.Rproj => dev_manynet.Rproj | 0 2 files changed, 2 insertions(+), 2 deletions(-) rename devmanynet.Rproj => dev_manynet.Rproj (100%) diff --git a/DESCRIPTION b/DESCRIPTION index 54ec2dd5..a4171eff 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.4.1 -Date: 2025-04-09 +Version: 1.5.0 +Date: 2025-04-24 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/devmanynet.Rproj b/dev_manynet.Rproj similarity index 100% rename from devmanynet.Rproj rename to dev_manynet.Rproj From b69ed922402468763586ce6fa56e996464ff1612 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:39:00 +0200 Subject: [PATCH 06/21] Dropped print and summary methods for diffs_model (now in migraph) --- NAMESPACE | 2 -- 1 file changed, 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3629913f..7fa64378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -151,7 +151,6 @@ S3method(plot,node_member) S3method(plot,node_motif) S3method(plot,tie_measure) S3method(print,diff_model) -S3method(print,diffs_model) S3method(print,learn_model) S3method(print,mnet) S3method(print,network_measure) @@ -165,7 +164,6 @@ S3method(print,tie_measure) S3method(select_nodes,igraph) S3method(select_nodes,tbl_graph) S3method(summary,diff_model) -S3method(summary,diffs_model) S3method(summary,learn_model) S3method(summary,network_measure) S3method(summary,network_motif) From 9536cd14ebcd78f7d5efce62d76d88dfcfc9c837 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:40:11 +0200 Subject: [PATCH 07/21] table_data() now reports longitudinal, dynamic, and changing networks, function arguments reversed --- R/manynet-tutorials.R | 14 +++++++++++--- man/data_overview.Rd | 6 +++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/R/manynet-tutorials.R b/R/manynet-tutorials.R index 4a393beb..e2f03696 100644 --- a/R/manynet-tutorials.R +++ b/R/manynet-tutorials.R @@ -113,8 +113,7 @@ NULL #' dplyr::distinct(directed, weighted, twomode, signed, #' .keep_all = TRUE) #' @export -table_data <- function(pkg = c("manynet","migraph"), - ...) { +table_data <- function(..., pkg = c("manynet","migraph")) { nodes <- NULL pkg <- intersect(pkg, rownames(utils::installed.packages())) out <- lapply(pkg, function(x){ @@ -150,7 +149,16 @@ table_data <- function(pkg = c("manynet","migraph"), multiplex = as.logi(vapply(datasets, is_multiplex, logical(1))), - acyclic = as.logi(vapply(datasets, + longitudinal = as.logi(vapply(datasets, + is_longitudinal, + logical(1))), + dynamic = as.logi(vapply(datasets, + is_dynamic, + logical(1))), + changing = as.logi(vapply(datasets, + is_changing, + logical(1))), + acyclic = as.logi(vapply(datasets, is_acyclic, logical(1))), attributed = as.logi(vapply(datasets, diff --git a/man/data_overview.Rd b/man/data_overview.Rd index 88a14715..7bfe9ccc 100644 --- a/man/data_overview.Rd +++ b/man/data_overview.Rd @@ -5,13 +5,13 @@ \alias{table_data} \title{Obtain overview of available network data} \usage{ -table_data(pkg = c("manynet", "migraph"), ...) +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.} + +\item{pkg}{String, name of the package.} } \description{ This function makes it easy to get an overview of available data: From ab646d21d65cd5681308bc32cb600c9ae76220b9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:41:14 +0200 Subject: [PATCH 08/21] Fixed bug in to_no_missing() where test data was used --- R/manip_format.R | 2 +- R/manip_reformed.R | 2 +- R/manynet-utils.R | 2 +- man/manip_deformat.Rd | 2 +- man/member_community_hier.Rd | 3 --- 5 files changed, 4 insertions(+), 7 deletions(-) diff --git a/R/manip_format.R b/R/manip_format.R index b780f855..2cf76024 100644 --- a/R/manip_format.R +++ b/R/manip_format.R @@ -1,6 +1,6 @@ # Deformatting #### -#' Modifying network formats +#' Modifying network formats by removing information #' #' @description #' These functions reformat manynet-consistent data. diff --git a/R/manip_reformed.R b/R/manip_reformed.R index e3199a0b..00954861 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -250,7 +250,7 @@ to_no_missing <- function(.data) UseMethod("to_no_missing") #' @export to_no_missing.tbl_graph <- function(.data){ - delete_nodes(.data, !stats::complete.cases(as_nodelist(test))) + delete_nodes(.data, !stats::complete.cases(as_nodelist(.data))) } diff --git a/R/manynet-utils.R b/R/manynet-utils.R index 0c0406bf..36aa8688 100644 --- a/R/manynet-utils.R +++ b/R/manynet-utils.R @@ -1,5 +1,5 @@ # defining global variables more centrally -utils::globalVariables(c(".data", "obs", +utils::globalVariables(c(".data", "obs", "from", "to", "name", "weight","sign","wave", "nodes","event","exposure", "student","students","colleges", diff --git a/man/manip_deformat.Rd b/man/manip_deformat.Rd index cdfdaed9..e62d3c97 100644 --- a/man/manip_deformat.Rd +++ b/man/manip_deformat.Rd @@ -8,7 +8,7 @@ \alias{to_unsigned} \alias{to_simplex} \alias{to_uniplex} -\title{Modifying network formats} +\title{Modifying network formats by removing information} \usage{ to_unnamed(.data) diff --git a/man/member_community_hier.Rd b/man/member_community_hier.Rd index b96aabbe..89138572 100644 --- a/man/member_community_hier.Rd +++ b/man/member_community_hier.Rd @@ -90,9 +90,6 @@ information about the hierarchical merging of communities is collected. \examples{ node_in_betweenness(ison_adolescents) -if(require("ggdendro", quietly = TRUE)){ -plot(node_in_betweenness(ison_adolescents)) -} node_in_greedy(ison_adolescents) node_in_eigen(ison_adolescents) node_in_walktrap(ison_adolescents) From 4103006b0ce7e4d21123d3123ad159bb3c3a1fbc Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:41:49 +0200 Subject: [PATCH 09/21] as_diffusion.mnet() now adds "diff_model" class --- R/manip_as.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/manip_as.R b/R/manip_as.R index bf4a6f45..8c463f01 100644 --- a/R/manip_as.R +++ b/R/manip_as.R @@ -1035,6 +1035,7 @@ as_diffusion.mnet <- function(.data, twomode = FALSE, events) { dplyr::any_of(c("time", "n", "S", "s", "E", "E_new", "I", "I_new", "R", "R_new"))) # make_diff_model(events, report, .data) + class(report) <- c("diff_model", class(report)) report } From 69635ad98e859f55ca6bf5c7234f791c8ff26fbd Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:44:58 +0200 Subject: [PATCH 10/21] Upgraded pandoc github action version --- .github/workflows/pushrelease.yml | 2 +- R/member_community.R | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/pushrelease.yml b/.github/workflows/pushrelease.yml index 6b47fca8..bb9ae555 100644 --- a/.github/workflows/pushrelease.yml +++ b/.github/workflows/pushrelease.yml @@ -134,7 +134,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r-dependencies@v2 with: diff --git a/R/member_community.R b/R/member_community.R index bb79af0f..28f00310 100644 --- a/R/member_community.R +++ b/R/member_community.R @@ -399,9 +399,6 @@ NULL #' \doi{10.1103/PhysRevE.69.026113} #' @examples #' node_in_betweenness(ison_adolescents) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(node_in_betweenness(ison_adolescents)) -#' } #' @export node_in_betweenness <- function(.data){ if(missing(.data)) {expect_nodes(); .data <- .G()} From 714ae1ef05e5225078db87c975e9e4e834d26eb9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 18:46:07 +0200 Subject: [PATCH 11/21] Dropped old plotting methods, now in autograph --- NAMESPACE | 21 ------- R/class_measures.R | 77 ------------------------- R/class_members.R | 140 --------------------------------------------- R/class_models.R | 105 ---------------------------------- R/class_motifs.R | 31 ---------- 5 files changed, 374 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7fa64378..d70d1f4e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -140,16 +140,6 @@ S3method(net_dims,igraph) S3method(net_dims,matrix) S3method(net_dims,network) S3method(pillar_shaft,logi) -S3method(plot,diff_model) -S3method(plot,diffs_model) -S3method(plot,learn_model) -S3method(plot,matrix) -S3method(plot,network_measures) -S3method(plot,network_motif) -S3method(plot,node_measure) -S3method(plot,node_member) -S3method(plot,node_motif) -S3method(plot,tie_measure) S3method(print,diff_model) S3method(print,learn_model) S3method(print,mnet) @@ -844,15 +834,9 @@ importFrom(dplyr,tibble) importFrom(dplyr,ungroup) importFrom(ggplot2,aes) importFrom(ggplot2,arrow) -importFrom(ggplot2,element_blank) -importFrom(ggplot2,element_text) -importFrom(ggplot2,geom_histogram) -importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_segment) importFrom(ggplot2,geom_text) -importFrom(ggplot2,geom_tile) -importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggsave) importFrom(ggplot2,ggtitle) @@ -861,12 +845,7 @@ importFrom(ggplot2,labs) importFrom(ggplot2,scale_alpha_manual) importFrom(ggplot2,scale_color_brewer) importFrom(ggplot2,scale_fill_brewer) -importFrom(ggplot2,scale_fill_gradient) importFrom(ggplot2,scale_size) -importFrom(ggplot2,scale_x_discrete) -importFrom(ggplot2,scale_y_discrete) -importFrom(ggplot2,theme) -importFrom(ggplot2,theme_grey) importFrom(ggplot2,theme_void) importFrom(ggplot2,unit) importFrom(ggplot2,xlab) diff --git a/R/class_measures.R b/R/class_measures.R index a3a30992..5c0e8341 100644 --- a/R/class_measures.R +++ b/R/class_measures.R @@ -28,16 +28,6 @@ make_network_measure <- function(out, .data, call) { out } -make_network_measures <- function(out, .data) { - time <- value <- NULL - out <- dplyr::as_tibble(out) %>% - dplyr::mutate(time = as.numeric(names(out))) %>% - dplyr::select(time, value) - class(out) <- c("network_measures", class(out)) - attr(out, "mode") <- net_dims(.data) - out -} - # Printing #### #' @importFrom cli spark_bar #' @export @@ -135,70 +125,3 @@ summary.network_measure <- function(object, ..., ", p = ", cli::style_italic(round(p,3)), ")") } - -# Plotting #### -#' @export -plot.node_measure <- function(x, type = c("h", "d"), ...) { - #type <- match.arg(type) - density <- NULL - if (is.null(attr(x, "mode"))) attr(x, "mode") <- rep(FALSE, length(x)) - data <- data.frame(Score = x, Mode = attr(x, "mode")) - if (length(type) == 2) { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(density)), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > - .1, .1, .01))) + - ggplot2::geom_density(col = 2) + - ggplot2::scale_y_continuous("Frequency", sec.axis = - ggplot2::sec_axis(~ ., breaks = c(0,1), - name = "Density")) - } else if (length(type) == 1 & type == "h") { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(density)), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > - .1, .1, .01))) + - ggplot2::labs(x = "Density", y = "Frequency") - } else if (length(type) == 1 & type == "d") { - p <- ggplot2::ggplot(data = data, ggplot2::aes(x = .data$Score)) + - ggplot2::geom_density(col = 2) + - ggplot2::ylab("Density") - } - p + - ggplot2::theme_classic() + - ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = "grey90")) -} - -#' @export -plot.tie_measure <- function(x, type = c("h", "d"), ...) { - type <- match.arg(type) - data <- data.frame(Score = x) - if (type == "h") { - p <- ggplot2::ggplot(data = data) + - ggplot2::geom_histogram(ggplot2::aes(x = .data$Score), - binwidth = ifelse(max(data$Score) > 1, 1, - ifelse(max(data$Score) > .1, - .1, - .01))) + - ggplot2::ylab("Frequency") - } else { - p <- ggplot2::ggplot(data = data) + - ggplot2::geom_density(ggplot2::aes(x = .data$Score)) + - ggplot2::ylab("Density") - } - p + ggplot2::theme_classic() + - ggplot2::theme(panel.grid.major = ggplot2::element_line(colour = "grey90")) -} - -#' @export -plot.network_measures <- function(x, ...) { - ggplot2::ggplot(data = x, ggplot2::aes(x = .data$time, y = .data$value)) + - ggplot2::geom_line() + - ggplot2::theme_minimal() + - ggplot2::xlab("Time") + - ggplot2::ylab("Value") -} - -# defining global variables more centrally -utils::globalVariables(c(".data")) diff --git a/R/class_members.R b/R/class_members.R index 40721c95..cf4bf01e 100644 --- a/R/class_members.R +++ b/R/class_members.R @@ -58,144 +58,4 @@ summary.node_member <- function(object, ..., } } -#' @importFrom stats cutree -#' @export -plot.node_member <- function(x, ...) { - thisRequires("ggdendro") - hc <- attr(x, "hc") - k <- attr(x, "k") - memb <- x[hc$order] - clust <- memb[!duplicated(memb)] - colors <- ifelse(match(memb, clust) %% 2, - "#000000", "#E20020") - ggdendro::ggdendrogram(hc, rotate = TRUE) + - ggplot2::geom_hline(yintercept = hc$height[length(hc$order) - k], - linetype = 2, - color = "#E20020") + - ggplot2::theme(axis.text.x = ggplot2::element_text(colour = "#5c666f"), - axis.text.y = suppressWarnings( - ggplot2::element_text(colour = colors))) -} - -# plot(as_matrix(ison_adolescents), -# membership = node_regular_equivalence(ison_adolescents, "e")) -# plot(as_matrix(ison_southern_women), -# membership = node_regular_equivalence(ison_southern_women, "e")) -#' @importFrom ggplot2 ggplot geom_tile aes scale_fill_gradient theme_grey labs theme scale_x_discrete scale_y_discrete geom_vline geom_hline element_blank element_text -#' @export -plot.matrix <- function(x, ..., membership = NULL) { - - thisRequires("tidyr") - if (!is_twomode(x)) { - blocked_data <- as_matrix(x) - if (!is.null(membership)) blocked_data <- blocked_data[order(membership), - order(membership)] - } else if (is_twomode(x) && - length(intersect(membership[!node_is_mode(x)], - membership[!node_is_mode(x)])) > 0) { - blocked_data <- as_matrix(to_multilevel(x)) - if (!is.null(membership)) blocked_data <- blocked_data[order(membership), - order(membership)] - } else { - blocked_data <- manynet::as_matrix(x) - } - - from <- to <- weight <- NULL - - plot_data <- as_edgelist(blocked_data) - if(!is_labelled(x)){ - indices <- c(plot_data$from,plot_data$to) - plot_data$from <- paste0("N", gsub("\\s", "0", - format(plot_data$from, - width=max(nchar(indices))))) - plot_data$to <- paste0("N", gsub("\\s", "0", - format(plot_data$to, - width=max(nchar(indices))))) - } - all_nodes <- expand.grid(node_names(blocked_data), - node_names(blocked_data)) - all_nodes <- data.frame(from = all_nodes$Var1, to = all_nodes$Var2, - weight = 0) - plot_data <- rbind(plot_data, all_nodes) %>% dplyr::distinct(from, to, .keep_all = TRUE) - g <- ggplot2::ggplot(plot_data, ggplot2::aes(to, from)) + - ggplot2::theme_grey(base_size = 9) + - ggplot2::labs(x = "", y = "") + - ggplot2::theme( - legend.position = "none", - axis.ticks = ggplot2::element_blank(), - axis.text.y = ggplot2::element_text( - size = 9 * 0.8, - colour = "grey50" - ), - axis.text.x = ggplot2::element_text( - size = 9 * 0.8, - angle = 30, hjust = 0, - colour = "grey50" - ) - ) + - # ggplot2::geom_tile(ggplot2::aes(fill = .data[["value"]]), - ggplot2::geom_tile(ggplot2::aes(fill = weight), - colour = "white" - ) - - # Color for signed networks - if (is_signed(x)) { - g <- g + - ggplot2::scale_fill_gradient2(high = "#003049", - mid = "white", - low = "#d62828") - } else { - g <- g + - ggplot2::scale_fill_gradient( - low = "white", - high = "black" - ) - } - - # Structure for multimodal networks - if (!is_twomode(x)) { - g <- g + - ggplot2::scale_x_discrete(expand = c(0, 0), position = "top", - limits = colnames(blocked_data) - ) + - ggplot2::scale_y_discrete(expand = c(0, 0), - limits = rev(rownames(blocked_data)) - ) - if (!is.null(membership)) - if(!is.numeric(membership)) membership <- as.numeric(as.factor(membership)) - g <- g + ggplot2::geom_vline( - xintercept = c(1 + which(diff(membership[order(membership)]) != 0)) - - .5, - colour = "red" - ) + - ggplot2::geom_hline( - yintercept = nrow(blocked_data) - - c(1 + which(diff(membership[order(membership)]) != 0)) + - 1.5, - colour = "red" - ) - } else { - g <- g + - ggplot2::scale_y_discrete(expand = c(0, 0), - limits = rev(rownames(x[["blocked.data"]])[x[["order.vector"]][["nodes1"]]]) - ) + - ggplot2::scale_x_discrete(expand = c(0, 0), position = "top", - limits = colnames(x[["blocked.data"]])[x[["order.vector"]][["nodes2"]]] - ) + - ggplot2::geom_vline( - xintercept = - c(1 + which(diff(x[["block.membership"]][["nodes2"]]) != 0)) - - .5, - colour = "blue" - ) + - ggplot2::geom_hline( - yintercept = nrow(x[["blocked.data"]]) - - c(1 + which(diff(x[["block.membership"]][["nodes1"]]) != 0)) - + 1.5, - colour = "red" - ) - } - g -} - elementwise.all.equal <- Vectorize(function(x, y) {isTRUE(all.equal(x, y))}) diff --git a/R/class_models.R b/R/class_models.R index d76ce8b0..52c85980 100644 --- a/R/class_models.R +++ b/R/class_models.R @@ -11,12 +11,6 @@ make_diff_model <- function(events, report, .data) { report } -make_diffs_model <- function(report, .data) { - class(report) <- c("diffs_model", class(report)) - attr(report, "mode") <- node_is_mode(.data) - report -} - #' @export print.diff_model <- function(x, ..., verbose = FALSE){ x <- x[,colSums(x, na.rm=TRUE) != 0] @@ -30,99 +24,11 @@ print.diff_model <- function(x, ..., verbose = FALSE){ print(dplyr::tibble(x, ...)) } -#' @export -print.diffs_model <- function(x, ...){ - x <- x[,colSums(x, na.rm=TRUE) != 0] - x$I_new <- NULL - print(dplyr::tibble(x, ...)) -} - #' @export summary.diff_model <- function(object, ...) { dplyr::tibble(attr(object, "events"), ...) } -#' @export -summary.diffs_model <- function(object, ...) { - sim <- fin <- n <- NULL - object %>% dplyr::mutate(fin = (I!=n)*1) %>% - dplyr::group_by(sim) %>% dplyr::summarise(toa = sum(fin)+1) -} - -#' @importFrom dplyr left_join -#' @importFrom ggplot2 geom_histogram -#' @export -plot.diff_model <- function(x, ..., all_steps = TRUE){ - S <- E <- I <- I_new <- n <- R <- NULL # initialize variables to avoid CMD check notes - if(nrow(x)==1) warning("No diffusion observed.") else { - data <- x - if(!all_steps) data <- data %>% dplyr::filter(!(data$I==data$I[length(data$I)] * - duplicated(data$I==data$I[length(data$I)]))) - p <- ggplot2::ggplot(data) + - ggplot2::geom_line(ggplot2::aes(x = t, y = S/n, color = "A"), linewidth = 1.25) + - ggplot2::geom_line(ggplot2::aes(x = t, y = I/n, color = "C"), linewidth = 1.25) + - ggplot2::geom_col(ggplot2::aes(x = t, y = I_new/n), - alpha = 0.4) + - ggplot2::theme_minimal() + - ggplot2::coord_cartesian(ylim = c(0,1)) + # using coord_cartesian to avoid printing warnings - ggplot2::scale_x_continuous(breaks = function(x) pretty(x, n=6)) + - ggplot2::ylab("Proportion") + ggplot2::xlab("Steps") - labs <- c("Susceptible", "Infected") - if(any(data$E>0)){ - p <- p + - ggplot2::geom_line(ggplot2::aes(x = t, y = E/n, color = "B"),size = 1.25) - labs <- c("Susceptible", "Exposed", "Infected") - } - if(any(data$R>0)){ - p <- p + - ggplot2::geom_line(ggplot2::aes(x = t, y = R/n, color = "D"),size = 1.25) - labs <- c(labs, "Recovered") - } - - p + ggplot2::scale_color_manual("Legend", - labels = labs, - values = c(A = "#4575b4", B = "#E6AB02", - C = "#d73027", D = "#66A61E"), - guide = "legend") - } -} - -#' @export -plot.diffs_model <- function(x, ...){ - S <- E <- I <- R <- n <- NULL # initialize variables to avoid CMD check notes - data <- dplyr::tibble(x) - # ggplot2::ggplot(data) + geom_smooth() - p <- ggplot2::ggplot(data) + - # ggplot2::geom_point(ggplot2::aes(x = t, y = S/n)) - ggplot2::geom_smooth(ggplot2::aes(x = t, y = S/n, color = "A"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = I/n, color = "C"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') + - ggplot2::theme_minimal() + - ggplot2::coord_cartesian(ylim = c(0,1)) + # using coord_cartesion to avoid printing warnings - ggplot2::scale_x_continuous(breaks = function(x) pretty(x, n=6)) + - ggplot2::ylab("Proportion") + ggplot2::xlab("Steps") - labs <- c("Susceptible", "Infected") - if(any(data$E>0)){ - p <- p + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = E/n, color = "B"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') - labs <- c("Susceptible", "Exposed", "Infected") - } - if(any(data$R>0)){ - p <- p + - ggplot2::geom_smooth(ggplot2::aes(x = t, y = R/n, color = "D"), - method = "loess", se=TRUE, level = .95, formula = 'y~x') - labs <- c(labs, "Recovered") - } - - p + ggplot2::scale_color_manual("Legend", - labels = labs, - values = c(A = "#4575b4", B = "#E6AB02", - C = "#d73027", D = "#66A61E"), - guide = "legend") -} - # learn_model #### make_learn_model <- function(out, .data) { out <- as.data.frame(out) @@ -152,14 +58,3 @@ summary.learn_model <- function(object, ..., epsilon = 0.0005) { steps-1, "steps.")) } -#' @export -plot.learn_model <- function(x, ...){ - Step <- Freq <- Var1 <- n <- NULL - y <- t(x) - colnames(y) <- paste0("t",0:(ncol(y)-1)) - y <- as.data.frame.table(y) - y$Step <- as.numeric(gsub("t", "", y$Var2)) - ggplot2::ggplot(y, ggplot2::aes(x = Step, y = Freq, color = Var1)) + - ggplot2::geom_line(show.legend = FALSE) + ggplot2::theme_minimal() + - ggplot2::ylab("Belief") -} diff --git a/R/class_motifs.R b/R/class_motifs.R index e3af971d..294865aa 100644 --- a/R/class_motifs.R +++ b/R/class_motifs.R @@ -33,37 +33,6 @@ print.node_motif <- function(x, ..., } } -#' @export -plot.node_motif <- function(x, ...) { - motifs <- dimnames(x)[[2]] - if("X4" %in% motifs){ - graphs(create_motifs(4), waves = 1:11) - } else if("021D" %in% motifs){ - graphs(create_motifs(3, directed = TRUE), waves = 1:16) - } else if("102" %in% motifs){ - graphs(create_motifs(3), waves = 1:4) - } else if("Asymmetric" %in% motifs){ - graphs(create_motifs(2, directed = TRUE), waves = 1:3) - } else if("Mutual" %in% motifs){ - graphs(create_motifs(2), waves = 1:2) - } else snet_unavailable("Cannot plot these motifs yet, sorry.") -} - -#' @export -plot.network_motif <- function(x, ...) { - motifs <- attr(x, "names") - if("X4" %in% motifs){ - graphs(create_motifs(4), waves = 1:11) - } else if("021D" %in% motifs){ - graphs(create_motifs(3, directed = TRUE), waves = 1:16) - } else if("102" %in% motifs){ - graphs(create_motifs(3), waves = 1:4) - } else if("Asymmetric" %in% motifs){ - graphs(create_motifs(2, directed = TRUE), waves = 1:3) - } else if("Mutual" %in% motifs){ - graphs(create_motifs(2), waves = 1:2) - } else snet_unavailable("Cannot plot these motifs yet, sorry.") -} # summary(node_by_triad(mpn_elite_mex), # membership = node_regular_equivalence(mpn_elite_mex, "elbow")) From 1913adae3f868787042b517a66797ab7c172b54b Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 21:54:21 +0200 Subject: [PATCH 12/21] Drop plots from examples and tests --- R/member_equivalence.R | 15 --------------- man/member_equivalence.Rd | 15 --------------- tests/testthat/test-measure_centrality.R | 3 --- 3 files changed, 33 deletions(-) diff --git a/R/member_equivalence.R b/R/member_equivalence.R index d469896c..622da391 100644 --- a/R/member_equivalence.R +++ b/R/member_equivalence.R @@ -77,12 +77,7 @@ node_in_equivalence <- function(.data, census, #' @rdname member_equivalence #' @examples -#' \donttest{ #' (nse <- node_in_structural(ison_algebra)) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nse) -#' } -#' } #' @export node_in_structural <- function(.data, k = c("silhouette", "elbow", "strict"), @@ -101,13 +96,8 @@ node_in_structural <- function(.data, #' @rdname member_equivalence #' @examples -#' \donttest{ #' (nre <- node_in_regular(ison_southern_women, #' cluster = "concor")) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nre) -#' } -#' } #' @export node_in_regular <- function(.data, k = c("silhouette", "elbow", "strict"), @@ -134,14 +124,9 @@ node_in_regular <- function(.data, #' @rdname member_equivalence #' @examples -#' \donttest{ #' if(require("sna", quietly = TRUE)){ #' (nae <- node_in_automorphic(ison_southern_women, #' k = "elbow")) -#' if(require("ggdendro", quietly = TRUE)){ -#' plot(nae) -#' } -#' } #' } #' @export node_in_automorphic <- function(.data, diff --git a/man/member_equivalence.Rd b/man/member_equivalence.Rd index efc6af46..eacc157a 100644 --- a/man/member_equivalence.Rd +++ b/man/member_equivalence.Rd @@ -104,27 +104,12 @@ of the hierarchical cluster and showing the returned cluster assignment. } \examples{ -\donttest{ (nse <- node_in_structural(ison_algebra)) -if(require("ggdendro", quietly = TRUE)){ -plot(nse) -} -} -\donttest{ (nre <- node_in_regular(ison_southern_women, cluster = "concor")) -if(require("ggdendro", quietly = TRUE)){ -plot(nre) -} -} -\donttest{ if(require("sna", quietly = TRUE)){ (nae <- node_in_automorphic(ison_southern_women, k = "elbow")) -if(require("ggdendro", quietly = TRUE)){ -plot(nae) -} -} } } \seealso{ diff --git a/tests/testthat/test-measure_centrality.R b/tests/testthat/test-measure_centrality.R index 836d3158..c3987d25 100644 --- a/tests/testthat/test-measure_centrality.R +++ b/tests/testthat/test-measure_centrality.R @@ -84,9 +84,6 @@ test_that("node measure class works", { expect_s3_class(node_closeness(ison_adolescents), "node_measure") expect_s3_class(node_eigenvector(ison_adolescents), "node_measure") expect_s3_class(node_reach(ison_adolescents), "node_measure") - testplot <- plot(node_degree(ison_adolescents)) - expect_equal(testplot$data$Score, unname(node_degree(ison_adolescents))) - # expect_equal(testplot$labels$y, "Frequency") }) # ####### Centralization From a84e874d390bcef55146bafcc5fc26af0f006c40 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 22:23:37 +0200 Subject: [PATCH 13/21] Added tests for to_no_missing() and table_data() --- tests/testthat/test-manip_reformed.R | 14 ++++++++++++++ tests/testthat/test-manynet-tutorials.R | 6 ++++++ 2 files changed, 20 insertions(+) create mode 100644 tests/testthat/test-manip_reformed.R create mode 100644 tests/testthat/test-manynet-tutorials.R diff --git a/tests/testthat/test-manip_reformed.R b/tests/testthat/test-manip_reformed.R new file mode 100644 index 00000000..5afe68dd --- /dev/null +++ b/tests/testthat/test-manip_reformed.R @@ -0,0 +1,14 @@ +test_that("to_no_missing.tbl_graph removes nodes with missing values", { + # Create a tbl_graph with some missing values + graph <- tbl_graph( + nodes = tibble::tibble(name = c("A", "B", NA, "D")), + edges = tibble::tibble(from = c(1, 2, 3), to = c(2, 3, 4)) + ) + + # Apply the function + cleaned_graph <- to_no_missing(graph) + + # Check that nodes with missing values are removed + expect_equal(nrow(as_tibble(cleaned_graph, active = "nodes")), 3) + expect_true(all(complete.cases(as_tibble(cleaned_graph, active = "nodes")))) +}) diff --git a/tests/testthat/test-manynet-tutorials.R b/tests/testthat/test-manynet-tutorials.R new file mode 100644 index 00000000..9bd9e3ea --- /dev/null +++ b/tests/testthat/test-manynet-tutorials.R @@ -0,0 +1,6 @@ +test_that("table_data returns a tibble with expected columns", { + result <- table_data(pkg = "manynet") + + expect_s3_class(result, "tbl_df") + expect_true(all(c("dataset", "nodes", "ties", "directed") %in% names(result))) +}) \ No newline at end of file From 85e5135497052c2a46cd26c216587845d497267e Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 22:23:57 +0200 Subject: [PATCH 14/21] Completed NEWS --- DESCRIPTION | 2 +- NEWS.md | 27 +++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a4171eff..cd57fb6c 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.5.0 -Date: 2025-04-24 +Date: 2025-06-22 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/NEWS.md b/NEWS.md index e39f2f70..7cc66a87 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,30 @@ +# manynet 1.5.0 + +## Package + +- Updated pandoc setup in pushrelease workflow + +## Making + +- Dropped print and summary methods for diffs_model (moved to `{migraph}`) + +## Modifying + +- Added `to_no_missing()` for removing nodes with missing data +- Fixed `as_diffusion.mnet()` so that it includes "diff_model" class + +## Measuring + +- Dropped plotting methods (moved to `{autograph}`) +- Added Page 2010 citation to `node_richness()` documentation + +## Data + +- Improved `table_data()` so that it lists longitudinal, dynamic, and changing +data +- Added more description for `fict_lotr` +- Added `irps_revere` data + # manynet 1.4.1 ## Making From 807edfc34fdf94e8edeb0234a4229772482369b5 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 22:50:19 +0200 Subject: [PATCH 15/21] Added components to table_data() --- NEWS.md | 4 ++-- R/manynet-tutorials.R | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7cc66a87..35096833 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,8 +20,8 @@ ## Data -- Improved `table_data()` so that it lists longitudinal, dynamic, and changing -data +- Improved `table_data()` so that it lists components, longitudinal, dynamic, +and changing data - Added more description for `fict_lotr` - Added `irps_revere` data diff --git a/R/manynet-tutorials.R b/R/manynet-tutorials.R index e2f03696..7b654f98 100644 --- a/R/manynet-tutorials.R +++ b/R/manynet-tutorials.R @@ -123,7 +123,8 @@ table_data <- function(..., pkg = c("manynet","migraph")) { 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)), + components = vapply(datasets, net_components, numeric(1)), + nodes = vapply(datasets, net_nodes, numeric(1)), ties = vapply(datasets, net_ties, numeric(1)), nattr = vapply(datasets, function (x) length(net_node_attributes(x)), @@ -140,7 +141,7 @@ table_data <- function(..., pkg = c("manynet","migraph")) { twomode = as.logi(vapply(datasets, is_twomode, logical(1))), - labelled = as.logi(vapply(datasets, + labelled = as.logi(vapply(datasets, is_labelled, logical(1))), signed = as.logi(vapply(datasets, From 1f9da184857f9a44a23cf602189fc449dd98927f Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 22:51:09 +0200 Subject: [PATCH 16/21] Fixed `node_in_leiden()` to use resolution parameter in call to igraph --- NEWS.md | 4 ++++ R/member_community.R | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 35096833..b17498ee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,10 @@ - Dropped plotting methods (moved to `{autograph}`) - Added Page 2010 citation to `node_richness()` documentation +## Memberships + +- Fixed `node_in_leiden()` to use resolution parameter in call to igraph + ## Data - Improved `table_data()` so that it lists components, longitudinal, dynamic, diff --git a/R/member_community.R b/R/member_community.R index 28f00310..16bf7971 100644 --- a/R/member_community.R +++ b/R/member_community.R @@ -350,7 +350,7 @@ node_in_leiden <- function(.data, resolution = 1){ resolution <- sum(tie_weights(.data))/(n*(n - 1)/2) } out <- igraph::cluster_leiden(as_igraph(.data), - resolution_parameter = resolution + resolution = resolution )$membership make_node_member(out, .data) } From 1a9b69f8b04ca410a415f98304e399a6831aa5d9 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 22:51:24 +0200 Subject: [PATCH 17/21] Tests of node_in_community() --- tests/testthat/test-member_community.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-member_community.R b/tests/testthat/test-member_community.R index 311aee61..c7634e39 100644 --- a/tests/testthat/test-member_community.R +++ b/tests/testthat/test-member_community.R @@ -22,3 +22,13 @@ test_that("node_walktrap algorithm works", { expect_length(node_in_walktrap(ison_southern_women), net_nodes(ison_southern_women)) }) + +test_that("node_in_community uses node_in_optimal on small networks", { + options(manynet_verbosity = "verbose") + options(snet_verbosity = "verbose") + expect_message(node_in_community(manynet::create_ring(10)), "optimal") + expect_message(node_in_community(manynet::create_ring(200)), "xcluding") + expect_message(node_in_community(fict_thrones), "xcluding") + options(manynet_verbosity = "quiet") + options(snet_verbosity = "quiet") +}) \ No newline at end of file From 83b19a58bef4679b4e1b0932f06e7edf9e3ca743 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 23:23:51 +0200 Subject: [PATCH 18/21] Added net_name() to extract name of the network --- R/class_networks.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/class_networks.R b/R/class_networks.R index 1c314a5b..b84e1d6f 100644 --- a/R/class_networks.R +++ b/R/class_networks.R @@ -106,6 +106,18 @@ is_grand <- function(.data){ !is.null(igraph::graph_attr(.data, "grand")) } +net_name <- function(.data, prefix = NULL){ + existname <- "" + if(!is.null(igraph::graph_attr(.data, "name"))) { + existname <- igraph::graph_attr(.data, 'name') + } else if(is_grand(.data) && + !is.null(igraph::graph_attr(.data, "grand")$name)){ + existname <- igraph::graph_attr(.data, 'grand')$name + } + if(existname != "" && !is.null(prefix)) existname <- paste(prefix, existname) + existname +} + describe_graph <- function(x) { paste0("A ", ifelse(is_dynamic(x), "dynamic, ", ""), From 4809cca99f4bce29cec8fbae558ce1493c7eb3dc Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 23:24:27 +0200 Subject: [PATCH 19/21] to_ego() now records the reformation in the title --- R/manip_reformed.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/manip_reformed.R b/R/manip_reformed.R index 00954861..d28c3499 100644 --- a/R/manip_reformed.R +++ b/R/manip_reformed.R @@ -280,7 +280,9 @@ to_ego.tbl_graph <- function(.data, node, max_dist = 1, min_dist = 0, direction = c("out","in")){ egos <- to_egos(.data, max_dist = max_dist, min_dist = min_dist, direction = direction) - as_tidygraph(egos[[node]]) + existname <- net_name(.data, prefix = "from") + out <- as_tidygraph(egos[[node]]) + add_info(out, name = paste("Ego network of", node, existname)) } #' @rdname manip_scope From ffd914f8babb11eb42de59e78fac51f425a75219 Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 23:31:53 +0200 Subject: [PATCH 20/21] Added node_is_pendant() tests --- tests/testthat/test-mark_nodes.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-mark_nodes.R b/tests/testthat/test-mark_nodes.R index 66f28e06..9342c71a 100644 --- a/tests/testthat/test-mark_nodes.R +++ b/tests/testthat/test-mark_nodes.R @@ -67,6 +67,16 @@ test_that("additional node mark functions work", { expect_mark(node_is_random(ison_adolescents, 2), c(F,T,F)) }) +test_that("node_is_pendant correctly identifies pendant nodes", { + # Apply the function + result <- node_is_pendant(create_star(5)) + + # The center of the star (node 1) is not pendant, others are + expect_type(result, "logical") + expect_length(result, 5) + expect_equal(as.logical(result), c(FALSE, TRUE, TRUE, TRUE, TRUE)) +}) + test_that("node infection, exposure, and recovery works", { skip_on_cran() skip_on_ci() From 3912e8a4eca12c263e55c0afdc2397a2c237469a Mon Sep 17 00:00:00 2001 From: James Hollway Date: Sun, 22 Jun 2025 23:44:16 +0200 Subject: [PATCH 21/21] Update crancomments --- cran-comments.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index cc5ca856..7c5065eb 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,9 +1,9 @@ ## Test environments -* local R installation, aarch64-apple-darwin20, R 4.4.2 -* macOS 14.5 (on Github), R 4.4.1 -* Microsoft Windows Server 2022 10.0.20348 (on Github), R 4.4.1 -* Ubuntu 22.04.4 (on Github), R 4.4.1 +* local R installation, aarch64-apple-darwin20, R 4.5.1 +* macOS 14.7.6 (on Github), R 4.5.1 +* Microsoft Windows Server 2022 10.0.20348 (on Github), R 4.5.1 +* Ubuntu 24.04.2 (on Github), R 4.5.1 ## R CMD check results