# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  ggHeatColumns.r                                                                        #
  #           Last Updated Funclist  :  19 Feb 2015,  1:05 PM (Thursday)                                                       #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   ggHeatColumns      ( DT, id.var=names(DT)[[1]]                                                                           #
  #                        , colsToPlot=setdiff(names(DT), id.var), heat=c("rank", "value"), sortCol=id.var                    #
  #                        , decreasing=FALSE, low="white", high="steelblue", top=nrow(DT)                                     #
  #                        , formatFunc=c("formnumb", "fwp", "asCurr"), divideBy=1, round=2, width=3                           #
  #                        , axis.included=TRUE, title="", bgcolor_axis="#222222" )                                            #
  #   title_maker        ( text )                                                                                              #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

# ggHeatColumns.r

ggHeatColumns <- function(DT, id.var=names(DT)[[1]], colsToPlot=setdiff(names(DT), id.var), heat=c("rank", "value"), sortCol=id.var, decreasing=FALSE, low="white", high="steelblue", top=nrow(DT), formatFunc=c("formnumb", "fwp", "asCurr"), divideBy=1, round=2, width=3, axis.included=TRUE, title="", bgcolor_axis="#222222") {

  heat <- match.arg(heat)
  formatFunc <- match.arg(formatFunc)

  DT <- copy(DT)

  ## Add a dummy x column
  force(colsToPlot)
  DT[, .x := "SINGLE_COLUMN"]

  sorting_by_idvar_which_is_factor <- (id.var == sortCol && is.factor(DT[[id.var]]))
  if (!is.null(sortCol)) {
      # if (!(id.var == sortCol && is.factor(DT[[id.var]]))) {
        levs <- DT[, unique(get(id.var)[order(get(sortCol), decreasing=decreasing)]) ]
        levs <- as.character(levs)
        if (!sorting_by_idvar_which_is_factor)
          levs <- rev(levs)
        DT[, (id.var) := factor(get(id.var), levels=levs)]
      # } else {
        #  DT[, id.var := reverseFactor(get(id.var))]
      # }
      DT <- DT[order(get(sortCol), decreasing=decreasing)][seq(top)]
  } else 
      DT <- DT[seq(top)]

  ## If started with a factor, then reverse it so that the "top" values are at the top
  if (sorting_by_idvar_which_is_factor)
     DT[, (id.var) := {x <- get(id.var); reverseFactor(x)}]

  setkeyIfNot(DT, id.var, verbose=FALSE)

  browser(expr=inDebugMode(c("plot", "ggHeatColumns")), text="in ggHeatColumns before for loop")

if (FALSE){
col <- colsToPlot[[1]]
col <- colsToPlot[[2]]
}

  PLOTS <- emptylist(colsToPlot)
  for (col in colsToPlot) 
  {
    DT.plot <- copy(DT)
    DT.plot[, .heat  := if(heat == "rank") rank(-get(col)) else get(col)]
    DT.plot[, .label := match.fun(formatFunc)(round(get(col)/divideBy, round))]
    {
      PLOTS[[col]] <- 
        ggplot(data=DT.plot) + 
          geom_tile(aes_string(y=id.var, fill=".heat", x=".x"), color = "white", size=0, width=3) +
          scale_fill_gradient(low  = ifelse(heat == "rank", high, low)
                            , high = ifelse(heat == "rank", low,  high)  
                             ) +
          scale_x_discrete(breaks=NULL) + 
          # relativetext(y=.4) +
          # angledtext() +
          labs(x="", y="", title=col) +
          theme(plot.title=element_text(size=rel(.6))) +
          nolegend() + 
          noaxis.y() +
          # theme(panel.grid.major.y = element_line(size = 1.5, colour="red")) + 
          geom_text(aes_string(label=".label", x=".x", y=id.var), size=1.8) +
          theme(plot.margin = unit(c(0.2,-0.8,.6,-0.8), "cm"))
    }
  }

  if (!length(PLOTS))
    stop ("Something went wrong. PLOTS has no length")


  P1 <- PLOTS[[1]] + labs(x="",y="",title=" ")
  ## Find geom_text layer and drop it
  ## update 2015-08-01 -- added the '%>% unlist' part... not positive this wont break it
  wh.geom_to_drop <- sapply(P1$layers, function(x) x[["geom"]][["objname"]] == "text") %>% unlist
  P1$layers[wh.geom_to_drop] <- NULL
  ## Find scale_fill aesthetic and drop it
  wh.scale_to_drop <- sapply(P1$scales$scales, function(s) identical(s[["scale_name"]], "gradient") & identical(s[["aesthetics"]], "fill"))
  P1$scales$scales[wh.scale_to_drop] <- NULL

  ## Add in the id.var text and background color (ie, scale to a single color)
  P1 <- P1 + geom_text(aes_string(label=id.var, x=".x", y=id.var), size=2, color="white", fontface="bold") +
             scale_fill_continuous(low=bgcolor_axis, high=bgcolor_axis)

  ## Drop axis
  for (i in seq(length(PLOTS)))
    PLOTS[[i]] <- PLOTS[[i]] + noaxis.y()

  ## Need to ensure same type of title in P.main and P.axis
  title_maker <- function(text) 
    gg_text(text, 0.8, "bold")

  P.main <- do.call(arrangeGrob, c(PLOTS, nrow=1, list(main=title_maker(title)))) # , just="bottom"

  browser(expr=inDebugMode(c("ggHeatColumns_bottom")), text="in ggHeatColumns at bottom, before arrangeGrob")

  if (!axis.included)
    return(arrangeGrob(P.main, nrow=1, widths=c(10))) # , just="bottom"
  ## ELSE
  P.axis <- arrangeGrob(P1, main=title_maker(if(nchar(title)) " " else title))
  return(arrangeGrob(P.axis, P.main, nrow=1, widths=c(1, 10))) # , just="bottom"
}


# base_size <- 9
# p + theme_grey(base_size = base_size) + 
#     labs(x="", y="") + 
#     scale_x_discrete(expand = c(0, 0)) +
#     scale_y_discrete(expand = c(0, 0)) + 
#     theme(legend.position = "none",
#     axis.ticks = theme_blank(), axis.text.x = theme_text(size = base_size *
#         0.8, angle = 330, hjust = 0, colour = "grey50"))