Merge pull request #60 from ropensci-review-tools/network

network page for #59

Author: mpadge

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.3.031
+Version: 0.1.3.042
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))
@@ -25,6 +25,7 @@ Imports:
 Suggests:
     brio,
     httptest2,
+    jsonlite,
     quarto,
     testthat (>= 3.0.0),
     tidyr,

NAMESPACE

@@ -2,6 +2,6 @@
 
 export(repo_pkgstats_history)
 export(repometrics_dashboard)
-export(repometrics_data_pkg)
+export(repometrics_data_repo)
 export(repometrics_data_user)
 importFrom(memoise,memoise)

R/analyse-users.R

@@ -17,6 +17,9 @@
 #' @noRd
 user_relation_matrices <- function (user_data) {
 
+    # Suppress no visible binding notes:
+    followers <- following <- org_repo <- repo <- login <- num_comments <- NULL
+
     user_names <- names (user_data)
     user_data <- add_user_login_cols (user_data) |>
         combine_user_data ()
@@ -100,7 +103,10 @@ combine_user_data <- function (user_data) {
 
 user_relate_fields <- function (user_data, user_names, what = "commits") {
 
-    user_combs <- t (combn (user_names, m = 2L))
+    # Suppress no visible binding notes:
+    num_commits <- login <- repo <- n <- NULL
+
+    user_combs <- t (utils::combn (user_names, m = 2L))
     if (what == "commits") {
         user_data [[what]] <- dplyr::rename (user_data [[what]], n = num_commits)
     } else if (what == "commit_cmt") {

R/data-repo.R

@@ -10,7 +10,7 @@
 #' }
 #'
 #' @export
-repometrics_data_pkg <- function (path, step_days = 1L, num_cores = -1L) {
+repometrics_data_repo <- function (path, step_days = 1L, num_cores = -1L) {
 
     cli::cli_alert_info ("Extracting package statistics ...")
     pkgstats <- repo_pkgstats_history (

R/quarto-dashboard.R

@@ -1,21 +1,24 @@
-#' Start quarto dashboard with results of main \link{repometrics_data_pkg}
+#' Start quarto dashboard with results of main \link{repometrics_data_repo}
 #' function.
 #'
-#' @param data Results of main \link{repometrics_data_pkg} function applied to
-#' one package.
+#' @param data_repo Data on repository as returned from
+#' \link{repometrics_data_repo} function applied to one package.
+#' @param data_users Data on repository developers ("users" in GitHub terms), as
+#' returned from \link{repometrics_data_user} function applied to one package.
 #' @param action One of "preview", to start and open a live preview of the
 #' dashboard website, or "render" to render a static version without previewing
 #' or opening.
 #' @return (Invisibly) Path to main "index.html" document of quarto site. Note
 #' that the site must be served with `action = "preview"`, and will not work by
 #' simply opening this "index.html" file.
 #' @export
-repometrics_dashboard <- function (data, action = "preview") {
+repometrics_dashboard <- function (data_repo, data_users, action = "preview") {
 
-    check_dashboard_arg (data)
-    data$pkgstats <- timestamps_to_dates (data$pkgstats)
+    check_dashboard_arg (data_repo)
+    data_repo$pkgstats <- timestamps_to_dates (data_repo$pkgstats)
 
     requireNamespace ("brio")
+    requireNamespace ("jsonlite")
     requireNamespace ("quarto")
     requireNamespace ("withr")
 
@@ -25,16 +28,44 @@ repometrics_dashboard <- function (data, action = "preview") {
     path_src <- system.file ("extdata", "quarto", package = "repometrics")
     path_dest <- fs::path (fs::path_temp (), "quarto")
     dir <- fs::dir_copy (path_src, path_dest, overwrite = TRUE)
-    saveRDS (data, fs::path (dir, "results-pkg.Rds"))
+    saveRDS (data_repo, fs::path (dir, "results-repo.Rds"))
+    saveRDS (data_users, fs::path (dir, "results-users.Rds"))
 
-    pkg_name <- data$pkgstats$desc_data$package [1]
+    dat_user_network <- get_user_network (data_users)
+    jsonlite::write_json (dat_user_network, fs::path (dir, "results-user-network.json"))
+
+    pkg_name <- data_repo$pkgstats$desc_data$package [1]
     quarto_insert_pkg_name (dir, pkg_name)
 
     withr::with_dir (dir, {
         do.call (eval (parse (text = quarto_action)), list ())
     })
 }
 
+get_user_network <- function (data_users) {
+
+    rels <- user_relation_matrices (data_users)
+    index <- which (!grepl ("^login", names (rels)))
+    relmat <- apply (as.matrix (rels [, index]), 2, function (i) i / sum (i))
+    if (!is.matrix (relmat)) {
+        relmat <- matrix (relmat, nrow = 1L)
+    }
+    relmat [which (is.na (relmat))] <- 0
+    relvec <- 20 * rowSums (relmat) / ncol (relmat)
+    reldf <- cbind (rels [, 1:2], value = relvec)
+    names (reldf) <- c ("source", "target", "value")
+
+    netdat <- list (
+        nodes = data.frame (
+            id = unique (c (rels$login1, rels$login2)),
+            group = 1L
+        ),
+        links = reldf
+    )
+
+    return (netdat)
+}
+
 timestamps_to_dates <- function (data) {
 
     lapply (data, function (i) {

README.md

@@ -40,7 +40,7 @@ The main data-gathering function requires just one parameter specifying the
 path to a local source repository:
 
 ``` r
-data <- repometrics_data_pkg (path)
+data <- repometrics_data_repo (path)
 ```
 
 The results can then be visualised as an interactive dashboard by running this

codemeta.json

@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci-review-tools/repometrics",
   "issueTracker": "https://github.com/ropensci-review-tools/repometrics/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.3.031",
+  "version": "0.1.3.042",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

inst/extdata/quarto/_quarto.yml

@@ -9,6 +9,7 @@ website:
     left:
       - fn-stats.qmd
       - contributors.qmd
+      - network.qmd
     right:
       - icon: "github"
         menu:

inst/extdata/quarto/contributors.qmd

@@ -17,7 +17,7 @@ requireNamespace ("tidyr", quietly = TRUE)
 ## Git log
 
 ```{r load-data}
-dat <- readRDS ("results-pkg.Rds")
+dat <- readRDS ("results-repo.Rds")
 ```
 ```{r ctbs-git-data}
 ctbs <- dat$rm$contributors

inst/extdata/quarto/fn-stats.qmd

@@ -31,7 +31,7 @@ per function, along with the sum over all functions within the package. These
 the other measures.
 
 ```{r load-data}
-dat <- readRDS ("results-pkg.Rds")$pkgstats
+dat <- readRDS ("results-repo.Rds")$pkgstats
 ```
 ```{r stats-data}
 cols <- names (dat$stats) [which (!names (dat$stats) %in% c ("package", "version"))]

inst/extdata/quarto/network.qmd

@@ -0,0 +1,53 @@
+---
+title: "Network"
+execute:
+  echo: false
+format: 
+  html:
+    fig-width: 8
+    fig-height: 4
+    code-fold: false
+---
+
+```{r load-pkg, echo = FALSE, message = FALSE}
+library (repometrics)
+requireNamespace ("dplyr", quietly = TRUE)
+requireNamespace ("tidyr", quietly = TRUE)
+```
+```{r load-data}
+dat_pkg <- readRDS ("results-repo.Rds")
+dat_users <- readRDS ("results-users.Rds")
+
+deps <- dat_pkg$rm$dependencies
+get_dep_df <- function (deps, type = "Imports", group = 1L) {
+    index <- which (deps$type == type)
+    data.frame (id = deps$name [index], group = rep (group, length (index)))
+}
+
+nodes_pkg_ <- rbind (
+    get_dep_df (deps, "Imports", 1L),
+    get_dep_df (deps, "Suggests", 2L)
+)
+nodes_user <- data.frame (id = dat_pkg$rm$contribs_from_gh_api$login, group = 4L)
+nodes_user$group [which (nodes_user$id %in% names (dat_users))] <- 3L
+```
+
+```{ojs ForceGraph-import}
+import {ForceGraph} from "@d3/force-directed-graph-component"
+```
+
+```{ojs import-network-data}
+network = FileAttachment("results-user-network.json").json()
+```
+
+```{ojs ForceGraph-plot}
+chart = ForceGraph(network, {
+    nodeId: d => d.id,
+    nodeGroup: d => d.group,
+    nodeTitle: d => `${d.id}\n${d.group}`,
+    linkStrokeWidth: l => Math.sqrt(l.value),
+    width,
+    height: 600,
+    invalidation // a promise to stop the simulation when the cell is re-run
+})
+```

man/repometrics_dashboard.Rd

@@ -5,6 +5,9 @@ pkgstats <- repo_pkgstats_history (path, num_cores = 1L)
 rm_data <- mock_rm_data ()
 data0 <- list (pkgstats = pkgstats, rm = rm_data)
 
+user_data <- lapply (1:2, function (i) mock_user_rel_data ())
+names (user_data) <- c ("a", "b")
+
 test_that ("dashboard input errors", {
 
     data <- data0
@@ -34,11 +37,12 @@ test_that ("dashboard input errors", {
 
 test_that ("dashboard build", {
 
-    data <- data0
-    repometrics_dashboard (data, action = "render")
+    data_repo <- data0
+    data_users <- user_data
+    repometrics_dashboard (data_repo, data_users, action = "render")
 
     # Expect quarto docs to have been modified with package name:
-    pkg_name <- data$pkgstats$desc_data$package [1]
+    pkg_name <- data_repo$pkgstats$desc_data$package [1]
     path_tmp <- fs::path (fs::path_temp (), "quarto")
     expect_true (fs::dir_exists (path_tmp))