R/timeDate-generateDST.R

In timeDate: Rmetrics - Chronological and Calendar Objects

# 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:
#  .genDaylightSavingTime   Create file with Daylight Saving Time Rules for all
#                           centers in listFinCenter()
################################################################################


# ---------------------------------------------------------------------------- #
# Roxygen Tags
#' @export
# ---------------------------------------------------------------------------- #
# The following DST Rules were extracted from tzdata (version tzdata2008e)
# and integrated into R functions.
##
## GNB: the rules were updated anumber of times later (but seemingly keeping the
##       financial centers unchanged 
##
## GNB: Dec 2022
##     - updated .genDaylightSavingTime(), see comments in the source below.
##     - turned 'finCenter' into an argument of the function


.genDaylightSavingTime <-
    function(filename = "DaylightSavingTime.R", finCenter = listFinCenter(),
             aliases = NULL, end_year = 2100)
{
    ## finCenter <- listFinCenter()

    finCenter

    ## message on console
    cat(
        "\t this function generates DST rules from the output
\t of the command line \"zdump\" on a _linux_ box.\n")

    # create source file
    cat(" # 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

# fCalendar::2A-DaylightSavingTime.R
################################################################################
# FUNCTION:                 DESCRIPOTION:
#  Algiers                   Returns Algiers Daylight Saving Time Rules
#  ...
#  Honolulu                  Returns Honolulu Daylight Saving Time Rules
################################################################################


################################################################################
# The following DST Rules were originally extracted from tzdata (version tzdata2007k)
# and integrated into R functions. The rules were updated a number of times since then.
# GNB: see the comments below for changes in Dec 2022
################################################################################
#
# GNB (Dec 2022):
#
# This file was auto-generated by .genDaylightSavingTime() (but see below) with
# suitable arguments:
#
#   .genDaylightSavingTime(finCenter = fc_work, aliases = aliases, end_year = 2100)
# 
# where 'fc_work' is the list financial centers and 'aliases' is a character vectors
# of lines of the form old_tz <- new_tz, for compatibility with previous versions
# of timeDate (old_tz is an old tz/FinCenter name, new_tz is the current one.
#
# The call '.genDaylightSavingTime()' will use listFinCenter() for FinCenter,
# thus updating the DST information but not changing the list of financial
# centers (even if there are some in zoneinfo database). However, 'aliases'
# will not be created (except for a handful of special ones).
#
# The file generated from the above call was then postprocessed with:
#
#   source('DaylightSavingTime.R')
#   source('~/repos/rmetrics/pkg/timeDate/work/DST_rules/gnb_compact_dst_rules.R')
#   create_dst_file_new(fc_work[-c(51)], aliases = aliases)
#
# where we drop (-51)  'America/Ciudad_Juarez' since it errors. The code used for
# this is loose at the time of writing this note (Dec 2022). I will include it
# when I have time to clean it up.
#
# This post-processing generates a replacement for the file generated by
# .genDaylightSavingTime(finCenter and 'sysdata.rda'. Both files need to be put
# in 'R/'. If you want to use the file produced by .genDaylightSavingTime
# without post processing, make sure to remove the index database from the
# current sysdata.R.


", file = filename)
    ## TODO: create aliases in a separate file, see the last sentence above?

    ## GNB: track unsuccessful zones
    failed <- character(0)
    
    all_fccity <-  strsplit(finCenter, "/")
    for (k in seq(length(finCenter))) {

        ## GNB: added  -c end_year. The default of zdump is 2500, which seems
        ##                          excessive for our purposes.
        # run zdump linux command
        zdump <- try(system(paste("zdump -v -c", end_year, finCenter[k], sep=" "), intern=TRUE))
        zdump <- strsplit(zdump, " +" )

        ## GNB: 2022-10-01 
        ## This seems to assume that all elements of zdump have the same length:
        ##     zdump <- matrix(unlist(zdump), nrow = length(zdump), byrow = TRUE)
        ## Also, the code below uses explicitly refers to columns up to 16.
        ##
        ## However now there are differently structured lines at the start and end.
        ## For example
        ##    zdump -v Africa/Abidjan
        ##    Africa/Abidjan  -9223372036854775808 = NULL
        ##    Africa/Abidjan  -9223372036854689408 = NULL
        ##    Africa/Abidjan  Mon Jan  1 00:16:07 1912 UT = Sun Dec 31 23:59:59 1911 LMT isdst=0 gmtoff=-968
        ##    Africa/Abidjan  Mon Jan  1 00:16:08 1912 UT = Mon Jan  1 00:16:08 1912 GMT isdst=0 gmtoff=0
        ##    Africa/Abidjan  9223372036854689407 = NULL
        ##    Africa/Abidjan  9223372036854775807 = NULL
        ##
        ## TODO: need to check if these lines change the intepratation.
        ##
        ## For now, try dropping non-standard lines:
        idrop <- sapply(zdump, length)
        zdump <- zdump[ idrop == 16 ]

        ## GNB: guard against empty data (after removing pre and post-amble
        ##   TODO: need to process it as well. But how?
        if(length(zdump) == 0) {
            cat("finCenter ", finCenter[k], " has no rules; skipping it", "\n")
            cat("\n\n ## TODO: finCenter ", finCenter[k], " has no rules; skipping it", "\n\n",
                file = filename, append = TRUE)
            failed <- c(failed, finCenter[k])
            next
        }
            
        zdump <- matrix(unlist(zdump), nrow = length(zdump), byrow = TRUE)

        # extract data
        fccity <-  all_fccity[[k]]
        tms <- zdump[,5]
        dts <-  as.Date(paste(zdump[,3], zdump[,4], zdump[,6]),
                        format="%b %d %Y")
        tzs <- zdump[,14]
        isdst <- as.integer(substr(zdump[,15],7,8))
        # important to use nchar(zdump[,16] because length of gmtoff is variable
        gmtoff <- as.integer(substr(zdump[,16],8,nchar(zdump[,16])))

###         # Determine the index of row which are relevant for DST rules
###         if (sum(isdst)==0) { ## when there is no DST rules for a given TZ
###             currentYear <- format(Sys.Date(), "%Y")
###             yearDTS <- format(dts, "%Y")
###             index <- length(yearDTS[yearDTS <= currentYear])
###         } else {
###             x <- isdst[1]
###             index <- NULL
###             j <- 1
###             for (i in seq(length(isdst))) {
###                 if (x != isdst[i]) {
###                     index[j] <- i-2
###                     x <- isdst[i]
###                     j <- j+1
###                 }
###             }
###         }

        # Determine the index of row which are relevant for offset/gmtoff rules
        test <- gmtoff - rep(gmtoff[1],length(gmtoff))
        if (sum(test)==0) { ## when there is no DST rules for a given TZ
            currentYear <- format(Sys.Date(), "%Y")
            yearDTS <- format(dts, "%Y")
            index <- length(yearDTS[yearDTS <= currentYear])
        } else {
            x <- gmtoff[1]
            index <- NULL
            j <- 1
            for (i in seq(length(gmtoff))) {
                if (x != gmtoff[i]) {
                    index[j] <- i-2
                    x <- gmtoff[i]
                    j <- j+1
                }
            }
            # YC: add last entry; important for short DST table like
            # Tokyo(), Singapore, ... !
            index[length(index) + 1] <- index[length(index)] + 2
        }

        # construct table rule for the given fin center
        dst <- data.frame(cbind(paste(dts[index],
                                      tms[index]),
                                gmtoff[index],
                                isdst[index],
                                tzs[index]),
                          stringsAsFactors = FALSE)
        
        ## GNB: convert 'Easter' to 'Easter_Island' to avoid clash with Easter() holiday
        ##      Note: the caller should also adjust "Easter" in the list of fin centers.
        ##            This cannot be done before calling this function since it needs to
        ##            give "Easter" to 'zdump' and change the name only on output.
        base_fccity <- fccity[length(fccity)]
        if(base_fccity == "Easter")
            base_fccity <- "Easter_Island"
        
        colnames(dst) <- c(base_fccity,
                           "offSet",
                           "isdst",
                           "TimeZone")

        # force offSet and isdst to be integer columns
        dst$offSet <- as.integer(dst$offSet)
        dst$isdst <- as.integer(dst$isdst)

        # add numeric column
        dst$numeric <- as.numeric(as.POSIXct(dst[[1]],
                                             format = "%Y-%m-%d %H:%M:%S",
                                             tz = "GMT"))

        # add function to file 'filename' if table exits
        if (nrow(dst) != 0) {
            dstFile <- file(filename, open = "a")
            cat("\"", base_fccity, "\"", " <- function () {\n",
                sep ="", file = dstFile)
            dput(dst, file = dstFile)
            cat("}\n\n", file = dstFile)
            close(dstFile)
        }
        else {
            cat("Error : Empty table for", finCenter[k], "\n")
        }
    }

    if(!is.null(aliases))
        cat("\n", aliases, sep = "\n", file = filename, append = TRUE)

    cat("
## this is for compatibility purpose with very old versions of timeDate;
## but 'Frankfurt' is sensible anyway.
BuenosAires <- Buenos_Aires  # now wordds are separated by underscore
LosAngeles  <- Los_Angeles
MexicoCity  <- Mexico_City
NewYork     <- New_York
Eastern     <- New_York
HongKong    <- Hong_Kong
KualaLumpur <- Kuala_Lumpur

Frankfurt   <- Berlin
Pacific     <- Los_Angeles
",
        file = filename, append = TRUE)

    list(file = filename, failed = failed)
}