-
Notifications
You must be signed in to change notification settings - Fork 1
/
dashboard-at-risk.qmd
152 lines (132 loc) · 5.59 KB
/
dashboard-at-risk.qmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
---
title: "Dashboard: Packages At-Risk of Being Archived"
execute:
freeze: false
---
<style>
tr { vertical-align: top; }
</style>
```{r setup, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
warning = FALSE,
message = FALSE,
echo = FALSE
)
```
```{r package-dependencies, include = FALSE}
## Install package dependencies, if missing
pkgs <- c("ciw", "dplyr", "DT", "jsonlite")
pkgs <- pkgs[!vapply(pkgs, FUN = requireNamespace, FUN.VALUE = FALSE)]
lapply(pkgs, FUN = install.packages, character.only = TRUE)
```
```{r dashboard}
packages_at_risk <- local({
data <- NULL
function() {
if (!is.null(data)) return(data)
db <- tools::CRAN_package_db()
db <- subset(db, !is.na(Deadline))
db <- db[, c("Deadline", "Package", "Version", "Published", "Maintainer", "BugReports", "URL", "Reverse depends", "Reverse imports", "Reverse linking to")]
db$Deadline <- as.Date(db$Deadline)
db$Published <- as.Date(db$Published)
db <- db[order(db$Deadline), ]
rownames(db) <- NULL
revdeps <- paste(db[["Reverse depends"]], db[["Reverse imports"]], db[["Reverse linking to"]], sep = ", ")
revdeps <- strsplit(revdeps, split = ",", fixed = TRUE)
revdeps <- lapply(revdeps, function(x) {
x <- gsub(" ", "", x)
x <- gsub("NA", "", x)
x <- x[nzchar(x)]
x <- sort(unique(x))
paste(x, collapse = ", ")
})
revdeps <- unlist(revdeps)
db[["Reverse Packages"]] <- revdeps
db <- db[, c("Deadline", "Package", "Version", "Published", "Maintainer", "BugReports", "URL", "Reverse Packages")]
data <<- db
data
}
})
#' @importFrom ciw incoming
cran_incoming <- local({
data <- NULL
function() {
if (!is.null(data)) return(data)
folders <- ciw:::known_folders
db <- ciw::incoming(folder = folders, check = FALSE)
db <- as.data.frame(db)
colnames(db) <- tolower(colnames(db))
db$package <- gsub("_.*", "", db$name)
db$version <- gsub("(.*_|[.]tar[.]gz)", "", db$name)
db <- db[, c("package", "version", "folder", "time")]
data <<- db
data
}
})
incoming <- cran_incoming()
## NOTE: If the same package is submitted multiple times to CRAN, it may
## show up as multiple entries in CRAN incoming, e.g.
## 1 MetaNet 0.1.2 newbies 2024-03-22 00:19:00
## 2 MetaNet 0.1.2 inspect 2024-03-21 01:25:00
## We need the latest submission to avoid duplicated in the dashboard.
incoming <- incoming[order(incoming$time, decreasing = TRUE), ]
incoming <- incoming[!duplicated(incoming$package), , drop = FALSE]
incoming <- incoming[, c("package", "folder")]
colnames(incoming)[2] <- "cran_incoming"
atrisk <- packages_at_risk()
atrisk <- merge(atrisk, incoming, by.x = "Package", by.y = "package",
all.x = TRUE)
idxs <- which(!is.na(atrisk$cran_incoming))
atrisk$event <- NA
atrisk$event[idxs] <- sprintf('<small><a href="https://nx10.github.io/cransubs/pkg#%s">resubmitted/%s</a></small>',
atrisk$Package[idxs], atrisk$cran_incoming[idxs])
days <- atrisk$Deadline - Sys.Date()
days <- ifelse(days == -1, "1 day overdue", ifelse(days < 0, sprintf("%s days overdue", abs(days)), ifelse(days == 0, "today", ifelse(days == 1, "in 1 day", sprintf("in %s days", days)))))
atrisk$Deadline <- sprintf("%s<br><small>(%s)</small>", atrisk$Deadline, days)
atrisk$Version <- sprintf("%s<br><small>(%s)<small>", atrisk$Version, atrisk$Published)
atrisk$Published <- NULL
atrisk$Maintainer <- sub("^([^<]+)<([^ ]+)>.*$", '<a href="mailto:\\2">\\1</a>', atrisk$Maintainer)
atrisk$Maintainer <- sub(" +<", "<", atrisk$Maintainer)
atrisk$Maintainer <- sub("@", "-at-", atrisk$Maintainer)
atrisk$Links <- sprintf('<a href="https://cran.r-project.org/web/checks/check_results_%s.html">checks</a>', atrisk$Package)
# Clean urls to only the first one
urls <- vapply(strsplit(atrisk$URL, split = ",\\s+|\\s+"), function(x){x[1]}, FUN.VALUE = character(1))
atrisk$Links <- sprintf('%s<br><a href="%s">url</a>', atrisk$Links, urls)
atrisk$Links <- sprintf('%s<br><a href="%s">url2</a>', atrisk$Links, atrisk$BugReports)
atrisk$Links <- gsub('<br><a href="NA">url</a>', "", atrisk$Links)
atrisk$URL <- NULL
atrisk$BugReports <- NULL
revdeps <- atrisk[["Reverse Packages"]]
nrevdeps <- lengths(strsplit(revdeps, split = ",", fixed = TRUE))
nrevdeps[revdeps == ""] <- 0L
atrisk[["Reverse Packages (n)"]] <- nrevdeps
atrisk[["Reverse Packages"]] <- ifelse(nrevdeps == 0, "", revdeps)
atrisk$Package <- sprintf('<a href="https://cran.r-project.org/package=%s">%s</a>', atrisk$Package, atrisk$Package)
colnames(atrisk) <- tolower(colnames(atrisk))
atrisk <- atrisk[, c("deadline", "package", "version", "maintainer", "links",
"event", "reverse packages (n)", "reverse packages")]
```
The below table lists `r nrow(atrisk)` R packages that are at risk of being archived[^1] on CRAN, because they have outstanding unresolved issues.
Some of them might have already submitted a new version to fix the issues identified by CRAN (check the event column).
[^1]: When a package is _archived_, the archived version is still
available in the [CRAN archive area] together with all previous
versions.
```{r}
# Show only recent packages
library("DT")
datatable(atrisk,
rownames = FALSE,
escape = FALSE,
elementId = "live-dashboard",
options = list(
pageLength = 50,
order = list(list(0, "asc"), list(6, "desc"), list(1, "asc"))
)
)
```
[CRAN archive area]: https://cran.r-project.org/src/contrib/Archive/
[CRAN mirror on R-universe]: https://cran.r-universe.dev/builds
[CRAN Repository Policy]: https://cran.r-project.org/web/packages/policies.html
[PACKAGES.in]: https://cran.r-project.org/src/contrib/PACKAGES.in