# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  addColsFrom.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                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   addColsFrom_       ( DT.receiving                                                                                        #
  #                        , DT.giving, colsToBring=setdiff(names(DT.giving), joinCols.giv), joinCols.rec=joinCols             #
  #                        , joinCols.giv=joinCols, joinCols=key(DT.receiving)                                                 #
  #                        , nms.newCols=colNamesFromVector(colsToBring), showWarnings=TRUE )                                  #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

## 2015-02-10 -- I believe I can remove this function fully now
# addColsFrom <- function(...) {
#   warning("\n+++++++++++++++++++++++++++++++++++++++++++++++\naddColsFrom() is deprecated.\nUse addColsFrom_ ()   --- note the underscore\n+++++++++++++++++++++++++++++++++++++++++++++++")
#   addColsFrom_(...)
# }

addColsFrom_ <- function(
      DT.receiving
    , DT.giving
    , colsToBring  = setdiff(names(DT.giving), joinCols.giv)
    , joinCols.rec = joinCols
    , joinCols.giv = joinCols
    , joinCols     = key(DT.receiving)
    , nms.newCols  = colNamesFromVector(colsToBring)
    , keyback.rec = TRUE
    , keyback.giv = TRUE
    , showWarnings = TRUE) {

  ## TODO 2015-06-01: Should the new cols be added to the key? 

  ## Bank the original keys
  key.bak.r <- key(DT.receiving)
  key.bak.g <- key(DT.giving)

  ## Capture the names, For error mesages
  DT.receiving.nm <- capture.output(substitute(DT.receiving))
  DT.giving.nm <- capture.output(substitute(DT.giving))

  if (!truelength(DT.receiving) || !truelength(DT.giving))
    stop ("Check the truelength(DT) -- self reference will fail\nHINT:  Did you load these from disk?\n You can use setDT(DT) to fix")
  
  ## Error Check 
  if (any(joinCols.rec %ni% names(DT.receiving)))
    stop("Missing columns from ", DT.receiving.nm, ": \n", commaSep(setdiff(joinCols.rec, names(DT.receiving))))
  if (any(joinCols.giv %ni% names(DT.giving)))
    stop("Missing columns from ", DT.giving.nm, ": \n", commaSep(setdiff(joinCols.giv, names(DT.giving))))

  ## new names cannot already exist in DT.receiving
  if (any(nms.newCols %in% names(DT.receiving)))
    stop ("Some 'nms.newCols' already exist in ", DT.receiving.nm, ": \n", commaSep(intersect(nms.newCols, names(DT.receiving))))
  ## colsToBring must all be in DT.giving
  if (any(colsToBring %ni% names(DT.giving)))
    stop ("Some 'colsToBring' do not exist in ", DT.giving.nm, ": \n", commaSep(setdiff(colsToBring, names(DT.giving))))

  lj.r <- length(joinCols.rec)
  lj.g <- length(joinCols.giv)
  if(!lj.r)
    stop("joinCols.rec has no length")
  if(!lj.g)
    stop("joinCols.giv has no length")
  if (lj.r < lj.g)
    stop(sprintf("length of joinCols.rec (%i) is smaller than length of joinCols.giv (%i)", lj.r, lj.g))
  if (lj.r > lj.g)
    verboseMsg(showWarnings, sprintf("length of joinCols.rec (%i) is larger than length of joinCols.giv (%i)", lj.r, lj.g))

  ## TODO CHECK CLASS
  classes.r <- DT.receiving[ , sapply(.SD, class), .SDcols = joinCols.rec]
  classes.g <- DT.giving[    , sapply(.SD, class), .SDcols = joinCols.giv]

  if (!all(classes.r == classes.g[seq(classes.r)]))
    stop ("classes are not the same for the join columns. Join will fail\n\nDT.rec has ", pasteQ(classes.r), "\nDT.giv has ", pasteQ(classes.g))

  setkeyIfNot(DT.receiving, joinCols.rec, superset.ok=FALSE, verbose=FALSE)
  setkeyIfNot(DT.giving,    joinCols.giv, superset.ok=FALSE, verbose=FALSE)

  browser(expr=inDebugMode(c("addColsFrom_")), text="in addColsFrom() right after changing keys")

  # debugging : #  ## When debugging, we will want to check this
  # debugging : #  if (FALSE) 
  # debugging : #  {
  # debugging : #    c
  # debugging : #    btext()
  # debugging : #
  # debugging : #    ## Optionally create a backup pointer; The second line reinstates it
  # debugging : #    if (exists("!.pointer_to_orig.rec", inherits=FALSE)) .pointer_to_orig.rec <- DT.receiving
  # debugging : #    print(Inspect(DT.receiving)); if (exists(".pointer_to_orig.rec", inherits=FALSE))  DT.receiving <- .pointer_to_orig.rec; print(Inspect(DT.receiving))
  # debugging : #
  # debugging : #    mem.rec <- Inspect(DT.receiving)
  # debugging : #    mem.giv <- Inspect(DT.giving)
  # debugging : #    cat("\nDT.receiving memory info: \n"); print(mem.rec)
  # debugging : #    cat("\nDT.giving    memory info: \n"); print(mem.giv)
  # debugging : #
  # debugging : #    cat("-------------\n")
  # debugging : #    DT.join <- DT.receiving[DT.giving, allow=TRUE]
  # debugging : #    cat(sprintf("ROWCOUNT:\n\tDT.rec has %i rows, DT.giv has %i rows, DT.join has %i rows\n\n", nrow(DT.receiving), nrow(DT.giving), nrow(DT.join)))
  # debugging : #    ## find a non-NA row
  # debugging : #    DT.join[is.na(get(setdiff(names(DT.giving), names(DT.receiving))[[1]]))]
  # debugging : #    DT.join[!is.na(get(setdiff(names(DT.giving), names(DT.receiving))[[1]]))]
  # debugging : #    DT.join[!is.na(get(setdiff(names(DT.receiving), names(DT.giving))[[1]]))]
  # debugging : #  }

  caught <- try({
    j.expr <- sprintf("(nms.newCols) := list(%s)", commaSep(sprintf("`i.%s`", colsToBring)))
    DT.receiving[DT.giving, j = eval(parse(text=j.expr)), allow.cartesian=TRUE]
  }, silent=TRUE)

  
  ## Confirm that the columns have been brought over -- which will not be the case if there were no rows in common
  if (showWarnings && any(nms.newCols %ni% names(DT.receiving))) {
    ## NOTE TO SELF:  I think this would catch a no-match
    # DT.receiving[, key(DT.receiving), with=FALSE][, .test := TRUE][DT.giving[, key(DT.giving), with=FALSE]][, all(is.na(.test))]
    if (all(nms.newCols %ni% names(DT.receiving)))
      warning ("None of the 'colsToBring' made it into ", DT.receiving.nm, "\nThis is possibly due to no shared matches in the key values")
    else 
      warning ("Some of the 'colsToBring' did not make it into ", DT.receiving.nm, "\nIt is unlikely that this is due to no shared matches in the key values, since the expected result is that none would have made it over. \nPlease investigate")
  }

  ## Put the keys back, specifically, before failing on error
  if (keyback.rec)  setkeyIfNot(DT.receiving, key.bak.r, superset.ok=FALSE, verbose=FALSE)
  if (keyback.giv)  setkeyIfNot(DT.giving,    key.bak.g, superset.ok=FALSE, verbose=FALSE)
  

  if (isErr(caught))
    stop("Attempting to add the columns failed with the following error:\n", attributes(caught)$condition$message)

  return(invisible(DT.receiving))
}



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



