R/HW_index_movTRS.R

In CUG-hydro/heatwave: What the Package Does (One Line, Title Case)

#' At least k consecutive days > or ≥ T1, default is the former
#' 15-day moving sampling by year
#' @export
HW_movTRS <- function(x, date, prob,
                                  k = 1, diff = FALSE,
                                  interval = 1961:1990, equate = FALSE) {
    # if (is.matrix(x)) x <- map2_dbl(x[, 1], x[, 2], ~ heat_index(.x, .y))
    # if (all(is.na(x)) == TRUE) {
    #     return(rep(FALSE, length(x)))
    # }
    dt <- data.table(date, date_md = format(date, "%m-%d"), x)
    index <- dt[year(date) %in% interval, ]
    thr <- slide(index$x, ~.x, .before = 7, .after = 7) %>%
        set_names(index$date_md) %>%
        utils::stack() %>%
        as.data.table() %>%
        .[, .(THR = quantile(values, prob, na.rm = TRUE)), by = ind]

    dt <- dt[thr, on = .(date_md = ind)][, status := "if"(equate, x >= THR, x > THR)]
    if (diff == TRUE) {
        return(dt[, x - THR])
    }

    if (k == 1) {
        return(replace_na(dt$status, FALSE))
    }

    run <- rle(dt$status)
    run$values[run$lengths < k] <- FALSE
    inverse.rle(run)
}