# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  setkeyIfNot.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   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   isSuperSet         ( x, setToSearchIn, must.start.with=TRUE, strict=FALSE, verbose="only if different" )                 #
  #   setkeyIfNot        ( DT, ..., superset.ok=TRUE, organize=FALSE, verbose=TRUE, warnForColNameInEnv=TRUE )                 #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

isSuperSet <- function(x, setToSearchIn, must.start.with=TRUE, strict=FALSE, verbose="only if different") {
  
  if (is.data.table(x) && is.data.table(setToSearchIn)) {
    must.start.with <- TRUE
    x <- key(x)
    setToSearchIn <- key(setToSearchIn)
  }
  

  ## If either is NULL (ie, from key(DT)) then cannot be superset
  if (!length(x) || !length(setToSearchIn))
    return(FALSE)

  if (length(x) > length(setToSearchIn))
    return(FALSE)
  

  if (must.start.with)
    issuper <- (all(setToSearchIn[seq(x)] == x))
  else 
    issuper <- all(x %in% setToSearchIn)


  ## If must be strict, then length of the set must be larger than that of x
  if (issuper && strict)
    issuper <- length(setToSearchIn) > length(x)

  if (!issuper && identical(verbose, "only if different")) {
    if (length(wh <- x[x %ni% setToSearchIn])) {
      message("The following set diff exists")
      allSetDiff(x, setToSearchIn)
    }
  }

  return(issuper)
}

setkeyIfNot <- function(DT, ..., superset.ok=TRUE, organize=FALSE, verbose=TRUE, warnForColNameInEnv=TRUE) {
## sets the key to a DT, however, first checks if 
##  the key is already set to the given column(s)
##
## if ... is only one argument and it is a variable of strings, the values of that var will be used
##    unless it is ALSO a column name of DT, in which case it is treated as a column name but will throw a warning. 
## if .... are missing, they default to names(DT)
##
## Purpose of this function is to save the overhead 
##    of setting the key when a key is already set.
## 
## superset.ok :  if the current key is a superset of the new key, do nothing
##
## organize : If TRUE will setcolorderpt(DT, keycols)


## TODO: 
##  This does not work (indexing a character vector).  Why? 
##         setkeyIfNot(sparse.DT, colsGrouped[1:2])
  
    ###                                                                                           ###
    ###   INFO ON TIMING:                                                                         ###
    ###                                                                                           ###
    ###     given a 1,991,816 x 13 DT,  and two numeric columns as keys,                          ###
    ###     which are already set, we get the following timings:                                  ###
    ###                                                                                           ###
    ###         Unit: microseconds  (ran 16 Times)                                                ###
    ###             expr         min           lq       median          uq         max neval      ###
    ###               sk 1169691.701 1232075.2535 1262345.5290 1293192.183 1392595.847    16      ###
    ###          skIfNot      14.422      15.1835      32.0665      77.529      92.712    16      ###
    ###                                                                                           ###
    ###                                                                                           ###

      
  if (is.character(DT))
    DT <- get(DT, envir=parent.frame())

  # grab the dots
  if (missing(...))
    dots <- names(DT)
  else 
    dots <- as.character(substitute(list(...))[-1])

  browser(expr=inDebugMode("setkey", "setkeyIfNot"), text="in setkeyIfNot(), right after dots taken.")

  # if dots has only one value, and it is an object name AND it is not a column name of DT
  # then substitute its value for 
  if (length(dots) == 1) {
    ## Three possibilities

    if (dots %in% names(DT)) {
      ## Throw a warning if also exists in parent.frame, except for column 'date' (a comonly used column name)
      if (warnForColNameInEnv && exists(dots, envir=parent.frame()) && dots != "date")
        warning ("Ambiguous key selected:\n\t`", dots, "` is a variable name AND a column name of the data.table.\n\nThe key will be set to the single column, `", dots, "`\nHINT: set  warnForColNameInEnv=FALSE  to hide this message")
      ## nothing else to do. 'dots' is fine

    ## If dots is the name of a vector in the parent frame, get it
    } else if ( exists(dots, envir=parent.frame()) ) {
        dots <- get(dots, envir=parent.frame())

    ## Otherwise, try using the dots themselves
    } else {
      ## presumably the '...' are some unevaluated expression
      dots.uneval <- as.list(substitute(list(...)))[-1L]
      dots.eval   <- unlist(lapply(dots.uneval, eval, envir=parent.frame()))

      ## error-check:  Confirm they eval'd to characters that are in names(DT)
      if (!is.character(dots.eval) && length(dots.eval)) {
            if (verbose) {
              cat("dots.eval before the error is: ")
              print(dput(dots.eval))
            }
            stop("invalid input")
      } else if (!all(dots.eval %in% names(DT))) {
          stop ("the following are not in names(DT):\n\t", paste_l(dots.eval[!dots.eval %in% names(DT)] ))
      }

      ## Otherwise, dots.eval is good, use that.
      dots <- dots.eval
    }
  }


  ## Convert character(0) to NULL
  if (!length(dots))
    dots <- NULL

  # ## Allow for  setkeyIfNot(DT, NULL)
  # if (!length(dots))  # dots %in% c("NULL", "c()", "character()", "character(0)") || 
  #   return(invisible(setkey(DT, NULL)))

   
  ## Make sure dots are unique
  if (any(dups <- duplicated(dots)) ) {
    warning("Arguments passed for the new key are NOT unique. Offenders are: \n\t  ", paste_l(dots[dups]))
    dots <- unique(dots)
  }

  ## Verbose output, useful for debugging, but don't want it all the time. 
  # verboseMsg(verbose, "Using the following for new key: ", paste(dots, collapse=",  "), time=FALSE)

  # grab the current key to compare against
  current <- key(DT)

  ## considered superset only if allowed and actually is superset
  ##  Using strict for the verboseMsg at the end:  If we are not setting the key and currentIsSuperSet is TRUE, 
  ##     then we know it was the reason why.
  currentIsSuperSet <- superset.ok && isSuperSet(dots, set=current, must.start.with=TRUE, strict=TRUE, verbose=FALSE)

  ## Key needs to be set iff they are NOT idenitcal AND  not a superset (the latter dependent on superset.ok)
  keyNeedsSetting <- (!identical(current, dots)) && !currentIsSuperSet  && !(length(current) + length(dots) == 0)

  # if they are not the same, change the key and return TRUE
  if (keyNeedsSetting) {
    setkeyv(DT, dots)
    verboseMsg(verbose, "Key has been set", time=FALSE)
  } else 
    verboseMsg(verbose, "Key did not need to be set", if (currentIsSuperSet) {" (current key is a superset)"} else "", time=FALSE)

  if (organize) {
    setcolorderpt(DT, startCols=dots)
  }

  return(invisible(DT))
}