R/crosstab.R

In misty: Miscellaneous Functions 'T. Yanagida'

#' Cross Tabulation
#'
#' This function creates a two-way and three-way cross tabulation with absolute
#' frequencies and row-wise, column-wise and total percentages.
#'
#' @param x         a matrix or data frame with two or three columns.
#' @param print     a character string or character vector indicating which
#'                  percentage(s) to be printed on the console, i.e., no percentages
#'                  (\code{"no"}) (default), all percentages (\code{"all"}),
#'                  row-wise percentages (\code{"row"}), column-wise percentages
#'                  (\code{"col"}), and total percentages (\code{"total"}).
#' @param freq      logical: if \code{TRUE}, absolute frequencies will be included
#'                  in the cross tabulation.
#' @param split     logical: if \code{TRUE}, output table is split in absolute
#'                  frequencies and percentage(s).
#' @param na.omit   logical: if \code{TRUE}, incomplete cases are removed before
#'                  conducting the analysis (i.e., listwise deletion).
#' @param digits    an integer indicating the number of decimal places digits
#'                  to be used for displaying percentages.
#' @param as.na     a numeric vector indicating user-defined missing values,
#'                  i.e. these values are converted to \code{NA} before conducting
#'                  the analysis.
#' @param write     a character string for writing the results into a Excel file
#'                  naming a file with or without file extension '.xlsx', e.g.,
#'                  \code{"Results.xlsx"} or \code{"Results"}.
#' @param check     logical: if \code{TRUE}, argument specification is checked.
#' @param output    logical: if \code{TRUE}, output is printed on the console.
#'
#' @author
#' Takuya Yanagida \email{takuya.yanagida@@univie.ac.at}
#'
#' \code{\link{freq}}, \code{\link{descript}}, \code{\link{multilevel.descript}},
#' \code{\link{na.descript}}, \code{\link{write.result}}
#'
#' @references
#' Rasch, D., Kubinger, K. D., & Yanagida, T. (2011). \emph{Statistics in psychology
#' - Using R and SPSS}. John Wiley & Sons.
#'
#' @return
#' Returns an object of class \code{misty.object}, which is a list with following
#' entries:
#' \tabular{ll}{
#' \code{call} \tab function call \cr
#' \code{type} \tab type of analysis \cr
#' \code{data} \tab matrix or data frame specified in \code{x} \cr
#' \code{args} \tab specification of function arguments \cr
#' \code{result} \tab list with result tables \cr
#' }
#'
#' @export
#'
#' @examples
#' dat <- data.frame(x1 = c(1, 2, 2, 1, 1, 2, 2, 1, 1, 2),
#'                   x2 = c(1, 2, 2, 1, 2, 1, 1, 1, 2, 1),
#'                   x3 = c(-99, 2, 1, 1, 1, 2, 2, 2, 2, 1))
#'
#' # Cross Tabulation for x1 and x2
#' crosstab(dat[, c("x1", "x2")])
#'
#' # Cross Tabulation for x1 and x2
#' # print all percentages
#' crosstab(dat[, c("x1", "x2")], print = "all")
#'
#' # Cross Tabulation for x1 and x2
#' # print row-wise percentages
#' crosstab(dat[, c("x1", "x2")], print = "row")
#'
#' # Cross Tabulation for x1 and x2
#' # print col-wise percentages
#' crosstab(dat[, c("x1", "x2")], print = "col")
#'
#' # Cross Tabulation x1 and x2
#' # print total percentages
#' crosstab(dat[, c("x1", "x2")], print = "total")
#'
#' # Cross Tabulation for x1 and x2
#' # print all percentages, split output table
#' crosstab(dat[, c("x1", "x2")], print = "all", split = TRUE)
#'
#' # Cross Tabulation for x1 and x3
#' # do not apply listwise deletion, convert value -99 to NA
#' crosstab(dat[, c("x1", "x3")], na.omit = FALSE, as.na = -99)
#'
#' # Cross Tabulation for x1 and x3
#' # print all percentages, do not apply listwise deletion, convert value -99 to NA
#' crosstab(dat[, c("x1", "x3")], print = "all", na.omit = FALSE, as.na = -99)
#'
#' # Cross Tabulation for x1, x2, and x3
#' crosstab(dat[, c("x1", "x2", "x3")])
#'
#' # Cross Tabulation for x1, x2, and x3
#' # print all percentages
#' crosstab(dat[, c("x1", "x2", "x3")], print = "all")
#'
#' # Cross Tabulation for x1, x2, and x3
#' # print all percentages, split output table
#' crosstab(dat[, c("x1", "x2", "x3")], print = "all", split = TRUE)
#'
#' \dontrun{
#' # Write Results into a Excel file
#' crosstab(dat[, c("x1", "x2")], print = "all", write = "Crosstab.xlsx")
#'
#' result <- crosstab(dat[, c("x1", "x2")], print = "all", output = FALSE)
#' write.result(result, "Crosstab.xlsx")
#' }
crosstab <- function(x, print = c("no", "all", "row", "col", "total"),
                     freq = TRUE, split = FALSE, na.omit = TRUE, digits = 2,
                     as.na = NULL, write = NULL, check = TRUE, output = TRUE) {

  #_____________________________________________________________________________
  #
  # Initial Check --------------------------------------------------------------

  # Check if input 'x' is missing
  if (isTRUE(missing(x))) { stop("Please specifiy a matrix or data frame for the argumen 'x'.", call. = FALSE) }

  # Check if input 'x' is NULL
  if (isTRUE(is.null(x))) { stop("Input specified for the argument 'x' is NULL.", call. = FALSE) }

  # Matrix or data frame for the argument 'x'?
  if (isTRUE(!is.matrix(x) && !is.data.frame(x))) { stop("Please specifiy a matrix or data frame for the argumen 'x'.", call. = FALSE) }

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ## As data frame ####

  x.crosstab <- as.data.frame(x, stringsAsFactors = FALSE)

  # Number of variables
  x.ncol <- ncol(x)

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ## Convert user-missing values into NA ####

  if (isTRUE(!is.null(as.na))) {

    x.crosstab <- misty::as.na(x.crosstab, na = as.na)

    # Variable with missing values only
    x.miss <- vapply(x.crosstab, function(y) all(is.na(y)), FUN.VALUE = logical(1))
    if (isTRUE(any(x.miss))) {

      stop(paste0("After converting user-missing values into NA, following variables are completely missing: ", paste(names(which(x.miss)), collapse = ", ")), call. = FALSE)

    }

    # Zero variance
    x.zero.var <- vapply(x.crosstab, function(y) length(na.omit(unique(y))) == 1, FUN.VALUE = logical(1))
    if (isTRUE(any(x.zero.var))) {

      stop(paste0("After converting user-missing values into NA, following variables have only one unique value: ", paste(names(which(x.zero.var)), collapse = ", ")), call. = FALSE)

    }

  }

  #_____________________________________________________________________________
  #
  # Input Check ----------------------------------------------------------------

  # Check input 'check'
  if (isTRUE(!is.logical(check))) { stop("Please specify TRUE or FALSE for the argument 'check'.", call. = FALSE) }

  if (isTRUE(check)) {

    # Check input 'x'
    if (isTRUE(ncol(x.crosstab) > 3L || ncol(x.crosstab) < 2L)) { stop("Please specify a matrix or data frame with two or three columns for the argument 'x'.", call. = FALSE) }

    # Check input 'x'
    x.zero.var <- vapply(x.crosstab, function(y) length(na.omit(unique(y))) == 1L, FUN.VALUE = logical(1))
    if (isTRUE(any(x.zero.var))) {

      stop(paste0("Following variables have only one unique value: ", paste(names(which(x.zero.var)), collapse = ", ")), call. = FALSE)

    }

    # Check input 'print'
    if (isTRUE(any(!print %in% c("no", "all", "row", "col", "total")))) { stop("Character strings in the argument 'print' do not match with \"no\", \"all\", \"row\", \"col\" or \"total\".", call. = FALSE) }

    # Check input 'freq'
    if (isTRUE(!is.logical(freq))) { stop("Please specify TRUE or FALSE for the argument 'freq'.", call. = FALSE) }

    # Check print = "no" and freq = FALSE
    if (isTRUE(all(print == "no") && isTRUE(!freq))) { stop("Please include either percentages (i.e., print != 'no') or absolute frequencies (i.e., freq = TRUE) in the cross tabulation.", call. = FALSE) }

    # Check input 'na.omit'
    if (isTRUE(!is.logical(na.omit))) { stop("Please specify TRUE or FALSE for the argument 'na.omit'.", call. = FALSE) }

    # Check input 'digits'
    if (isTRUE(digits %% 1L != 0L || digits < 0L)) { warning("Specify a positive integer number for the argument 'digits'.", call. = FALSE) }

    # Check input 'output'
    if (isTRUE(!is.logical(output))) { stop("Please specify TRUE or FALSE for the argument 'output'.", call. = FALSE) }

  }

  #_____________________________________________________________________________
  #
  # Arguments ------------------------------------------------------------------

  # Argument print
  if (isTRUE(all(c("no", "all", "row", "col", "total") %in% print))) { print <- "no" }

  if (isTRUE(length(print) == 1 && print == "all")) { print <- c("row", "col", "total") }

  # Global variable
  addmargins <- NULL

  #_____________________________________________________________________________
  #
  # Main Function --------------------------------------------------------------

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ## Two variables ####

  if (isTRUE(x.ncol == 2L)) {

    # If na.omit = FALSE, then include NA if any present
    if (isTRUE(!na.omit)) {

      x.crosstab <- data.frame(lapply(x.crosstab, function(y) misty::rec(y, "NA = 'NA'")), stringsAsFactors = FALSE)

    } else {

      if (isTRUE(any(is.na(x.crosstab)))) {

        warning(paste0("Listwise deletion of incomplete cases, number of cases removed from the analysis: ", length(attributes(na.omit(x.crosstab))$na.action)), call. = FALSE)

      }

    }

    #...................
    ### Absolute frequencies without margins ####
    freq.a <- table(x.crosstab)

    #...................
    ### Row-wise percentages ####

    perc.r <- addmargins(prop.table(freq.a, margin = 1L) * 100L)
    perc.r[row.names(perc.r) == "Sum", ] <- addmargins(prop.table(table(x.crosstab[, 2L])) * 100L)

    rownames(perc.r)[nrow(perc.r)] <- "Total"
    colnames(perc.r)[ncol(perc.r)] <- "Total"

    #...................
    ### Column-wise percentages ####

    perc.c <- addmargins(prop.table(freq.a, margin = 2L) * 100L)
    perc.c[, colnames(perc.c) == "Sum"] <- addmargins(prop.table(table(x.crosstab[, 1L])) * 100L)

    rownames(perc.c)[nrow(perc.c)] <- "Total"
    colnames(perc.c)[ncol(perc.c)] <- "Total"

    #...................
    ### Total percentages ####

    perc.t <- addmargins(prop.table(freq.a) * 100L)

    rownames(perc.t)[nrow(perc.t)] <- "Total"
    colnames(perc.t)[ncol(perc.t)] <- "Total"

    #...................
    ### Add margins ####
    freq.a <- addmargins(freq.a)

    rownames(freq.a)[nrow(freq.a)] <- "Total"
    colnames(freq.a)[ncol(freq.a)] <- "Total"

    #...................
    ### Table ####

    result <- data.frame(rep(names(freq.a[, 1L]), times = 4L),
                             rep(c("Freq", "Row %", "Col %", "Tot %"), each = nrow(freq.a)),
                             misty::as.na(rbind(freq.a, perc.r, perc.c, perc.t), na = "NaN", check = FALSE),
                             row.names = NULL, check.rows = FALSE, check.names = FALSE, fix.empty.names = FALSE)

    #...................
    ### Sort Table ####

    #### First variable is a factor ####
    if (isTRUE(is.factor(x.crosstab[, 1L]))) {

      # Sort with NA
      if (isTRUE(any(is.na(x.crosstab)) && isTRUE(!na.omit))) {

        result <- result[order(factor(result[, 1L], levels = c(levels(x.crosstab[, 1L]), "NA"), labels = c(levels(x.crosstab[, 1L]), "NA"))), ]

      # Sort without NA
      } else {

        result <- result[order(factor(result[, 1L], levels = levels(x.crosstab[, 1L]), labels = levels(x.crosstab[, 1L]))), ]

      }

    #### First variable is not a factor ####
    } else {

      result.temp <- result[-which(result[, 1L] == "Total"), ]

      #### Numeric
      if (isTRUE(is.numeric(x[, 1L]))) {

        # 'NA' character
        if (isTRUE(any(x.crosstab[, 1L] == "NA", na.rm = TRUE))) {

          result.temp.NA <- result.temp[-which(result.temp[, 1L] == "NA"), ]

          result <- rbind(result.temp.NA[order(as.numeric(result.temp.NA[, 1L])), ], result.temp[which(result.temp[, 1L] == "NA"), ], result[which(result[, 1L] == "Total"), ])

        # No 'NA' character
        } else {

          result <- rbind(result.temp[order(as.numeric(result.temp[, 1L])), ], result[which(result[, 1L] == "Total"), ])

        }

      ####  Character
      } else {

        # 'NA' character
        if (isTRUE(any(x.crosstab[, 1L] == "NA", na.rm = TRUE))) {

          result.temp.NA <- result.temp[-which(result.temp[, 1L] == "NA"), ]

          result <- rbind(result.temp.NA[order(result.temp.NA[, 1L]), ], result.temp[which(result.temp[, 1L] == "NA"), ], result[which(result[, 1L] == "Total"), ])

        # No 'NA' character
        } else {

          result <- rbind(result.temp[order(result.temp[, 1L]), ], result[which(result[, 1L] == "Total"), ])

        }

      }

    }

    rownames(result) <- NULL

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ## Three variables ####
  } else if (isTRUE(x.ncol == 3L)) {

    # If na.omit = FALSE, then include NA if any present
    if (isTRUE(!na.omit)) {

      x.crosstab <- data.frame(lapply(x.crosstab, function(y) misty::rec(y, "NA = 'NA'")), stringsAsFactors = FALSE)

    } else {

      if (isTRUE(any(is.na(x.crosstab)))) {

        warning(paste0("Listwise deletion of incomplete cases, number of cases removed from the analysis: ", length(attributes(na.omit(x.crosstab))$na.action)), call. = FALSE)

      }

    }

    #...................
    ### Absolute frequencies without margins ####

    x.table <- table(x.crosstab[, names(x.crosstab)[c(2L, 3L, 1L)]])

    freq.a <- list()
    for (i in seq_len(dim(x.table)[3L])) { freq.a[[i]] <- x.table[, , i] }

    names(freq.a) <- dimnames(x.table)[[3L]]

    #...................
    ### Row-wise percentages ####

    perc.r <- lapply(freq.a, function(y) prop.table(y, margin = 1L) * 100L)

    #...................
    ### Column-wise percentages ####

    perc.c <- lapply(freq.a, function(y) prop.table(y, margin = 2L) * 100L)

    #...................
    ### Total percentages ####

    perc.t <- lapply(freq.a, function(y) prop.table(y) * 100L)

    #...................
    ### Absolute frequencies a add margins ####

    freq.a <- lapply(freq.a, function(y) rbind(y, colSums(y)))
    freq.a <- lapply(freq.a, function(y) cbind(y, rowSums(y)))

    for (i in names(freq.a)) {

      rownames(freq.a[[i]]) <- c(rownames(freq.a[[i]])[-length(rownames(freq.a[[i]]))], "Total")
      colnames(freq.a[[i]]) <- c(colnames(freq.a[[i]])[-length(colnames(freq.a[[i]]))], "Total")

    }

    #...................
    ### Row-wise percentages a add margins ####

    for (i in names(perc.r)) {

      perc.r[[i]] <- rbind(perc.r[[i]], prop.table(freq.a[[i]][nrow(freq.a[[i]]), -ncol(freq.a[[i]])]) * 100L)
      perc.r[[i]] <- cbind(perc.r[[i]], rowSums(perc.r[[i]]))

      rownames(perc.r[[i]]) <- c(rownames(perc.r[[i]])[-length(rownames(perc.r[[i]]))], "Total")
      colnames(perc.r[[i]]) <- c(colnames(perc.r[[i]])[-length(colnames(perc.r[[i]]))], "Total")

    }

    #...................
    ### Column-wise percentages a add margins ####

    for (i in names(perc.c)) {

      perc.c[[i]] <- cbind(perc.c[[i]], prop.table(freq.a[[i]][-nrow(freq.a[[i]]), ncol(freq.a[[i]])]) * 100L)
      perc.c[[i]] <- rbind(perc.c[[i]], colSums(perc.c[[i]]))

      rownames(perc.c[[i]]) <- c(rownames(perc.c[[i]])[-length(rownames(perc.c[[i]]))], "Total")
      colnames(perc.c[[i]]) <- c(colnames(perc.c[[i]])[-length(colnames(perc.c[[i]]))], "Total")

    }

    #...................
    ### Total percentages add margins ####

    for (i in names(perc.t)) {

      perc.t[[i]] <- cbind(perc.t[[i]], prop.table(freq.a[[i]][-nrow(freq.a[[i]]), ncol(freq.a[[i]])]) * 100L)
      perc.t[[i]] <- rbind(perc.t[[i]], c(prop.table(freq.a[[i]][nrow(freq.a[[i]]), -ncol(freq.a[[i]])]) * 100L, 100L))

      rownames(perc.t[[i]]) <- c(rownames(perc.t[[i]])[-length(rownames(perc.t[[i]]))], "Total")
      colnames(perc.t[[i]]) <- c(colnames(perc.t[[i]])[-length(colnames(perc.t[[i]]))], "Total")

    }

    #...................
    ### Merge lists ####

    # Absolute frequencies
    freq.a.merge <- NULL
    for (i in seq_len(length(freq.a))) { freq.a.merge <- rbind(freq.a.merge, freq.a[[i]]) }

    # Row %
    perc.r.merge <- NULL
    for (i in seq_len(length(perc.r))) { perc.r.merge <- rbind(perc.r.merge, perc.r[[i]]) }

    # Column %
    perc.c.merge <- NULL
    for (i in seq_len(length(perc.c))) { perc.c.merge <- rbind(perc.c.merge, perc.c[[i]]) }

    # Total %
    perc.t.merge <- NULL
    for (i in seq_len(length(perc.t))) { perc.t.merge <- rbind(perc.t.merge, perc.t[[i]]) }

    #...................
    ### Result table ####

    result <- data.frame(rep(names(freq.a), each = nrow(freq.a[[1L]]), times = 4L),
                         rep(rownames(freq.a[[1L]]), times = 4L*length(freq.a)),
                         rep(c("Freq", "Row %", "Col %", "Tot %"), each = nrow(freq.a.merge)),
                         misty::as.na(rbind(freq.a.merge, perc.r.merge, perc.c.merge, perc.t.merge), na = "NaN", check = FALSE),
                         row.names = NULL, check.rows = FALSE, check.names = FALSE, fix.empty.names = FALSE)

    #...................
    ### Sort Table ####

    #### First and second variables are factors
    if (isTRUE(is.factor(x[, 1L]) && is.factor(x[, 2L]))) {

      ##### Sort with NA
      if (isTRUE(any(x.crosstab == "NA", na.rm = TRUE) && isTRUE(!na.omit))) {

        result <- result[order(factor(result[, 1L], levels = c(levels(x.crosstab[, 1L]), "NA"), labels = c(levels(x.crosstab[, 1L]), "NA")),
                               factor(result[, 2L], levels = c(levels(x.crosstab[, 2L]), "NA"), labels = c(levels(x.crosstab[, 2L]), "NA"))), ]

      ##### Sort without NA
      } else {

        result <- result[order(factor(result[, 1L], levels = levels(x.crosstab[, 1L]), labels = levels(x.crosstab[, 1L])),
                               factor(result[, 2L], levels = levels(x.crosstab[, 2L]), labels = levels(x.crosstab[, 2L]))), ]

      }

    #### First variable is a factor, second variable is not a factor
    } else if (isTRUE(is.factor(x[, 1L]) && !is.factor(x[, 2L]))) {

      ##### Sort with NA
      if (isTRUE(any(x.crosstab == "NA", na.rm = TRUE) && isTRUE(!na.omit))) {

        result.temp <- NULL
        for (i in unique(result[, 1L])) {

          temp <- result[result[, 1L] == i, ]

          temp.temp <- temp[-which(temp[, 2L] %in% c("NA", "Total")), ]

          # Second variable is numeric
          if (isTRUE(is.numeric(x[, 2L]))) {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(as.numeric(temp.temp[, 2L])), ], temp[which(temp[, 2L] == "NA"), ], temp[which(temp[, 2L] == "Total"), ]))

          # Second variable is character
          } else {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(temp.temp[, 2L]), ], temp[which(temp[, 2L] == "NA"), ], temp[which(temp[, 2L] == "Total"), ]))

          }

        }

        result <- result.temp

      ##### Sort without NA
      } else {

        result.temp <- NULL
        for (i in unique(result[, 1L])) {

          temp <- result[result[, 1L] == i, ]

          temp.temp <- temp[-which(temp[, 2L] == "Total"), ]

          # Second variable is numeric
          if (isTRUE(is.numeric(x[, 2L]))) {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(as.numeric(temp.temp[, 2L])), ], temp[which(temp[, 2L] == "Total"), ]))

          # Second variable is character
          } else {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(temp.temp[, 2L]), ], temp[which(temp[, 2L] == "Total"), ]))

          }

        }

        result <- result.temp

      }

    #### First variable is not a factor, second variable is a factor
    } else if (isTRUE(!is.factor(x[, 1L]) && is.factor(x[, 2L]))) {

      ##### Sort with NA
      if (isTRUE(any(x.crosstab == "NA", na.rm = TRUE) && isTRUE(!na.omit))) {

        # First variable is numeric
        if (isTRUE(is.numeric(x[, 1L]))) {

          result <- result[order(factor(result[, 1L], levels = c(sort(unique(as.numeric(suppressWarnings(misty::chr.omit(result[, 1L], omit = "NA"))))))),
                                 factor(result[, 2L], levels = c(levels(x.crosstab[, 2L]), "NA"), labels = c(levels(x.crosstab[, 2L]), "NA"))), ]


        # First variable is character
        } else {

          result <- result[order(factor(result[, 1L], levels = c(sort(unique(suppressWarnings(misty::chr.omit(result[, 1L], omit = "NA")))))),
                                 factor(result[, 2L], levels = c(levels(x.crosstab[, 2L]), "NA"), labels = c(levels(x.crosstab[, 2L]), "NA"))), ]

        }

      ##### Sort without NA
      } else {

        # First variable is numeric
        if (isTRUE(is.numeric(x[, 1L]))) {

          result <- result[order(factor(result[, 1L], levels = sort(unique(as.numeric(result[, 1L])))),
                                 factor(result[, 2L], levels = levels(x.crosstab[, 2L]), labels = levels(x.crosstab[, 2L]))), ]

        # First variable is character
        } else {

          result <- result[order(factor(result[, 1L], levels = sort(unique(result[, 1L]))),
                                 factor(result[, 2L], levels = levels(x.crosstab[, 2L]), labels = levels(x.crosstab[, 2L]))), ]

        }

      }

    #### First and second variables are not factors
    } else if (isTRUE(!is.factor(x[, 1L]) && !is.factor(x[, 2L]))) {

      ##### Sort with NA
      if (isTRUE(any(x.crosstab == "NA", na.rm = TRUE) && isTRUE(!na.omit))) {

        # NA in first variable
        if (isTRUE(any(result[, 1L] == "NA"))) {

          # First variable is numeric
          if (isTRUE(is.numeric(x[, 1L]))) {

            value.unique <- c(sort(as.numeric(suppressWarnings(misty::chr.omit(unique(result[, 1L]), omit = "NA", check = FALSE)))), "NA")

          # First variable is character
          } else {

            value.unique <- c(sort(suppressWarnings(misty::chr.omit(unique(result[, 1L]), omit = "NA", check = FALSE))), "NA")

          }

        # No NA in first variable
        } else {

          # First variable is numeric
          if (isTRUE(is.numeric(x[, 1L]))) {

            value.unique <- sort(as.numeric(unique(result[, 1L])))

          # First variable is character
          } else {

            value.unique <- sort(unique(result[, 1L]))

          }

        }

        result.temp <- NULL
        for (i in value.unique) {

          temp <- result[result[, 1L] == i, ]

          temp.temp <- temp[-which(temp[, 2L] %in% c("NA", "Total")), ]

          # Second variable is numeric
          if (isTRUE(is.numeric(x[, 2L]))) {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(as.numeric(temp.temp[, 2L])), ], temp[which(temp[, 2L] == "NA"), ], temp[which(temp[, 2L] == "Total"), ]))

          # Second variable is chracter
          } else {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(temp.temp[, 2L]), ], temp[which(temp[, 2L] == "NA"), ], temp[which(temp[, 2L] == "Total"), ]))

          }

        }

        result <- result.temp

      ##### Sort without NA
      } else {

        result.temp <- NULL
        for (i in unique(result[, 1L])) {

          temp <- result[result[, 1L] == i, ]

          temp.temp <- temp[-which(temp[, 2L] == "Total"), ]

          # Second variable is numeric
          if (isTRUE(is.numeric(x[, 2L]))) {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(as.numeric(temp.temp[, 2L])), ],  temp[which(temp[, 2L] == "Total"), ]))

          # Second variable is character
          } else {

            result.temp <- rbind(result.temp, rbind(temp.temp[order(temp.temp[, 2L]), ],  temp[which(temp[, 2L] == "Total"), ]))

          }

        }

        result <- result.temp

      }

    }

    #...................
    ### Add results for total ####

    result <- rbind(result,
                    setNames(data.frame(cbind("Total", suppressWarnings(crosstab(x[, c(2L, 3L)], as.na = as.na, na.omit = na.omit, check = FALSE, output = FALSE))$result$crosstab)), nm = colnames(result)))

    rownames(result) <- NULL

    #...................
    ### Return objects ####

    freq.a <- freq.a.merge
    perc.r <- perc.r.merge
    perc.c <- perc.c.merge
    perc.t <- perc.t.merge

  }

  #_____________________________________________________________________________
  #
  # Return Object --------------------------------------------------------------

  object <- list(call = match.call(),
                 type = "crosstab",
                 data = x.crosstab,
                 args = list(freq = freq, print = print, split = split, na.omit = na.omit,
                             digits = digits, as.na = as.na, check = check, output = output),
                 result = list(crosstab = result, freq.a = freq.a, perc.r = perc.r, perc.c = perc.c, perc.t = perc.t))

  class(object) <- "misty.object"

  #_____________________________________________________________________________
  #
  # write Result ---------------------------------------------------------------

  if (isTRUE(!is.null(write))) { misty::write.result(object, file = write) }

  #_____________________________________________________________________________
  #
  # Output ---------------------------------------------------------------------

  if (isTRUE(output)) { print(object, check = FALSE) }

  return(invisible(object))

}