Merge pull request #126 from ropensci-review-tools/json-models

mpadge · web-flow · commit 4bf1d6c29c8a · 2025-03-06T18:08:24.000+01:00
add chaoss-models.json for #124 in extdata
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: repometrics
 Title: Metrics for Your Code Repository
-Version: 0.1.6.088
+Version: 0.1.6.095
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))
diff --git a/R/cm-metrics-issue-response.R b/R/cm-metrics-issue-response.R
@@ -29,11 +29,12 @@ cm_data_issue_response_time <- function (path, end_date = Sys.Date ()) {
         created_at >= start_date & response_date <= end_date
     )
 
-    return (issue_responses$response_time)
+    return (issue_responses)
 }
 
 cm_metric_issue_response_time <- function (path, end_date = Sys.Date ()) {
-    cm_data_issue_response_time (path, end_date)
+    issue_responses <- cm_data_issue_response_time (path, end_date)
+    res <- mean (as.integer (issue_responses$response_time), na.rm = TRUE)
 }
 
 cm_data_defect_resolution_dur <- function (path, end_date = Sys.Date ()) { # nolint
@@ -65,7 +66,8 @@ cm_data_defect_resolution_dur <- function (path, end_date = Sys.Date ()) { # nol
 }
 
 cm_metric_defect_resolution_dur <- function (path, end_date = Sys.Date ()) {
-    cm_data_defect_resolution_dur (path, end_date)
+    dat <- cm_data_defect_resolution_dur (path, end_date)
+    dat [["mean"]]
 }
 
 #' CHAOSS metric "Time to Close"
diff --git a/R/cm-metrics-pr-reviews.R b/R/cm-metrics-pr-reviews.R
@@ -134,7 +134,10 @@ cm_data_pr_review_duration <- function (path, end_date = Sys.Date ()) {
 }
 
 cm_metric_pr_review_duration <- function (path, end_date = Sys.Date ()) {
-    cm_data_pr_review_duration (path, end_date)
+    dat <- cm_data_pr_review_duration (path, end_date)
+    # That has "cycle_dur_mn" and overall "review_dur_mn"; take mean of both:
+    res <- mn_med_sum (dat [grep ("\\_mn$", names (dat))])
+    return (res [["mean"]])
 }
 
 cm_data_pr_cmt_count <- function (path, end_date = Sys.Date ()) {
@@ -249,3 +252,14 @@ cm_data_pr_reviews_approved <- function (path, end_date = Sys.Date ()) {
 cm_metric_pr_reviews_approved <- function (path, end_date = Sys.Date ()) {
     cm_data_pr_reviews_approved (path, end_date)
 }
+
+cm_metric_num_prs_merged <- function (path, end_date = Sys.Date ()) {
+    pr_dat <- cm_metric_change_req (path, end_date)
+    num_prs_merged <- ifelse (
+        length (pr_dat) > 1,
+        as.integer (pr_dat [["n_closed"]]),
+        0L
+    )
+
+    return (num_prs_merged)
+}
diff --git a/R/cm-models.R b/R/cm-models.R
@@ -25,40 +25,20 @@ cm_model_dev_responsiveness <- function (path,
                                          metrics_data = NULL) {
 
     if (is.null (metrics_data)) {
-        pr_durs <- cm_metric_pr_review_duration (path, end_date = end_date)
+        pr_dur_mn <- cm_metric_pr_review_duration (path, end_date = end_date)
         issue_resp_time <-
             cm_metric_issue_response_time (path, end_date = end_date)
         defect_resol_dur <-
             cm_metric_defect_resolution_dur (path, end_date = end_date)
     } else {
-        pr_durs <- metrics_data$pr_review_duration
+        pr_dur_mn <- metrics_data$pr_review_duration
         issue_resp_time <- metrics_data$issue_response_time
         defect_resol_dur <- metrics_data$defect_resolution_dur
     }
 
-    issue_resp_time <- mn_med_sum (as.integer (issue_resp_time))
-    names (issue_resp_time) <- paste0 ("issue_resp_", names (issue_resp_time))
-    names (defect_resol_dur) <-
-        paste0 ("defect_resol_", names (defect_resol_dur))
-
-    nms <- list (c ("mn", "mean"), c ("md", "median"))
-    vals <- lapply (nms, function (nm) {
-        index_i <- grep (nm [2], names (issue_resp_time), value = TRUE)
-        index_d <- grep (nm [2], names (defect_resol_dur), value = TRUE)
-        vals_i <- c (
-            pr_durs [grep (nm [1], names (pr_durs), value = TRUE)],
-            issue_resp_time [index_i],
-            defect_resol_dur [index_d]
-        )
-        return (vals_i [which (!is.na (vals_i))])
-    })
-    vals <- c (mean = mean (vals [[1]]), median = stats::median (vals [[2]]))
-    names (vals) <- c ("mean", "median")
-    vals [which (is.na (vals))] <- NA_real_
-
-    # But only return mean value, to align with all others
-    # And convert final value to scale so that higher is better by
-    val <- 2 - log10 (vals [["mean"]])
+    vals <- c (pr_dur_mn, issue_resp_time, defect_resol_dur)
+    # convert final value to scale so that higher is better by
+    val <- 2 - log10 (mean (vals, na.rm = TRUE))
     val <- ifelse (is.na (val), 0, val)
     return (val)
 }
@@ -89,7 +69,7 @@ cm_model_proj_engagement <- function (path,
 
     if (is.null (metrics_data)) {
 
-        pr_dat <- cm_metric_change_req (path, end_date = end_date)
+        num_prs_merged <- cm_metric_num_prs_merged (path, end_date = end_date)
         counts <- cm_metric_committer_count (path, end_date = end_date)
         # has number of unique commiters for (watchers or forks, issues, prs)
 
@@ -108,20 +88,14 @@ cm_model_proj_engagement <- function (path,
         #   cm_metric_pr_review_duration (path, end_date = end_date)
     } else {
 
-        pr_dat <- metrics_data$pr_dat
+        num_prs_merged <- metrics_data$num_prs_merged
         counts <- metrics_data$committer_count
         num_code_ctbs <- metrics_data$ctb_count
         num_issues_closed <- metrics_data$issues_closed
         num_issues_updated <- metrics_data$issue_updates
         num_issue_comments <- metrics_data$issue_cmt_count
     }
 
-    num_prs_merged <- ifelse (
-        length (pr_dat) > 1,
-        pr_dat [["n_closed"]],
-        0L
-    )
-
     res <- c (
         num_prs_merged, counts, num_code_ctbs,
         num_issues_closed, num_issues_updated, num_issue_comments
@@ -269,7 +243,6 @@ cm_model_oss_compliance <- function (path,
 
     bp_badge <- as.integer (bp_badge)
     lic_declared <- as.integer (length (lic_declared) > 0L)
-    defect_res_dur <- defect_res_dur [["mean"]]
     defect_res_dur <- ifelse (defect_res_dur > 0, log10 (defect_res_dur), 0)
     libyears <- libyears [["mean"]]
 
@@ -573,7 +546,7 @@ cm_model_comm_serv_support <- function (path,
             cm_metric_defect_resolution_dur (path, end_date = end_date)
 
         pr_age <- cm_metric_pr_age (path, end_date = end_date)
-        pr_dur <- cm_metric_pr_review_duration (path, end_date = end_date)
+        pr_dur_mn <- cm_metric_pr_review_duration (path, end_date = end_date)
 
         # Metrics measured in N > 1, for which higher is better:
         issue_num_cmts <- cm_metric_issue_comments (path, end_date = end_date)
@@ -586,23 +559,20 @@ cm_model_comm_serv_support <- function (path,
         issue_age <- metrics_data$issue_age
         issue_res_duration <- metrics_data$defect_resolution_dur
         pr_age <- metrics_data$pr_age
-        pr_dur <- metrics_data$pr_review_duration
+        pr_dur_mn <- metrics_data$pr_review_duration
         issue_num_cmts <- metrics_data$issue_comments
         issues_active <- metrics_data$issues_active
         pr_num_revs <- metrics_data$pr_reviews
 
     }
 
-    issue_resp_time <- as.numeric (mean (issue_resp_time))
     issue_age <- issue_age [["mean"]]
-    issue_res_duration <- issue_res_duration [["mean"]]
     pr_age <- pr_age [["mean"]]
-    pr_dur <- pr_dur [["review_dur_mn"]]
 
     pr_num_revs_approved <- pr_num_revs [["approved_count"]]
     pr_num_revs_rejected <- pr_num_revs [["rejected_count"]]
 
-    res_N_days <- c (issue_resp_time, issue_age, issue_res_duration, pr_age, pr_dur)
+    res_N_days <- c (issue_resp_time, issue_age, issue_res_duration, pr_age, pr_dur_mn)
     res_ON <-
         c (issue_num_cmts, issues_active, pr_num_revs_approved, pr_num_revs_rejected)
     res_log10 <- vapply (list (res_N_days, res_ON), function (i) {
@@ -649,7 +619,6 @@ cm_model_starter_health <- function (path,
 
     }
 
-    time_first_resp <- mn_med_sum (time_first_resp) [["mean"]]
     time_first_resp <- ifelse (time_first_resp == 0, 1, time_first_resp)
 
     pr_closure_ratio <- NA_real_
@@ -719,7 +688,6 @@ cm_model_comm_welcoming <- function (path,
 
     issue_age <- issue_age [["mean"]] # [0, N >> 1]
     issue_age <- ifelse (issue_age == 0, 1, issue_age)
-    time_first_resp <- mn_med_sum (time_first_resp) [["mean"]]
     time_first_resp <- ifelse (time_first_resp == 0, 1, time_first_resp)
 
     val_days <- log10 (c (issue_age, time_first_resp))
diff --git a/codemeta.json b/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.6.088",
+  "version": "0.1.6.095",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
diff --git a/inst/extdata/chaoss-models/chaoss-models.json b/inst/extdata/chaoss-models/chaoss-models.json
@@ -0,0 +1,104 @@
+{
+    "models": {
+        "dev_reponsiveness": [
+            "pr_review_duration",
+            "issue_response_time",
+            "defect_resolution_dur"
+        ],
+        "proj_engagement": [
+            "num_prs_merged",
+            "committer_count",
+            "ctb_count",
+            "issues_closed",
+            "issue_updates",
+            "issue_cmt_count"
+        ],
+        "proj_awareness": [
+            "num_forks",
+            "popularity"
+        ],
+        "community_activity": [
+            "ctb_count",
+            "pr_reviews",
+            "recent_releases",
+            "issue_updates",
+            "maintainer_count",
+            "commit_freq",
+            "issue_cmt_count"
+        ],
+        "oss_compliance": [
+            "best_practices",
+            "license_coverage",
+            "licenses_declared",
+            "defect_resolution_dur",
+            "libyears",
+            "dependency_count"
+        ],
+        "viability_community": [
+            "committer_count",
+            "change_req",
+            "maintainer_count",
+            "libyears"
+        ],
+        "viability_starter": [
+            "contrib_absence",
+            "elephant_factor",
+            "licenses_declared",
+            "change_req",
+            "libyears"
+        ],
+        "viability_gov": [
+            "label_inclusivity",
+            "change_req",
+            "popularity",
+            "time_to_close",
+            "libyears",
+            "issue_age",
+            "release_freq"
+        ],
+        "viability_strategy": [
+            "languages",
+            "contrib_absence",
+            "elephant_factor",
+            "release_freq"
+        ],
+        "collab_devel_index": [
+            "has_ci",
+            "change_req",
+            "issues_to_prs",
+            "num_contributors",
+            "pr_reviews",
+            "num_forks",
+            "num_commits",
+            "code_change_lines"
+        ],
+        "comm_serv_support": [
+            "issue_response_time",
+            "issue_age",
+            "defect_resolution_dur",
+            "pr_age",
+            "pr_review_duration",
+            "issue_comments",
+            "issues_active",
+            "pr_reviews"
+        ],
+        "starter_health": [
+            "issue_response_time",
+            "change_req",
+            "contrib_absence",
+            "release_freq"
+        ],
+        "comm_welcoming": [
+            "issue_age",
+            "issue_response_time",
+            "license_coverage",
+            "licenses_declared",
+            "test_coverage",
+            "best_practices",
+            "change_req",
+            "contrib_absence",
+            "elephant_factor",
+            "ctb_count"
+        ]
+    }
+}
diff --git a/tests/testthat/test-cm-metrics.R b/tests/testthat/test-cm-metrics.R
@@ -217,15 +217,12 @@ test_that ("cm metric review duration", { # R/cm-metrics-pr-reviews.R
     Sys.setenv ("REPOMETRICS_TESTS" = "true")
     dat <- mock_rm_data ()
     path <- generate_test_pkg ()
-    revs <- cm_metric_pr_review_duration (path, end_date = end_date)
+    rev_dur_mn <- cm_metric_pr_review_duration (path, end_date = end_date)
     fs::dir_delete (path)
 
-    expect_type (revs, "double")
-    expect_length (revs, 4L)
-    expect_named (
-        revs,
-        c ("cycle_dur_mn", "cycle_dur_md", "review_dur_mn", "review_dur_md")
-    )
+    expect_type (rev_dur_mn, "double")
+    expect_length (rev_dur_mn, 1L)
+    expect_named (rev_dur_mn, NULL)
 })
 
 test_that ("cm metric issue numbers, durations, response times", {
@@ -242,7 +239,6 @@ test_that ("cm metric issue numbers, durations, response times", {
 
     # Vector of response durations:
     expect_type (dur_issues, "double")
-    expect_s3_class (dur_issues, "difftime")
     expect_true (length (dur_issues) >= 0L)
 
     # Overall summary statistic on repsonse times from both issues and PRs:
@@ -271,8 +267,8 @@ test_that ("cm metric defect resolution duration", {
     fs::dir_delete (path)
 
     expect_type (res, "double")
-    expect_length (res, 2L)
-    expect_named (res, c ("mean", "median"))
+    expect_length (res, 1L)
+    expect_named (res, NULL)
 })
 
 test_that ("cm metric label inclusivity", { # R/cm-metric-labels.R
@@ -588,17 +584,17 @@ test_that ("cm metric collate all", {
     fs::dir_delete (path)
 
     expect_type (metrics_data, "list")
-    expect_length (metrics_data, 44L)
+    expect_length (metrics_data, 45L)
     metric_fns <- get_cm_fns ("metric")
     expect_identical (names (metrics_data), gsub ("^cm\\_metric\\_", "", metric_fns))
 
     lens <- vapply (metrics_data, length, integer (1L), USE.NAMES = FALSE)
-    lens_expected <- c (
+    lens_expected <- as.integer (c (
         1, 1, 1, 1, 4, 3, 3, 1, 4, 1,
-        2, 1, 3, 1, 3, 4, 1, 0, 1, 1,
+        1, 1, 3, 1, 3, 4, 1, 1, 1, 1,
         1, 1, 3, 5, 4, 1, 1, 2, 1, 1,
-        2, 4, 4, 1, 4, 0, 4, 14, 1, 1,
-        2, 4, 3, 4
-    )
+        2, 1, 4, 4, 1, 4, 0, 1, 14, 1,
+        1, 2, 4, 3, 4
+    ))
     expect_equal (lens, lens_expected)
 })

Original file line number	Diff line number	Diff line change
`@@ -29,11 +29,12 @@ cm_data_issue_response_time <- function (path, end_date = Sys.Date ()) {`
`29`	`29`	`created_at >= start_date & response_date <= end_date`
`30`	`30`	`)`
`31`	`31`
`32`		`- return (issue_responses$response_time)`
	`32`	`+ return (issue_responses)`
`33`	`33`	`}`
`34`	`34`
`35`	`35`	`cm_metric_issue_response_time <- function (path, end_date = Sys.Date ()) {`
`36`		`- cm_data_issue_response_time (path, end_date)`
	`36`	`+ issue_responses <- cm_data_issue_response_time (path, end_date)`
	`37`	`+ res <- mean (as.integer (issue_responses$response_time), na.rm = TRUE)`
`37`	`38`	`}`
`38`	`39`
`39`	`40`	`cm_data_defect_resolution_dur <- function (path, end_date = Sys.Date ()) { # nolint`
`@@ -65,7 +66,8 @@ cm_data_defect_resolution_dur <- function (path, end_date = Sys.Date ()) { # nol`
`65`	`66`	`}`
`66`	`67`
`67`	`68`	`cm_metric_defect_resolution_dur <- function (path, end_date = Sys.Date ()) {`
`68`		`- cm_data_defect_resolution_dur (path, end_date)`
	`69`	`+ dat <- cm_data_defect_resolution_dur (path, end_date)`
	`70`	`+ dat [["mean"]]`
`69`	`71`	`}`
`70`	`72`
`71`	`73`	`#' CHAOSS metric "Time to Close"`