# This R package is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This R package is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this R package; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA  02111-1307  USA


################################################################################
# FUNCTION:             DESCRIPTION:
#  timeDate              Creates a 'timeDate' object from given dates
#  setMethod("timeDate", "character",
#  setMethod("timeDate", "timeDate",
#  setMethod("timeDate", "POSIXt",
#  setMethod("timeDate", "Date",
#  setMethod("timeDate", "numeric",
#  setMethod("timeDate", "missing",
#  setMethod("timeDate", "ANY",
# FUNCTION:
#  .formatFinCenter      Internal called by timeDate
#  strptimeDate          Creates for character time stamps a 'timeDate' object
################################################################################


setGeneric("timeDate",
           function(charvec, format = NULL, zone = "", FinCenter = "", ...)
{
    # A function implemented by Yohan Chalabi and Diethelm Wuertz

    # Description:
    #   Creates a "timeDate' object from a character vector

    # Arguments:
    #   charvec - a character vector of dates and times. Alternatively
    #       it may be a 'timeDate', a 'Date', or a 'POSIXt' object. In
    #       these cases the argument will be coerced into a character
    #       string or character vector.
    #   format - the format specification of the input character
    #       vector. If set to NULL autodetection will be tried.
    #   zone - the time zone or financial center where the data
    #       were recorded.
    #   FinCenter - a character string with the the location of
    #       the financial center named as "continent/city" where the
    #       data will be used.

    # Value:
    #   Returns a S4 object of class 'timeDate'.

    # Note:
    #   Changeover DST not yet fully implemented!

    # Examples:
    #   timeDate("2004-01-01")
    #   timeDate(c("2004-01-01", "2004-01-01"))
    #   timeDate("2004-01-01 00:00:00")
    #   timeDate("20040101")
    #   timeDate("200401011600")
    #   timeDate("20040101000000")
    #   timeDate("1/1/2004") # American format
    #   timeDate("2004-01-01", FinCenter = "GMT")
    #   timeDate("20040101", FinCenter = "GMT")
    #   td = timeDate("2004-01-01", FinCenter = "GMT"); timeDate(td)
    #   td = timeDate("20040101", FinCenter = "GMT"); timeDate(td)


    standardGeneric("timeDate")
}
)

setMethod("timeDate", "character",
          function(charvec, format = NULL, zone = "", FinCenter = "", dst_gap = "+")
{
    # Settings and Checks:
    if (zone == "")
        zone <- getRmetricsOptions("myFinCenter")
    if (FinCenter == "")
        FinCenter <- getRmetricsOptions("myFinCenter")

    ## 2023-12-15 GNB: return empty 'timeDate' (it was returning NA timeDate before when
    ##                 'format' was missing but empty timeDate if format was specified);
    ##                 also, brings it in line with numeric and other 'charvec' of length 0,
    ##                 which do return 0-length objets.
    if(!length(charvec)) {
        charvec <- as.POSIXct(charvec, origin = "1970-01-01", tz = "GMT")
        ## callGeneric()
        return(timeDate(charvec, zone = zone, FinCenter = FinCenter))
    }

    # ISO Date/Time Format:
    isoDate   <- "%Y-%m-%d"
    isoFormat <- "%Y-%m-%d %H:%M:%S"

    # Autodetect Format :
    if (is.null(format))
        ## 2023-12-09 GNB:
        ##     whichFormat(charvec[1])
        ## fails if charvec[1] is NA, even if otherwise the strings are uniform,
        ## call whichFormat with the whole vector:
        format <- whichFormat(charvec)
    if (format %in% c("unknown", "counts")) #-> "counts" catch potential problems from timeSeries
        return(timeDate(NA, zone = zone, FinCenter = FinCenter))

    # Midnight Standard & conversion to isoFormat:
    ct <- midnightStandard2(charvec, format)

    ## Do conversion
    ## YC: .formatFinCenterNum faster than .formatFinCenter
    ## TS: using zone is correct (charvec is converted to GMT)
    num <- .formatFinCenterNum(unclass(ct), zone, type = "any2gmt", dst_gap = dst_gap)

    ## Manually create the POSIXct object:
    ## it is important to set manually the tzone flag,
    num <-
        if (getRversion() >= "2.12.0")
            .POSIXct(num, "GMT")
        else
            structure(num, class = c("POSIXt", "POSIXct"), tzone = "GMT")

    new("timeDate",
        Data = num,
        # Note format is automatically created in
        # initialize,timeDate-method
        FinCenter = as.character(FinCenter))
}
)


