#' Perfectly Flat Cross Table by native xtabs
#'
#' This function makes the result of xtabs perfectly flat.
#'
#' @param formula a formula object of the form lhs~rhs
#' @param data an optional data frame containing the variables in
#' the formula formula.
#' @param remove_zeros = 1 to remove zero frequency cells
#' @param print = 1 to print the result
#' @param debug = 1 to print the intermediate results
#' @param subset xtabs parameter
#' @param sparse xtabs parameter
#' @param na.action xtabs parameter
#' @param na.rm xtabs parameter
#' @param addNA xtabs parameter
#' @param exclude xtabs parameter
#' @param drop.unused.levels xtabs parameter
#'
#' @details
#' \code{formula} and \code{data} parameters function the same way
#' as native xtab function. \cr
#' In addtion, those parameters marked as "xtabs parameter",
#' see \link[stats:xtabs]{stats::xtabs}.
#'
#' The core part of thus function is as follows:
#' \preformatted{
#'  res <- ftable( xtabs( lhs~rhs,  data=data ) )
#' }
#' The above returns a matrix when \code{lhs} is a matrix.
#' However, as shown in the examples,
#' when \code{lhs} is a vector or missing, the result is a cross table. \cr
#' Note that, by adjusting \code{row.vars} and \code{col.vars} options of
#'  \code{ftable}, it is possible to produce a completely flat table.
#'
#'
#' @examples
#'
#' seed=1701
#' set.seed(seed)
#' n <- 50
#' x1 <- sample(1:3,n,replace=TRUE)
#' x2 <- sample(LETTERS[1:2],n,replace=TRUE)
#' x3 <- sample(letters[1:2],n,replace=TRUE)
#' c1 <- sample(c(0:3),n,replace=TRUE)
#' c2 <- sample(c(0:5),n,replace=TRUE)
#' data=data.frame(x1,x2,c1,c2)
#'
#' # 3 by variables
#' fxtabs( cbind(c1,c2)~x1+x2+x3, data=data)
#' ftable(xtabs( cbind(c1,c2)~x1+x2+x3, data=data))
#' fxtabs( c1~x1+x2+x3, data=data)
#' ftable(xtabs( c1~x1+x2+x3, data=data))
#' fxtabs( ~x1+x2+x3, data=data)
#' ftable(xtabs( ~x1+x2+x3, data=data))
#'
#' # 2 by variables
#' fxtabs( cbind(c1,c2)~x1+x2, data=data)
#' ftable(xtabs( cbind(c1,c2)~x1+x2, data=data))
#' fxtabs( c1~x1+x2, data=data)
#' ftable(xtabs( c1~x1+x2, data=data))
#' fxtabs( ~x1+x2, data=data)
#' ftable(xtabs( ~x1+x2, data=data))
#'
#' # single by variable
#' fxtabs( cbind(c1,c2)~x1, data=data)
#' ftable(xtabs( cbind(c1,c2)~x1, data=data))
#' fxtabs( c1~x1, data=data)
#' ftable(xtabs( c1~x1, data=data))
#' fxtabs( ~x1, data=data)
#' ftable(xtabs( ~x1, data=data))
#'
#'
#' @return
#' a matrix of flat contingency table.
#'
#' @export
#'

fxtabs <- function( formula = ~., data = parent.frame(), subset
                    , sparse = FALSE, na.action, na.rm = FALSE, addNA = FALSE
                    , exclude = if (!addNA) c(NA,NaN)
                    , drop.unused.levels = FALSE
                    , remove_zeros=0, print=0, debug=0 ){
 # Completely Flat Cross Table by native xtabs
 # Shin-ichi Mayekawaq
 # 20260514
 #
 # note
 # The original version was aggregate_freqdist which was renamed as fxtabs0.
 #
 #

 # analyze the input formula
 fmc=gsub(" ","", deparse(substitute(formula)))
 countname=strsplit(fmc,"~")[[1]][1]
 xname=strsplit(fmc,"~")[[1]][2]
 xname=strsplit(xname,"\\+")[[1]]
 nxvar=length(xname)

 if( debug ){
  cat("\n\n")
  printm(fmc,countname,xname)
 }

 #
 # Note that, flatten does not flatten when there are single count variable
 # and two by variables (classification variables.)
 # Therefore, when count is a single varible,
 #  we must fake xtabs by cbinding c_c_c_=1 to the given count.
 # The easiest way to do so is to add c_c_c_=1 always.
 #
 # Also, when the count variable is missing, we must add c_c_c_=rep(1,n)
 # before faking xtabs.
 # The resulting count will be in .count. variable.
 #


 # fake xtabs by adding .count.=rep(1,n) when there are only one count variable.
 if( countname == "" ){
  # get n: we need n when the count is missing.
  m <- match.call(expand.dots = FALSE)
  drop=c("print","debug","remove_zeros")
  m=m[ !(names(m) %in% drop) ]
  m[[1L]] <- quote(stats::model.frame)
  mf <- eval(m, parent.frame())
  n=nrow(mf$data)
  rm(mf,m)
  if( debug ) printm(n)
  formula <- update(formula, cbind(.count.=rep(1,n)) ~ ., evaluate=FALSE)
 }
 # always fake xtabs by adding c_c_c_=1
 formula <- update(formula, cbind(c_c_c_=1,.) ~ ., evaluate=FALSE)

 # use xtabs
 temp=xtabs( formula=formula, data=data, sparse = sparse   # , subset=subset
             , na.rm = na.rm, addNA = addNA
             , exclude = exclude, drop.unused.levels = drop.unused.levels
 )

 if( debug ){
  printm("xtabs", temp)
  str(temp)
 }

 # flatten the xtabs output
 ft=ftable(temp)
 rname=attributes(ft)$row.vars
 cname=attributes(ft)$col.vars[[1]]

 if( debug ){
  cat("\nFlattened table by ftabs\n")
  print(ft)
  printm(rname,cname)
  str(ft)
 }

 # make the last variable change first: rev reverses the columns of data frame
 id2=rev(expand.grid(rev(rname)))
 # merge id2
 ft=unclass(ft)
 colnames(ft)=cname

 # convert to num or char
 for( j in 1:ncol(id2) ){
  id2[,j]=type.convert(as.character(id2[,j]), as.is = TRUE)
 }

 locnz=apply( ft,1, function(x) !all(x==0) )
 ft=cbind(id2,ft )

 if( remove_zeros ){
  ft=ft[locnz,]
  if( debug ) ft=ft[locnz]
 }

 # remove fake var
 locfake=which(colnames(ft)=="c_c_c_")
 if( length(locfake) > 0 ) ft=ft[,-locfake, drop=FALSE]


 if( print ) printm(ft)

 return( ft )


} # end of fxtabs




