aseshms: Toolkit for ASES HMS Team

#' aseshms: An R Analytics Toolkit for ASES-HMS Team
#'
#' An analytics toolkit comprising of a series of work functions. The toolkit has
#' a lot of featured funcionalities specifically designed for ASES HMS team.
#'
#' @details The toolkit comprises of several types of functions:
#' \itemize{
#'  \item useful tool functions: \code{\link{loadPkgs}}, \code{\link{unloadPkgs}},
#'     \code{\link{convCoord}}, ...
#'  \item data cleaning: \code{\link{bindPDFs}}, \code{\link{bindTXTs}}, ...
#'  \item reporting: \code{\link{setRptParam}}, \code{\link{tabRisks}}, ...
#'  \item statistics tabulating: \code{\link{aggregRisk}}, \code{\link{tabEpiPrev}}, ...
#'  \item plots: \code{\link{chartColumn}}, \code{\link{chartTornado}},
#'    \code{\link{chartLine}}, ...
#'  \item others: \code{\link{getHexPal}}, \code{\link{iif}}, \code{\link{ifnull}}, 
#'    \code{\link{reheadHTMLTable}}, ...
#' }
#'
#' @author \strong{Maintainer}: Yiying Wang, \email{wangy@@aetna.com}
#' 
#' @importFrom magrittr %>%
#' @export %>%
#' @seealso \pkg{\link{recharts}}
#' @docType package
#' @keywords internal
#' @name aseshms
NULL


