Skip to content

Commit d6ad8ab

Browse files
mpadgempadge
authored
Merge pull request #17 from ropensci-review-tools/chaoss
chaoss metrics for #11
2 parents 3af4119 + b9e27de commit d6ad8ab

14 files changed

+268
-4
lines changed

‎DESCRIPTION

+4-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: githist
22
Title: Code analyses traced along the 'git' history of a package
3-
Version: 0.1.0.038
3+
Version: 0.1.0.044
44
Authors@R:
55
person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
66
comment = c(ORCID = "0000-0003-2172-5265"))
@@ -15,10 +15,13 @@ Imports:
1515
dplyr,
1616
fs,
1717
gert,
18+
httr2,
19+
memoise,
1820
pbapply,
1921
pkgstats
2022
Suggests:
2123
brio,
24+
httptest2,
2225
lubridate,
2326
quarto,
2427
testthat (>= 3.0.0),

‎NAMESPACE

+1
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,4 @@
22

33
export(ghist_dashboard)
44
export(githist)
5+
importFrom(memoise,memoise)

‎R/chaoss-metrics-external.R

+27
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
#' Extract total CRAN downloads for nominated package over period defined by
2+
#' `options("githist_period")`.
3+
#'
4+
#' @param pkg_name Name of package. For packages not on CRAN, the 'cranlogs'
5+
#' API returns download counts of 0.
6+
#' @param end_date The date up to which download counts are to be aggregated.
7+
#' @return A single integer counting the number of downloads.
8+
#' @noRd
9+
cran_downloads <- function (pkg_name, end_date = Sys.Date ()) {
10+
11+
checkmate::assert_character (pkg_name, len = 1L)
12+
checkmate::assert_date (end_date)
13+
period <- get_githist_period ()
14+
start_date <- as.Date (end_date - period)
15+
interval <- paste (start_date, sep = ":", end_date)
16+
17+
base_url <- "http://cranlogs.r-pkg.org/"
18+
daily_url <- paste0 (base_url, "downloads/total/")
19+
req_url <- paste0 (daily_url, interval, "/", pkg_name)
20+
21+
req <- httr2::request (req_url)
22+
resp <- httr2::req_perform (req)
23+
httr2::resp_check_status (resp)
24+
25+
body <- httr2::resp_body_json (resp)
26+
return (body [[1]]$downloads)
27+
}

‎R/chaoss-metrics-internal.R

+64
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
chaoss_internal_num_commits <- function (path, end_date = Sys.Date ()) {
2+
3+
log <- git_log_in_period (path, end_date, get_githist_period ())
4+
5+
return (nrow (log))
6+
}
7+
8+
chaoss_internal_num_contributors <- function (path, end_date = Sys.Date ()) {
9+
10+
log <- git_log_in_period (path, end_date, get_githist_period ())
11+
12+
auths_un <- unique (log$author)
13+
14+
# separate handles from emails:
15+
emails <- regmatches (auths_un, gregexpr ("<.*>", auths_un))
16+
emails <- vapply (emails, function (i) {
17+
ifelse (length (i) == 0L, "", gsub ("<|>", "", i))
18+
}, character (1L))
19+
handles <- gsub ("<.*$", "", auths_un)
20+
21+
# Remove any duplicates of either, but excluding non-entries:
22+
rm_dup_rows <- function (x) {
23+
x <- gsub ("\\s+", "", x)
24+
index <- seq_along (x)
25+
index_out <- which (duplicated (x) & nzchar (x))
26+
if (length (index_out) > 0) {
27+
index <- index [-(index_out)]
28+
}
29+
return (index)
30+
}
31+
index1 <- rm_dup_rows (handles)
32+
index2 <- rm_dup_rows (emails)
33+
34+
# Then extract only instances where neither handles nor emails are
35+
# duplicated:
36+
index_table <- table (c (index1, index2))
37+
index <- as.integer (names (index_table) [which (index_table == 2L)])
38+
39+
auths_un <- auths_un [index]
40+
41+
return (length (auths_un))
42+
}
43+
44+
git_log_in_period_internal <- function (path, end_date = Sys.Date (), period = 90) {
45+
checkmate::assert_character (path, len = 1L)
46+
checkmate::assert_directory (path)
47+
checkmate::assert_date (end_date)
48+
49+
h <- gert::git_log (repo = path, max = 1e6)
50+
if (nrow (h) == 0) {
51+
return (h)
52+
}
53+
dates <- as.Date (h$time)
54+
today_minus_period <- as.Date (end_date - period)
55+
index <- which (dates >= today_minus_period)
56+
h <- h [index, ]
57+
58+
if (dates [1] > end_date) {
59+
h <- h [which (dates <= end_date), ]
60+
}
61+
62+
return (h)
63+
}
64+
git_log_in_period <- memoise::memoise (git_log_in_period_internal)

