# -------------------------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                                              #
  #           File Name              :  mbench.r                                                                                                 #
  #           Last Updated Funclist  :  10 Feb 2015,  1:01 PM (Tuesday)                                                                          #
  #                                                                                                                                              #
  #           Author Name            :  Rick Saporta                                                                                             #
  #           Author Email           :  RickSaporta@gmail.com                                                                                    #
  #           Author URL             :  www.github.com/rsaporta                                                                                  #
  #                                                                                                                                              #
  #           Packages Called        :  data.table, microbenchmark                                                                               #
  #           Packages Used via NS   :  NA                                                                                                       #
  #                                                                                                                                              #
  #  -----------------------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                                              #
  #   mbench             ( ..., maxSeconds=20, maxReps=200L, verbose=TRUE, times=NA, sort=TRUE, align="right"                                    #
  #                        , check=TRUE, checkEQUAL=check, debug=FALSE                                                                           #
  #                        , use=c("elapsed", "user.self", "sys.self"), maxDiffX=5                                                               #
  #                        , units=c("nanoseconds", "microseconds", "milliseconds", "seconds", "minutes", "hours", "days", "secs"), roundDigs=2  #
  #                        , relativeTo="min", MADs=FALSE, force=FALSE, showWarnings=FALSE                                                       #
  #                        , orderBy=c("Median", "Expr", "MAD", "Relative") )                                                                    #
  #   timesFormula       ( sampleTime )                                                                                                          #
  #   mxdifChar          ( x )                                                                                                                   #
  #                                                                                                                                              #
  #                                                                                                                                              #
  #                                                              <END FUNCS>                                                                     #
  #  -----------------------------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------------------------  #

