R/DoModuleFunctions.R
In Boodogs/zoon-clone: Reproducible, Accessible & Shareable Species Distribution Modelling
# Code to run all output modules
# If not chained, we need to apply over output modules,
# covariate output or model output.
# If chained, we certainly need to apply over output modules,
# AND apply over covariate or model output.
# Options are:
# Output listed.
# Model listed (therefore model will have more outputs than process)
# Process, covariate or occurrence listed (model will have same number of
# outputs as process and list elements need to be matched.
#
# Output Chained & model listed
# Output Chained & process, covariate or occurrence listed
# FLOW:
# Not Chained
# length(output) > 1 (output is a list)
# length(output) == 1 (output isn't a list)
# length(process) == length(model) (process, covariate or occurrence is a list)
# length(process) != length(model) (model or nothing is a list)
#
# Is Chained
# length(process) == length(model) (process, covariate or occurrence is a list)
# length(process) != length(model) (model or nothing is a list)
DoOutputModules <- function(output.module, outputName, process.module,
process.output, model.output, e) {
DoOutputList <- function(x, model.output, process.output, e){
output.output <- do.call(x$func,
c(list(.model = model.output[[1]],
.ras = process.output[[1]]$ras),
x$paras), envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(model.output[[1]], 'call_path'),
output = as.character(x$module))
}
return(output.output)
}
DoOutputPairedList <- function(x, outputName, e){
output.output <- do.call(outputName[[1]]$func,
c(list(.model = x[[1]],
.ras = x[[2]]$ras),
outputName[[1]]$paras),
envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(x[[1]], 'call_path'),
output = as.character(outputName[[1]]$module))
}
return(output.output)
}
DoOutputModelList <- function(x, outputName, process.output, e){
output.output <- do.call(outputName[[1]]$func,
c(list(.model = x,
.ras = process.output[[1]]$ras),
outputName[[1]]$paras),
envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(x, 'call_path'),
output = as.character(outputName[[1]]$module))
}
return(output.output)
}
# Not chained
if(!identical(attr(output.module, 'chain'), TRUE)){
# if output is a list
if (length(output.module) > 1){
# There must be only one model and process
output.output <- lapply(outputName, FUN = DoOutputList, e = e,
model.output = model.output,
process.output = process.output)
# Otherwise model may be parallel. If not, this will still run the
# single model ok.
} else {
# Multiple models a result of list in Occ or Cov modules
if (length(process.output) == length(model.output)){
# Create a paired list of model and process output
MP.output <- list()
for(i in seq_along(1:length(process.output))){
MP.output[[i]] <- list(model.output[[i]], process.output[[i]])
}
output.output <- lapply(MP.output, FUN = DoOutputPairedList,
e = e, outputName = outputName)
} else { # there must be only one process output and multiple models
output.output <- lapply(model.output,
FUN = DoOutputModelList,
e = e,
process.output = process.output,
outputName = outputName)
}
}
# Chained
} else {
# Process, covariate or occurrence listed (model will have same number of
# outputs as process and list elements need to be matched.
if (length(process.output) == length(model.output)){
# Create a paired list of model and process output
MP.output <- list()
for(i in 1:length(process.output)){
MP.output[[i]] <- list(model.output[[i]], process.output[[i]])
}
output.output <- lapply(MP.output,
function(x) lapply(outputName,
function(y){
output.output <- DoOutputPairedList(x = x,
outputName = list(y),
e = e)
}
)
)
} else { # there must be only one process output and multiple models
output.output <- unlist(lapply(model.output,
function(y) lapply(outputName,
function(x){
output.output <- DoOutputList(x = x,
model.output = list(y),
process.output = process.output,
e = e)
})
), recursive = FALSE)
}
}
return(output.output)
}
# Do all model modules
# If listed model modules, we need to apply over models
# otherwise need to apply over process output.
# We put model function names into RunModels which runs models multiple
# times as requested by cross validation/external validation
# and predicts all test data.
DoModelModules <- function(model.module, modelName, process.output, e){
DoModelList <- function(x, e, process.output){
model.output <- do.call(RunModels,
list(df = process.output[[1]]$df,
modelFunction = x$func,
paras = x$paras,
workEnv = e
),
envir = e)
call_path <- c(attr(process.output[[1]], 'call_path'),
model = as.character(x$module))
attr(model.output, 'call_path') <- call_path
return(model.output)
}
DoModelNotList <- function(x, e, modelName){
model.output <- do.call(RunModels,
list(df = x$df,
modelFunction = modelName[[1]]$func,
paras = modelName[[1]]$paras,
workEnv = e
),
envir = e)
call_path <- c(attr(x, 'call_path'),
model = as.character(modelName[[1]]$module))
attr(model.output, 'call_path') <- call_path
return(model.output)
}
if (length(model.module) > 1){
model.output <-
lapply(modelName, FUN = DoModelList, e = e, process.output = process.output)
} else {
model.output <-
lapply(process.output, FUN = DoModelNotList, e = e, modelName = modelName)
}
return(model.output)
}
# Do all process modules
# If process is not chained, then either apply over process (for list of
# process modules) or over 'data' which is list combining data from covariate
# and occurrence modules.
# If process IS chained, then we loop through process modules putting output of
# one as input to next.
DoProcessModules <- function(process.module, processName, data, e){
DoProcessList <- function(x, e){
process.output<- do.call(x$func,
c(list(.data = data[[1]]), x$paras),
envir = e)
call_path <- list(occurrence = attr(data[[1]]$df, 'call_path')$occurrence,
covariate = attr(data[[1]]$ras, 'call_path')$covariate,
process = as.character(x$module))
attr(process.output, 'call_path') <- call_path
return(process.output)
}
DoProcessNotList <- function(x, e){
process.output <- do.call(processName[[1]]$func,
c(list(.data = x), processName[[1]]$paras),
envir = e)
call_path <- list(occurrence = attr(x$df, 'call_path')$occurrence,
covariate = attr(x$ras, 'call_path')$covariate,
process = as.character(processName[[1]]$module))
attr(process.output, 'call_path') <- call_path
return(process.output)
}
DoProcessChain <- function(x, p, e){
process.output <- do.call(processName[[p]]$func,
c(list(.data = x), processName[[p]]$paras),
envir = e)
call_path <- list(occurrence = attr(x$df, 'call_path')$occurrence,
covariate = attr(x$ras, 'call_path')$covariate)
attr(process.output, 'call_path') <- call_path
return(process.output)
}
if (!identical(attr(process.module, 'chain'), TRUE)){
if (length(processName) > 1){
process.output <- lapply(processName, FUN = DoProcessList, e = e)
} else {
process.output <- lapply(data, FUN = DoProcessNotList, e = e)
}
} else {
# If process was chained, we must loop through the process modules
# applying them to the output of the previous one.
# If covariate or occurrence was list, data will be list w/ length > 1
# so we assign data -> process.output then apply over that.
# We might want to save output of each process and return all of them
# at the end of the workflow.
process.output <- data
for(p in 1:length(processName)){
process.output <- lapply(process.output, FUN = DoProcessChain, p = p, e = e)
}
call_path_process_chain <- function(x){
attr(x, 'call_path') <- c(attr(x, 'call_path'),
process = paste('Chain(',
paste(lapply(processName, function(x) x$module),
collapse = ', '),
')', sep = ''))
return(x)
}
process.output <- lapply(process.output, call_path_process_chain)
# # add call_path for the chain
# attr(process.output, 'call_path') <- list(attr(process.output, 'call_path'),
# paste('Chain(',
# paste(processName, collapse = ', '),
# ')', sep = ''))
}
return(process.output)
}
# DoOccurrenceModule is for occurrence modules
# and is very simple. x is the name of the module
# (occurrenceName)
DoOccurrenceModule <- function(x, e){
occurrence.output <- do.call(x$func, x$paras, envir = e)
attr(occurrence.output, 'call_path') <- list(occurrence = as.character(x$module))
return(occurrence.output)
}
# DoCovariateModule is for covariate modules
# and is very simple. x is the name of the module
# (covariateName)
DoCovariateModule <- function(x, e){
covariate.output <- do.call(x$func, x$paras, envir = e)
attr(covariate.output, 'call_path') <- list(covariate = as.character(x$module))
return(covariate.output)
}
Boodogs/zoon-clone documentation built on May 6, 2019, 7:59 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Code to run all output modules
# If not chained, we need to apply over output modules,
# covariate output or model output.
# If chained, we certainly need to apply over output modules,
# AND apply over covariate or model output.
# Options are:
# Output listed.
# Model listed (therefore model will have more outputs than process)
# Process, covariate or occurrence listed (model will have same number of
# outputs as process and list elements need to be matched.
#
# Output Chained & model listed
# Output Chained & process, covariate or occurrence listed
# FLOW:
# Not Chained
# length(output) > 1 (output is a list)
# length(output) == 1 (output isn't a list)
# length(process) == length(model) (process, covariate or occurrence is a list)
# length(process) != length(model) (model or nothing is a list)
#
# Is Chained
# length(process) == length(model) (process, covariate or occurrence is a list)
# length(process) != length(model) (model or nothing is a list)
DoOutputModules <- function(output.module, outputName, process.module,
process.output, model.output, e) {
DoOutputList <- function(x, model.output, process.output, e){
output.output <- do.call(x$func,
c(list(.model = model.output[[1]],
.ras = process.output[[1]]$ras),
x$paras), envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(model.output[[1]], 'call_path'),
output = as.character(x$module))
}
return(output.output)
}
DoOutputPairedList <- function(x, outputName, e){
output.output <- do.call(outputName[[1]]$func,
c(list(.model = x[[1]],
.ras = x[[2]]$ras),
outputName[[1]]$paras),
envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(x[[1]], 'call_path'),
output = as.character(outputName[[1]]$module))
}
return(output.output)
}
DoOutputModelList <- function(x, outputName, process.output, e){
output.output <- do.call(outputName[[1]]$func,
c(list(.model = x,
.ras = process.output[[1]]$ras),
outputName[[1]]$paras),
envir = e)
if(!is.null(output.output)){
attr(output.output, 'call_path') <- c(attr(x, 'call_path'),
output = as.character(outputName[[1]]$module))
}
return(output.output)
}
# Not chained
if(!identical(attr(output.module, 'chain'), TRUE)){
# if output is a list
if (length(output.module) > 1){
# There must be only one model and process
output.output <- lapply(outputName, FUN = DoOutputList, e = e,
model.output = model.output,
process.output = process.output)
# Otherwise model may be parallel. If not, this will still run the
# single model ok.
} else {
# Multiple models a result of list in Occ or Cov modules
if (length(process.output) == length(model.output)){
# Create a paired list of model and process output
MP.output <- list()
for(i in seq_along(1:length(process.output))){
MP.output[[i]] <- list(model.output[[i]], process.output[[i]])
}
output.output <- lapply(MP.output, FUN = DoOutputPairedList,
e = e, outputName = outputName)
} else { # there must be only one process output and multiple models
output.output <- lapply(model.output,
FUN = DoOutputModelList,
e = e,
process.output = process.output,
outputName = outputName)
}
}
# Chained
} else {
# Process, covariate or occurrence listed (model will have same number of
# outputs as process and list elements need to be matched.
if (length(process.output) == length(model.output)){
# Create a paired list of model and process output
MP.output <- list()
for(i in 1:length(process.output)){
MP.output[[i]] <- list(model.output[[i]], process.output[[i]])
}
output.output <- lapply(MP.output,
function(x) lapply(outputName,
function(y){
output.output <- DoOutputPairedList(x = x,
outputName = list(y),
e = e)
}
)
)
} else { # there must be only one process output and multiple models
output.output <- unlist(lapply(model.output,
function(y) lapply(outputName,
function(x){
output.output <- DoOutputList(x = x,
model.output = list(y),
process.output = process.output,
e = e)
})
), recursive = FALSE)
}
}
return(output.output)
}
# Do all model modules
# If listed model modules, we need to apply over models
# otherwise need to apply over process output.
# We put model function names into RunModels which runs models multiple
# times as requested by cross validation/external validation
# and predicts all test data.
DoModelModules <- function(model.module, modelName, process.output, e){
DoModelList <- function(x, e, process.output){
model.output <- do.call(RunModels,
list(df = process.output[[1]]$df,
modelFunction = x$func,
paras = x$paras,
workEnv = e
),
envir = e)
call_path <- c(attr(process.output[[1]], 'call_path'),
model = as.character(x$module))
attr(model.output, 'call_path') <- call_path
return(model.output)
}
DoModelNotList <- function(x, e, modelName){
model.output <- do.call(RunModels,
list(df = x$df,
modelFunction = modelName[[1]]$func,
paras = modelName[[1]]$paras,
workEnv = e
),
envir = e)
call_path <- c(attr(x, 'call_path'),
model = as.character(modelName[[1]]$module))
attr(model.output, 'call_path') <- call_path
return(model.output)
}
if (length(model.module) > 1){
model.output <-
lapply(modelName, FUN = DoModelList, e = e, process.output = process.output)
} else {
model.output <-
lapply(process.output, FUN = DoModelNotList, e = e, modelName = modelName)
}
return(model.output)
}
# Do all process modules
# If process is not chained, then either apply over process (for list of
# process modules) or over 'data' which is list combining data from covariate
# and occurrence modules.
# If process IS chained, then we loop through process modules putting output of
# one as input to next.
DoProcessModules <- function(process.module, processName, data, e){
DoProcessList <- function(x, e){
process.output<- do.call(x$func,
c(list(.data = data[[1]]), x$paras),
envir = e)
call_path <- list(occurrence = attr(data[[1]]$df, 'call_path')$occurrence,
covariate = attr(data[[1]]$ras, 'call_path')$covariate,
process = as.character(x$module))
attr(process.output, 'call_path') <- call_path
return(process.output)
}
DoProcessNotList <- function(x, e){
process.output <- do.call(processName[[1]]$func,
c(list(.data = x), processName[[1]]$paras),
envir = e)
call_path <- list(occurrence = attr(x$df, 'call_path')$occurrence,
covariate = attr(x$ras, 'call_path')$covariate,
process = as.character(processName[[1]]$module))
attr(process.output, 'call_path') <- call_path
return(process.output)
}
DoProcessChain <- function(x, p, e){
process.output <- do.call(processName[[p]]$func,
c(list(.data = x), processName[[p]]$paras),
envir = e)
call_path <- list(occurrence = attr(x$df, 'call_path')$occurrence,
covariate = attr(x$ras, 'call_path')$covariate)
attr(process.output, 'call_path') <- call_path
return(process.output)
}
if (!identical(attr(process.module, 'chain'), TRUE)){
if (length(processName) > 1){
process.output <- lapply(processName, FUN = DoProcessList, e = e)
} else {
process.output <- lapply(data, FUN = DoProcessNotList, e = e)
}
} else {
# If process was chained, we must loop through the process modules
# applying them to the output of the previous one.
# If covariate or occurrence was list, data will be list w/ length > 1
# so we assign data -> process.output then apply over that.
# We might want to save output of each process and return all of them
# at the end of the workflow.
process.output <- data
for(p in 1:length(processName)){
process.output <- lapply(process.output, FUN = DoProcessChain, p = p, e = e)
}
call_path_process_chain <- function(x){
attr(x, 'call_path') <- c(attr(x, 'call_path'),
process = paste('Chain(',
paste(lapply(processName, function(x) x$module),
collapse = ', '),
')', sep = ''))
return(x)
}
process.output <- lapply(process.output, call_path_process_chain)
# # add call_path for the chain
# attr(process.output, 'call_path') <- list(attr(process.output, 'call_path'),
# paste('Chain(',
# paste(processName, collapse = ', '),
# ')', sep = ''))
}
return(process.output)
}
# DoOccurrenceModule is for occurrence modules
# and is very simple. x is the name of the module
# (occurrenceName)
DoOccurrenceModule <- function(x, e){
occurrence.output <- do.call(x$func, x$paras, envir = e)
attr(occurrence.output, 'call_path') <- list(occurrence = as.character(x$module))
return(occurrence.output)
}
# DoCovariateModule is for covariate modules
# and is very simple. x is the name of the module
# (covariateName)
DoCovariateModule <- function(x, e){
covariate.output <- do.call(x$func, x$paras, envir = e)
attr(covariate.output, 'call_path') <- list(covariate = as.character(x$module))
return(covariate.output)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.