Nothing
# forked from @mitchelloharawild 's rj package
# https://github.com/mitchelloharawild/rj/tree/7b1984dca1c8e211a5797451c2fe87f7e034cc28
# Status
# List of Final status of articles
final_status <- c(
"reject and resubmit",
"published",
"withdrawn",
"rejected"
)
# List of valid status of articles
valid_status <- c(
"submitted",
"acknowledged",
"passed initial checks",
"needs reviewers",
"needs editor",
"updated",
"out for review",
"major revision",
"minor revision",
"revision received",
"accepted",
"copy edited",
"online",
"proofed",
"out for proofing",
"style checked",
"with AE",
"AE: major revision",
"AE: minor revision",
"AE: accept",
"AE: reject",
final_status
)
# -- Status meta datatype and parser ------------------------------------------
status <- function(status, date = Sys.Date(), comments = "") {
stopifnot(is.Date(date), length(date) == 1)
stopifnot(is.character(status), length(status) == 1)
stopifnot(is.character(comments), length(comments) == 1)
# Date + 1 provides a buffer for timezones with remote resources.
if (date > (Sys.Date() + 1)) stop("Date must not be in the future")
if (date < as.Date("2002-01-01")) {
stop("Date must not before the R journal was created")
}
status <- str_trim(status)
if (!(status %in% valid_status)) {
guess <- amatch_status(status)
if (tolower(status) == tolower(guess)) {
status <- guess
} else {
stop(status, " is not a known status. ",
"Did you mean ", amatch_status(status), "?",
call. = FALSE
)
}
}
structure(list(date = date, status = status, comments = comments),
class = "status"
)
}
is.status <- function(x) inherits(x, "status")
c.status <- c.status_list <- function(..., recursive = FALSE) {
pieces <- list(...)
statuses <- lapply(pieces, function(x) {
if (is.status(x)) {
list(x)
} else if (is.status_list(x)) {
x
} else {
stop("Don't know how to combine with ", class(x)[1])
}
})
status_list(unlist(statuses, recursive = FALSE))
}
format.status <- function(x, ...) {
paste(format(x$date), " ", x$status,
if (!empty(x$comments)) paste(" [", x$comments, "]", sep = ""),
sep = ""
)
}
print.status <- function(x, ...) cat(format(x), "\n")
amatch_status <- function(status) {
ldist <- utils::adist(status, valid_status,
ignore.case = TRUE, partial = FALSE,
costs = c(ins = 0.5, sub = 1, del = 2)
)[1, ]
valid_status[which.min(ldist)]
}
is.date <- function(x) {
parsed <- strptime(x, "%Y-%m-%d")
!is.na(parsed) && format(parsed) == x
}
is.Date <- function(x) inherits(x, "Date")
format_non_null <- function(x) if(is.null(x)) NULL else format(x)
parse_status_list <- function(x) {
stopifnot(is.character(x), length(x) == 1)
x <- trimws(x)
if (empty(x)) {
return(status_list())
}
statuses <- trimws(strsplit(x, ",[ \t\r]*(\n|$)")[[1]])
statuses <- statuses[statuses != ""]
status_list(lapply(statuses, parse_status))
}
parse_status <- function(x) {
x <- stringr::str_trim(x)
re <- "^(\\d{4}-\\d{2}-\\d{2}) ([^\\[]*)(?: \\[([^\\[]+)\\])?$"
if (!stringr::str_detect(x, re)) {
# NM added line
message("bad status:", x, "\n")
stop("Status must have form 'yyyy-mm-dd status [optional comments]'",
call. = FALSE
)
}
pieces <- stringr::str_match(x, re)[1, ]
date <- pieces[2]
if (!is.date(date)) stop("Date must be a valid date")
date <- as.Date(date)
status <- pieces[3]
comments <- if (is.na(pieces[4])) "" else pieces[4]
status(status = status, date = date, comments = comments)
}
# -- status_list class --------------------------------------------------------
status_list <- function(x = list()) {
structure(x, class = "status_list")
}
format.status_list <- function(x, ...) {
statuses <- lapply(x, format)
paste(statuses, collapse = ",\n ")
}
print.status_list <- function(x, ...) {
statuses <- lapply(x, format)
cat(paste(statuses, collapse = "\n"))
}
is.status_list <- function(x) inherits(x, "status_list")
# -- Id parser ----------------------------------------------------------------
parse_id <- function(x) {
if (is.id(x)) {
return(x)
}
re <- "^([0-9]{4})-([0-9]{2,3})[a-z]?$"
x <- str_trim(x)
if (!str_detect(x, re)) stop("ID must have form XXXX-YYY?")
pieces <- str_match(x, re)[1, ]
year <- pieces[2]
seq <- pieces[3]
if (!is.number(year)) stop("Year must be a number")
if (!is.number(seq)) stop("ID must be a number")
if (year > year()) stop("Year must be in the present or past")
if (year < 2002) stop("Year must be >= 2002")
id(as.integer(year), as.integer(seq))
}
id <- function(year, seq) {
stopifnot(is.numeric(year), length(year) == 1)
stopifnot(is.numeric(seq), length(seq) == 1)
year <- as.integer(year)
seq <- as.integer(seq)
structure(list(year = year, seq = seq), class = "id")
}
is.id <- function(x) inherits(x, "id")
format.id <- function(x, ...) {
paste(x$year, sprintf("%02d", x$seq), sep = "-")
}
print.id <- function(x, ...) cat(format(x), "\n")
year <- function() as.POSIXlt(Sys.Date())$year + 1900
is.number <- function(x) {
suppressWarnings(!is.na(as.numeric(x)))
}
as.character.id <- function(x, ...)
format.id(x)
# -- Address parser -----------------------------------------------------------
parse_address_list <- function(x) {
stopifnot(is.character(x), length(x) == 1)
if (empty(x)) {
return(address_list())
}
addresses <- str_trim(str_split(x, ",")[[1]])
address_list(lapply(addresses, parse_address))
}
address_list <- function(addresses = list()) {
stopifnot(is.list(addresses))
structure(addresses, class = "address_list")
}
address <- function(email = NULL, name = NULL, comment = NULL) {
if (is.null(email) && is.null(name)) {
stop("Address must have name or email", call. = FALSE)
}
structure(list(name = name, email = email, comment = comment), class = "address")
}
format.address <- function(x, ...) {
name <- if (!is.null(x$name)) paste('"', x$name, '"', sep = "")
email <- if (!is.null(x$email)) paste("<", x$email, ">", sep = "")
comment <- if (!is.null(x$comment)) paste("[", x$comment, "]", sep = "")
paste(c(name, email, comment), collapse = " ")
}
parse_address <- function(x) {
stopifnot(is.character(x), length(x) == 1)
pieces <- str_match(x, "^\\s*([^<>]*) ?(<.*>)? ?(\\[.*\\])?")[1, ]
comment <- str_trim(pieces[4])
comment <- str_replace_all(comment, "\\[|\\]", "")
if (is.na(comment) || str_length(comment) == 0) comment <- NULL
email <- str_trim(pieces[3])
email <- str_replace_all(email, "<|>", "")
if (is.na(email) || str_length(email) == 0) email <- NULL
name <- str_trim(pieces[2])
name <- str_replace_all(name, fixed('"'), "")
if (is.na(name) || str_length(name) == 0) name <- NULL
address(email, name, comment)
}
# -- supplementaries parsing --------------------------------------------------
parse_supplementaries <- function(suppl) {
x <- str_trim(str_split(suppl, ",\\s*\n")[[1]])
x <- x[str_length(x) > 0]
xs <- lapply(x, function(y) {
class(y) <- "supplfile"
y
})
class(xs) <- "supplfile_list"
xs
}
Parse_status_list <- function(x) {
stopifnot(is.character(x), length(x) == 1)
x <- trimws(x)
if (empty(x)) {
return(status_list())
}
statuses <- trimws(strsplit(x, ",[ \t\r]*(\n|$)")[[1]])
statuses <- statuses[statuses != ""]
status_list(lapply(statuses, parse_status))
}
parse_status <- function(x) {
x <- stringr::str_trim(x)
re <- "^(\\d{4}-\\d{2}-\\d{2}) ([^\\[]*)(?: \\[([^\\[]+)\\])?$"
if (!stringr::str_detect(x, re)) {
# NM added line
message("bad status:", x, "\n")
stop("Status must have form 'yyyy-mm-dd status [optional comments]'",
call. = FALSE
)
}
pieces <- stringr::str_match(x, re)[1, ]
date <- pieces[2]
if (!is.date(date)) stop("Date must be a valid date")
date <- as.Date(date)
status <- pieces[3]
comments <- if (is.na(pieces[4])) "" else pieces[4]
status(status = status, date = date, comments = comments)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.