R/includeTaxa.R

In mchevalier2/crestr: A Probabilistic Approach to Reconstruct Past Climates Using Palaeoecological Datasets

#' Includes the list of taxa into the reconstructions.
#'
#' Includes the list of taxa into the reconstructions.
#'
#' @param x A \code{\link{crestObj}} produced by one of the \code{\link{crest}},
#'        \code{\link{crest.get_modern_data}}, \code{\link{crest.calibrate}},
#'        \code{\link{crest.reconstruct}} or \code{\link{loo}} functions.
#' @param taxa A vector of taxa to include.
#' @param climate A vector of climate variables to link the taxa with.
#' @return Return the updated \code{\link{crestObj}}.
#' @export
#' @examples
#' data(reconstr)
#' print(reconstr$inputs$selectedTaxa)
#' reconstr <- includeTaxa(reconstr, reconstr$inputs$taxa.name, 'bio12')
#' ## All the taxa are not selected for 'bio12', except for 'Taxon7' for which
#' ## data are unavailable.
#' print(reconstr$inputs$selectedTaxa)
#'
includeTaxa <- function(x, taxa, climate) {
    if(base::missing(x)) x
    if(base::missing(taxa)) taxa
    if(base::missing(climate)) climate

    if(!is.crestObj(x)) {
        cat('\nx should be a crestObj.\n\n')
        return(invisible(NA))
    }

    err <- c()
    for(clim in climate) {
        if(! clim %in% x$parameters$climate) err <- c(err, clim)
    }
    if(length(err) > 0) {
        stop(paste0("The following variables are not available in your crestObj: '", paste(err, collapse="', '"), "'\n\n"))
        return(invisible(NA))
    }

    err <- c()
    for(tax in taxa) {
        if(! tax %in% rownames(x$input$selectedTaxa)) err <- c(err, tax)
    }
    if(length(err) > 0) {
        stop(paste0("The following taxa names are not available in your dataset: '", paste(err, collapse="', '"), "'\n\n"))
        return(invisible(NA))
    }

    for (tax in taxa) {
        for (clim in c(climate)) {
            if (x$inputs$selectedTaxa[tax, ncol(x$inputs$selectedTaxa)] >= 0 ) {
                x$inputs$selectedTaxa[tax, climate] <- rep(1, length(climate))
            }
        }
    }
    x
}


#' Excludes the list of taxa from the reconstructions.
#'
#' Excludes the list of taxa from the reconstructions.
#'
#' @param x A \code{\link{crestObj}} produced by one of the \code{\link{crest}},
#'        \code{\link{crest.get_modern_data}}, \code{\link{crest.calibrate}},
#'        \code{\link{crest.reconstruct}} or \code{\link{loo}} functions.
#' @param taxa A vector of taxa to exclude.
#' @param climate A vector of climate variables to unlink the taxa with.
#' @return Return the updated \code{\link{crestObj}}.
#' @export
#' @examples
#' data(reconstr)
#' print(reconstr$inputs$selectedTaxa)
#' reconstr <- excludeTaxa(reconstr, 'Taxon3', 'bio1')
#' ## 'Taxon3' is now excluded from the reconstruction of 'bio1'.
#' print(reconstr$inputs$selectedTaxa)
#'
excludeTaxa <- function(x, taxa, climate) {
    if(base::missing(x)) x
    if(base::missing(taxa)) taxa
    if(base::missing(climate)) climate

    if(!is.crestObj(x)) {
        cat('\nx should be a crestObj.\n\n')
        return(invisible(NA))
    }

    err <- c()
    for(clim in climate) {
        if(! clim %in% x$parameters$climate) err <- c(err, clim)
    }
    if(length(err) > 0) {
        stop(paste0("The following variables are not available in your crestObj: '", paste(err, collapse="', '"), "'\n\n"))
        return(invisible(NA))
    }

    err <- c()
    for(tax in taxa) {
        if(! tax %in% rownames(x$input$selectedTaxa)) err <- c(err, tax)
    }
    if(length(err) > 0) {
        stop(paste0("The following taxa names are not available in your dataset: '", paste(err, collapse="', '"), "'\n\n"))
        return(invisible(NA))
    }

    for (tax in taxa) {
        for (clim in c(climate)) {
          if (x$inputs$selectedTaxa[tax, ncol(x$inputs$selectedTaxa)] >= 0 ) {
                x$inputs$selectedTaxa[tax, climate] <- rep(0, length(climate))
            }
        }
    }
    x
}