addMeta_ <- function(DT, DT.meta, colsToBring, idCol.candidates, idCol.candidates.DT=idCol.candidates, idCol.candidates.meta=idCol.candidates, fill.only.missingcols=TRUE, overwrite.existing.cols=FALSE, drop.idCol=FALSE, convertIdCols=FALSE , envir.for_assign=globalenv(), cluster=getOption("db.defaultcluster"), description.forWarnings=NULL, showWarnings=TRUE, verbose.get_dim=TRUE, verbose=TRUE) {
## Wrapper function to addColsFrom_() 
## This adds meta columns using get_dim_x


  ## bank the key for later
  key.bak <- key(DT)

  ## Auto-select idCol.candidates if both are data.tables and have exactly one column in common
  if (missing(idCol.candidates) && is.data.table(DT) && is.data.table(DT.meta)) {
    cols_shared <- intersect(names(DT), names(DT.meta))
    if (length(cols_shared) == 1) {
      message ("Auto-selected join col to be: ", cols_shared)
      idCol.candidates <- cols_shared
    }
  }


  if (!is.null(description.forWarnings))
    description.forWarnings %<>% paste0(" ", .)

  ## Find which col to join on
  ## For meta, first check if cidCol.DT is a column in meta, if so use that. If not, use the first option of the intersect
  cidCol.DT <- intersect(idCol.candidates.DT, names(DT))
  if (!length(cidCol.DT)) {
    # warning ("None of the idCol.candidates.DT are actual names of DT. Could not add meta info from ", clean.capture.output(substitute(DT.meta)), " -- Returning the DT unchanged")
    verboseMsg(showWarnings, "None of the", description.forWarnings, " idCol.candidates.DT are actual names of DT. Could not add meta info from DT.meta -- Returning the DT unchanged.\nHINT: The values in idCol.candidates.DT were c", pasteQ(idCol.candidates.DT), sep="")
    return(invisible(DT))
  }

  cidCol.DT <- cidCol.DT[[1]]

  if (!is.data.table(DT.meta) && is.data.frame(DT.meta))
    DT.meta <- as.data.table(DT.meta)

  if (!is.data.table(DT.meta)) {
    ## FOR artist, release, track FILTER BY ID
    if (is.char_of_length1(DT.meta, showWarnings=FALSE) && DT.meta %in% c("release", "track", "artist"))
      whereIn <- setNames(obj=list(unique(DT[[cidCol.DT]])), nm=paste0(DT.meta, "id"))
    else 
      whereIn <- NULL

    fun <- sprintf("get_dim_%s", DT.meta)
    ## Check that the function exists
    if (!exists(fun)) stop ("DT.meta ", if (is.char_of_length1(DT.meta, showWarnings=FALSE)) sprintf("'%s'", DT.meta), " is neither a data.table nor the name of a known get_dim_x function.")
    fun <- match.fun(fun)
    DT.meta <- fun(whereIn=whereIn, refresh=!is.null(whereIn), assign=FALSE, force.save=FALSE, envir=envir.for_assign, cluster=cluster, verbose=verbose.get_dim)
  }

  # ## try get_dim_x
  # if (!is.data.table("DT.meta")) {
  #   ## FOR artist, release, track FILTER BY ID
  #   if (identical(DT.meta, "release")) {
  #     DT.meta <- get_dim_release(whereIn=list(releaseid=unique(DT[[cidCol.DT]])), envir=envir.for_assign, verbose=verbose.get_dim)
  #   } else if (identical(DT.meta, "artist")) {
  #     DT.meta <- get_dim_artist(whereIn=list(artistid=unique(DT[[cidCol.DT]])), envir=envir.for_assign, verbose=verbose.get_dim)
  #   } else if (identical(DT.meta, "track")) {
  #     DT.meta <- get_dim_track(whereIn=list(trackid=unique(DT[[cidCol.DT]])), envir=envir.for_assign, verbose=verbose.get_dim)
  #   } else {
  #     fun <- sprintf("get_dim_%s", DT.meta)
  #     if (!exists(fun)) stop ("cannot find DT.meta or get_dim_x equivalent for '", DT.meta, "'")
  #     fun <- match.fun(fun)
  #     DT.meta <- fun(refresh=FALSE, assign=FALSE, force.save=FALSE, envir=envir.for_assign, verbose=verbose.get_dim)
  #   }
  # }

  ## This next line is speicifically for transacs abbr -- if idCol.candidates.DT is of an abbr, so should meta, if available
  if (isTRUE(grepl("abbr", cidCol.DT)) && any(grepl("abbr", names(idCol.candidates.meta))) && any(grepl("abbr", names(DT.meta)))) idCol.candidates.meta <- grep("abbr", idCol.candidates.meta, value=TRUE)
  cidCol.meta <- ifelse(cidCol.DT %in% names(DT.meta), cidCol.DT, intersect(idCol.candidates.meta, names(DT.meta))[[1]])

  ## If either of the two idCols are blank, issue warning then return the DT unchanged
  if (!length(cidCol.DT)) verboseMsg(showWarnings, "No", description.forWarnings, " id col found in DT. Meta data not added")
  if (!length(cidCol.meta)) verboseMsg(showWarnings, "No", description.forWarnings, " id col found in DT.meta. Meta data not added to DT")
  if (!length(cidCol.DT) || !length(cidCol.meta)) return(invisible(DT))

  
  browser(expr=inDebugMode("addMeta_"), text="in addMeta_() before cleaning colsToBring")

  ## Clean up and erorr-check colsToBring
  ## ------------------------ 

if (FALSE)
  colsToBring=cols.meta_for_label

  ## dont bring the joining cols
  ## OLD: colsToBring <- setdiff(colsToBring, c(cidCol.DT, cidCol.meta))
  colsToBring %<>% { .[colNamesFromVector(.) %ni% c(cidCol.DT, cidCol.meta)] }

  if (fill.only.missingcols)
    ## OLD: colsToBring <- setdiff(colsToBring, names(DT))
    colsToBring %<>% { .[colNamesFromVector(.) %ni% names(DT)] }
  if (!length(colsToBring)) {
    verboseMsg(showWarnings, "There are no", description.forWarnings, " columns to bring that are not already in the DT")
    return(invisible(DT))
  }

  ## Clean up the cols column 
  if (length(wh.cols <- setdiff(colsToBring, names(DT.meta)))) {
    stop (warningCols(paste0("Some", description.forWarnings, " columns do not exist in the DT.meta and hence cannot be brought over\nOffenders are: "), wh.cols))
    ## Not sure if this should be an error or just a warning.  For now, stop, if not use the next line to continue
    ## OLD:  colsToBring <- intersect(colsToBring, names(DT.meta))
    colsToBring %<>% { .[. %in% names(DT.meta)] }
  }

  ## Check if cols are already present. If so, either fail or drop them
  if (length(wh.cols <- intersect(colNamesFromVector(colsToBring), names(DT)))) {
    if (!overwrite.existing.cols) stop (warningCols(paste0("Some", description.forWarnings, " columns already exist in DT -- Drop them or set  overwrite=TRUE\nOffenders are: "), wh.cols))
    else  DT[, (wh.cols) := NULL]
  }
  if (!length(colsToBring)) {
    verboseMsg(showWarnings, "After cleaning", description.forWarnings, " colsToBring it is now empty")
    return(invisible(DT))
  }

  ## Grab the names column as it currently stands
  nms.newCols <- colNamesFromVector(colsToBring)

  ## ------------------------ 

  ## We will insert the new columns in place along side the idCol. Therefore, find the position, which will be used in setcolorderpt()
  firstCols <- c(names(DT)[seq(min(which(names(DT) == cidCol.DT)))], nms.newCols)

  ## Bring the columns over
  addColsFrom_(DT, DT.meta, joinCols.r=cidCol.DT, joinCols.g=cidCol.meta, colsToBring=colsToBring, nms.newCols=nms.newCols, showWarnings=showWarnings)

  ## optionally drop the original idcol
  ## However, only drop of we were succesfull in bringing over the columns
  if (length(wh.cols <- setdiff(colNamesFromVector(colsToBring), names(DT)))) {
    warning(warningCols("Internal Error -- some", description.forWarnings, " columns in colsToBring didnt make it over. Namely: ", wh.cols))
    setkeyIfNot(DT, key.bak, verbose=FALSE)
    return(invisible(DT))
  } 

  if (cidCol.DT %in% key.bak)
    insert(key.bak, setdiff(colsToBring, key.bak), after=which(key.bak == cidCol.DT))

  if (drop.idCol) {
    DT[, (cidCol.DT) := NULL]
    key.bak <- setdiff(key.bak, cidCol.DT)
  }

  ## Clean up the column order
  setcolorderpt(DT, intersect(firstCols, names(DT)))

  if (convertIdCols) {
    ## some columns may have been dropped
    cidCol.DT <- intersect(cidCol.DT, names(DT))
    if (length(cidCol.DT))
      DT[, (cidCol.DT) := lapply(.SD, as.idcol), .SDcols=cidCol.DT]
  }

  setkeyIfNot(DT, key.bak, organize=FALSE, verbose=FALSE)
  return(invisible(DT))
}