.onLoad <- function(libname, pkgname){
    
    if (Sys.info()[['sysname']] == 'Windows'){
        Sys.setlocale('LC_CTYPE', 'Chs')
    }else{
        Sys.setlocale('LC_CTYPE', 'zh_CN.utf-8')
    }
    if (Sys.info()[['machine']] == "x64") if (Sys.getenv("JAVA_HOME") != "")
        Sys.setenv(JAVA_HOME="")
    
    addRtoolsPath()
	
    # aseshms_env is a hidden env under pacakge:aseshms
    # -----------------------------------------------------------
    assign("aseshms_env", new.env(), parent.env(environment()))
    
    pkgParam <- .pkgPara()
    if (!is.null(pkgParam$remote.pkg.dir)){
        files.remote <- list.files(pkgParam$remote.pkg.dir[[1]])
        latest.ver <- try(sub("^aseshms_(\\d.+)\\.zip$", "\\1", 
                              files.remote[grep("^aseshms.+\\.zip", files.remote)]),
                          silent=TRUE)
        if (inherits(latest.ver, "try-error")) latest.ver <- NULL
        if (length(latest.ver) == 0) latest.ver <- NULL
    }else{
        latest.ver <- NULL
    }
    
    # constants for coord conversion
    aseshms_env$A <- 6378245.0
    aseshms_env$EE <- 0.00669342162296594323
    aseshms_env$XM_PI <- pi * 3000.0 / 180.0
    # constants for encrpytion
    aseshms_env$START_TAG <- paste(
        "\u2016\u251c\u0432\u0259\u03b4\u03b9\u03bd",
        "\u0113\u0418\u03ba\u03c1\u03b9\u03c0\u0442\u03b9\u25cb\u0438\u2524\u2016")
    aseshms_env$END_TAG <- paste(
        "\u2016\u251c\u30e8\u03b7\u03b4",
        "\u0113\u0418\u03ba\u03c1\u03b9\u03c0\u0442\u03b9\u25cb\u0438\u2524\u2016")
    
    # constants for char2num conversion
    aseshms_env$CHAR2NUM_SCI <- get_char2num_pattern(c("e", ",", "$", "%"))
    aseshms_env$CHAR2NUM_NOSCI <- get_char2num_pattern(c(",", "$", "%"))  # in util_num_pct.R
    aseshms_env$WIDE_NUMCHAR <- structure(
        c(".", "-", "+", "*", "e", "%", as.character(0:9)),
        names=c("\uff0e", "\uff0d", "\uff0b", "\uff45", "\uff05", "\uff0a", "\uff10", "\uff11",
                "\uff12", "\uff13", "\uff14", "\uff15", "\uff16", "\uff17", "\uff18", "\uff19"))
    
    # constatns for palette
    aseshms_env$PALETTE <- list(
        brewer = structure(c(rownames(RColorBrewer::brewer.pal.info)),
                           names=tolower(c(rownames(RColorBrewer::brewer.pal.info)))),
        ggtableau = structure(
            c("Tableau 10", "Tableau 20", "Color Blind", "Seattle Grays", "Traffic", 
              "Miller Stone", "Superfishel Stone", "Nuriel Stone", "Jewel Bright", 
              "Summer", "Winter", "Green-Orange-Teal", "Red-Blue-Brown", "Purple-Pink-Gray",
              "Hue Circle", "Classic 10", "Classic 10 Medium", "Classic 10 Light", 
              "Classic 20", "Classic Gray 5", "Classic Color Blind", "Classic Traffic Light", 
              "Classic Purple-Gray 6", "Classic Purple-Gray 12", "Classic Green-Orange 6", 
              "Classic Green-Orange 12", "Classic Blue-Red 6", "Classic Blue-Red 12", 
              "Classic Cyclic",
              "Orange-Blue Diverging", "Red-Green Diverging", "Green-Blue Diverging", 
              "Red-Blue Diverging", "Red-Black Diverging", "Gold-Purple Diverging",
              "Red-Green-Gold Diverging", "Sunset-Sunrise Diverging", "Orange-Blue-White Diverging",
              "Red-Green-White Diverging", "Green-Blue-White Diverging", "Red-Blue-White Diverging",
              "Red-Black-White Diverging", "Orange-Blue Light Diverging", "Temperature Diverging",
              "Classic Red-Green", "Classic Red-Blue", "Classic Red-Black", "Classic Area Red-Green",
              "Classic Orange-Blue", "Classic Green-Blue", "Classic Red-White-Green",
              "Classic Red-White-Black", "Classic Orange-White-Blue", "Classic Red-White-Black Light", 
              "Classic Orange-White-Blue Light", "Classic Red-White-Green Light", 
              "Classic Red-Green Light",
              "Blue-Green Sequential", "Blue Light", "Orange Light", "Blue", "Orange", 
              "Green", "Red", "Purple", "Brown", "Gray", "Gray Warm", "Blue-Teal", 
              "Orange-Gold", "Green-Gold", "Red-Gold", "Classic Green", "Classic Gray", 
              "Classic Blue", "Classic Red", "Classic Orange", "Classic Area Red", 
              "Classic Area Green", "Classic Area-Brown"),
            names=c("tableau10", "tableau20", "tbl_colorblind", "tbl_seattle_grays", "tbl_traffic", 
                    "tbl_miller_stone", "tbl_superfishel_stone", "tbl_nuriel_stone", "tbl_jewel_bright", 
                    "tbl_summer", "tbl_winter", "tbl_gnorte", "tbl_rdbubw", "tbl_pupkgy",
                    "tbl_hue_circle", "tbl_classic10", "tbl_classic10_medium", "tbl_classic10_light", 
                    "tbl_classic20", "tbl_classic_gray5", "tbl_classic_colorblind", "tbl_classic_traffic_light", 
                    "tbl_classic_pugy6", "tbl_classic_pugy12", "tbl_classic_gnor6", 
                    "tbl_classic_gnor12", "tbl_classic_burd6", "tbl_classic_burd12", 
                    "tbl_classic_cyclic",
                    "tbl_orbu_div", "tbl_rdgn_div", "tbl_gnbu_div", 
                    "tbl_rdbu_div", "tbl_rdbl_div", "tbl_gdpu_div",
                    "tbl_rdgngd_div", "tbl_sunset_sunrise_div", "tbl_orbuwi_div",
                    "tbl_rdgnwi_div", "tbl_gnbuwi_div", "tbl_rdbuwi_div",
                    "tbl_rdblwi_div", "tbl_orbu_light_div", "tbl_temperature_div",
                    "tbl_classic_rdgn", "tbl_classic_rdbu", "tbl_classic_rdbl", "tbl_classic_area_rdgn",
                    "tbl_classic_orbu", "tbl_classic_gnbu", "tbl_classic_rdwign",
                    "tbl_classic_rdwibl", "tbl_classic_orwibu", "tbl_classic_rdwibl_light", 
                    "tbl_classic_orwibu_light", "tbl_classic_rdwign_light", 
                    "tbl_classic_rdgn_light",
                    "tbl_bugn_seq", "tbl_blue_light", "tbl_orange_light", "tbl_blue", "tbl_orange", 
                    "tbl_green", "tbl_red", "tbl_purple", "tbl_brown", "tbl_gray", "tbl_gray_warm", "tbl_bute", 
                    "tbl_orgd", "tbl_gngd", "tbl_rdgd", "tbl_classic_green", "tbl_classic_gray", 
                    "tbl_classic_blue", "tbl_classic_red", "tbl_classic_orange", "tbl_classic_area_red", 
                    "tbl_classic_area_green", "tbl_classic_area_brown")),
        ggthemes = structure(
            c('calc', 'economist', 'economist_white', 'excel_line', 
              'excel_fill', 'excel_new', 'few','fivethirtyeight', 'gdocs', 
              'pander', 'stata', 'stata1', 'stata1r','statamono', 'hc', 'darkunica',
              'wsj', 'wsj_rgby', 'wsj_red_green', 'wsj_black_green', 'wsj_dem_rep', 
              'colorblind', 'trafficlight'),
            names=c('calc', 'economist', 'economist_white', 'excel_line', 
                    'excel_fill', 'excel_new', 'few','fivethirtyeight', 'gdocs', 
                    'pander', 'stata', 'stata1', 'stata1r','statamono', 'hc', 'darkunica',
                    'wsj', 'wsj_rgby', 'wsj_red_green', 'wsj_black_green', 'wsj_dem_rep', 
                    'colorblind', 'trafficlight')),
        ggsolarized = structure(
            c('solarized','solarized_red', 'solarized_yellow', 'solarized_orange',
              'solarized_magenta','solarized_violet', 'solarized_blue', 'solarized_cyan',
              'solarized_green'),
            names=c('solarized','solarized_red', 'solarized_yellow', 'solarized_orange',
                    'solarized_magenta','solarized_violet', 'solarized_blue', 'solarized_cyan',
                    'solarized_green')),
        viridis = structure(c('megma', 'inferno', 'plasma', 'viridis', 'cividis'),
                            names=c('megma', 'inferno', 'plasma', 'viridis', 'cividis')),
        aetna = structure(paste0(
            "aetna", c('green', 'blue', 'teal', 'cranberry', 'orange', 'violet')),
            names=paste0(
                "aetna", c('green', 'blue', 'teal', 'cranberry', 'orange', 'violet'))),
        grdevice=structure(c('rainbow', 'terrain', 'topo', 'heat', 'cm'),
                           names=c('rainbow', 'terrain', 'topo', 'heat', 'cm'))
    )
    # ----------------------------------------------------------
    
    # options
    assign("op", options(), envir=aseshms_env)
    
    options(guiToolkit="tcltk")
    options(`aseshms.latest.version`=latest.ver)
    options(`aseshms.loaded.at`=Sys.time())
    toset <- !(names(pkgParam) %in% names(aseshms_env$op))
    if (any(toset)) options(pkgParam[toset])
}