setMethod("timeDate", "timeDate",
    function(charvec, format = NULL, zone = "", FinCenter = "", dst_gap = "+")
{
    # Description:
    #   timeDate

    # if zone not provided, change only the FinCenter in charvec (timeDate)
    if (zone == "") {
        if (FinCenter != "")
            finCenter(charvec) <- FinCenter
        charvec
    } else {
        callGeneric(format(charvec), zone = zone, FinCenter = FinCenter, dst_gap = dst_gap)
    }
}
)


setMethod("timeDate", "POSIXt",
    function(charvec, format = NULL, zone = "", FinCenter = "")
{
    # Description:
    #   POSIXt

    if (!(zone %in% c("", "GMT", "UTC"))) {
        callGeneric(format(charvec), zone = zone, FinCenter = FinCenter)
    } else {

        # Since zone is not provided consider that charvec is in GMT
        charvec <- as.POSIXct(charvec)
        attr(charvec, "tzone") <- "GMT"

        # FinCenter
        if (FinCenter == "")
            FinCenter = getRmetricsOptions("myFinCenter")

        new("timeDate",
            Data = charvec,
            # Note format is automatically created in
            # initialize,timeDate-method
            FinCenter = as.character(FinCenter))
    }
}
)


setMethod("timeDate", "Date",
    function(charvec, format = NULL, zone = "", FinCenter = "", dst_gap = "+")
{
    # Description:
    #   Date

    if (!(zone %in% c("", "GMT", "UTC"))) {
        callGeneric(format(charvec), zone = zone, FinCenter = FinCenter, dst_gap = dst_gap)
    } else {

        # Since zone is not provided consider that charvec is in GMT
        charvec <- as.POSIXct(charvec)
        attr(charvec, "tzone") <- "GMT"

        # FinCenter
        if (FinCenter == "")
            FinCenter = getRmetricsOptions("myFinCenter")

        new("timeDate",
            Data = charvec,
            # Note format is automatically created in
            # initialize,timeDate-method
            FinCenter = as.character(FinCenter))
    }
})


setMethod("timeDate", "numeric",
    function(charvec, format = NULL, zone = "", FinCenter = "")
{
    # Description:
    #   numeric

    # DW: Modification of setMethod("timeDate", "numeric") to handle
    #   decimal like inputs (exactly that what "yearmon" does)

    if (!is.null(format) & (format == "%Y" || format == "yearmon" )) {
        # DW: Handles what is known as yearmon format
        # Example:     timeDate(2008+seq(0, 23, by = 1)/12, "yearmon")
        #   Quarterly: timeDate(2008+seq(2, 23, by = 3)/12, format = "%Y")
        # The next 4 lines are borrowed from Zeileis' yearmon()
        year <- floor(charvec + 0.001)
        month <- floor(12 * (charvec - year) + 1 + 0.5 + 0.001)
        dd.start <- as.Date(paste(year, month, 1, sep = "-"))
        # here we concentrate to the end of month date ...
        dd.end <- dd.start + 32 - as.numeric(format(dd.start + 32, "%d"))
        charvec <- as.POSIXct(dd.end, origin = "1970-01-01", tz = "GMT")
    } else {
        charvec <- as.POSIXct(charvec, origin = "1970-01-01", tz = "GMT")
    }

    callGeneric()
}
)


setMethod("timeDate", "missing",
    function(charvec, format = NULL, zone = "", FinCenter = "")
{
    # Description:
    #   missing

    callGeneric(Sys.time(), format, zone, FinCenter)
}
)

setMethod("timeDate", "ANY",
    function(charvec, format = NULL, zone = "", FinCenter = "", dst_gap = "+")
{
    callGeneric(as.character(charvec), format, zone, FinCenter, dst_gap = dst_gap)
}
)


################################################################################

