change request chaoss metric for #11

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.1.005
+Version: 0.1.1.009
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))

R/chaoss-internal-change-req.R

@@ -0,0 +1,23 @@
+#' From \url{https://chaoss.community/kb/metrics-model-collaboration-development-index/},
+#' the "Code Commit linked with Change Request" (which is not hyperlinked to
+#' anywhere else), is defined as "Percentage of new code commits linked with
+#' change request in last 90 days." The interpretation of "Change Request" is
+#' defined at \url{https://chaoss.community/kb/metric-change-requests/} as
+#' "proposals for modifications to a project's source code that have been
+#' submitted for review ... Examples include GitHub 'Pull Request', GitLab
+#' 'Merge Requests' and Gerrit 'code reviews'." These are here analysed as
+#' merge commits in the git log, even though these may not have been actual PRs
+#' on GitHub or similar, and may not have been reviewed.
+#'
+#' @return NA if no commits made in given period, otherwise the proportion of
+#' commits which came from merged branches.
+#' @noRd
+chaoss_internal_change_req <- function (path, end_date = Sys.Date ()) {
+
+    log <- git_log_in_period (path, end_date, get_repometrics_period ())
+    res <- NA_integer_
+    if (nrow (log) > 0L) {
+        res <- length (which (log$merge)) / nrow (log)
+    }
+    return (res)
+}

R/chaoss-internal-ci.R

@@ -0,0 +1,20 @@
+#' Return names of CI services from corresponding configuration files contained
+#' in local repo.
+#' @noRd
+repo_has_ci_files <- function (path) {
+
+    flist <- fs::dir_ls (path, type = "file", all = TRUE, recurse = TRUE)
+    ptns <- c (
+        "\\.appveyor\\.yml",
+        "\\.github\\/workflows",
+        "\\.gitlab\\-ci\\.yml",
+        "\\.circleci\\/config\\.yml",
+        "codefresh\\.yml",
+        "drone\\.yml",
+        "\\.travis\\.yml"
+    )
+    has_it <- vapply (ptns, function (i) any (grepl (i, flist)), logical (1L))
+    nms <- gsub ("\\\\.|\\\\.y.*$|\\\\/.*$|\\\\-.*$", "", ptns)
+
+    return (nms [which (has_it)])
+}

R/chaoss-internal-num-ctb.R

@@ -0,0 +1,35 @@
+chaoss_internal_num_contributors <- function (path, end_date = Sys.Date ()) {
+
+    log <- git_log_in_period (path, end_date, get_repometrics_period ())
+
+    auths_un <- unique (log$author)
+
+    # separate handles from emails:
+    emails <- regmatches (auths_un, gregexpr ("<.*>", auths_un))
+    emails <- vapply (emails, function (i) {
+        ifelse (length (i) == 0L, "", gsub ("<|>", "", i))
+    }, character (1L))
+    handles <- gsub ("<.*$", "", auths_un)
+
+    # Remove any duplicates of either, but excluding non-entries:
+    rm_dup_rows <- function (x) {
+        x <- gsub ("\\s+", "", x)
+        index <- seq_along (x)
+        index_out <- which (duplicated (x) & nzchar (x))
+        if (length (index_out) > 0) {
+            index <- index [-(index_out)]
+        }
+        return (index)
+    }
+    index1 <- rm_dup_rows (handles)
+    index2 <- rm_dup_rows (emails)
+
+    # Then extract only instances where neither handles nor emails are
+    # duplicated:
+    index_table <- table (c (index1, index2))
+    index <- as.integer (names (index_table) [which (index_table == 2L)])
+
+    auths_un <- auths_un [index]
+
+    return (length (auths_un))
+}

R/chaoss-internal.R

@@ -0,0 +1,28 @@
+chaoss_internal_num_commits <- function (path, end_date = Sys.Date ()) {
+
+    log <- git_log_in_period (path, end_date, get_repometrics_period ())
+
+    return (nrow (log))
+}
+
+git_log_in_period_internal <- function (path, end_date = Sys.Date (), period = 90) {
+    checkmate::assert_character (path, len = 1L)
+    checkmate::assert_directory (path)
+    checkmate::assert_date (end_date)
+
+    h <- gert::git_log (repo = path, max = 1e6)
+    if (nrow (h) == 0) {
+        return (h)
+    }
+    dates <- as.Date (h$time)
+    today_minus_period <- as.Date (end_date - period)
+    index <- which (dates >= today_minus_period)
+    h <- h [index, ]
+
+    if (dates [1] > end_date) {
+        h <- h [which (dates <= end_date), ]
+    }
+
+    return (h)
+}
+git_log_in_period <- memoise::memoise (git_log_in_period_internal)

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.1.005",
+  "version": "0.1.1.009",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

tests/testthat/test-chaoss-metrics-internal.R

@@ -1,12 +1,14 @@
+end_date <- as.Date ("2024-08-01")
+
 test_that ("chaoss internal num_commits", {
     pkg <- system.file ("extdata", "testpkg.zip", package = "repometrics")
     flist <- unzip (pkg, exdir = fs::path_temp ())
     path <- fs::path_dir (flist [1])
 
-    n <- chaoss_internal_num_commits (path, end_date = as.Date ("2024-08-01"))
+    n <- chaoss_internal_num_commits (path, end_date = end_date)
     expect_equal (n, 4L)
 
-    n <- chaoss_internal_num_contributors (path, end_date = as.Date ("2024-08-01"))
+    n <- chaoss_internal_num_contributors (path, end_date = end_date)
     expect_equal (n, 1L)
 
     fs::dir_delete (path)
@@ -38,3 +40,16 @@ test_that ("chaoss has CI internal", {
 
     fs::dir_delete (path)
 })
+
+test_that ("chaoss internal change requests", {
+    pkg <- system.file ("extdata", "testpkg.zip", package = "repometrics")
+    flist <- unzip (pkg, exdir = fs::path_temp ())
+    path <- fs::path_dir (flist [1])
+
+    x <- chaoss_internal_change_req (path, end_date = end_date)
+    expect_equal (x, 0)
+    x <- chaoss_internal_change_req (path, end_date = Sys.Date ())
+    expect_equal (x, NA_integer_) # no commits, so NA returned
+
+    fs::dir_delete (path)
+})