# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  DateTime_to_factors.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                                                                              #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   is.Date                             ( x )                                                                                #
  #   weekSpan                            ( weeks, start=NULL, end=NULL, range=FALSE, round.startday=NULL                      #
  #                                         , round.endday=NULL, round.direction="past", showWarnings=TRUE                     #
  #                                         , origin="1970-01-01", months, ... )                                               #
  #   StringToDate.CheckingForMonth       ( x, endOfMonth=FALSE, origin="1970-01-01" )                                         #
  #   weekRound                           ( x, start.wday=NULL, end.wday=NULL                                                  #
  #                                         , direction=c("closest", "future", "past"), addNames=FALSE )                       #
  #   factor.wdays                        ( x, start=4L, wdays=c("Su", "Mo", "Tu", "We", "Th", "Fr", "Sa", "Su") )             #
  #   factor.hours                        ( x, startAt=4L, decreasing=TRUE, noon=c("Noon", "12 PM") )                          #
  #   factor.ydays <- factor.genres <- factor.user_countrys <- factor.artist_countrys ( x )                                    #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

# DateTime_to_factors.r

### This is a collection of functions that makes factors with pretty labels 
##   Most of them are for extracted Date/Time components
## however, at the bottom of this file there are a few others (ie, genres, user_ countrys etc)
##
## This is used heavily by  ggHeatGrid()  and related to makeFactor() inside that function
##    ~/git/misc/rscripts/utils/ggWrappers/ggHeatGrid.r
## 

## There should already be a function is.Date() if not, create one
if (!exists("is.Date")) is.Date <- function(x) is(x, "Date")

  

weekSpan <- function(weeks, start=NULL, end=NULL, range=FALSE, round.startday=NULL, round.endday=NULL, round.direction="past", showWarnings=TRUE, origin="1970-01-01", months, ...) {
## Calculates a sequence of dates based on the number of weeks requested.
## Returns (if range==FALSE) all of the days in that sequence
## Returns (if range==TRUE)  the first and last day of the sequence
## months is a short hand for 4 * .. 

  if (missing(weeks) && !missing(months))
    weeks <- 4 * months
  
  ## ERROR CHECK ##
  if (!is.logical(range))
    stop("Argument `range` should be TRUE / FALSE")
  if (!is.numeric(weeks) || weeks < 1)
    stop("Weeks should be a number >= 1")

  ## COMPUTE ##
  length.out <- weeks * 7 
  ret <-  {
  if (length(start)) {
    if (length(end) && showWarnings)
      warning("Both `start` and `end` have been specified, but only one can be used. `end` will be ignored.  Please use `seq.Date` for more flexible options.")
    if (is.character(start))
      start <- StringToDate.CheckingForMonth(start, endOfMonth=FALSE, origin=origin)

    seq(from=start, length.out=length.out, by=1, ...)

  } else if (length(end)) {
    if (is.character(end))
      end <- StringToDate.CheckingForMonth(end, endOfMonth=TRUE, origin=origin)

    start <- (end - length.out) + 1
    seq(from=start, to=end, by=1, ...)
  } else 
    stop("One of either `start` or `end` **must** be specified")
  }

  if (range)
    ret <- c(start=ret[[1]], end=ret[[length(ret)]])

  ##  ROUND   ##
  if (length(c(round.startday, round.endday) ))
    ret <- weekRound(ret, start.wday=round.startday, end.wday=round.endday, direction=round.direction)

  return(ret)
}

StringToDate.CheckingForMonth <- function(x, endOfMonth=FALSE, origin="1970-01-01") {

  ## If no numbers present and we can match it to a month
  MoNo <- pmatch(substr(tolower(x), 1, 3), tolower(month.name))    
  if (!any(grepl("\\d", x)) && !is.na(MoNo)) {
    YEAR <- lubridate::year(Sys.Date())
    if (MoNo > month(Sys.Date()) - endOfMonth) # if beyond today (or beyond last full month, if we're using endOfMonth)
       YEAR <- YEAR - 1
    ret <- as.Date(paste0(YEAR, "-", MoNo, "-01"))
    if (endOfMonth)
      ret <- ret + lubridate::days_in_month(ret) - 1
    return(ret)
  } else {
    as.Date(x, origin=origin)
  }
}