.formatFinCenterNum <-
function(num, FinCenter, type = c("gmt2any", "any2gmt"), dst_gap = c("+", "-", "NA", ""))
{
    ## A function implemented by Diethelm Wuertz and Yohan Chalabi.
    ##
    ## Modified by GNB to work correctly around DST changes and documented below
    ## to easy further maintenance. Also added options to treat non-existent DST
    ## times (gaps) at the time of switching to DST.
    ##
    ## Description:
    ##   Internal function used by function timeDate()
    ##
    ## When the clocks are moved forward (usually in spring) in a particular
    ## zone an hour is skipped. What to do if such a time is
    ## specified. Technically, it is NA. But using that as default is likely to
    ## cause more harm than good. A number of alternatives may be sensible in
    ## particular cases. The new argument 'dst_gap' offers the possibility to
    ## move it up or down by one hour, or to set it to NA.
    ##
    ## Let y be the time at time zone Z and t the corresponding UTC/GMT time.
    ## timeDate objects store t. We have
    ##     t = y - DST - GMToffset = y - offset
    ## and
    ##     y = t + DST + GMToffset = t + offset
    ## before the modification the function was essentially using
    ##     t = y - offset
    ##     y = t + offset
    ## but this leads to misterious shifts around DST changes, except for the
    ## meridians of London and Central Europe.
    ##
    ## For example, Bulgaria/Sofia is GMT+2 non-DST and GMT+3 during DST.  The
    ## switch to DST in 1983 was at "1983-03-27 01:00:00". so this time doesn't
    ## actually exist in that time zone.
    ## With timeDate v4021.106 (and earlier) we get
    ##
    ##     Sofia_to_DST_char <- c("1983-03-26 23:00:00",
    ##                            "1983-03-27 00:00:00", # change to DST; doesn't exist in Sofia DST
    ##                            "1983-03-27 01:00:00",
    ##                            "1983-03-27 02:00:00",
    ##                            "1983-03-27 03:00:00")
    ##
    ##     Sofia_to_DST_test <- Sofia_to_DST_char
    ##     Sofia_to_DST_test[2] <- "1983-03-27 01:00:00" # gap to gap + 1 hour
    ##
    ##     Sofia_to_DST <- timeDate(Sofia_to_DST_char, zone = "Sofia", FinCenter = "Sofia")
    ##
    ##     > Sofia_to_DST
    ##     Sofia
    ##     [1] [1983-03-26 23:00:00] [1983-03-26 23:00:00] [1983-03-27 00:00:00]
    ##     [4] [1983-03-27 01:00:00] [1983-03-27 03:00:00]
    ##
    ## We see that 1am and 2am are wrong. 0am on this date doesn't exist, so it
    ## being moved back by an hour may be suitable in some circumstances. 23pm
    ## and 3am are ok.
    ##
    ## The underlying GMT times:
    ##
    ##     > Sofia_to_DST@Data
    ##     [1] "1983-03-26 21:00:00 GMT" "1983-03-26 21:00:00 GMT"
    ##     [3] "1983-03-26 22:00:00 GMT" "1983-03-26 23:00:00 GMT"
    ##     [5] "1983-03-27 00:00:00 GMT"
    ##
    ## Note that here 2am GMT is the time of switch to DST. We see that the
    ## GMT's are correct (with the caviat for 0am Sofia) but the conversion for
    ## 22pm and 23pm GMT adds the non-DST GMToffset (+2), instead of GMT+3.
    ##
    ## The source of the errors is revealed by writing the formulas so that they
    ## show what is a function of what.
    ##
    ## Let y be the time at time zone Z and t the corresponding UTC/GMT time
    ## (both in seconds since some origin, typically "1970-01-01").
    ## "timeDate" objects store t. We have
    ##
    ##     t = y - DST(y) - GMToffset(y) = y - offset(y)
    ## and
    ##     y = t + DST(y) + GMToffset(y) = t + offset(y)
    ##
    ## Time zone tables normally contain y paired with offset(y), so computing t
    ## from y is straightforward. But for computing y from t we need offset(y),
    ## not offset(t). GMToffset(y) typically is fixed at a given place (although
    ## changes do happen) but even so, DST(y) may not be the same as DST(t) at
    ## and just after the switch of DST (on or off).

    if (FinCenter == "GMT" || FinCenter == "UTC")
        return(num)

    type <- match.arg(type)
    signum <- switch(type,
                     "gmt2any" = +1,
                     "any2gmt" = -1)
    ##  otherwise give error

    dst_gap <- match.arg(dst_gap)

    # Get the DST list from the database:
    try <- try(dst.list <- rulesFinCenter(FinCenter), silent = TRUE)
    if (inherits(try, "try-error"))
        stop(gettextf("'%s' is not a valid FinCenter.", FinCenter))

    offSetIdx <- findInterval(num, dst.list$numeric)
    offSetIdx[offSetIdx < 1] <- 1 # consider first DST rule if event occured before

    ## GNB: add check for non-existent times;
    ##      assuming DST skips some time interval.

    if(signum == -1) { # any2gmt
        ## TODO: Check if this resolves cases like BDST in UK during WW2
        shifted_offset <- offSetIdx

        indx <- which(dst.list$isdst[offSetIdx] == 1)
        if(length(indx) > 0  &&  (dst_gap == "+" || dst_gap == "NA")) {
            ## GNB: check for non-existent DST times at FinCenter
            ##
            ## TODO: handle the case when offSetIdx contains 1
            ## DONE 2023-12-06 handle the case when offSetIdx contains 1
            ##    was giving error, eg for
            ##        holidayLONDON(1915:1917)
            ##    but not for the individual years, these were ok:
            ##        holidayLONDON(1915)
            ##        holidayLONDON(1916)
            ##        holidayLONDON(1917)
            ##
            ## TODO: check the fix? I have somewhat forgotten the details
            offSetIdx_minus1 <- offSetIdx - 1

            ## 2024-12-07: timeCeiling(Sofia_to_DSTa, "days") gives
            ##    Error in if (any(offSetIdx_minus1 == 0)) offSetIdx_minus1[offSetIdx_minus1
            ##    == : missing value where TRUE/FALSE needed
            ##
            ## > offSetIdx_minus1
            ## [1] 16 NA 16 16 16
            ##
            ## so add na.rm = TRUE here:
            ##    if(any(offSetIdx_minus1 == 0, na.rm = TRUE))
            ##        offSetIdx_minus1[offSetIdx_minus1 == 0] <- 1
            ## or, even better, drop the redundant 'if':
            offSetIdx_minus1[offSetIdx_minus1 == 0] <- 1

            #dst_skip <- dst.list$offSet[offSetIdx][indx] - dst.list$offSet[offSetIdx - 1][indx]
            #adjust <- dst.list$offSet[offSetIdx][indx]
            adjust <- dst.list$offSet[offSetIdx][indx] -
                          dst.list$offSet[offSetIdx_minus1][indx]
            #adjust <- 3600

            wrk <- num[indx] - adjust
            shifted_offset[indx] <- findInterval(wrk, dst.list$numeric)
            shifted_offset[shifted_offset < 1] <- 1
            ## 2024-12-07:
            ##       changed <- shifted_offset != offSetIdx
            ## gives error below (in the assignment to num[changed]) if changed contains NAs
            ## Use 'which()'
            changed <- which(shifted_offset != offSetIdx)

            if(dst_gap == "+") {
                #offSetIdx[changed] <- shifted_offset[changed]
                ## TODO: 3600? better to choose suitable elements of adjust
                #num[changed] <- num[changed] + dst.list$offSet[offSetIdx - 1][indx]
                #num[indx] <- num[indx] + 3600 # adjust[indx][changed] #dst_skip
                num[changed] <- num[changed] + 3600 # adjust[indx][changed] #dst_skip
            } else # dst_gap == "NA"
                num[changed] <- NA
        }
        num - dst.list$offSet[offSetIdx]
    } else { # gmt2any
        ## 2023-12-19 GNB: (see also the related comment in the timeDate method for atoms()).
        ##
        ##   As far as I understand this, it computes a GMT time which is the same as the
        ##   time at FinCenter.
        ##
        ## GNB: this was just
        ##          num + dst.list$offSet[offSetIdx]
        ##      but this is incorrect around DST changes, since the offset offSetIdx
        ##      may need correction, particularly evident for time zones further from GMT.
        res <- num + dst.list$offSet[offSetIdx]

        offset_after <- findInterval(res, dst.list$numeric)
        offset_after[offset_after < 1] <- 1

        offset_diff <- dst.list$offSet[offset_after] - dst.list$offSet[offSetIdx]

        ## 2024-11-29 - subset assignment fails if there are NAs in res
        ##              (see example with NAs in class-timeDate.Rd)
        ##
        flag_offset_diff_pos <- offset_diff > 0 & !is.na(res)
        if(any(flag_offset_diff_pos))
            res[flag_offset_diff_pos] <- res[flag_offset_diff_pos] + 3600

        flag_dst_special <- num + 3600 <= dst.list$numeric[offset_after]

        ## 2024-11-29 - see above remark for > 0
        flag_offset_diff_neg <- offset_diff < 0 & !is.na(res)

        ## ambiguous t change from DST to non-DST; consider DST
        ## 2024-11-29 - the first line below doesn't change anythin;
        ##    TODO: check if it is redundant or a bug that needs fixing.
        ##          (could it be also that the assignment in the case !flag_dst_special
        ##           should actually be to flag_dst_special ?)
        res[flag_offset_diff_neg & flag_dst_special] + 3600
        res[flag_offset_diff_neg & !flag_dst_special] <-
            res[flag_offset_diff_neg & !flag_dst_special] - 3600

        res
    }
}


## 2023-01-08 GNB: removed .formatFinCenter() since no longer used.
##
## .formatFinCenter <-
## function(charvec, FinCenter, type = c("gmt2any", "any2gmt"))
## {
##     # A function implemented by Diethelm Wuertz
##     #   thanks to contributions from Martin Maechler
##
##     # Description:
##     #   Internal function used by function timeDate()
##
##     if (FinCenter == "GMT" || FinCenter == "UTC")
##         return(charvec)
##
##     ## else start working:
##     type <- match.arg(type)
##     signum <- switch(type,
##                      "gmt2any" = +1,
##                      "any2gmt" = -1)
##     ##  otherwise give error
##
##
##     # Get the DST list from the database:
##     try <- try(dst.list <- rulesFinCenter(FinCenter), silent = TRUE)
##     if (inherits(try, "try-error"))
##         stop(gettextf("'%s' is not a valid FinCenter.", FinCenter))
##     # Update list with last entry:
##     z = as.matrix(dst.list)
##     z[dim(z)[1], ]
##     vec1 = as.vector(c(z[, 1], "2099-01-01 00:00:00"))
##     vec2 = as.vector(c(z[, 2], rev(z[, 2])[1]))
##     dst.list = data.frame(ruleChanges = as.character(vec1),
##     offSet = as.integer(vec2))
##     # Extract the dates when DST was changed:
##     dst.dates = as.character(dst.list[, 1])
##     # Extract the Offsets to GMT
##     dst.offsets = as.character(dst.list[, 2])
##     # The new dates ar the charvec's:
##     new.dates = charvec
##     # The new offsets are still unknown:
##     new.offsets = rep(NA, length(charvec))
##     # Combine all Dates and Offsets:
##     dates = c(dst.dates, new.dates)
##     offsets = c(dst.offsets, new.offsets)
##     # The number of Offsets:
##     n = length(dates)
##     # Order the Dates:
##     o = order(dates)
##     # Dates and Offsets in the right order:
##     o.dates = dates[o]
##     o.offsets = offsets[o]
##     # The points at which we have to determine the offsets
##     xout = (1:n)[is.na(o.offsets)]
##     # The date indexes:
##     x = (1:n)[-xout]
##     # The corresponding offsets
##     y = o.offsets[x]
##     # The new offsets:
##     yout = approx(x, y , xout, method = "constant")$y
##     # All dates:
##     m = length(dst.dates)
##     # Put them in the right order:
##     # Added DW: 2005-05-27
##     idx = order(o[which(o>m)])
##     offSets = yout[idx]
##     dt = strptime(charvec, "%Y-%m-%d %H:%M:%S", tz = "GMT")
##
##     ## Return Value:
##     format(dt + signum * offSets, format="%Y-%m-%d %H:%M:%S")
## }


strptimeDate <- function(x, format = whichFormat(x), tz = "") {
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Creates for character time stamps a 'timeDate' object

    # Example:
    #   timeDate(); strptimeDate(as.character(Sys.timeDate()))

    # Note:
    #   This function works like strptime.

    # FUNCTION:

    # Check Arguments:
    stopifnot(is.character(x))

    # Settings and Checks:
    if (tz == "")
        tz = getRmetricsOptions("myFinCenter")

    # Create 'timeDate':
    ans = timeDate(x, format, zone = tz, FinCenter = tz)

    # Return Value:
    ans
}

################################################################################