‎R/githist-package.R

+1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
#' @keywords internal
2+
#' @importFrom memoise memoise
23
#' @aliases githist-package
34
"_PACKAGE"
45

‎R/utils.R

+7
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,13 @@ set_num_cores <- function (num_cores) {
2828
return (num_cores)
2929
}
3030

31+
pkg_name_from_path <- function (path) {
32+
desc <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$")
33+
checkmate::assert_file_exists (desc)
34+
35+
unname (read.dcf (desc) [, "Package"])
36+
}
37+
3138
filter_git_hist <- function (h, n, step_days) {
3239
if (!is.null (n)) {
3340
h <- h [seq_len (n), ]

‎R/zzz.R

+22
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
# nocov start
2+
.onLoad <- function (libname, pkgname) { # nolint
3+
4+
op <- options ()
5+
6+
op.githist <- list (
7+
githist_period = 90
8+
)
9+
10+
toset <- !(names (op.githist) %in% names (op))
11+
if (any (toset)) {
12+
options (op.githist [toset])
13+
}
14+
invisible ()
15+
}
16+
# nocov end
17+
18+
get_githist_period <- function () {
19+
period <- getOption ("githist_period")
20+
checkmate::assert_int (period, lower = 1L)
21+
return (period)
22+
}

‎codemeta.json

+69-3
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
"codeRepository": "https://github.com/ropensci-review-tools/githist",
99
"issueTracker": "https://github.com/ropensci-review-tools/githist/issues",
1010
"license": "https://spdx.org/licenses/GPL-3.0",
11-
"version": "0.1.0.038",
11+
"version": "0.1.0.044",
1212
"programmingLanguage": {
1313
"@type": "ComputerLanguage",
1414
"name": "R",
@@ -46,6 +46,30 @@
4646
},
4747
"sameAs": "https://CRAN.R-project.org/package=brio"
4848
},
49+
{
50+
"@type": "SoftwareApplication",
51+
"identifier": "httptest2",
52+
"name": "httptest2",
53+
"provider": {
54+
"@id": "https://cran.r-project.org",
55+
"@type": "Organization",
56+
"name": "Comprehensive R Archive Network (CRAN)",
57+
"url": "https://cran.r-project.org"
58+
},
59+
"sameAs": "https://CRAN.R-project.org/package=httptest2"
60+
},
61+
{
62+
"@type": "SoftwareApplication",
63+
"identifier": "lubridate",
64+
"name": "lubridate",
65+
"provider": {
66+
"@id": "https://cran.r-project.org",
67+
"@type": "Organization",
68+
"name": "Comprehensive R Archive Network (CRAN)",
69+
"url": "https://cran.r-project.org"
70+
},
71+
"sameAs": "https://CRAN.R-project.org/package=lubridate"
72+
},
4973
{
5074
"@type": "SoftwareApplication",
5175
"identifier": "quarto",
@@ -71,6 +95,18 @@
7195
},
7296
"sameAs": "https://CRAN.R-project.org/package=testthat"
7397
},
98+
{
99+
"@type": "SoftwareApplication",
100+
"identifier": "tidyr",
101+
"name": "tidyr",
102+
"provider": {
103+
"@id": "https://cran.r-project.org",
104+
"@type": "Organization",
105+
"name": "Comprehensive R Archive Network (CRAN)",
106+
"url": "https://cran.r-project.org"
107+
},
108+
"sameAs": "https://CRAN.R-project.org/package=tidyr"
109+
},
74110
{
75111
"@type": "SoftwareApplication",
76112
"identifier": "withr",
@@ -146,6 +182,30 @@
146182
"sameAs": "https://CRAN.R-project.org/package=gert"
147183
},
148184
"6": {
185+
"@type": "SoftwareApplication",
186+
"identifier": "httr2",
187+
"name": "httr2",
188+
"provider": {
189+
"@id": "https://cran.r-project.org",
190+
"@type": "Organization",
191+
"name": "Comprehensive R Archive Network (CRAN)",
192+
"url": "https://cran.r-project.org"
193+
},
194+
"sameAs": "https://CRAN.R-project.org/package=httr2"
195+
},
196+
"7": {
197+
"@type": "SoftwareApplication",
198+
"identifier": "memoise",
199+
"name": "memoise",
200+
"provider": {
201+
"@id": "https://cran.r-project.org",
202+
"@type": "Organization",
203+
"name": "Comprehensive R Archive Network (CRAN)",
204+
"url": "https://cran.r-project.org"
205+
},
206+
"sameAs": "https://CRAN.R-project.org/package=memoise"
207+
},
208+
"8": {
149209
"@type": "SoftwareApplication",
150210
"identifier": "pbapply",
151211
"name": "pbapply",
@@ -157,13 +217,19 @@
157217
},
158218
"sameAs": "https://CRAN.R-project.org/package=pbapply"
159219
},
160-
"7": {
220+
"9": {
161221
"@type": "SoftwareApplication",
162222
"identifier": "pkgstats",
163223
"name": "pkgstats",
164224
"sameAs": "https://github.com/ropensci-review-tools/pkgstats"
165225
},
166226
"SystemRequirements": {}
167227
},
168-
"fileSize": "55.256KB"
228+
"fileSize": "90.739KB",
229+
"readme": "https://github.com/ropensci-review-tools/githist/blob/main/README.md",
230+
"contIntegration": [
231+
"https://github.com/ropensci-review-tools/githist/actions?query=workflow%3AR-CMD-check",
232+
"https://app.codecov.io/gh/ropensci-review-tools/githist"
233+
],
234+
"developmentStatus": "https://www.repostatus.org/#active"
169235
}