.onUnload <- function(libname, pkgname){
    toset <- (names(.pkgPara()) %in% names(aseshms_env$op))
    if (any(toset)) try(options(aseshms_env$op[toset]), silent=TRUE)
    if (file.exists(paste0(Sys.getenv("HOME"), "/acckey.pem")))
        unlink(paste0(Sys.getenv("HOME"), "/acckey.pem"))
}


.onAttach <- function(libname, pkgname){
    ver.warn <- ""
    latest.ver <- getOption("aseshms.latest.version")
    current.ver <- getOption("aseshms.version")
    if (!is.null(latest.ver) && !is.null(current.ver))
        if (latest.ver > current.ver)
            ver.warn <- paste0("\nThe most up-to-date version is ", latest.ver, 
                               ". You are currently using ", current.ver)
    packageStartupMessage(paste0("Welcome to aseshms ", current.ver, 
                                 ver.warn))
}

.pkgPara <- function(){
    is_aetna <- any(Sys.getenv() %in% c("AETH", "AETH.AETNA.COM") |
                        names(Sys.getenv()) %in% c("Aetna_Build_Info"))
    if (is_aetna){
        init.dir <- "//ship-oa-001/China_Health_Advisory/Analytics/"
        toolkit.dir <- "//ship-oa-001/China_Health_Advisory/Analytics/GUIDE And TOOLS/"
        remote.pkg.dir <- "//ship-oa-001/China_Health_Advisory/Analytics/R_scripts/"
        init.pal <- "aetnagreen"
    } else {
        init.dir <- Sys.getenv("HOME")
        toolkit.dir <- Sys.getenv("HOME")
        remote.pkg.dir <- NULL
        init.pal <- NULL  # default ggplot2 theme
    }
    na.string <- c(cn="\u{4E0D}\u{8BE6}", en="NA")
    mach.arch <- switch(Sys.info()[['machine']], `x86-32` = '32', `x86-64` = '64')
    aseshms.version <- try(readLines(system.file("DESCRIPTION", package="aseshms")),
                           silent=TRUE)
    aseshms.version <- if (inherits(aseshms.version, "try-error")) NULL else
        sub("^Version: (\\d.+)$", "\\1", 
            aseshms.version[grepl("^Version", aseshms.version)])
    return(structure(
        list(init.dir, toolkit.dir, init.pal, na.string, mach.arch, remote.pkg.dir, 
          aseshms.version, NULL, NULL),
        names=c("init.dir", "toolkit.dir", "init.pal", "na.string",
                "mach.arch", "remote.pkg.dir", "aseshms.version",
                "aseshms.latest.version", "guiToolkit"))
    )
}