##----------------------------------------------------------------------------##
## format_date ##
##----------------------------------------------------------------------------#
format_date <- function(x, tz = "UTC") {
o <- tryCatch(
as.POSIXct(
x,
format = "%a %b %d %T %z %Y",
tz = tz
),
error = function(e) return(NULL)
)
if (any(is.null(o), all(is.na.quiet(o)))) {
o <- tryCatch(as.POSIXct(
x,
format = "%a %b %d %H:%M:%S %z %Y",
tz = tz,
origin = "1970-01-01"),
error = function(e) return(NULL))
}
if (any(is.null(o), all(is.na.quiet(o)))) {
o <- tryCatch(as.POSIXct(
x,
format = "%a %b %d %H:%M:%S %z %Y"),
error = function(e) return(NULL))
}
if (any(is.null(o), all(is.na.quiet(o)))) {
curLocale <- Sys.getlocale("LC_TIME")
on.exit(
Sys.setlocale("LC_TIME", curLocale)
##add = TRUE
)
Sys.setlocale("LC_TIME", "C")
o <- tryCatch(as.POSIXct(
x,
tz = tz,
format = "%a, %d %b %Y %H:%M:%S +0000"),
error = function(e) return(NULL)
)
}
if (any(is.null(o), all(is.na.quiet(o)))) {
o <- tryCatch(as.POSIXct(
x, tz = tz,
format = "%a %b %d %H:%M:%S +0000 %Y"),
error = function(e) return(NULL))
}
if (any(is.null(o), all(is.na.quiet(o)))) {
o <- tryCatch(as.POSIXct(
x, format = "%a %b %d %H:%M:%S %z %Y"),
error = function(e) return(NULL))
}
if (any(is.null(o), all(is.na.quiet(o)))) {
o <- x
}
o
}
##----------------------------------------------------------------------------##
## fetch/return features ##
##----------------------------------------------------------------------------##
last <- function(x) {
x[[length(x)]]
}
##----------------------------------------------------------------------------##
## check data ##
##----------------------------------------------------------------------------##
has_name_ <- function(x, name) isTRUE(name %in% names(x))
has_name_children <- function(x, name, children) {
has_name_(x, name) && has_name_(x[[name]], children)
}
any_recursive <- function(x) {
if (!is.recursive(x)) {
return(FALSE)
}
any(vapply(x, is.recursive, logical(1)))
}
is.na.quiet <- function(x) {
suppressWarnings(is.na(x))
}
as_tbl <- tibble::as_tibble
is_n <- function(n) {
if (is.character(n)) {
n <- suppressWarnings(as.numeric(n))
}
length(n) == 1L && is.numeric(n) && !is.na(n) && n > 0L
}
maybe_n <- function(x) {
if (is.character(x)) {
x <- suppressWarnings(as.numeric(x))
}
length(x) == 1L && is.numeric(x) && !is.na(x)
}
is_testing <- function() {
identical(Sys.getenv("TESTTHAT"), "true") && requireNamespace("testthat", quietly = TRUE)
}
is_dev_mode <- function() {
exists(".__DEVTOOLS__", .getNamespace("rtweet"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.