weekRound <- function(x, start.wday=NULL, end.wday=NULL, direction=c("closest", "future", "past"), addNames=FALSE) {
# shifts x over so that the series of dates starts (or ends) with the selected day of the week

  if (!is.Date(x) || !length(x))
    stop("x should be a date vector of length at least 1")
 
  FirstOrLast <- ifelse(is.null(end.wday), 1, length(x))

  wday <- c(start.wday, end.wday)
  if (length(wday) != 1)
    stop("Exactly one of start.wday & end.wday should be specified, and it should be of length exactly one.\nIts value should be a weekday string  (eg 'Mon', 'Tue', etc)")

  if (toupper(wday) %in% c("S", "T"))
    stop("Ambiguous value for `wday`. Please use at least two letters of the weekday")

  direction <- match.arg(direction)

  ## Match the argument to the list of days
  wdays  <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
  wday <- pmatch(topropper(wday), wdays)
  if (is.na(wday))
    stop("Invalid value.\n`start.wday` (or `end.wday`) should be a character string of a weekday (eg 'Mon', 'Tue', etc)")

  # how many days to shift by
  wdayX1  <- pmatch(weekdays(x[[FirstOrLast]]), wdays)
  shiftby <- wday - wdayX1

  if (shiftby > 0 && direction=="past")
      shiftby <- shiftby - 7
  else if (shiftby < 0 && direction=="future")
      shiftby <- shiftby + 7
  else if (abs(shiftby) > 3 && direction=="closest")
      shiftby <- shiftby %% (-7 * sign(shiftby)) # neg to go pos & pos to go neg

  ret <- x + shiftby
  
  if (!addNames)
    return(ret)
  return(setNames(ret, weekdays(ret, abbreviate=TRUE)))

#  ## TESTS
#  if (FALSE) {
#    x1 <- structure(15736:15739, class = "Date")
#    x2 <- structure(15740:15743, class = "Date")
#    x3 <- structure(15739:15749, class = "Date")
#    for (roundTo in  c("SUNDAY", "MONDAY", "FRIDAY"))
#      for (x in list(x1, x2, x3)) {
#        cat("\n\n\t", pasteR("~", 30)," \n\t\t\t ORIGINAL: \n")
#        print(setNames(x, weekdays(x, T)))
#        cat("\n\n\t      {[ ROUNDING TO:", toupper(roundTo), "]}","\n\n" )
#        for (direc in c("closest", "future", "past")) {
#          cat("\n\tstart & end. direction=", direc, "\n", sep="")
#          print(weekRound(x, start=roundTo, direction=direc, addNames=TRUE))
#          print(weekRound(x, end=roundTo, direction=direc, addNames=TRUE))
#        }
#      }
#  }
  
}



factor.wdays <- function(x, start=4L, wdays=c("Su", "Mo", "Tu", "We", "Th", "Fr", "Sa", "Su")) {
    if (is.character(start))
      start <- match(tolower(start), tolower(wdays))

    if (!is.numeric(x) || !is.finite(x))
      stop("Invalid start value. Start should be an integer or a value of wdays.")

    L <- length(wdays)
    ordering <- (( (start-2)+(1:L) ) %% L) + 1    
    factor(x, levels=ordering, labels=wdays[ordering])  
}

factor.hours <- function(x, startAt=4L, decreasing=TRUE, noon=c("Noon", "12 PM")) {

  noon <- match.arg(noon)

  ## Short-circuit for the default value
  if (startAt==4 && !decreasing) {
    return(factor(x, levels=c(4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 0L, 1L, 2L, 3L), 
                     labels=c(" 4 AM", " 5 AM", " 6 AM", " 7 AM", " 8 AM", " 9 AM", "10 AM", "11 AM", noon, " 1 PM", " 2 PM", " 3 PM", " 4 PM", " 5 PM", " 6 PM", " 7 PM", " 8 PM", " 9 PM", "10 PM", "11 PM", "12 AM", " 1 AM", " 2 AM", " 3 AM") ))
  }

  ## For all other values, calculate it
  if (startAt < 0 || startAt > 23)
    stop("startAt must be an integer in [0, 23]")

  ordering <- c(seq(startAt, 23), if(startAt != 0) 0:(startAt-1))
  hh <-  c(12, 1:11)
  nms <- c(sprintf("%2d AM", hh), sprintf("%2d PM", hh))
  nms[nms == "12 PM"] <- noon

  nms <- nms[ordering+1]

  if (decreasing) {
    nms <- rev(nms)
    ordering <- rev(ordering)
  }

  factor(x, levels=ordering, labels=nms)
}

# No Special Treatment
factor.ydays <- factor.genres <- factor.user_countrys <- factor.artist_countrys <- function(x) return(factor(x))