# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  sampleWithAccurateProbs.r                                                              #
  #           Last Updated Funclist  :  08 Feb 2015,  5:12 AM (Sunday)                                                         #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   sampleWithAccurateProbs ( x, size, replace=FALSE, prob=NULL, maxAttempts=50, thresh=max(1/size, 1/100), verbose=FALSE )  #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

sampleWithAccurateProbs <- function (x, size, replace = FALSE, prob = NULL, maxAttempts=50, thresh=max(1/size, 1/100), verbose=FALSE) {

  if (verbose)
  cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ \n")

  if (maxAttempts < 1)
    stop ("maxAttempts has to be at least 1")

  levs <- (x)
  if (anyDuplicated(x)) {
    warning("There are duplicate values in x so sampleWithAccurateProbs can do no better than regular sample. (Afterall, if a sample is drawn, which bucket should it go into to?)")
    currentAttempt <- maxAttempts - 1
  } else 
    currentAttempt <- 0

  useNA <- ifelse(any(is.na(levs)), "always", "no")

  probNormal <- prob / sum(prob)
  probNormal.bot <- probNormal - thresh
  probNormal.top <- probNormal + thresh

  ## Initialize
  found <- FALSE

  bestDistance <- Inf
  bestResult   <- NULL
  bestAttempt  <- NULL

  while (!found && currentAttempt < maxAttempts) {
    currentAttempt <- currentAttempt + 1

    ret <- sample(x=x, size=size, replace=replace, prob=prob)
    (probEmpiral <- table(factor(ret, levels=levs), useNA=useNA) / size)

    # probNormal - thresh < probEmpiral < probNormal + thresh
    browser(expr= any({abs(probEmpiral - probNormal) < thresh} != {(probNormal.bot < probEmpiral & probEmpiral < probNormal.top)}), text="in sampleWithAccurateProbs -- inaccurate inequality")

    distance <- abs(probEmpiral - probNormal)

    if (verbose)
    cat(paste0(capture.output(table(factor(ret, levels=levs), useNA=useNA))[-1L], rbind(" |  Attempt", sprintf(" |   %-6s", currentAttempt)), rbind("  |  Distance", sprintf("  |  %s", sum(distance)))) , sep="\n", fill=TRUE)

    if (sum(distance) <= bestDistance) {
      bestDistance <- sum(distance)
      bestResult   <- ret
      bestAttempt  <- currentAttempt
    }

    found <- all(distance < thresh)
  }

  if (verbose)
  cat(paste0("\n    USING  for thresh=", thresh, ":"), paste0(capture.output(table(factor(bestResult, levels=levs), useNA=useNA))[-1L], rbind(" |  Attempt", sprintf(" |   %-6s", bestAttempt)), rbind("  |  Distance", sprintf("  |  %s", sum(bestDistance)))) , sep="\n", fill=TRUE)

  return(bestResult)
}