From 7a87fc3c9ab68a171dd3fa84b724e00addf63c06 Mon Sep 17 00:00:00 2001 From: Joshua Lambert Date: Mon, 7 Oct 2024 16:35:22 +0100 Subject: [PATCH] Add `` diagram to design principles vignette (#383) * add diagram for methods to design principles vignette, fixes #247 * add RColorBrewer to suggests and visNetwork to Config/Needs/website * add visNetwork to Config/Needs/check * remove library(visNetwork) from vignette as requireNamespace loads namespace * explicitly namespace visNetwork functions * add visNetwork as suggested dependency to DESCRIPTION * update visNetwork calls and use library() Co-authored-by: Chris Hartgerink * fix trailing comma in DESCRIPTION --------- Co-authored-by: Chris Hartgerink --- DESCRIPTION | 6 +- vignettes/design_principles.Rmd | 102 ++++++++++++++++++++++++++++++++ 2 files changed, 106 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d5cc048ae..6c9fe29e5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,18 +39,20 @@ Suggests: bookdown, DT, ggplot2, + RColorBrewer, jsonlite, knitr, rmarkdown, spelling, testthat (>= 3.0.0), - vdiffr (>= 1.0.7) + vdiffr (>= 1.0.7), + visNetwork VignetteBuilder: knitr Config/Needs/check: mrc-ide/epireview Config/Needs/website: epiverse-trace/epiversetheme, mrc-ide/epireview -Config/testthat/edition: 3 Config/potools/style: explicit +Config/testthat/edition: 3 Encoding: UTF-8 Language: en-GB LazyData: true diff --git a/vignettes/design_principles.Rmd b/vignettes/design_principles.Rmd index 959118256..651fc80c3 100644 --- a/vignettes/design_principles.Rmd +++ b/vignettes/design_principles.Rmd @@ -30,6 +30,108 @@ The output of the `epiparameter()` constructor function is an `` o Other functions return the simplest type possible, this may be an atomic vector (including single element vectors), or un-nested lists. +## Package architecture + +Much of the {epiparameter} package is centred around the `` class. Here is a diagram showing the class with it's S3 methods (the diagram below is interactive so can adjusted if labels are overlapping). + +```{r, echo=FALSE, fig.width=8, fig.height=5} +# read NAMESPACE +namespace <- base::parseNamespaceFile("epiparameter", .libPaths()[1L]) # nolint: undesirable_function_linter +s3methods <- namespace$S3methods +epiparameter_class_methods <- + s3methods[which(s3methods[, 2] == "epiparameter"), 1] + +# create network with all methods around the central node +getters <- c("family()", "get_citation()", "get_parameters()") +modifiers <- c("discretise()", "as.function()") +distribution_functions <- c("cdf()", "density()", "generate()", "quantile()") +utilities <- c("print()", "plot()", "mean()", "c()", "format()") +checkers <- c("is_epiparameter()", "is_parameterised()", "is_truncated()") +conversions <- c( + "convert_params_to_summary_stats()", "convert_summary_stats_to_params()" +) +coercion <- "as.data.frame()" + +# add one to each for the intermediate group nodes +groups <- data.frame( + group = c( + rep("Getters", length(getters) + 1), + rep("Modifiers", length(modifiers) + 1), + rep("Distribution functions", length(distribution_functions) + 1), + rep("Utilities", length(utilities) + 1), + rep("Checkers", length(checkers) + 1), + rep("Conversions", length(conversions) + 1), + rep("Coercion", length(coercion) + 1) + ), + functions = c( + c("Getters", getters), + c("Modifiers", modifiers), + c("Distribution functions", distribution_functions), + c("Utilities", utilities), + c("Checkers", checkers), + c("Conversions", conversions), + c("Coercion", coercion) + ) +) + +nodes <- data.frame( + id = seq_len(nrow(groups) + 1), + group = c("", groups$group), + label = c("", groups$functions), + shape = "box", + stringsAsFactors = FALSE +) + +from <- seq_len(nrow(groups)) + +# plus one for the central node +to <- 2:(nrow(groups) + 2) + +for (grp in unique(groups$group)) { + # plus one for central node + from[which(groups$group == grp) + 1] <- min(which(groups$group == grp)) + 1 +} + +# set intermediate nodes to connect to central node +from[groups$group == groups$functions] <- 1 + +edges <- data.frame( + from = from, + to = to, + color = "black", + stringsAsFactors = FALSE +) + +colours <- RColorBrewer::brewer.pal( + n = length(unique(nodes$group)), + name = "Set3" +) + +# functions from parseNamespaceFile() need parentheses to match formatting +epiparameter_class_methods <- paste0(epiparameter_class_methods, "()") +if (!all(epiparameter_class_methods %in% groups$functions)) { + message( + "This diagram is out of date, as new methods have been added to the ", + "package which are not included." + ) +} + +library(visNetwork) +visNetwork(nodes, edges) |> + visNodes(font = list(size = 18)) |> + visGroups(groupname = "", color = colours[1]) |> + visGroups(groupname = "Getters", color = colours[2]) |> + visGroups(groupname = "Modifiers", color = colours[3]) |> + visGroups( + groupname = "Distribution functions", + color = colours[4] + ) |> + visGroups(groupname = "Utilities", color = colours[5]) |> + visGroups(groupname = "Checkers", color = colours[6]) |> + visGroups(groupname = "Conversions", color = colours[7]) |> + visGroups(groupname = "Coercion", color = colours[8]) +``` + ## Design decisions * The `` class is designed to be a core unit for working with epidemiological parameters. It is designed in parallel to other epidemiological data structures such as a the `` class from the [{contactmatrix} R package](https://socialcontactdata.github.io/contactmatrix/index.html). The design principles of the `` class are aligned with the [`` design principles](https://socialcontactdata.github.io/contactmatrix/articles/design-principles.html). These include: