###Fuction to create categories for random recording selection
###Can specify times only or dates only if needed
#' Categorize recording data based on dates/times
#'
#'
#' @param data Selection data.frame.
#' @param category.name String of what you want to call your category. Example: "Early Morning".
#' @param start.date Start date for given category. Defaults to min date. Accepts multiple inputs including column name of a calculated field. Has to be numeric yday, string in "YYYY-MM-DD" format, Date format, or POSIXct.
#' @param end.date End date for given category. Defaults to max date. Accepts multiple inputs including column name of a calculated field. Has to be numeric yday, string in "YYYY-MM-DD" format, Date format, or POSIXct.
#' @param start.time Start time for a given category. Defaults to min time. Accepts multiple inputs including column name of a calculated field. Has to be a string in "hh:mm:ss" format, hms format, or POSIXct.
#' @param end.time End time for a given category. Defaults to max time. Accepts multiple inputs including column name of a calculated field. Has to be a string in "hh:mm:ss" format, hms format, or POSIXct.
#' @return A data.frame with a category column of defined categories.
#' @keywords wav, categorize, get, recordings
#' @export
#' @examples
#' data %>% dplyr::group_by(location) %>% dplyr::mutate(category=NA) %>% categorize("EN","2017-16-01","2017-16-15","22:00:00","23:59:00")
categorize <- function(data,category.name, start.date, end.date, start.time, end.time){
if(!"datetime" %in% colnames(data)) stop("The datatime column is missing from your data file and is needed to get suncalc times.")
##date vars
#startdate
if(missing(start.date)){
startdate <- min(lubridate::yday(data$datetime))
} else {
if(rlang::is_symbol(substitute(start.date)) & as.character(substitute(start.date)) %in% colnames(data)){
startdate <- enquo(start.date)
} else {
if(is.character(start.date)){
startdate <- lubridate::yday(ymd(start.date))
}
else {
if(lubridate::is.Date(start.date)){
startdate <- lubridate::yday((start.date))
} else {
if(is.POSIXct(start.date)){
startdate <- lubridate::yday((start.date))
} else {
if(start.date %% 1==0){
if(start.date < 367) stop("Your start.date yday value is greater than 366 which is out of bounds for a year.")
startdate <-start.date
} else {
stop("Your start.date value needs to be either a column name, character, date format (yyyy-mm-dd), POSIXct, or integer.")}
}
}
}
}
}
### end date
if(missing(end.date)){
enddate <- max(lubridate::yday(data$datetime))
} else {
if(rlang::is_symbol(substitute(end.date)) & as.character(substitute(end.date)) %in% colnames(data)){
enddate <- enquo(end.date)
} else {
if(is.character(end.date)){
enddate <- lubridate::yday(ymd(end.date))}
else {
if(lubridate::is.Date(end.date)){
enddate <- lubridate::yday((end.date))
} else {
if(is.POSIXct(end.date)){
enddate <- lubridate::yday((end.date))
} else {
if(end.date %%1==0){
if(end.date < 367) stop("Your end.date yday value is greater than 366 which is out of bounds for a year.")
startdate <-start.date
enddate <- end.date
} else {
stop("Your end.date value needs to be either a column name, character, date format (yyyy-mm-dd), POSIXct, or integer.")}
}
}
}
}
}
#### Time vars
#starttime
if(missing(start.time)){
starttime <- hms::as_hms(min(hms::as_hms(data$datetime)))
} else {
if(rlang::is_symbol(substitute(start.time)) & as.character(substitute(start.time)) %in% colnames(data)){
starttime <- enquo(start.time)
} else {
if(is.character(start.time)){
if(nchar(start.time) !=8) stop("The start.time character string must be in hh:mm:ss format in order to work (e.g. 04:00:00)")
starttime <- hms::as_hms((start.time))}
else {
if(hms::is_hms(start.time)){
starttime <- start.time
} else {
if(is.POSIXct(start.time)){
starttime <- hms::as_hms(start.time)
} else {
stop("Your start.time needs to be in character,hms format (hh:mm:ss), or POSIXct to work.")}
}
}
}
}
##endtime
if(missing(end.time)){
endtime <- hms::as_hms(max(hms::as_hms(data$datetime)))
} else {
if(rlang::is_symbol(substitute(end.time)) & as.character(substitute(end.time)) %in% colnames(data)){
endtime<- enquo(end.time)
} else {
if(is.character(end.time)){
if(nchar(end.time) !=8 ) stop("The end.time character string must be in hh:mm:ss format in order to work (e.g. 04:00:00)")
endtime <- hms::as_hms((end.time))}
else {
if(hms::is_hms(end.time)){
endtime <- end.time
} else {
if(is.POSIXct(end.time)){
endtime <- hms::as_hms((end.time))
} else {
stop("Your end.time needs to be in character,hms format (hh:mm:ss), or POSIXct to work.")}
}
}
}
}
if(!"category" %in% colnames(data)){
dplyr::mutate(data,category = ifelse(!!starttime > !!endtime,
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate && lubridate::yday(datetime)<= !!enddate &&
(hms::as_hms(datetime) >= !!starttime || hms::as_hms(datetime) <= !!endtime) ~ category.name ),
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate && lubridate::yday(datetime)<= !!enddate &&
(hms::as_hms(datetime) >= !!starttime && hms::as_hms(datetime) <= !!endtime) ~ category.name )))
}
else {
existingcat <- data$category
newdata <- data %>% dplyr::mutate(newcat = ifelse(!!starttime > !!endtime,
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate & lubridate::yday(datetime)<= !!enddate &
(hms::as_hms(datetime) >= !!starttime | hms::as_hms(datetime) <= !!endtime) ~ category.name ),
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate & lubridate::yday(datetime)<= !!enddate &
hms::as_hms(datetime) >= !!starttime & hms::as_hms(datetime) <= !!endtime ~ category.name )))
newcat <- newdata$newcat
for (i in 1:nrow(data)) {
if(!any(is.na(existingcat[i]),is.na(newcat[i]))){warning(paste0('Your categories contain overlaps for the location ',
data$location[i]," and categories ", existingcat[i], " & ",newcat[i], ". Categories will not be overwritten if previously defined." ))}
}
dplyr::mutate(data,category = ifelse(is.na(category),ifelse(!!starttime > !!endtime,
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate & lubridate::yday(datetime)<= !!enddate &
(hms::as_hms(datetime) >= !!starttime | hms::as_hms(datetime) <= !!endtime) ~ category.name ),
dplyr::case_when(
lubridate::yday(datetime) >= !!startdate & lubridate::yday(datetime)<= !!enddate &
hms::as_hms(datetime) >= !!starttime & hms::as_hms(datetime) <= !!endtime ~ category.name )),category))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.