# -----------------------------------------------------------------------------------------------------------------------------------------  #
  #  ---------------------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                                            #
  #           File Name              :  aggregateDT and changeAndAggregate.r                                                                   #
  #           Last Updated Funclist  :  19 Feb 2015, 12:52 PM (Thursday)                                                                       #
  #                                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                                #
  #                                                                                                                                            #
  #           Packages Called        :  NA                                                                                                     #
  #           Packages Used via NS   :  data.table                                                                                             #
  #                                                                                                                                            #
  #  ---------------------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                                            #
  #   changeAndAggregate ( DT, colsToAgg=canBeNumeric(DT, justNames=TRUE, exclude.idCols.byname=TRUE)                                          #
  #                        , changeFunc, aggFunc="sumn", confirm=TRUE, changeFunc.args=list(), colsToDrop=NULL                                 #
  #                        , ..., confirmFunc=aggFunc                                                                                          #
  #                        , addInfo=c("append", "preserve_original", "new_only", "none"), browseOnFail=FALSE                                  #
  #                        , cols.to.agg="deprecated", verbose=TRUE, newKey=NA )                                                               #
  #   aggregateDT        ( DT, by=key(DT)                                                                                                      #
  #                        , colsToAgg=setdiff(names(DT), by), exclude=setdiff(names(DT), c(by, colsToAgg)), convert.integers.to.numeric=TRUE  #
  #                        , aggFunc="sumn"                                                                                                    #
  #                        , addInfo=c("append", "preserve_original", "new_only", "none"), showWarnings=TRUE                                   #
  #                        , showWarnings.info=showWarnings, ... )                                                                             #
  #                                                                                                                                            #
  #                                                                                                                                            #
  #                                                             <END FUNCS>                                                                    #
  #  ---------------------------------------------------------------------------------------------------------------------------------------   #
  # -----------------------------------------------------------------------------------------------------------------------------------------  #

aggregateMonthly <- function(DT
                            , dateCol
                            , newCol.nm=dateCol
                            , aggFunc=sumn
                            , byCols=setdiff(key(DT) , dateCol)
                            , colsToAgg=setdiff(names(DT), c(byCols, dateCol))
                            , monthFunc=monthFloor
                            , failOnMissingDateCol=TRUE
                            , verbose=TRUE
                            ) {
    if (is.null(aggFunc) || (is.character(aggFunc) && tolower(aggFunc) == "count"))
        aggFunc <- "sumn"
    aggFunc   <- match.fun(aggFunc)
    monthFunc <- match.fun(monthFunc)

    if (missing(newCol.nm) && identical(dateCol, "date")) {
      newCol.nm <- "month"
    }

    key.bak <- key(DT)
    nms <- names(DT)
    if (missing(dateCol) || is.null(dateCol)) {
      if ("date" %in% nms)
        dateCol <- "date"
      else if ("download_date" %in% nms)
        dateCol <- "download_date"
      else if ("download_datetime" %in% nms)
        dateCol <- "download_datetime"
      else {
        msg <- paste0("dateCol '", dateCol, "' is not a column of DT.  Also checked for and could not find 'download_date' and 'download_datetime'")
        if (failOnMissingDateCol)
          stop (msg)
        warning(msg, "\nReturning the DT unchanged")
        return(DT)
      }
    }

    if (!is.date_or_time(DT[[dateCol]]))
      stop ("'", dateCol, "' is not a date. Please convert before running this function")

    ## if colsToAgg is neither missing nor NULL and byCols IS missing or null, then replace byCols
    if ( (!missing(colsToAgg) && !is.null(colsToAgg)) && (missing(byCols) || is.null(byCols)))
      byCols <- setdiff(nms, c(dateCol, colsToAgg))
    if (is.null(colsToAgg) || missing(colsToAgg)) {
      colsToAgg <- setdiff(names(DT), c(byCols, dateCol))
      if(!all(unlist(canBeNumeric(DT)[, colsToAgg, with=FALSE])))
        warning("colsToAgg seem to not all be numeric.  aggregateMonthly() will likely fail. If so, try setting colsToAgg manually")
    }

    if (dateCol %in% byCols) {
      message("[Removing dateCol from byCols]")
      byCols %<>% setdiff(dateCol)
    }

    verboseMsg(verbose
              , "Beginning aggregateMonthly",          "\n"
              , "dateCol    : ", commaSep(dateCol),    "\n"
              , "byCols     : ", commaSep(byCols),     "\n"
              , "colsToAgg  : ", commaSep(colsToAgg),  "\n"
              , sprintf("Original Dim is %22s ", dim2txt(DT)),     "\n"
              , time=TRUE)

    ## CHECK THAT ALL COLUMNS ARE ACCOUNTED FOR if both missing
    ret <- copy(DT)
    ret[, (dateCol) := monthFunc(get(dateCol))]
    ret <- ret[, lapply(.SD, aggFunc), .SDcols=colsToAgg, keyby=c(dateCol, byCols)]

    cleanTrueLengthOfDTs(ret, verbose=FALSE)

    if (length(wh.missing_key <- setdiff(key.bak, names(ret)))) {
      key.bak %<>% intersect(names(ret))
      warning("Some columns from the key of original DT are not in final DT:\n\t", pasteC(wh.missing_key, C="\n\t"), "\nThe key will be set to:  ", pasteC(gsub(pat=sprintf("\\b%s\\b", dateCol), newCol.nm, key.bak), C=", "))
    }
    setkeyIfNot(ret, key.bak, verbose=FALSE)
    # browser(text = "right before setnames")
    try(setnames(ret, dateCol, newCol.nm))

    ## ADD in min/max dates as attribtues
    minmaxDates <- DT[[dateCol]] %>% range(na.rm=TRUE)
    setattr(DT, "minDate_present", min(minmaxDates))
    setattr(DT, "maxDate_present", max(minmaxDates))

    verboseMsg(verbose, sprintf(" Aggreg'd Dim is %22s \nDate range of original DT was %s ~ %s", dim2txt(ret), minmaxDates %>% min %>% as.character, minmaxDates %>% max %>% as.character), time=TRUE)
    return(ret)
}