‎inst/httptest2/redact.R

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
function (resp) {
2+
3+
resp <- httptest2::gsub_response (
4+
resp,
5+
"http://cranlogs.r-pkg.org/downloads/total/",
6+
"cranlogs/",
7+
fixed = TRUE
8+
)
9+
10+
# Timestamp pattern, where replacing with "" removes sub-dir:
11+
ptn <- "[0-9]{4}\\-[0-9]{2}\\-[0-9]{2}"
12+
resp <- httptest2::gsub_response (
13+
resp,
14+
paste0 (ptn, "\\:", ptn),
15+
"",
16+
fixed = FALSE
17+
)
18+
19+
return (resp)
20+
}

‎tests/testthat.R

+1
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
# * https://testthat.r-lib.org/articles/special-files.html
88

99
library (testthat)
10+
library (httptest2)
1011
library (githist)
1112

1213
test_check ("githist")

‎tests/testthat/cran_dl/cranlogs/goodpractice.json

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
[
2+
{
3+
"start": "2023-10-03",
4+
"end": "2024-01-01",
5+
"downloads": 2308,
6+
"package": "goodpractice"
7+
}
8+
]

‎tests/testthat/test-chaoss-metrics-external.R

+22
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
test_that ("chaoss external util fns", {
2+
pkg <- system.file ("extdata", "testpkg.zip", package = "githist")
3+
flist <- unzip (pkg, exdir = fs::path_temp ())
4+
path <- fs::path_dir (flist [1])
5+
6+
pkg_name <- pkg_name_from_path (path)
7+
expect_equal (pkg_name, "testpkg")
8+
9+
fs::dir_delete (path)
10+
})
11+
12+
test_that ("chaoss external cran_downloads", {
13+
14+
pkg_name <- "goodpractice"
15+
end_date <- as.Date ("2024-01-01")
16+
dl <- with_mock_dir ("cran_dl", {
17+
cran_downloads (pkg_name = pkg_name, end_date = end_date)
18+
})
19+
expect_type (dl, "integer")
20+
expect_length (dl, 1L)
21+
expect_equal (dl, 2308)
22+
})

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

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
test_that ("chaoss internal num_commits", {
2+
pkg <- system.file ("extdata", "testpkg.zip", package = "githist")
3+
flist <- unzip (pkg, exdir = fs::path_temp ())
4+
path <- fs::path_dir (flist [1])
5+
6+
n <- chaoss_internal_num_commits (path, end_date = as.Date ("2024-08-01"))
7+
expect_equal (n, 4L)
8+
9+
n <- chaoss_internal_num_contributors (path, end_date = as.Date ("2024-08-01"))
10+
expect_equal (n, 1L)
11+
12+
fs::dir_delete (path)
13+
})

‎tests/testthat/test-testpkg.R

+9
Original file line numberDiff line numberDiff line change
@@ -47,4 +47,13 @@ test_that ("githist parameters", {
4747
length (res2$desc_dat$date),
4848
length (unique (res2$desc_data$date))
4949
)
50+
51+
# Finally, test step_days > 1, which has no effect anyway, as all commits
52+
# are on same day
53+
flist <- unzip (pkg, exdir = fs::path_temp ())
54+
res3 <- githist (path, n = 2L, step_days = 2L, num_cores = 1L)
55+
fs::dir_delete (path)
56+
57+
n3 <- vapply (res3, nrow, integer (1L))
58+
expect_equal (n2, n3)
5059
})

0 commit comments

Comments
 (0)