# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  areEqual.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                                                                             #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   areEqual.slow      ( x, na.rm=TRUE, checkNames=TRUE, debug=FALSE, silent=FALSE )                                         #
  #   areEqual           ( x, na.rm=TRUE, tolerance=.Machine$double.eps^0.5, warn=FALSE, listlist=TRUE                         #
  #                        , failOnNULLs=TRUE, verbose=TRUE, NoWarnings=!warn, checkNames=FALSE                                #
  #                        , NoWarningsName=NoWarnings, debug=FALSE )                                                          #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #


areEqual.slow <- function(x, na.rm=TRUE, checkNames=TRUE, debug=FALSE, silent=FALSE) {
  # checks if all elements in a single vector are equal
  # returns TRUE / FALSE
  
  ## Debugging
    if (debug)
      browser(text="areEqual.slow, right at the beginning")

  # check input type  
  if (!is.null(dim(x)) && !is.matrix(x))
    stop("x must be a vector, a list, or a matrix")

  # All the dims should be equal (even if NULL). 
  # This avoids having to check all of the values
  if (!all(   duplicated( lapply(x, dim) )[-1]   )) {
      return(FALSE)
  }

  if (!checkNames) {
    ## data.tables have to be handled differently
    if (is.data.table(x) || is.data.table(x[[1]])) {
          x <- copy(x)
          data.table::setattr(x, "names", NULL)
          data.table::setattr(x, "rownames", NULL)
          for (i in seq_along(x)) {
            ## cannot unname(x[[i]]) for certain DTs (might be bug). Instead, give them all the same name. 
            data.table::setattr(x[[i]], "names", paste0("X", seq_along(length(x[[i]]))) )
            data.table::setattr(x[[i]], "rownames", NULL )
          } # // end forloop
    } else {
      rownames(x) <- NULL
      x[] <- unname(x)
      if (length(x[[1]]) > 1)
        x <- lapply(x, function(z) {rownames(z) <- NULL; unname(z)})
    }
  }

  if (na.rm)
    x <- x[!is.na(x)] 

  # Compare each emelent in x against x[[1]]. They should all be the same. 
  ##### TEMPORARY BUG IN `dplyr`
  #### ORIGINAL:
  #  ret <- sapply(x, all.equal, x[[1]])
  ##### INSTEAD:
  if ("dplyr" %in% loadedNamespaces())
    ret <- sapply(x, all.equal.default, x[[1]])
  else 
    ret <- sapply(x, all.equal, x[[1]])
  ##### TEMPORARY BUG IN `dplyr`

  # If there were some that were not the same, ret will have a value other than T/F
  #   hence we need to check first that it is logical, and then that it is TRUE
  all(sapply(ret, function(y) is.logical(y) && y))
}

