#' Get timezone offset from UTC
#'
#' @param tz Character. Timezone to calculate offset from
#' @param dst Character. Whether or not to consider day-light-savings
#' @param tz_name Logical. Whether or not to return name of the timezone or
#' just the offset in hours.
#'
#' @export
tz_offset <- function(tz, dst = FALSE, tz_name = FALSE) {
tz <- check_tz(tz)
if(!dst) t <- as.numeric(difftime(as.POSIXct("2016-01-01 00:00:00", tz = "UTC"),
as.POSIXct("2016-01-01 00:00:00", tz = tz), units = "hours"))
if(dst) t <- as.numeric(difftime(as.POSIXct("2016-06-01 00:00:00", tz = "UTC"),
as.POSIXct("2016-06-01 00:00:00", tz = tz), units = "hours"))
if(tz_name) {
if(t > 0) t <- paste0("Etc/GMT-", t)
if(t <= 0) t <- paste0("Etc/GMT+", abs(t))
}
return(t)
}
last <- function(x) return(x[length(x)])
mp <- function(x) paste0(sort(unlist(strsplit(as.character(x), "_"))), collapse = "_")
# Grab extra columns unique only
keep_extra <- function(d, n, only = c("animal_id", "logger_id", "date")){
# Ungroup, if exists
d <- dplyr::ungroup(d)
d <- unique(d[, setdiff(names(d), n)])
# If loc present, deconstruct
if(any(names(d) == "loc")){
d$lon <- as.numeric(gsub("\\(([-0-9.]+),[-0-9.]+\\)", "\\1", d$loc))
d$lat <- as.numeric(gsub("\\([-0-9.]+,([-0-9.]+)\\)", "\\1", d$loc))
d <- d[, names(d) != "loc",]
}
extra <- names(d)[!(names(d) %in% c("animal_id", "logger_id", "date"))]
animal_id <- logger_id <- date <- all <- NULL
if("animal_id" %in% only) animal_id <- extra[lapply(extra, FUN = function(x) nrow(unique(cbind(d$animal_id, d[, x])))) == length(unique(d$animal_id))]
if("logger_id" %in% only) logger_id <- extra[lapply(extra, FUN = function(x) nrow(unique(cbind(d$logger_id, d[, x])))) == length(unique(d$logger_id))]
if("date" %in% only) date <- extra[lapply(extra, FUN = function(x) nrow(unique(cbind(d$date, d[, x])))) == length(unique(d$date))]
#if(all(c("logger_id", "animal_id", "date") %in% only)) {
all <- intersect(intersect(animal_id, logger_id), date)
bf <- setdiff(intersect(animal_id, logger_id), all)
bd <- setdiff(intersect(animal_id, date), all)
fd <- setdiff(intersect(logger_id, date), all)
logger_id <- setdiff(logger_id, all)
animal_id <- setdiff(setdiff(animal_id, all), bf)
date <- setdiff(setdiff(setdiff(date, all), bd), fd)
#}
if(length(all) > 0) all <- unique(d[, c("animal_id", "logger_id", "date", all)]) else all <- NULL
if(length(animal_id) > 0) animal_id <- unique(d[, c("animal_id", animal_id)]) else animal_id <- NULL
if(length(logger_id) > 0) logger_id <- unique(d[, c("logger_id", logger_id)]) else logger_id <- NULL
if(length(date) > 0) date <- unique(d[, c("date", date)]) else date <- NULL
return(list(all = all, animal_id = animal_id, logger_id = logger_id, date = date))
}
merge_extra <- function(d, extra, only = NULL) {
if(!is.null(extra$all)) d <- dplyr::left_join(d, extra$all, by = c("animal_id", "logger_id", "date"))
if(!is.null(extra$animal_id)) d <- dplyr::left_join(d, extra$animal_id, by = "animal_id")
if(!is.null(extra$logger_id)) d <- dplyr::left_join(d, extra$logger_id, by = "logger_id")
if(!is.null(extra$date)) d <- dplyr::left_join(d, extra$date, by = "date")
return(d)
}
# Average clock time
mean_clock <- function(time, origin = FALSE) {
tz <- lubridate::tz(time[1])
mean_time <- format(mean(as.POSIXct(paste("1970-01-01", format(time, "%H:%M:%S")))), "%H:%M:%S")
mean_date <- ifelse(origin, "1970-01-01", as.character(lubridate::as_date(mean(time))))
return(as.POSIXct(paste(mean_date, mean_time), tz = tz))
}
fill_trips <- function(x) {
if(all(is.na(x))) return(NA)
n1 <- sum(is.na(x)[seq_len(which(!is.na(x))[1])])
x1 <- x[which(!is.na(x))][cumsum(!is.na(x))]
if(n1 > 0) x1 <- c(rep(NA, n1), x1)
return(x1)
}
# If first or last enter/exit is odd
remove_edges <- function(x, dir_to, dir_from) {
if(x$direction[1] == dir_to) x <- x[-1, ]
if(nrow(x) > 0) if(x$direction[nrow(x)] == dir_from) x <- x[-nrow(x), ]
x
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.