Mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
gps_QC <- function(gps) {
time = NULL # global variable binding
# Create temporary data frame
tmp <- data.frame(date = strptime(gps$date, format = "%Y-%m-%d"),
time = lubridate::hms(gps$time))
tmp$start_date <- tmp$date - lubridate::days(ifelse(lubridate::hour(tmp$time) < 13, 1, 0))
## Check for multiple (valid) start nights in GPS file...
# If so, prompt user to make a decision (bad GPS dates, i.e., 1969-12-31)
# are ignored at this point.
start_dates <- unique(tmp$start_date)
start_dates <- start_dates[!grepl(c("1969|1970"), as.character(start_dates))]
if (length(start_dates) > 1) {
use_date <- utils::select.list(start_dates,
title="\nMultiple start dates detected in GPS text file. Choose one.",
multiple = FALSE)
keep_range <- range(which(tmp$start_date == use_date))
tmp <- tmp[keep_range[1]:keep_range[2],]
gps <- gps[keep_range[1]:keep_range[2],]
}
# Assume most fixes are correct, so we can get correct year from modal date
surv_year <- Mode(lubridate::year(tmp$date))
# Which rows are valid (i.e., collected in modal survey year)
good_dates <- which(lubridate::year(tmp$date) == surv_year)
# If survey spanned two dates (i.e., went past midnight), extract start date (minimum)
start_date <- min(tmp[good_dates,]$date)
# Fix records with bad date (i.e., did not occur during modal year)
fix_dates <- gps[-good_dates, ]
fix_dates <- mutate(fix_dates,
date = ifelse(as.numeric(substr(time, 1, 2)) >= 12,
as.character(start_date),
as.character(start_date + lubridate::days(1))))
# Now, put them back like a good guest
gps[-good_dates, ] <- fix_dates
# Expunge rows with missing lat/lon, time, or date info
# Should capture extra blank lines in the GPS file as well
anyNA <- apply(gps[, c("lat", "lon", "date", "time")], 1, function(row) any(is.na(row)))
gps <- gps[!anyNA, ]
return(gps)
}
makeBatIconList <- function(w = 38, h = 21, anchX = 20, anchY = 20) {
iconList(CORA = makeIcon(system.file("icons", "Corynorhinus.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
COTO = makeIcon(system.file("icons", "Corynorhinus.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
EPFU = makeIcon(system.file("icons", "EPFU.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
LABO = makeIcon(system.file("icons", "LABO.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
LACI = makeIcon(system.file("icons", "LACI_LANO.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
LANO = makeIcon(system.file("icons", "LACI_LANO.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYAU = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYGR = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYLE = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYLU = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYSE = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
MYSO = makeIcon(system.file("icons", "Myotis.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
NYHU = makeIcon(system.file("icons", "NYHU.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
PESU = makeIcon(system.file("icons", "PESU.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY),
UNKN = makeIcon(system.file("icons", "UNKN.png", package = "MABM"),
iconWidth = w, iconHeight = h,
iconAnchorX = anchX, iconAnchorY = anchY))
}
set_col_types <- function(obj, types){
obj <- as.data.frame(obj)
for (i in 1:length(obj)){
FUN <- switch(types[i],
character = as.character,
numeric = as.numeric,
integer = as.integer)
obj[,i] <- FUN(obj[,i])
}
obj
}
move <- function(file, in_dir, out_dir) {
file.rename(paste(in_dir, file, sep = "/"), paste(out_dir, file, sep = "/"))
}
sequence <- function(start, end) {
mat <- cbind(start, end)
unlist(apply(mat, 1, function(x) seq(x[1], x[2], 1)))
}
clean_tabs <- function(x) gsub("[\t\n]", "", x)
dec_min <- function(call_id) {
hh <- substr(call_id, 1, 2)
# Just in case a few GPS or calls go past midnight
hh <- ifelse(as.integer(hh) < 12, as.character(as.integer(hh) + 24), hh)
mm <- substr(call_id, 3, 4)
ss <- substr(call_id, 5, 6)
as.numeric(paste0(hh, mm)) + as.numeric(ss)/60
}
yesno <- function() {
ans <- substr(readline(prompt="Would you like to set a MABM root directory (y/n)?"), 1L, 1L)
return(tolower(ans))
}
two_deep <- function(dir) {
dirs <- list.dirs(dir, recursive = FALSE)
lapply(dirs, function(i) list.dirs(i, recursive = FALSE)) %>% unlist()
}
parse_time <- function(call_id) {
call_id <- formatC(call_id, width = 6, format = "d", flag = "0")
gsub("(\\d{2})(?=\\d{2})", "\\1:", call_id, perl = TRUE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.