#' @include mortalityTable.R mortalityTable.period.R
NULL

#' Class mortalityTable.ageShift - Cohort life tables generated by age-shift
#'
#' A cohort life table, obtained by age-shifting from a given base table (death probabilities
# for a base birth year)
#'
#' @slot ageShifts  A \code{data.frame} with columns \code{YOB} and \code{shifts} giving the age shifts for each birth year
#'
#' @examples
#' mortalityTables.load("Austria_Annuities_AVOe2005R")
#' tb = mortalityTable.ageShift(
#'     ages = ages(AVOe2005R.male),
#'     deathProbs = deathProbabilities(AVOe2005R.male, YOB = 1992),
#'     ageShifts = generateAgeShift(1, c(1962, 1985, 2000, 2015, 2040, 2070)))
#' # The cohort tables for different birth years are just the base probabilities with modified ages
#' plot(getCohortTable(tb, YOB = 1963), getCohortTable(tb, YOB = 2017))
#'
#' @export mortalityTable.ageShift
#' @exportClass mortalityTable.ageShift
mortalityTable.ageShift = setClass(
    "mortalityTable.ageShift",
    slots = list(
        ageShifts = "data.frame"
    ),
    prototype = list(
        ageShifts = data.frame(from = c(), to = c(), shift = c())
    ),
    contains = "mortalityTable.period"
)

#' Generate data.frame containing age shifts for each birth year
#'
#' Generate a dataframe suitable to be passed to the mortalityTable.ageShift
#' class.
#'
#' @param initial Age shift for the first birth year given in the \code{YOBs} vector
#' @param YOBs    Vector of birth years in which the age shift changes by \code{step}.
#' The last entry gives the first birth year that does not have any shift defined
#' any more. If the first entry is \code{NA}, all earlier years get the initial
#' age shift, if the last entry is \code{NA}, all later years get the final
#' age-shift.
#' @param step    How much the age shift changes in each year given in the \code{YOBs} vector
#'
#' @examples
#' generateAgeShift(initial = 1, YOBs = c(1922, 1944, 1958, 1973, 1989, 2006, 2023, 2041, 2056))
#' generateAgeShift(initial = 3, YOBs = c(NA, 1944, 1958, 1973, 1989, 2006, 2023, 2041, 2056))
#' generateAgeShift(initial = 3, YOBs = c(NA, 1944, 1958, 1973, 1989, 2006, 2023, 2041, 2056, NA))
#'
#' @export
generateAgeShift = function(initial = 0, YOBs = c(1900, 2100), step = -1) {
    data.frame(
        from = head(YOBs, -1),
        to = YOBs[-1] - 1,
        shift = seq(initial, length.out = length(YOBs) - 1, by = step)
    )
}

find.flights = function(v) {
    vals = sort(v)
    # Index of all values, where the next is not consecutive
    non.consec = diff(vals) != 1
    # Prepend TRUE so indicate the beginning, the rest is shifted by one index!
    data.frame(
        from = vals[c(TRUE, non.consec)],
        to = vals[c(non.consec, TRUE)]
    )
}

#' @export
generateAgeShiftFromTable = function(shifts) {
    if (!"YOB" %in% colnames(shifts) || !"shift" %in% colnames(shifts)) {
        warning("generateAgeShiftFromTable expects a data frame with columns \"YOB\" and \"shift\". Data frame has columns: \"", paste(colnames(shifts), collapse = "\", \""), "\"")
        return();
    }
    shifts = dplyr::filter(shifts, !is.na(shift), !is.na(YOB)) %>%
        dplyr::select(YOB, shift)
    shifts %>%
        dplyr::group_by(shift) %>%
        do(find.flights(.$YOB)) %>%
        dplyr::select(from, to, shift) %>%
        dplyr::arrange(from)
}



