Fix vectorization of chk2time (suntimes) and optimize COW_ND.

parent e5c06ceb
Pipeline #26496121 passed with stages
in 16 minutes and 20 seconds
......@@ -11,17 +11,17 @@ export(suntimes)
export(trimData)
importFrom(doParallel,registerDoParallel)
importFrom(dplyr,"%>%")
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows)
importFrom(dplyr,filter)
importFrom(dplyr,group_by)
importFrom(dplyr,group_indices)
importFrom(dplyr,lead)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,rowwise)
importFrom(dplyr,select)
importFrom(dplyr,summarize)
importFrom(dplyr,summarize_all)
importFrom(dplyr,ungroup)
importFrom(foreach,"%do%")
importFrom(foreach,"%dopar%")
importFrom(foreach,foreach)
......@@ -30,6 +30,7 @@ importFrom(iterators,icount)
importFrom(lpSolve,lp)
importFrom(lubridate,date)
importFrom(lubridate,force_tz)
importFrom(lubridate,hours)
importFrom(parallel,detectCores)
importFrom(parallel,makeCluster)
importFrom(parallel,stopCluster)
......
......@@ -2,63 +2,58 @@
#'
#' Calculates daily maxima and minima after \insertCite{zaknic-catovic_2018_comparison}{claut}
#'
#' @param dat data frame; the data to analyze; the first column must be date times; subsequent columns should contain for which to detect extremes
#' @param lat numeric; the latitude of the observer
#' @param lon numeric; the longitude of the observer
#' @param tz integer; the number of hours shifted from GMT, e.g. for GMT-5, pass \code{-5}
#' @param datetime POSIXct; vector of date times that correspond to the vector \code{var}
#' @param var numeric; a vector of observations for which maxima and minima should be determined
#' @param ... additional parameters to pass to \code{\link{registerDoParallel}}
#' @param stimes Boolean; whether the sunrise and sunset should be included in the results table
#' @param ... additional parameters to pass to \code{\link{max}} and \code{\link{min}}, e.g. \code{na.rm = TRUE}
#'
#' @source \insertRef{zaknic-catovic_2018_comparison}{claut}
#'
#' @return A table of class \code{\link{tbl_df}}.
#'
#' @importFrom dplyr %>% filter mutate rowwise summarize ungroup
#' @importFrom doParallel registerDoParallel
#' @importFrom foreach %dopar%
#' @importFrom lubridate date
#' @importFrom dplyr %>% bind_cols filter lead left_join mutate select summarize
#' @importFrom lubridate date hours
#' @importFrom rlang .data
#' @importFrom tibble tibble
#'
#' @export
#'
COW_ND <- function(lat, lon, tz, datetime, var, ...) {
COW_ND <- function(dat, lat, lon, tz, stimes = FALSE, ...) {
date <- date(datetime) %>% unique() %>% sort()
tib <- tibble(Date = date) %>%
rowwise %>%
mutate(period_start = suntimes(lat, lon, tz, Date, "sunrise"),
period_middle = suntimes(lat, lon, tz, Date, "sunset")) %>%
ungroup() %>%
mutate(period_start = period_start + hours(1),
period_end = lead(period_start))
date <- date(dat[[1]]) %>% unique() %>% sort()
periods <- tibble(Date = date) %>%
mutate(start = suntimes(lat, lon, tz, .data$Date, "sunrise") + hours(1),
middle = suntimes(lat, lon, tz, .data$Date, "sunset"),
end = lead(.data$start))
tib2 <- tibble(DateTime = datetime, Var = var)
for (i in 1:length(date)) {
suppressWarnings(dat$maxgrp[dat[[1]] >= periods$start[i] &
dat[[1]] <= periods$middle[i]] <- i)
suppressWarnings(dat$mingrp[dat[[1]] >= periods$middle[i] &
dat[[1]] <= periods$end[i]] <- i)
}
registerDoParallel(...)
maxs <- dat %>% select(-mingrp) %>%
filter(!is.na(.data$maxgrp)) %>% group_by(.data$maxgrp) %>%
summarize_all(max, ...) %>% select(-2)
names(maxs)[2:ncol(maxs)] <- paste0("Max", names(maxs)[2:ncol(maxs)])
mins <- dat %>% select(-maxgrp) %>%
filter(!is.na(.data$mingrp)) %>% group_by(.data$mingrp) %>%
summarize_all(min, ...) %>% select(-2)
names(mins)[2:ncol(mins)] <- paste0("Min", names(mins)[2:ncol(mins)])
results <- foreach(i = icount(length(date)),
.combine = "rbind",
.packages = "dplyr") %dopar% {
start = tib$period_start[i]
middle = tib$period_middle[i]
end = tib$period_end[i]
period_tab <- if (isTRUE(stimes)) {
select(periods, Date, Sunrise = .data$start, Sunset = .data$middle) %>%
mutate(Sunrise = .data$Sunrise - 3600)
} else {
select(periods, Date)
}
max <- tib2 %>% filter(DateTime >= start &
DateTime <= middle) %>%
summarize(Tmax = max(Var)) %>% unlist()
min <- ifelse(is.na(end), NA,
tib2 %>% filter(DateTime >= middle &
DateTime <= end) %>%
summarize(Tmin = min(Var)) %>% unlist())
tibble(
Date = date[i],
Sunrise = start - 3600,
Sunset = middle,
Max = max,
Min = min
)
}
results
bind_cols(
period_tab,
left_join(maxs, mins, by = c("maxgrp" = "mingrp")) %>% select(-maxgrp)
)
}
......@@ -33,15 +33,14 @@ suntimes <- function(lat, lon, tz, date, out = c("sunrise", "solar_noon", "sunse
chk2time <- function(chk, tz) {
remainder <- chk * 24
hours <- remainder %/% 1
hrs <- sprintf("%02d", remainder %/% 1)
remainder <- (remainder %% 1) * 60
minutes <- remainder %/% 1
mins <- sprintf("%02d", remainder %/% 1)
remainder <- (remainder %% 1) * 60
seconds <- remainder %/% 1
as.POSIXct(
paste(date,
paste(sprintf("%02d", c(hours, minutes, seconds)),
collapse = ":")), tz = paste0("Etc/GMT", tz))
secs <- sprintf("%02d", remainder %/% 1)
as.POSIXct(paste(date,
paste(hrs, mins, secs, sep = ":")),
tz = paste0("Etc/GMT", tz))
}
jdate <- julian(date, -2440588)
......
......@@ -7,20 +7,20 @@
\insertRef{zaknic-catovic_2018_comparison}{claut}
}
\usage{
COW_ND(lat, lon, tz, datetime, var, ...)
COW_ND(dat, lat, lon, tz, stimes = FALSE, ...)
}
\arguments{
\item{dat}{data frame; the data to analyze; the first column must be date times; subsequent columns should contain for which to detect extremes}
\item{lat}{numeric; the latitude of the observer}
\item{lon}{numeric; the longitude of the observer}
\item{tz}{integer; the number of hours shifted from GMT, e.g. for GMT-5, pass \code{-5}}
\item{datetime}{POSIXct; vector of date times that correspond to the vector \code{var}}
\item{var}{numeric; a vector of observations for which maxima and minima should be determined}
\item{stimes}{Boolean; whether the sunrise and sunset should be included in the results table}
\item{...}{additional parameters to pass to \code{\link{registerDoParallel}}}
\item{...}{additional parameters to pass to \code{\link{max}} and \code{\link{min}}, e.g. \code{na.rm = TRUE}}
}
\value{
A table of class \code{\link{tbl_df}}.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment