Commit 999f16da by Conor Anderson

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!