mbench <- function(...
                  , maxSeconds=20, maxReps=200L, verbose=TRUE, times=NA, sort=TRUE
                  , runOneTime=is.na(times)
                  , align="right", check=TRUE, checkEQUAL=check, debug=FALSE
                  , use=c("elapsed", "user.self", "sys.self"), maxDiffX=5
                  , units = c("seconds", "nanoseconds", "microseconds", "milliseconds", "minutes", "hours", "days", "secs")
                  , roundDigs = 2
                  , relativeTo="min"
                  , MADs = FALSE
                  , force=FALSE
                  , showWarnings=FALSE
                  , orderBy=c("Median", "Expr", "MAD", "Relative")
                  ) { 
# runOneTime :: will run once, just to give a quick preview
# times :: how mmany times to iterate.  If it is NA, each expression will be ran once and then times will be set so as to not exceed maxSeconds
# force is an undocumented synonym for maxDiffX=NULL
# check : synonym for checkEQUAL
# checkEQUAL : first evaluates each expression and confirms that they are all equal

  require(microbenchmark)
  require(data.table)
  
  cls(3)
  
#  Moving to bottom
#  # units  
#  units <- names(secondsScale(units, toSeconds=TRUE))
#  multiplyBy <- secondsScale("nano", toSeconds=TRUE) * secondsScale(units, fromSeconds=TRUE)
#  names(multiplyBy) <- paste0("FROM nanoseconds TO ", units)
#
  if (force)
    maxDiffX <- NULL

  # match the use argument
  missing.units <- missing(units)
  units   <- match.arg(units)
  use     <- match.arg(use)
  orderBy <- match.arg(orderBy)

  if (length(sort) && !is.logical(sort))
    stop ("\n`sort` must be logical (T/F).\nUse `orderby` to indicate which columns to sort by.\n")

  # grab the dots
  dots <- list(...)

  # Check that the arguments are quoted calls
  if(! all(sapply(dots, is.call)) ) {
    dots <- match.call(expand.dots=FALSE)[["..."]]
    if (showWarnings)
      warning("\n  All arguments should be quoted calls.\n  We will fix this by using match.call trickery, but the names will be funky.\n  ",
              "Next time use something like \n\n\t\tsomeName <- quote(", dots[[1]], ")\n")
  }

  ## Grab names, add to dots
  mc <- match.call()
  nms <- ifelse(names(dots) == "", as.character(mc[(1:length(dots))+1]), names(dots))
  names(dots) <- nms

  # Function for calculating time based on a sample time
  timesFormula <- function(sampleTime)
    min(as.integer(floor(maxSeconds / max(sampleTime, 0.00001) )),  maxReps)  # The max(., .0001) is to prevent div by zero

        ### ~~~~ HERE IS WHERE WE DO A SINGLE EVALUATION FIRST ~~~~ ###

  ## Debugging
  if (debug)
    browser()
  browser(expr=inDebugMode(c("mbench", "microbenchmark", "benchmark")), text = "in mbench right before if (checkEQUAL)")    

  ## if checkEQUAL, evaluate each one first then check that they are the same. Fail if not.
  times.matrix.single.run <- NULL
  if (checkEQUAL) {
      #     timeToEval <- system.time({
      #       evald.dots <- lapply( seq(dots), function(x) eval( dots[[x]] ) )       
      #     })

    ### ~~~~ This is the actual evaluation, for a single run ~~~~ ###
    ## eval one time, capturing time it took to exectue and the values
    evald.dots <- lapply( seq(dots), function(x) { Time <- system.time(Val <- eval( dots[[x]] )); return(list(Time=Time, Val=Val))}  ) 

    ## Check that the values are equal
    if (!areEqual(lapply(evald.dots, "[[", "Val"), listlist=FALSE, NoWarningsName=TRUE)) {
      # if there are only two items, check their actual values
      if (length(evald.dots)==2 && identical(
              unname(as.vector(evald.dots[[1]][["Val"]]))
            , unname(as.vector(evald.dots[[2]][["Val"]]))
            ))
        warning("The numeric values of the two expressions are the same, but some attribute(s) is(are) not.") 
      else
       stop("\n\t Values are not the same. If this is not important, use argument  checkEQUAL=FALSE\n\n")
    }

    # Capture the times into a matrix
    times.matrix.single.run <- t(sapply(evald.dots, "[[", "Time"))
    rownames(times.matrix.single.run) <- nms
  } 

  ## -------- RUN ONE TIME TO FIND HOW MANY TOTAL times TO RUN TO REACH maxSeconds ------------------ ##
  ## if times is not given explicitly, calculate it based on how long one execution of each takes
  if (runOneTime || is.na(times)) {

    # If times not calculated already, run one time
    if (is.null(times.matrix.single.run))
      times.matrix.single.run <- t(sapply(dots, function(x) system.time(eval(x))))

    ## Isolate to the system.time column using
    use.times.single.run <- times.matrix.single.run[, use]

    ## Do not proceed if maxDiffX ratio is exceed
    if (isTRUE(maxDiffX > 1))  {
      rng <- range(use.times.single.run)
      rng[[1]] <- max(rng[[1]], 0.00001) ## avoid division by zero
      if  ((rng[[2]] / rng[[1]])  > maxDiffX)  {
          cat ("Single Run:\n", capture.output(times.matrix.single.run), "\n", sep="\n")
          cat ("\t\t\t<ONLY RAN ONCE>\n\nRatio between max & min time (", round(rng[[2]] / rng[[1]], 1) ,") exceeds maxDiffX (", maxDiffX, ").\nTo force full run anyway use argument `maxDiffX=NULL    eg:\n\n\t",   gsub("\\)$", ", maxDiffX=NULL)", as.character(as.expression(sys.call()))), "\n\n",  sep="")
          return(invisible(TRUE)) 
      }
    }
    .relative_to_single_run <- which(use.times.single.run == minn(use.times.single.run))
    use.factors.single.run <- sprintf("[%0.1f x]", use.times.single.run / use.times.single.run[.relative_to_single_run])
    use.factors.single.run[.relative_to_single_run] <- "[ x ]"

    ## if 'times' (number of iterations) is not set, determine it from the total time that the single-run took
    if (is.na(times)) {
      summed.run.time <- sum(use.times.single.run)
      times <- timesFormula(sampleTime=summed.run.time)
    }
  } 

  ## make sure times is an integer 
  times <- as.integer(times)

  if (verbose) {
    preInfo <- center(capture.output({
                  cat("Times for a singe run are: \n")
                  if (exists("use.times.single.run"))
                      print(  as.data.frame(rbind(round(use.times.single.run, 4), use.factors.single.run))   , row.names=FALSE)
                  else if (exists("timeToEval"))
                      timeToEval
                  else
                      cat("< unavailable (not calculated) >\n")
                  cat("\nMicrobenchmark will run", times, "times")
                }), shiftLeft=23, trim.first=FALSE)
    cat(center(preInfo, trim=FALSE, width.min=55), sep="\n")    
    cls(3)
    hr <- pasteR("~", 50)
#    cat(center("RESULTS:", pad=8, hbar=TRUE, width=50), sep="\n")
  }
  ## -------- RUN ONE TIME TO FIND HOW MANY TOTAL times TO RUN TO REACH maxSeconds ------------------ ##

  ## It is possible that `times` (the number of reps to execute) is 0
  ## In which case, stop the function and the user needs to increase the maxSeconds argument
  if (times == 0L) {
    stop("In mbench(), the 'maxSeconds' was capped at ", maxSeconds, "secs. which is not enough time for even one full run of each expression.\n\nIt is recommended to increase this number, or better yet,\n  set the 'times' argument explicitly,\n  such as 'mbench(..., times=7)'\n")
  } 

  # EXECUTE:  Compute the Times
  res <- microbenchmark(list=dots, times=times)


  ## ## -------------------------------- CREATE OUTPUT DT ----------------------------- ##
  ## Convert to data.table and then create the summary DT, smryDT
  resDT <- data.table(Expr=factor(res$expr, levels=names(dots)), Time=res$time, key="Expr")
  smryDT <- copy(resDT[, list(Median=median(Time), MAD = mad(Time)), keyby=Expr])


  ## ## -------------------------------------- ADJUST UNITS ----------------------------- ##
      units %<>% tolower()
      multiplyBy <- unname(secondsScale("nano", toSeconds=TRUE) * secondsScale(units, fromSeconds=TRUE))
      names(multiplyBy) <- paste0("FROM nanoseconds TO ", tolower(units))

      ## If we are rounding (as indicated by roundDigs) AND the desired units is relatively large, 
      ##  it's possible that times will appear to be 0.00 when in fact they are not.
      ## Therefore, we iterate through the scales (using MetricScaleNextRank()) until we find the next largest fit
      ## (We wrap the whole thing in try() because MetricScaleNextRank can potentially fail if no smaller scale is available)
      {
        tooCoarse <- FALSE  ## tracked for warning message below
        try({
          while(0 < sum(0 == round(smryDT[, -1, with=FALSE] * multiplyBy, roundDigs))  - sum(0 == smryDT[, -1, with=FALSE])) {
            units <- removeText("seconds", units) %>% MetricScaleNextRank(decreasing=TRUE, mod=3) %>% paste0("seconds")
            multiplyBy <- secondsScale("nano", toSeconds=TRUE) * secondsScale(units, fromSeconds=TRUE)
            names(multiplyBy) <- paste0("FROM nanoseconds TO ", units)
            tooCoarse <- TRUE
          }
        })
        if (tooCoarse && !missing.units) 
          warning("Selected units was too coarse.\n  Using ", units, " instead.")
      }
  ## ## -------------------------------------- ADJUST UNITS ----------------------------- ##

  ## Add  ±2 MADs columns
  if (MADs)
    smryDT[, c("(-2MAD)", "(+2MAD)") := list(Median - 2*MAD, Median + 2*MAD) ]

  smryDT[, setdiff(names(smryDT), "Expr") := {lapply(.SD, function(x) round(x * multiplyBy, roundDigs))}, by=Expr]
  smryDT[,  {lapply(.SD, function(x) round(x * multiplyBy, roundDigs))}, by=Expr]

  ## add relative column, unleess set to NULL
  if (!is.null(relativeTo)) {
    if (length(relativeTo) > 1) {
      warning("`relativeTo` should be just a single value.  Default is `min`. Other values could be names of expressions being evaluated. Taking only first element.")
      relativeTo <- relativeTo[[1]]
    }
    
    ## Allow for user to have inputed "Min", "MIN", "Max", "MAX", etc
    if (is.character(relativeTo) && any(tolower(relativeTo) == c("min", "max", "auto")))
      relativeTo %<>% tolower

    ## resolve which relativeTo to use
    if (relativeTo %in% smryDT$Expr)
      relativeTo <- which(smryDT$Expr == relativeTo)
    else if (relativeTo == "min" || relativeTo == "auto")
      relativeTo <- which.min(smryDT$Median)
    else if (relativeTo == "max")
      relativeTo <- which.max(smryDT$Median)
    else if (!is.numeric(relativeTo)) {
      warning("unknown value for relativeTo (", relativeTo, ") -- will use min")
      relativeTo <- which.min(smryDT$Median)
    }

    if (exists(".relative_to_single_run", inherits=FALSE)) {
      if (.relative_to_single_run != relativeTo)
        warning("Note that the 'relative X' for the initial single run is different than the 'relative X' now after multiple runs")
    }

    ## CALULATE THE RELATIVE MEDIANS
    smryDT[, relative := Median/Median[relativeTo]]
    smryDT[, relative := round(relative, 2-ceiling(log(relative-.999999, 10)))]
  }

  ## Add MAD / Median Ratio column
  smryDT[, "(2xMAD)/Median" := fwp(2*MAD / Median, 1)]

  ## Set column order
  standardOrder <- c("Expr", "relative", "(-2MAD)", "Median", "(+2MAD)", "MAD", "MAD/Median")
  setcolorderpt(smryDT, standardOrder, showWarnings=FALSE)

  ## Set Row Order
  smryDT <- smryDT[orderch(orderBy, decreasing=FALSE, showWarnings=FALSE, verbose=FALSE)]

  ## Clean `Expr` column (make aligned string)
  smryDT[, Expr := as.character(Expr)]
  mxdifChar <- function(x) max(abs(diff(nchar(x))))
  smryDT[, Expr := center(Expr, align=ifelse(mxdifChar(Expr) < 6, "left", "right"))]

  setnames(smryDT, "Median", "Median Time")

 ## Clean up numbers to align decimals
  smryDT[, relative := sprintf("%0.03f", relative)]
  smryDT[, `Median Time`]

  # capture output
  shift <- 5
  out <- center(formnumb(smryDT), pad=2.5, trim=FALSE, add.endl=FALSE, shiftLeft=shift
              , matrix.lines.collapse=TRUE, hbar=TRUE, all.same=FALSE, debug=FALSE)

  ## add units & times info 
  nc <- min(nchar(out)) - 2
  using <- paste0("'", use, "'")
  if (length(using)>1) using[[length(using)]] <- paste("&", using[[length(using)]])
  usingInfo <- paste0("Measuring ", pasteC(using, C=", "), " time.")
  unitsInfo <- paste0("Units: ", units)
  repsInfo  <- paste0("Number of Repetitions: ", times)
  nc.tot <- nchar(repsInfo) + nchar(unitsInfo)
  headerInfo <- paste0(unitsInfo, pasteR(" ", max(5, nc-nc.tot) ), repsInfo)
  usingInfo  <- paste0(usingInfo, pasteR(" ", nc-nchar(usingInfo))) 

  ## Display Output
  resultsHr <- paste0(center(c(hr, "RESULTS:", hr), pad=6, width=50, shiftLeft=shift, add.endl=TRUE))
  out <- c(resultsHr, "", "", 
           paste0(pasteR(" ", shift), c(usingInfo, headerInfo, "", out) ))

  catnn(center(out, shiftLeft=0, trim=FALSE))

  # return results from microbenchmark
  return(invisible(res))
}