R/class-raster2.R

In kongdd/CMIP5tools: Functions to Tidy and Analysis CMIP5/6 Data

# ' Class of `HWindex`
# ' 
#' @importFrom methods isGeneric
HWindex <- function(x, ...) {
    if (!isGeneric("HWindex")) UseMethod("HWindex")
}

#' Combine raster2 objects
#' 
#' `year_start` of `r1` must be earlier than that of `r2`
#' 
#' @param r1,r2 `raster2` object
#' @param year_begin integer
#' @param year_end integer
#' 
#' @keywords internal
#' @export
combine_raster2 <- function(r1, r2, year_begin = NULL, year_end = NULL){
    year1 <- r1$HW$year
    year2 <- r2$HW$year
    
    year_end1 <- last(year1)
    if (is.null(year_begin)) year_begin <- first(year1)
    if (is.null(year_end)) year_end <- last(year1)

    if (year_end1 >= year_end) {
        ok("historial is already complete.\n")
        res <- filter_raster2(r1, year_begin, year_end)
    } else {
        l1 <- filter_raster2(r1, year_begin, year_end1)
        l2 <- filter_raster2(r2, year_end1+1, year_end)
        # index
        HW <- foreach(x1 = l1$HW[1:6], x2 = l2$HW[1:6]) %do% {
            # probs
            foreach(mat1 = x1, mat2 = x2) %do% {
                cbind(mat1, mat2)
            }
        }
        HW$year  <- c(l1$year, l2$year)
        T_annual <- cbind(r1$T_annual[, year1 >= year_begin & year1 <= year_end1], 
            r2$T_annual[, year2 > year_end1 & year2 <= year_end])
        grid <- r1[intersect(c("grid", "grid.origin"), names(r1))]
        res  <- c(grid, listk(HW, T_annual)) %>% structure(class = "raster2")
    }
    res
}

#' combine_HWindex
#' 
#' @inheritParams combine_raster2
#' @param HW1,HW2 `HW` object
#' 
#' @keywords internal
#' @export
combine_HWindex <- function(HW1, HW2, year_begin = NULL, year_end = NULL){
    year1 <- HW1$year
    year2 <- HW2$year
    
    year_end1 <- last(year1)
    
    if (is.null(year_begin)) year_begin <- first(year1)
    if (is.null(year_end)) year_end <- last(year1)
    
    if (year_end1 >= year_end) {
        ok("historial is already complete.\n")
        res <- filter_HWindex(HW1, year_begin, year_end)
    } else {
        l1 <- filter_HWindex(HW1, year_begin, year_end1)
        l2 <- filter_HWindex(HW2, year_end1+1, year_end)
        # index
        res <- foreach(x1 = l1[1:6], x2 = l2[1:6]) %do% {
            # probs
            foreach(mat1 = x1, mat2 = x2) %do% {
                cbind(mat1, mat2)
            }
        }
        res$year <- c(l1$year, l2$year)
    }
    res
}

#' @param HW child element of `raster2` objected, returned by `FUN_HW_index`
#' @rdname combine_HWindex
#' @export
filter_HWindex <- function(HW, year_begin = NULL, year_end = NULL){
    year <- HW$year
    
    if (is.null(year_begin) && is.null(year_end)) {
        return(HW)
    } else if (is.null(year_begin)) {
        year_begin <- first(year)
    } else if (is.null(year_end)) {
        year_end <- last(year)
    } 
    
    # if select all time-series
    if (year_begin == 1 && year_end == last(year)) {
        return(HW)
    }
    
    I <- year >= year_begin & year <= year_end
    HW[1:6] %<>% map(function(lst){
        map(lst, ~.[, I])
    })
    HW$year <- year[I]
    HW
}

#' @param r `raster2` object
#' @rdname combine_raster2
#' @export
filter_raster2 <- function(r, year_begin = NULL, year_end = NULL){
    year <- r$HW$year
    
    if (is.null(year_begin) && is.null(year_end)) {
        return(HW)
    } else if (is.null(year_begin)) {
        year_begin <- first(year)
    } else if (is.null(year_end)) {
        year_end <- last(year)
    } 
    
    # if select all time-series
    if (year_begin == 1 && year_end == last(year)) {
        return(x)
    }
    
    I <- year >= year_begin & year <= year_end
    r$HW[1:6] %<>% map(function(lst){
        map(lst, ~.[, I])
    })
    r$HW$year <- year[I]
    r$T_annual %<>% .[, I]
    r
}