Merge pull request #137 from ropensci-review-tools/vignette

chaoss metrics vignette for #124

Author: mpadge

.pre-commit-config.yaml

@@ -5,7 +5,7 @@ repos:
     rev: v0.4.3.9003
     hooks:
     -   id: style-files
-        args: [--style_pkg=spaceout, --style_fun=spaceout_style]
+        args: [--style_pkg=spaceout, --style_fun=spaceout_style, --include_roxygen_examples=FALSE]
         additional_dependencies:
         - ropensci-review-tools/spaceout
       # -   id: roxygenize

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.6.132
+Version: 0.1.6.145
 Authors@R: 
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))
@@ -26,6 +26,7 @@ Imports:
 Suggests:
     brio,
     desc,
+    DT,
     httptest2,
     jsonlite,
     knitr,

NAMESPACE

@@ -5,4 +5,5 @@ export(repometrics_dashboard)
 export(repometrics_data)
 export(repometrics_data_repo)
 export(repometrics_data_user)
+export(rm_chaoss_metrics_list)
 importFrom(memoise,memoise)

R/cm-collate-all.R

@@ -1,18 +1,51 @@
-get_cm_fns <- function (what = "metric") {
+#' List all implemented CHAOSS metrics
+#'
+#' This function returns a list of internal functions defined within the
+#' 'repometrics' package. These internal functions are not intended to be
+#' called directly, rather this list is provided for information only, to
+#' enable users to know which metrics are implemented.
+#'
+#' @return A `data.frame` with two columns:
+#' \enumerate{
+#' \item "fn_names", with the internal function names of all implemented CHAOSS
+#' metrics.
+#' \item "url", with the URL to the CHAOSS community web page describing that
+#' metric.
+#' }
+#'
+#' @note Metrics have been adapted in this package, and so may not precisely
+#' reflect the descriptions provided in the CHAOSS community web pages linked
+#' to in the URLs from this function. Adaptations have in particular been
+#' implemented to align metrics with their usage in aggregate "models".
+#'
+#' @examples
+#' metrics <- rm_chaoss_metrics_list ()
+#' @family auxiliary
+#' @export
+rm_chaoss_metrics_list <- function () {
+
+    fn_names <- chaoss_metrics_fn_names ()
+    url_fns <- paste0 (fn_names, "_url")
+    urls <- vapply (url_fns, function (u) do.call (u, list ()), character (1L))
+    urls <- paste0 (cm_metric_base_url (), unname (urls))
+
+    data.frame (fn_name = fn_names, url = urls)
+}
 
-    what <- match.arg (what, c ("metric", "model"))
-    ptn <- paste0 ("^cm\\_", what, "\\_")
+chaoss_metrics_fn_names <- function () {
 
+    ptn <- "^cm\\_metric\\_"
     pkg_fns <- ls (envir = asNamespace ("repometrics"))
     fns <- grep (ptn, pkg_fns, value = TRUE)
-    fns <- fns [which (!grepl ("internal", fns))]
+    fns <- fns [which (!grepl ("\\_internal|\\_url$", fns))]
 
     return (fns)
+
 }
 
 collate_all_metrics <- function (path, end_date = Sys.Date ()) {
 
-    metric_fns <- get_cm_fns ("metric")
+    metric_fns <- rm_chaoss_metrics_list ()$fn_name
 
     pars <- list (path = path, end_date = end_date)
     extra_pars <- list (
@@ -84,3 +117,7 @@ models_over_end_dates <- function (path, end_date = Sys.Date (), num_years = 3)
 
     return (models_data)
 }
+
+cm_metric_base_url <- function () {
+    "https://chaoss.community/kb/"
+}

R/cm-metric-best-practices.R

@@ -3,8 +3,6 @@
 #' This extends beyond the single CHAOSS recommendation of OpenSSF to also
 #' include the core infrastructure best practices badge.
 #'
-#' \url{https://chaoss.community/kb/metric-open-source-security-foundation-openssf-best-practices-badge/}
-#'
 #' This metric does not use the `end_date` parameter (but includes it to
 #' provide a consistent interface).
 #'
@@ -25,3 +23,7 @@ cm_data_best_practices <- function (path, end_date = NULL) {
 cm_metric_best_practices <- function (path, end_date = NULL) {
     cm_data_best_practices (path, end_date)
 }
+
+cm_metric_best_practices_url <- function () {
+    "metric-open-source-security-foundation-openssf-best-practices-badge"
+}

R/cm-metric-burstiness.R

@@ -61,3 +61,7 @@ cm_data_burstiness <- function (path, end_date, band_len = 31L, band_width = 2)
 cm_metric_burstiness <- function (path, end_date, band_len = 31L, band_width = 2) {
     cm_data_burstiness (path, end_date, band_len = 31L, band_width = 2)
 }
+
+cm_metric_burstiness_url <- function () {
+    "metric-burstiness"
+}

R/cm-metric-change-req.R

@@ -64,3 +64,19 @@ cm_metric_change_req_prop_code <- function (path, end_date = Sys.Date ()) {
     dat <- cm_data_change_req (path, end_date)
     dat [["prop_code_from_prs"]]
 }
+
+cm_metric_change_req_n_opened_url <- function () {
+    "metric-change-requests"
+}
+
+cm_metric_change_req_n_closed_url <- function () {
+    "metric-change-requests"
+}
+
+cm_metric_change_req_prop_merged_url <- function () {
+    "metric-change-requests"
+}
+
+cm_metric_change_req_prop_code_url <- function () {
+    "metric-change-requests"
+}

R/cm-metric-code-change.R

@@ -19,3 +19,7 @@ cm_metric_code_change_lines <- function (path,
 
     cm_data_code_change_lines (path, end_date, exclude_whitespace)
 }
+
+cm_metric_code_change_lines_url <- function () {
+    "metric-code-changes-commits"
+}

R/cm-metric-cran-downloads.R

@@ -24,6 +24,10 @@ cm_metric_cran_downloads <- function (path, end_date = Sys.Date ()) {
     cm_data_cran_downloads (path, end_date)
 }
 
+cm_metric_cran_downloads_url <- function () {
+    "metric-number-of-downloads"
+}
+
 #' Download the full daily log over `nyears`, and use memoised return value to
 #' filter to desired period for subsequent calls.
 #' @noRd

R/cm-metric-ctb-absence.R

@@ -26,6 +26,10 @@ cm_metric_contrib_absence_commits <- function (path, end_date = Sys.Date ()) {
     dat [["ncommits"]]
 }
 
+cm_metric_contrib_absence_commits_url <- function () {
+    "metric-contributor-absence-factor"
+}
+
 # These others are not used, as they are highly correlated with main measure
 # anyway:
 #

R/cm-metric-ctb-count.R

@@ -36,6 +36,10 @@ cm_metric_ctb_count <- function (path, end_date = Sys.Date ()) {
     return (dat [["code"]])
 }
 
+cm_metric_ctb_count_url <- function () {
+    "metrics-model-community-activity"
+}
+
 #' CHAOSS metric for committer count
 #'
 #' \url{https://chaoss.community/kb/metric-committers/}.
@@ -87,3 +91,11 @@ cm_metric_watcher_count <- function (path, end_date = Sys.Date ()) {
     dat <- cm_data_committer_count (path, end_date)
     return (dat [["watchers"]])
 }
+
+cm_metric_committer_count_url <- function () {
+    "metrics-model-community-activity"
+}
+
+cm_metric_watcher_count_url <- function () {
+    "metrics-model-community-activity"
+}

R/cm-metric-ctb-types.R

@@ -43,3 +43,7 @@ cm_data_ctb_diversity <- function (path, end_date = Sys.Date ()) {
 cm_metric_ctb_diversity <- function (path, end_date = Sys.Date ()) {
     cm_data_ctb_diversity (path, end_date)
 }
+
+cm_metric_ctb_diversity_url <- function () {
+    "metric-types-of-contributions"
+}

R/cm-metric-elephant-factor.R

@@ -43,3 +43,7 @@ cm_metric_elephant_factor <- function (path, end_date = Sys.Date ()) {
     dat <- cm_data_elephant_factor (path, end_date)
     dat [["ncommits"]]
 }
+
+cm_metric_elephant_factor_url <- function () {
+    "metric-elephant-factor"
+}

R/cm-metric-has-ci.R

@@ -50,3 +50,7 @@ cm_data_has_ci <- function (path, end_date = NULL) {
 cm_metric_has_ci <- function (path, end_date = NULL) {
     cm_data_has_ci (path, end_date)
 }
+
+cm_metric_has_ci_url <- function () {
+    "metric-test-coverage"
+}

R/cm-metric-issue-updates.R

@@ -25,6 +25,10 @@ cm_metric_issue_updates <- function (path, end_date = Sys.Date ()) {
     cm_data_issue_updates (path, end_date)
 }
 
+cm_metric_issue_updates_url <- function () {
+    "metric-issues-active"
+}
+
 cm_data_issue_cmt_count <- function (path, end_date = Sys.Date ()) {
 
     # Suppress no visible binding note:
@@ -56,6 +60,10 @@ cm_metric_issue_cmt_count <- function (path, end_date = Sys.Date ()) {
     cm_data_issue_cmt_count (path, end_date) [["mean"]]
 }
 
+cm_metric_issue_cmt_count_url <- function () {
+    "metric-issues-active"
+}
+
 cm_data_issues_closed <- function (path, end_date = Sys.Date ()) {
 
     # Suppress no visible binding note:
@@ -74,3 +82,7 @@ cm_data_issues_closed <- function (path, end_date = Sys.Date ()) {
 cm_metric_issues_closed <- function (path, end_date = Sys.Date ()) {
     cm_data_issues_closed (path, end_date)
 }
+
+cm_metric_issues_closed_url <- function () {
+    "metric-issues-closed"
+}

R/cm-metric-issues-to-prs.R

@@ -15,6 +15,10 @@ cm_metric_issues_to_prs <- function (path, end_date = Sys.Date ()) {
     cm_data_issues_to_prs (path, end_date)
 }
 
+cm_metric_issues_to_prs_url <- function () {
+    "metric-change-requests"
+}
+
 get_issues_in_period <- function (path,
                                   end_date = Sys.Date (),
                                   closed_only = FALSE) {

R/cm-metric-labels.R

@@ -58,3 +58,7 @@ cm_metric_label_inclusivity <- function (path, end_date = Sys.Date ()) {
     dat <- cm_data_label_inclusivity (path, end_date)
     return (dat [["prop_friendly_overall"]])
 }
+
+cm_metric_label_inclusivity_url <- function () {
+    "chaoss.community/kb/metric-issue-label-inclusivity"
+}

R/cm-metric-languages.R

@@ -50,3 +50,7 @@ cm_metric_languages <- function (path, end_date = NULL) {
     lang_dist_mn <- ifelse (lang_dist_mn == 0, 0, 0.25 / lang_dist_mn)
     return (lang_dist_mn)
 }
+
+cm_metric_languages_url <- function () {
+    "chaoss.community/?p=3430"
+}

R/cm-metric-libyears.R

@@ -25,3 +25,11 @@ cm_metric_dependency_count <- function (path, end_date = NULL) {
 
     return (nrow (deps))
 }
+
+cm_metric_libyears_url <- function () {
+    "chaoss.community/kb/metric-libyears"
+}
+
+cm_metric_dependency_count_url <- function () {
+    "chaoss.community/kb/metric-libyears"
+}

R/cm-metric-licenses.R

@@ -19,6 +19,10 @@ cm_metric_licenses_declared <- function (path, end_date = NULL) {
     return (length (lic_dat) > 0L)
 }
 
+cm_metric_licenses_declared_url <- function () {
+    "chaoss.community/kb/metric-licenses-declared"
+}
+
 #' Metric fo rnumber of files with declared licenses
 #'
 #' \url{https://chaoss.community/kb/metric-license-coverage/}
@@ -77,6 +81,10 @@ cm_metric_license_coverage <- function (path,
     cm_data_license_coverage (path, end_date, dirs)
 }
 
+cm_metric_license_coverage_url <- function () {
+    "chaoss.community/kb/metric-license-coverage"
+}
+
 included_exts <- c ("r", "q", "qmd", "rmd", "c", "cpp", "h", "js", "py")
 
 # https://www.r-project.org/Licenses/

R/cm-metric-maintainer-count.R

@@ -52,6 +52,10 @@ cm_metric_maintainer_count <- function (path, end_date = Sys.Date ()) {
     return (dat [["recent"]])
 }
 
+cm_metric_maintainer_count_url <- function () {
+    "metric-contributors"
+}
+
 #' Match repo contributors from both git log and GitHub API to author names and
 #' emails given in "DESCRIPTION" file.
 #'
@@ -95,8 +99,6 @@ match_repo_ctbs_to_desc <- function (path, desc_auts, gh_auts) {
     return (max (c (n_from_log, n_from_gh)))
 }
 
-
-
 get_desc_authors <- function (path, roles = c ("cre", "aut")) {
 
     desc_path <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$")

R/cm-metric-num-ctb.R

@@ -27,3 +27,7 @@ cm_data_num_contributors <- function (path, end_date = Sys.Date ()) {
 cm_metric_num_contributors <- function (path, end_date = Sys.Date ()) {
     cm_data_num_contributors (path, end_date)
 }
+
+cm_metric_num_contributors_url <- function () {
+    "metric-contributors"
+}

R/cm-metric-popularity.R

@@ -36,3 +36,11 @@ cm_metric_num_stars <- function (path, end_date = Sys.Date ()) {
     dat <- cm_data_popularity (path, end_date)
     return (dat [["stars"]])
 }
+
+cm_metric_num_forks_url <- function () {
+    "metric-project-popularity"
+}
+
+cm_metric_num_stars_url <- function () {
+    "metric-project-popularity"
+}

R/cm-metric-release-freq.R

@@ -31,6 +31,10 @@ cm_metric_release_freq <- function (path, end_date = Sys.Date ()) {
     return (dat [["mean"]])
 }
 
+cm_metric_release_freq_url <- function () {
+    "metric-release-frequency"
+}
+
 cm_data_recent_releases <- function (path, end_date = Sys.Date ()) {
 
     # Suppress no visible binding note:
@@ -48,3 +52,7 @@ cm_data_recent_releases <- function (path, end_date = Sys.Date ()) {
 cm_metric_recent_releases <- function (path, end_date = Sys.Date ()) {
     cm_data_recent_releases (path, end_date)
 }
+
+cm_metric_recent_releases_url <- function () {
+    "metric-release-frequency"
+}

R/cm-metric-response-time.R

@@ -17,3 +17,7 @@ cm_data_response_time <- function (path, end_date = Sys.Date ()) {
 cm_metric_response_time <- function (path, end_date = Sys.Date ()) {
     cm_data_response_time (path, end_date)
 }
+
+cm_metric_response_time_url <- function () {
+    "metric-time-to-first-response"
+}

R/cm-metric-test-coverage.R

@@ -42,3 +42,7 @@ cm_metric_test_coverage_internal <- function (path, end_date = Sys.Date ()) {
     cm_data_test_coverage (path, end_date) / 100
 }
 cm_metric_test_coverage <- memoise::memoise (cm_metric_test_coverage_internal)
+
+cm_metric_test_coverage_url <- function () {
+    "metric-test-coverage"
+}