WSL/SLF GitLab Repository

Commit 7846502a authored by Adrien Michel's avatar Adrien Michel
Browse files

Moved temporal pool to new file

parent 5da683bf
compute.temporal.pools.internal<- function(timestamps, time, temporal.pool)
{
lower.temporal.bound <- (time-temporal.pool) %% 365
higher.temporal.bound <- (time+temporal.pool) %% 365
if(lower.temporal.bound < higher.temporal.bound)
{
time.pool <- seq(lower.temporal.bound, higher.temporal.bound)
}else if(lower.temporal.bound == higher.temporal.bound){
time.pool <- time
}else
{
time.pool <- c(seq(lower.temporal.bound,366), seq(1,higher.temporal.bound))
}
time.pool <- which(as.integer(strftime(timestamps, format = "%j")) %in% time.pool)
return(time.pool)
}
#' Title
#'
#' @param x A
#' @param ... A
compute.temporal.pools <- function(data, params.qm, ncores=1, output.file=NULL)
{
if(!is.null(output.file)) {
if(!dir.exists(dirname(output.file))) {
stop(paste0("Output directory '",dirname(output.file),"' does not exist"))
}
else if(file.access(".", mode=2)==-1) {
stop(paste0("Output directory '",dirname(output.file),"' seems to benot writable"))
}
}
if(is.null(params.qm$temporal.pool)) {
stop("temporal.pool must to exist in params.qm")
}
#Remove useless data
data$data = NULL
timestamps <- data$time.date
if(ncores>1) {
`%dopar%` <- foreach::`%dopar%`
doParallel::registerDoParallel(ncores)
temporal.pools <- foreach::foreach(time=c(1:366)) %dopar% {
compute.temporal.pools.internal(timestamps, time,
params.qm$temporal.pool)
}
doParallel::stopImplicitCluster()
}
else {
`%do%` <- foreach::`%do%`
temporal.pools <- foreach::foreach(time=c(1:366)) %do% {
compute.temporal.pools.internal(timestamps, time,
params.qm$temporal.pool)
}
}
if(!is.null(output.file)) {
saveRDS(temporal.pools,paste0(output.file))
}
return(temporal.pools)
}
#' Title
#'
#' @param x A
......
compute.temporal.pools.internal<- function(timestamps, time, temporal.pool)
{
lower.temporal.bound <- (time-temporal.pool) %% 365
higher.temporal.bound <- (time+temporal.pool) %% 365
if(lower.temporal.bound < higher.temporal.bound)
{
time.pool <- seq(lower.temporal.bound, higher.temporal.bound)
}else if(lower.temporal.bound == higher.temporal.bound){
time.pool <- time
}else
{
time.pool <- c(seq(lower.temporal.bound,366), seq(1,higher.temporal.bound))
}
time.pool <- which(as.integer(strftime(timestamps, format = "%j")) %in% time.pool)
return(time.pool)
}
#' Title
#'
#' @param x A
#' @param ... A
compute.temporal.pools <- function(data, params.qm, ncores=1, output.file=NULL)
{
if(!is.null(output.file)) {
if(!dir.exists(dirname(output.file))) {
stop(paste0("Output directory '",dirname(output.file),"' does not exist"))
}
else if(file.access(".", mode=2)==-1) {
stop(paste0("Output directory '",dirname(output.file),"' seems to benot writable"))
}
}
if(is.null(params.qm$temporal.pool)) {
stop("temporal.pool must to exist in params.qm")
}
#Remove useless data
data$data = NULL
timestamps <- data$time.date
if(ncores>1) {
`%dopar%` <- foreach::`%dopar%`
doParallel::registerDoParallel(ncores)
temporal.pools <- foreach::foreach(time=c(1:366)) %dopar% {
compute.temporal.pools.internal(timestamps, time,
params.qm$temporal.pool)
}
doParallel::stopImplicitCluster()
}
else {
`%do%` <- foreach::`%do%`
temporal.pools <- foreach::foreach(time=c(1:366)) %do% {
compute.temporal.pools.internal(timestamps, time,
params.qm$temporal.pool)
}
}
if(!is.null(output.file)) {
saveRDS(temporal.pools,paste0(output.file))
}
return(temporal.pools)
}
Supports Markdown
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