changeAndAggregate <- function(DT
                            , colsToAgg=canBeNumeric(DT, justNames=TRUE, exclude.idCols.byname=TRUE)
                            , changeFunc
                            , aggFunc="sumn"
                            , confirm=TRUE
                            , changeFunc.args=list()
                            , colsToDrop=NULL, ...
                            , confirmFunc=aggFunc
                            , addInfo=c("append", "preserve_original", "new_only", "none")
                            , browseOnFail=FALSE
                            , cols.to.agg="deprecated"
                            , verbose=TRUE
                            , newKey=NA) {
## Two Functions are ran on DT. 
## changeFunc  :: changes the content of the DT, generally modifying values of a column 
##                (ie, every country outside "US" and "GB" are labeled as "Other")
## aggFunc     :: What function to then run over the colsToAgg, to tidy up the DT. 
##                 (ie, generally sum or sumn)
## ... : arguments passed to aggFunc
## changeFunc.args : arguments passed to changeFunc

    if (!missing(cols.to.agg))
        stop("'cols.to.agg' has been deprecated in changeAndAggregate().\nUse 'colsToAgg' instead")

    if (is.logical(addInfo))
      addInfo <- ifelse(isTRUE(addInfo), "append", "none")
    else 
      addInfo <- match.arg(addInfo)

    ## grab string versions for info
    changeFunc.string <- if (is.character(changeFunc)) changeFunc else capture.output(substitute(changeFunc))
    aggFunc.string    <- if (is.character(aggFunc))  aggFunc else capture.output(substitute(aggFunc))
    if (!grepl("\\(|\\)", changeFunc.string)) changeFunc.string <- paste0(changeFunc.string, "()")
    if (!grepl("\\(|\\)", aggFunc.string   )) aggFunc.string    <- paste0(aggFunc.string   , "()")

    ## Match the functions
    changeFunc  <- match.fun(changeFunc)
    aggFunc     <- match.fun(aggFunc)
    confirmFunc <- match.fun(confirmFunc)

    ## Preserve colorder & key
    key.bak      <- setdiff(key(DT),   colsToDrop)
    colorder.bak <- setdiff(names(DT), colsToDrop)

    ## Preserve attributes
    all_OtherAttrs <- attributes(DT)
    all_OtherAttrs <- all_OtherAttrs[names(all_OtherAttrs) %ni% c("names", "row.names", "class", ".internal.selfref", "sorted")]

    ## Prepare the info, before taking a hardcopy
    orig.info <- getInfo(DT, verbose=FALSE)
    if (addInfo == "append") {
      new.info  <- chopAfterWord(pasteC(c("Aggregated using changeFunc=", changeFunc.string, " and aggFunc=", aggFunc.string)), "and", after=FALSE, max=80)
      info      <- appendInfo(new.info, orig.info, capture.output(substitute(DT)), DT)
    } else if (addInfo == "new_only") {
      info <- chopAfterWord(pasteC(c("Aggregation of ", capture.output(substitute(DT)), " using changeFunc=", changeFunc.string, " and aggFunc=", aggFunc.string)), "and", after=FALSE, max=80)
    } else if (addInfo == "preserve_original") {
      info <- orig.info
    }


    ## Hard copy -- moved this to the do.call(.. ) line
    # ret <- copy(DT)

    ## Grab the sums for confirmation
    if (confirm)
      totals <- sapply(DT[, colsToAgg, with=FALSE], confirmFunc)

    browser(expr=inDebugMode(c("changeAndAggregate", "aggregate")), text="in changeAndAggregate() after hard copy, before calling do.call(.. changeFunc)")

    ## HARD COPY
    ## MAKE CHANGES
    ret <- do.call(changeFunc, c(list(copy(DT)), as.list(changeFunc.args)))

    ## Aggregate the DT. If the changes did not reduce the number of groups, aggregation will not have an effect
    byCols <- c(setdiff(names(ret), c(colsToAgg, colsToDrop)))
    ret    <- ret [, lapply(.SD, function(x) if (all(is.na(x))) x[1] else aggFunc(x, ...)), by=byCols, .SD=colsToAgg]

    ## Put the attributes back. Make sure to use setattr() 
    fullAttributes <- c(attributes(ret), all_OtherAttrs)
    for (atr in names(fullAttributes))
      data.table::setattr(ret, atr, fullAttributes[[atr]])

    ## put back original key and colorder
    setcolorderpt(ret, colorder.bak)
    if (!is.na(newKey)) {
      key.bak <- intersect(newKey, names(ret))
      if (!identical(key.bak, newKey))
        warning("some cols of newKey are not in the resulting DT, ret : ", setdiff(newKey, key.bak))
    }

    if (length(key.bak)) ## key.bak might be character(0) due to setdiff
      setkeyv(ret, key.bak)

    ## Confirm totals are still correct
    if (confirm) {
      if (any(!(wh.totals_are_correct <- equals(totals, sapply(ret[, colsToAgg, with=FALSE], sumn), tol=1e-3)), na.rm=TRUE)) {
        browser(expr=browseOnFail, text="in changeAndAggregate() about to fail. Check  get('wh.totals_are_correct')   --  The column showing 'FALSE' is where the problem lies")
        stop (warningCols("The following columns failed to confirm for totals in changeAndAggregate()", nwhich(wh.totals_are_correct)), "\n\nHINT: run again using  browseOnFail=TRUE")
      }
    }
    verboseMsg(verbose, sprintf("New DT has %s;  This is %s of the original size (%s rows)", formnumb(nrow(ret)), fwp(nrow(ret) / nrow(DT), zero=1e-10), formnumb(nrow(DT))) )

    cleanTrueLengthOfDTs(ret, verbose=FALSE)

    if (addInfo == "none")
      clearInfo(ret)
    else
      setInfo(ret, info)

    ## 2015-02-01  Returning a copy(ret) instead, as there is something up with the modify by reference.  Something breaks downstream
    return(copy(ret))
}


## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ##

showWhereNAsWillIntroduce <- function(DT, col, func=as.num.nowarn) {
  func <- match.fun(func)
  is.char_of_length1(col, fail=TRUE)
  return(DT[!is.na(get(col)) & is.na(func(get(col)))])
}

aggregateDT <- function(DT
                        , by=key(DT)
                        , colsToAgg=setdiff(names(DT), by)
                        , exclude=setdiff(names(DT), c(by, colsToAgg))
                        , convert.integers.to.numeric=TRUE
                        , aggFunc = "sumn"
                        , addInfo = c("append", "preserve_original", "new_only", "none")
                        , showWarnings = TRUE
                        , showWarnings.info = showWarnings && !grepl("\\[", capture.output(substitute(DT)))
                        , ... # additional arguments to aggFunc
  ) {
## NOTE 2015-01-07 -- changed  exclude from 
##   setdiff(names(DT), include)   to     setdiff(names(DT), c(by, colsToAgg))
##   (ie, dropping the columns in by)
## If this function suddently starts to fail, look there. 
## -----
## Also, renaming 'include' to 'colsToAgg'
## I am deliberately NOT making it backwards compatible so that errors get thrown and 
## I can double check that the exclude portion did not break anything
## -----
##
##
##  by        :: which cols to aggregate by  (aka, the 'dimension' cols)
##  colsToAgg :: which columns will be aggregated  (aka, the 'measure' cols)
##  exclude :: columns NOT to aggreagate
## NOTE:  NO WAY TO MAKE THIS "modify by reference" DUE TO THE NEED TO CALL unique()

  aggFunc <- match.fun(aggFunc)

  browser(expr=inDebugMode(c("aggregateDT", "aggregateDT_top")), text="in aggregateDT() at the top, before the args have been set")

  ## CHECK FOR HUMAN ERROR
  if ("except" %in% names(list(...)))
    warning ("'except' detected in '...' for aggregateDT.   Did you mean 'exclude'?", call.=FALSE)

  ## If all col arguments are misisng
  if (missing(by) && missing(colsToAgg) && missing(exclude)) {
    colsToAgg <- canBeNumeric(DT, justNames=TRUE, exclude.idCols.byname=TRUE)
    by <- setdiff(names(DT), colsToAgg)
    exclude <- NULL
    ## If ther eare no columns to aggregate, return the DT as is
    if (!length(colsToAgg)) {
      warning("No colsToAgg identified. Returning the DT unchanged")
      return(invisible(copy(DT)))
    }
  }

  ## If the only column given is exclude, try to auto set 'by' and 'colsToAgg' even without a key 
  if (missing(by) && missing(colsToAgg) && !missing(exclude) && is.null(by)) {
    colsToAgg <- canBeNumeric(DT, justNames=TRUE, exclude.idCols.byname=TRUE) %>% setdiff(exclude)
    by <- setdiff(names(DT), colsToAgg)
    ## TODO: Some sort of verbose info
  }

  if ((is.null(by) || missing(by)) && !missing(colsToAgg) && !missing(exclude)) {
    by <- setdiff(names(DT), c(colsToAgg, exclude))
    if (!length(by))
      stop ("by must have a length. (it was taken to be setdiff(names(DT), c(colsToAgg, exclude)), which resulted in no length)")
    cat("Will aggregate by ", pasteQand(by), "\n")
  }

  ## Levarging lazy eval on  colsToAgg= ..(.., by)
  if (!is.null(by) && length(by))
    by <- unlist(strsplit(unlist(by), ","), use.names=TRUE)
  else 
    stop ("The 'by' argument cannot be NULL")

  ## Capture the names before setdiff'ing
  ## Also, the names of nms.incl will be the values of colsToAgg (for later filtering)
  nms.incl <- invDict(colsToAgg)

  ## Any blanks, set to the value of the column itself (ie, set to colsToAgg)
  nms.incl <- ifelse(nms.incl=="", colsToAgg, nms.incl)

  ## exclude can be either the original DT names or the new ones, but not both
  if (!any(exclude %in% colsToAgg) && any(exclude %in% nms.incl))
      exclude <- invDict(nms.incl)[exclude]

  ## REMOVE THE COLUMNS IDENTIFIED IN EXCLUDE
  ## Not to self, do not try to put this in the function call, because 
  ##    the user will not be able to modify
  by  <- setdiff(by, exclude)
  colsToAgg <- setdiff(unlist(colsToAgg), exclude)

  browser(expr=inDebugMode(c("aggregateDT_middle")), text="in aggregateDT() middle, after args have been set")

  ## Filter out those 
  nms.incl <- nms.incl[colsToAgg]

  ### --------------------------------------- ###
  ### INFO arg
      if (is.logical(addInfo))
          addInfo <- ifelse(isTRUE(addInfo), "append", "none")
      else 
          addInfo <- match.arg(addInfo)

      ## Prepare the info, before taking a hardcopy
      DT.nm     <- capture.output(substitute(DT))
      new.info  <- chopAfterWord(pasteC(c("aggregateDT() of ", DT.nm, " using by=c", pasteQ(by), 
                                " and colsToAgg=c", pasteQ(colsToAgg), "and exclude=c", pasteQ(colsToAgg)))
                        , words="and", after=FALSE, max=80)

      ## Get orig.info either from the DT directly, or if it is a function, from it's predessor
      if (grepl("\\[", DT.nm) && is.null(getInfo(DT, verbose=FALSE, showWarnings=showWarnings.info))) {
        DT.nm <- strsplit(DT.nm, "\\[")[[c(1, 1)]]
        orig.info <- getInfo(get(DT.nm, envir=parent.frame()), verbose=FALSE, showWarnings=FALSE)
      } else 
        orig.info <- getInfo(DT, verbose=FALSE, showWarnings=showWarnings.info)

      if (addInfo == "append") {
        info <- appendInfo(new.info, orig.info, DT.nm, DT, showWarnings=FALSE)
      } else if (addInfo == "new_only") {
        info <- new.info
      } else if (addInfo == "preserve_original") {
        info <- orig.info
      }
  ### --------------------------------------- ###

  ## Check specifically for datetime columns
  if (any(DT[, sapply(.SD, is.date_or_time), .SDcols=colsToAgg]))
    stop ("There are date or time columns in the 'colsToAgg' field. We cannot aggregate these.\nHINT: Did you mean to put these in the 'by' argument?")

  ## Check if any numeric columns need to be converted.  To avoid integer overflow 
  if (convert.integers.to.numeric) {
      toConvert <- nwhich(sapply(DT[, colsToAgg, with=FALSE], is.integer))
      if (length(toConvert)) {
          ## Show warning for large table
          if (prod(dim(DT)) > 1e8)
              warning ("We will be copying the whole DT. This may take a minute")
          ## Take a copy to not modify original 
          DT <- copy(DT)
          DT[, c(toConvert) := lapply(.SD, as.numeric), .SDcols=toConvert]
      }
  }

  ## Check for character columns
  wh.not_numeric <- !sapply(colsToAgg, function(x) is.numeric(DT[[x]]))
  if (any(wh.not_numeric)) {
    stop(warningCols("Some colsToAgg are not numeric, namely: ", wh.not_numeric), "\n\nHINT: try   showWhereNAsWillIntroduce(", DT.nm, ", '", names(wh.not_numeric)[[1]], "')")
  }


  # ret <- unique(DT[, setNames(nm=nms.incl, lapply(.SD, sum, na.rm=TRUE)), keyby=by, .SDcols=colsToAgg],  by=by)    
  # if (addInfo == "none")
  #     clearInfo(ret)
  #   else
  #     setInfo(ret, info)

  # pre-pipe and cleanTrueLengthOfDTs #  if (addInfo == "none")
  # pre-pipe and cleanTrueLengthOfDTs #      return(clearInfo(
  # pre-pipe and cleanTrueLengthOfDTs #          unique(DT[, setNames(nm=nms.incl, lapply(.SD, aggFunc, ...)), keyby=by, .SDcols=colsToAgg], keyby=by)
  # pre-pipe and cleanTrueLengthOfDTs #      ))
  # pre-pipe and cleanTrueLengthOfDTs #  else
  # pre-pipe and cleanTrueLengthOfDTs #      return(setInfo(
  # pre-pipe and cleanTrueLengthOfDTs #          unique(DT[, setNames(nm=nms.incl, lapply(.SD, aggFunc, ...)), keyby=by, .SDcols=colsToAgg], keyby=by)
  # pre-pipe and cleanTrueLengthOfDTs #        , info
  # pre-pipe and cleanTrueLengthOfDTs #      ))

  # with pipe #  if (addInfo == "none")
  # with pipe #      return(
  # with pipe #        DT[, setNames(nm=nms.incl, lapply(.SD, aggFunc, ...)), keyby=by, .SDcols=colsToAgg] %>% 
  # with pipe #              unique(by=by) %>% cleanTrueLengthOfDTs(verbose=FALSE) %>% clearInfo
  # with pipe #            )
  # with pipe #  else
  # with pipe #      return(
  # with pipe #        DT[, setNames(nm=nms.incl, lapply(.SD, aggFunc, ...)), keyby=by, .SDcols=colsToAgg] %>%
  # with pipe #        unique(by=by) %>%  cleanTrueLengthOfDTs(verbose=FALSE) %>% setInfo(info)
  # with pipe #        )


  ## RETURN
  return (
    DT[, setNames(nm=nms.incl, lapply(.SD, aggFunc, ...)), keyby=by, .SDcols=colsToAgg] %>%
      unique(by = by) %>%
      cleanTrueLengthOfDTs(verbose=FALSE) %>%
      { if  (addInfo == "none") 
             clearInfo(.) 
        else setInfo(., info) 
      }
  )
}