areEqual <- function(x, na.rm=TRUE, tolerance = .Machine$double.eps ^ 0.5, warn=FALSE, listlist=TRUE, failOnNULLs=TRUE, verbose=TRUE
                  , NoWarnings=!warn, checkNames=FALSE, NoWarningsName=NoWarnings, debug=FALSE) { 
#  Depends on:  areEqual.slow()
#
# checkNames  : If TRUE, will first check the names of the values of x.  If the names do not match, will return FALSE.
# warn        : synonym (well, antonym) for NoWarnings
# failOnNULLs : If TRUE, if any NULL is present and not all NULL, value is FALSE. 
#               If FALSE, if any NULL is is present and not all NULL, NULLs are dropped
# 
# checks if all of the elements of a vector, list, or matrix are equal
# if checkNames is on, and the names are different, no further checks are made. 
# Returns TRUE / FALSE  (does not give info on what is not equal)

  # check input # 
  #--------------------------------------#
    # if called on a data.frame, convert to list
    if(is.data.frame(x)) {
      if (!NoWarnings)
        warning("`areEqual` was called on a data.frame. Coercing to list to do column-to-column comparisons.\nTo do row-wise comparisons use `duplicated(.)`.")
      x <- as.list(x)
    }

    if(!is.null(dim(x)) && !is.matrix(x))
      stop("x must be a vector, a list, or a matrix")

    if(!length(x)) {
      if (!NoWarnings)
        warning("x is length 0")
      return(TRUE)
    }

    if (!is.logical(na.rm)) {
      stop("`na.rm` must be a logical value.", if(length(na.rm)>1 || !is.null(dim(na.rm))) "\n\n   HINT: Did you accidentally pass to `areEqual` two different arguments to compare?  That is the wrong syntax ")
    }

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

  ## Debugging
  browser(expr={debug || inDebugMode(c("areEqual"))}, text="in areEqual() debugging before checkNames and failOnNULLs")

  ## TODO: 
  if (failOnNULLs) {
    "I am not sure if I actually need to manually address these"
  } else {
    warning ("failOnNULLs=FALSE is not yet implemented")
  }


  # if we are checking names, check those first.
  # all but the first element should be duplicates 
  if (checkNames && !all(duplicated(names(x))[-1]))  {  # note: `all()` returns TRUE for `logical(0)`
      if(!NoWarningsName)
            warning("Names differ, not checking any further.")
      return(FALSE)
  }

  # if x is a list of list, we need to compare all of the elements against themselves. 
  #  Thus use the slower method, which iterates over each element in the list
  if (length(x[[1]]) > 1) {
    if (listlist)
    ## TODO:  Insert check for `all(duplicated(names(x))[-1])`  <~~ When should this work?
        return(areEqual.slow(x, na.rm=na.rm, checkNames=checkNames, debug=debug))
    ## We can simply check if the values are all duplicated (which they should be)
    ## but if the names are off, this will throw off duplicated, so we need to remove them. 
    else {
      ## Check that all same dimensions
      if (!all(duplicated(lapply(x, dim))[-1L])) {
        verboseMsg(verbose, "The dims are different")
        return(FALSE)
      }
      ## If names or rownames are NOT equal, then remove them (Since otherwise they will throw off checkNames)
      if (!all(duplicated(lapply(x, names))[-1L]) || !all(duplicated(lapply(x, rownames))[-1L]) ) {
        if(!NoWarningsName)
          warning("Names differ.")
        # if checkNames was flagged on, then we return FALSE since values are not considered identical
        if (checkNames)
          return(FALSE)
        x <- lapply(x, function(z) {rownames(z) <- NULL; unname(z)})
      }
      return(all(duplicated(x)[-1]))
    }
  }

  # check if x is an empty set
  if (length(x)==0) {
    if (!NoWarnings)
      warning("x has no elements. Returning TRUE by default.")
    return(TRUE)
  }

  # check if the whole vector is nothing but NA's. 
  if (all(NAs <- is.na(x))) { 
    # check to see if na.rm is flagged on. In which case, that would leave the empty set
    if (na.rm && !NoWarnings)
      warning("`na.rm` is flagged on, but the vector is nothing but `NA`s.  `TRUE` was returned by default.")
    return(TRUE)
  }

  # NA's found in previous if statment
  if(na.rm)
    x <- x[!NAs]
  
  # if x is a factor, we will compare its numeric value
  if (is.factor(x))
    x <- as.integer(x)

  # otherwise, calculate the range and compare the max and the min.
  #  Note that this works even if `x` is `character`
  rng <- range(x, na.rm=na.rm)

  # if we are not checking the names, remove the names
  if(!checkNames)
    rng <- unname(rng)

  ## TODO:  I had this next portion ni here before adding the check for `all(is.na(x))` (two sections up)
  ##        I think this is no longer needed, but not certain. Specifically, the `is.infinite` part. 
  ##        When else could I get unexpected infiinities? 
  # # if we're not removing NA's we need to check for all NA
  # if(all(is.na(rng)) || all(is.infinite(rng)))
  #   return(all(is.na(x)))

  # else: 
  ret <- all.equal(rng[[1]], rng[[2]], tolerance=tolerance)

  # all.equal will not return a logical value if they are not equal
  return(is.logical(ret) && ret)
}