...
 
Commits (1)
Package: claut
Type: Package
Title: Functions from the University of Toronto Climate Lab
Version: 0.1.6
Version: 0.1.7
Date: 2018-04-17
Authors@R: c(person(given = c("Conor", "I."), family = "Anderson",
role = c("aut","cre"), email = "conor.anderson@utoronto.ca"),
......
......@@ -13,9 +13,11 @@ importFrom(doParallel,registerDoParallel)
importFrom(dplyr,"%>%")
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows)
importFrom(dplyr,case_when)
importFrom(dplyr,filter)
importFrom(dplyr,group_by)
importFrom(dplyr,group_indices)
importFrom(dplyr,inner_join)
importFrom(dplyr,lead)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
......@@ -29,6 +31,7 @@ importFrom(gdata,unmatrix)
importFrom(iterators,icount)
importFrom(lpSolve,lp)
importFrom(lubridate,date)
importFrom(lubridate,days)
importFrom(lubridate,force_tz)
importFrom(lubridate,hours)
importFrom(parallel,detectCores)
......
......@@ -13,8 +13,8 @@
#'
#' @return A table of class \code{\link{tbl_df}}.
#'
#' @importFrom dplyr %>% bind_cols filter lead left_join mutate select summarize
#' @importFrom lubridate date hours
#' @importFrom dplyr %>% bind_cols case_when filter inner_join lead left_join mutate select summarize
#' @importFrom lubridate date days hours
#' @importFrom rlang .data
#' @importFrom tibble tibble
#'
......@@ -23,37 +23,59 @@
COW_ND <- function(dat, lat, lon, tz, stimes = FALSE, ...) {
date <- date(dat[[1]]) %>% unique() %>% sort()
periods <- tibble(Date = date) %>%
if (names(dat)[1] != "DateTime") names(dat)[1] <- "DateTime"
periods <- tibble(Date = date(dat$DateTime) %>% unique() %>% sort()) %>%
mutate(start = suntimes(lat, lon, tz, .data$Date, "sunrise") + hours(1),
middle = suntimes(lat, lon, tz, .data$Date, "sunset"),
middle = suntimes(lat, lon, tz, .data$Date, "sunset") + hours(1),
end = lead(.data$start))
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)
}
all_periods <- inner_join(
select(dat, .data$DateTime) %>% mutate(Date = date(.data$DateTime)),
periods,
by = "Date"
)
all_periods <- mutate(all_periods, Period = case_when(
.data$start <= .data$DateTime & .data$middle >= .data$DateTime ~ "Day",
.data$middle <= .data$DateTime & .data$end >= .data$DateTime ~ "Night",
TRUE ~ as.character(NA)))
all_periods$Date[is.na(all_periods$Period) & all_periods$Date != max(all_periods$Date)] <- all_periods$Date[is.na(all_periods$Period) & all_periods$Date != max(all_periods$Date)] - days(1)
all_periods$Period[is.na(all_periods$Period) & all_periods$Date != max(all_periods$Date)] <- "Night"
all_periods$Date[is.na(all_periods$Period) & all_periods$DateTime <= max(all_periods$end, na.rm = TRUE)] <- all_periods$Date[is.na(all_periods$Period) & all_periods$DateTime <= max(all_periods$end, na.rm = TRUE)] - days(1)
all_periods$Period[is.na(all_periods$Period) & all_periods$DateTime <= max(all_periods$end, na.rm = TRUE)] <- "Night"
maxs <- dat %>% select(-mingrp) %>%
filter(!is.na(.data$maxgrp)) %>% group_by(.data$maxgrp) %>%
summarize_all(max, ...) %>% select(-2)
vals <- bind_cols(
select(all_periods, .data$Date, .data$Period),
select(dat, -.data$DateTime))
maxs <- vals %>% filter(.data$Period == "Day") %>%
group_by(.data$Date, .data$Period) %>%
summarize_all(max, ...) %>% select(-.data$Period)
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)
mins <- vals %>% filter(.data$Period == "Night") %>%
group_by(.data$Date, .data$Period) %>%
summarize_all(min, ...) %>% select(-.data$Period)
names(mins)[2:ncol(mins)] <- paste0("Min", names(mins)[2:ncol(mins)])
mins <- mins[-1,]
means <- vals %>% select(-.data$Period) %>%
group_by(.data$Date) %>%
summarize_all(mean, ...)
names(means)[2:ncol(means)] <- paste0("Mean", names(means)[2:ncol(means)])
means <- means[c(-1,-nrow(means)),]
period_tab <- if (isTRUE(stimes)) {
select(periods, Date, Sunrise = .data$start, Sunset = .data$middle) %>%
mutate(Sunrise = .data$Sunrise - 3600)
select(periods, .data$Date, Sunrise = .data$start, Sunset = .data$middle) %>%
mutate(Sunrise = .data$Sunrise - hours(1),
Sunset = .data$Sunset - hours(1))
} else {
select(periods, Date)
select(periods, .data$Date)
}
bind_cols(
period_tab,
left_join(maxs, mins, by = c("maxgrp" = "mingrp")) %>% select(-maxgrp)
)
left_join(period_tab,
left_join(maxs, mins, by = "Date") %>%
left_join(., means, by = "Date"), by = "Date")
}