# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  as.data.table.table.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   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   as.data.table.microbenchmark ( x, key="expr", ... )                                                                      #
  #   dcast.mbench                 ( DT, ... )                                                                                 #
  #   test.mbench                  ( DT, test=c("t.test", "wilcox.test") )                                                     #
  #   as.data.table.table          ( x, value.col.name="count", showWarnings=TRUE )                                            #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #


as.data.table.TukeyHSD <- function(Tukey, wh=names(Tukey), zero_included=TRUE) {

  ## Input check
  if (!is.character(wh) || !length(wh))
    stop ("wh should be a character vector of length at least 1")

  ## Vectorize
  if (length(wh) > 1) {
    if (is.null(names(wh)))
      names(wh) <- wh
    return(lapply(wh, function(w) as.data.table.TukeyHSD(Tukey=Tukey, wh=w) ))
  }

  ## if name not present, throw warning and return NULL
  if (wh %ni% names(Tukey)) {
    warning (wh, "not names of Tukey")
    return (NULL)
  }

  ## Create the column splits
  nms <- strsplit(wh, ":")[[1]]
  froms <- paste("from", nms, sep="_")
  tos   <- paste("to",   nms, sep="_")

  DT.ret <- as.data.table(Tukey[[wh]], keep.rownames=TRUE)
  DT.ret[, c("from", "to") := strsplitToDT(rn, "-")]
  DT.ret[, (froms) := strsplitToDT(from, ":")]
  DT.ret[, (tos)   := strsplitToDT(to,   ":")]

  ## Remove the unsplat columns
  DT.ret[, c("from", "to", "rn") := NULL]

  if (zero_included)
    DT.ret[, zero_in_interval := (lwr < 0 & upr > 0)]

  colorders <- zipperCombine(froms, tos)
  setcolorderpt(DT.ret, startCols=colorders, endCols=c("diff", "lwr", "upr", "p adj"))
  setkeyIfNot(DT.ret, colorders, verbose=FALSE)

  return(DT.ret)
}


as.data.table.microbenchmark <- function(x, key="expr", ...) {
## Specific to microbenchmark package
  ret <- data.table(cbind(x), key=key, ...)
  setattr(ret, "class", c("mbench", class(ret)))
  return(ret)
}

dcast.mbench <- function(DT, ...) {
  if (!exists("dcast") && !require(reshape2))
    stop("Could not reshape the data.\nPlease ensure you have installed package 'reshape2'\n")

  DT[, .rn := seq(.N), by=expr]
  as.data.table(dcast(DT, .rn~expr, value.var="time" ))[, .rn := NULL]
}

test.mbench <- function(DT, test=c("t.test", "wilcox.test")) {
  test <- match.arg(test)
  test <- match.fun(test)
  res <- do.call(test, unname(DT))
  if (identical(test, t.test) && length(names(DT))==2)
    res[["data.name"]] <- sprintf("Time results for %s and %s", names(DT)[[1]], names(DT)[[2]])
  return(res)
}

as.data.table.table <- function(x, value.col.name="count", showWarnings=TRUE, convert_numerics=TRUE) {
	if (!is.table(x))
		stop("x must be a table")

 	d <- dim(x)
 	
 	if (all(d==0L)) {
 		if (showWarnings)
 			warning("x is table with no dimension. Returning empty data.table")
 		return(data.table())
 	## Single dimension
#	} else if (length(d) == 1L) {
#		name <- names(x)
#		D <- data.table(name=name, .tmp.name.=x, key="name")
 	} else  {
 		# if x is an array, 
 		#  when it is coerced to vector, 
 		#  it effectively is in 'rev' order relative to CJ(dimnames(x))
 		#  Thus, the use of rev, then setcolorder
    ARGS_to_CJ <- rev(dimnames(x)) %>% c(sorted=FALSE)
		D <- do.call(CJ, ARGS_to_CJ)
		setcolorder(D, rev(names(D)))
		
    if (convert_numerics)
      convertNumberCols_(D, colsToIgnore=".tmp.name.", verbose=FALSE)

		## Add in the count column
		D[, .tmp.name. := c(x)]

		## key by the original dimnames of x
		setkeyv(D, setdiff(names(D), ".tmp.name."))

        # This line simply to confirm correct values being assigned to `.tmp.name.` when x is, say, a three-dimensional table
		# D[, list(`.tmp.name.`, do.call(`[`, x, .BY[[1]], .BY[[2]], .BY[[3]]]), by=key(D)]
	}
	setnames(D, '.tmp.name.', value.col.name)
	return(D)
}


## EXAMPLES:  
if (FALSE)  {

	DF1 <- data.frame(ab=c("hello", "hi"), val={set.seed(1); sample(4, 20, TRUE)})
	DF2 <- data.frame(ab=c("hello", "hi"), val={set.seed(1); sample(4, 20, TRUE)}, other=sample(LETTERS[1:5], 20, TRUE))

	x_empty <- table(c())
	x  <- table({set.seed(1); sample(4, 20, TRUE)})
	x1 <- table(DF1)
	x2 <- table(DF2)

	length(dim(x_empty))
	as.data.table(x_empty)
	as.data.table(x)
	as.data.table(x1)
	as.data.table(x2)
}