## 20141003 -- NOTE TO SELF
"These are used in someLivre, Pricing, PricingES  SpottifyAdds, etc
"

  # -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  dateBreaks.r                                                                           #
  #           Last Updated Funclist  :  08 Feb 2015,  5:14 AM (Sunday)                                                         #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  lubridate                                                                              #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   center_date        ( d, unit=c("second", "minute", "hour", "day", "week", "month", "year"), origin="1970-01-01", ... )   #
  #   dateBreaks         ( from=rng[[1]], to=rng[[length(rng)]], N=5, addl=NULL, rng, format="%m '%y"                          #
  #                        , origin="1970-01-01", dropMargin=0.2                                                               #
  #                        , roundBy=c("month", "day", "week", "year"), addYear=FALSE, N.margin=1.25, verbose=TRUE             #
  #                        , retNumeric=TRUE, remOverlap=FALSE )                                                               #
  #   score              ( z )                                                                                                 #
  #   toDate             ( d )                                                                                                 #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

center_date <- function(d, unit = c("second","minute","hour","day", "week", "month", "year"), origin="1970-01-01", ...) {
  D <- as.Date(d, origin=origin)

  flr <- lubridate::floor_date(D, unit="month", ...)
  cel <- lubridate::ceiling_date(D, unit="month", ...)
  
  return((cel - flr)/2 + flr)
}

dateBreaks  <- function(from=rng[[1]], to=rng[[length(rng)]], N=5, addl=NULL, rng
                        , format="%m '%y", origin="1970-01-01"
                        , dropMargin=0.2
                        , roundBy = c("month", "day", "week", "year") # "second", "minute", "hour", 
                        , addYear = FALSE
                        , N.margin = 1.25
                        , verbose=TRUE
                        , retNumeric=TRUE
                        , remOverlap=FALSE) { 

  # if the difference in months is less than N 
  #  use 

  if (length(c(from, to))!=2) {
    stop("Invalid input for ", ifelse(!missing(rng),"rng","from & to"), ".")
  }

  # Space between breaks
  chunk <- abs((to - from) / (N-1))

  if (missing(roundBy)) {
    roundBy <- 
        if (N < 5 && chunk < 30)
           "day"
        else if ( N < 10 && chunk < 22)
           "week"
        else  if (N >=3 & chunk > 300)
           "year"
        else 
          "month"
  } else 
    roundBy <- match.arg(roundBy)

  from.cntr <- center_date(from, unit=roundBy, origin=origin) 
  to.cntr   <- center_date(to,   unit=roundBy, origin=origin) 

  b.seq <- seq.Date(from=from.cntr, to=to.cntr, by=roundBy)

  ## We are going to keep only every 2nd (or 1st, or 3rd, 4th, etc) element of b.seq
  L <- length(b.seq) 

  if (L > 9) {
    bby <- round(L / N / N.margin)
    
    ## Choose 
    score <- function(z) {d=diff(z); d <- abs(d - median(d)); data.table(mean=mean(d), sd=sd(d))}
  
    choices <- list(  b.seq[seq(from=1,   to=L,   length.out=N)]
                    , b.seq[seq(from=1+1, to=L-1, length.out=N)]
                    , b.seq[seq(from=1,   to=L-1, length.out=N)]
                    , b.seq[seq(from=1+1, to=L,   length.out=N)]
  
                    , b.seq[seq(from=1,   to=L,   length.out=N*N.margin)]
                    , b.seq[seq(from=1+1, to=L-1, length.out=N*N.margin)]
                    , b.seq[seq(from=1,   to=L-1, length.out=N*N.margin)]
                    , b.seq[seq(from=1+1, to=L,   length.out=N*N.margin)]
  
                    , b.seq[seq(from=1,   to=L,   length.out=N*1.6)]
                    , b.seq[seq(from=1+1, to=L-1, length.out=N*1.6)]
                    , b.seq[seq(from=1,   to=L-1, length.out=N*1.6)]
                    , b.seq[seq(from=1+1, to=L,   length.out=N*1.6)]
                    )
  
    choices <- lapply(choices, unique)
  
    selected <- cbind(rbindlist(lapply(choices, score)), ROW=seq_along(choices))[order(mean, sd)][1, ROW]
  
    if (verbose)
      cat("Selected #", selected, " of ", length(choices), "\n")
  
  
    breaks <- choices[[selected]]
  } else {
    breaks <- b.seq
  }

#  # create breaks.  If from>to, by needs to be negative
#  breaks <- seq(from=from, to=to, by=chunk * (-1)^(from>to) )
#
#  # round out the dates
#  breaks <- as.Date(breaks, origin=origin)
#  breaks <- unique( mapply(function(x, y) (x-y) / 2 + y,
#                   lubridate::ceiling_date(breaks, unit=roundBy)
#                ,  lubridate::floor_date(breaks, unit=roundBy)
#                ))


  ## check if there is an overlap between breaks & addl
  breakRanges <- sapply(breaks, "+", chunk * dropMargin * c(-1, 1))
  toDrop      <- apply(breakRanges, 2, function(x) 
                        any(addl %between% x))

  if (missing(format)) {
    #  eg: "Jun '13"
    #      "Jun 9"
    #      "Jun"

    ## Are all the days essentially, the same? If so, dont add day


    ## Does the range span more than one year? 
    multiYear <- year(as.Date(from, origin=origin)) != year(as.Date(to, origin=origin)) 

    ## Dont auto-add the day if they're all essentially the same day of the month
    dayss <- lubridate::day(as.Date(breaks, origin=origin))
    dontAutoAddDay <- {sum(abs(dayss - mean(dayss)) < 2.5) >= (.8 * length(dayss))}

    format <- paste0("%b",
                if (addYear || roundBy=="year" ||  (multiYear && (N > 3 || chunk > 230)))
                  " '%y"
                else if (roundBy %in% c("week", "day") || (chunk < 22 || N < 10 && !dontAutoAddDay )) 
                  " %d"
                )
  }

  toDate <- function(d)
     format(as.Date(d, origin=origin), format=format)

  if (is.null(names(breaks)))
    breaks <- setNames(breaks, toDate(breaks))

  if (remOverlap)
    names(breaks) <- ifelse(toDrop, "", names(breaks))

  if (is.null(names(addl)) && !is.null(addl))
    addl <- setNames(addl, toDate(addl))
  if (!is.null(addl)) {
    spc <- pasteR(" ", 4)
    names(addl) <- paste0(names(addl), spc)
    names(addl) <- gsub("\n", paste0(spc, "\n"), names(addl))
  }

  b2 <- sort(c(breaks, addl), decreasing=(from>to))

  func <- if(retNumeric) as.numeric else identity
  return(list(breaks=func(b2), labels=names(b2)))
}


# addl <- c(start=startDate, end=endDate)
# (bl <- dateBreaks(rng=dat$date, addl=addl, addYear=TRUE, remOverlap=FALSE))
# ggplot(data=dat, aes(x=date, y=value)) + geom_line(alpha=0.4) +
#         geom_vline(xintercept=c(startDate, endDate), color="blue") +
#         scale_x_continuous(breaks = bl$breaks, labels= bl$labels) +
#         theme(axis.text.x =element_text(angle=65, vjust=0.85, size=-1) )# 
# 
#